Results 1 to 4 of 4

vba code running too slow

Threaded View

  1. #1
    Registered User
    Join Date
    03-07-2013
    Location
    london
    MS-Off Ver
    Excel 2003
    Posts
    2

    Post vba code running too slow

    Hi,
    i am trying to solve non-linear equations using gauss-siedel. somehow, the code take longer to run. please advise thanks


    Option Explicit
    Sub crossisedel()
    
    
    Dim y(0 To 10, 1 To 2) As Variant
    Dim x(0 To 10, 1 To 2) As Variant
    Dim Q(0 To 10, 1 To 2) As Variant
    Dim ff(10), fp(10), pr(10), P(2), pf(10), counter, im1, retentate(10), fr(10), theta, pp(10), i, j As Double
    
    Dim alpha, area, currentcell, areaperstage, nostages, nocomponents, errmax, maxItteration, Err1, Err2, Err3 As Long
    
    
    
    currentcell = 5
    area = 1000
    areaperstage = 100
    nostages = 10
    nocomponents = 2
    P(1) = 0.00001
    P(2) = 0.000001
    ff(0) = 100
    pf(0) = 760
    pp(10) = 76
    x(0, 1) = 0.21
    x(0, 2) = 0.79
    errmax = 0.0001
    maxItteration = 100
    alpha = 0.1
    
    'flowfeed=ff
    'pressurefeed=pf
    'flowretentate=fr
    'pressureretentate=pr
    'flowpermeate=fp
    'pressurepermeate=pp
    
           For i = 1 To 10
        
            For j = 1 To 2
            im1 = i - 1
            fr(im1) = 100
            pf(0) = 76
            'Permeation flow at each stages
            Q(i, j) = area * (P(j) * x(im1, j) - alpha * y(i, j))
            'Feed compostion at each stages
            x(i, j) = (fr(im1) * x(im1, j) - Q(i, j) / (fr(im1) - Q(i, j)))
            'calculate the theta
            theta = Q(i, j) / ff(0)
                'Permeate composition at each stages
           y(i, j) = ((P(j) * pf(0) * x(im1, j) / theta) / (Q(i, j) + pp(10) * P(j) + P(j) * pf(0) * (1 - theta) / theta))
            
                
            Next j
           Next i
        ReDim x_new(1 To 10, 1 To 2), y_new(1 To 10, 1 To 2), Q_new(0 To 10, 1 To 2) As Long
        
            
         counter = 0  ' counter to handle indifinite loop
        
        
          For i = 1 To 10
            For j = 1 To 2
          Err1 = 1
          Err2 = 1
          Err3 = 1
          
          Q(i, j) = 0
          x(i, j) = 0
          y(i, j) = 0
          
        errmax = 0.000001
        Do Until ((Err1 < errmax) And (Err2 < errmax) And (Err3 < errmax))
        
        'Estimate  permeate flow composition
         Q_new(i, j) = area * (P(j) * x(i - 1, j) - alpha * y(i, j))
        'Estimate feed composition
        x_new(i, j) = (fr(im1) * x(im1, j) - Q_new(i, j)) / (fr(im1) - Q_new(i, j))
        'Estimate permeate compostion
        y_new(i, j) = ((P(j) * pf(0) * x(im1, j) / theta) / (Q_new(i, j) + pp(i) * P(j) + P(j) * pf(0) * (1 - theta) / theta))
        
        'Estimate error
        Err1 = Abs((Q_new(i, j) - Q(i, j) / (Q(i, j) + 0.001)))
        Err2 = Abs((x_new(i, j) - x(i, j) / (x(i, j) + 0.001)))
        Err3 = Abs((y_new(i, j) - y(i, j) / (y(i, j) + 0.001)))
        
        Q(i, j) = Q_new(i, j)
        x(i, j) = x_new(i, j)
        y(i, j) = y_new(i, j)
        
        counter = counter + 1
        If (counter > maxItteration) Then
        Sheet2.Range("b10").Value = "diverges"
        
      
     End If
       Loop
      
    
    Sheets("sheet2").Range("b" & i + currentcell).Value = Q(i, 1)
    Sheets("sheet2").Range("c" & i + currentcell).Value = Q(i, 2)
    Sheets("sheet2").Range("c" & i + currentcell).Value = x(i, 1)
    Sheets("sheet2").Range("d" & i + currentcell).Value = x(i, 2)
    Sheets("sheet2").Range("e" & i + currentcell).Value = y(i, 1)
    Sheets("sheet2").Range("f" & i + currentcell).Value = y(i, 2)
    Next j
    Next i
    
    
    End Sub
    Last edited by hitsujicute; 03-31-2013 at 06:22 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1