Download supde2.eso

Back to the list

   1 : C SUPDE2    SOURCE    CHAT      05/01/13    03:26:46     5004           
   2 :       SUBROUTINE SUPDE2(IPPVV,IVPO,VAL,VECTBB,
   3 :      >  NA,inumli,inbine,ipremf,IPREL)
   4 : 
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       DIMENSION IPPVV(1),IVPO(1),VAL(1),VECTBB(1)
   8 : 
   9 :            inumli = IPREL
  10 :            NA1 = max(1,(ipremf-inumli+1))
  11 :            if (NA1 .ne. 1) inumli = ipremf
  12 :            do 20 ii1=NA1,NA
  13 :              aux = 0.D0
  14 :              ibldeb = ippvv(ii1)
  15 :              iblfin = ippvv(ii1+1) - 1
  16 :              iposd  = ivpo((2*ibldeb)-1)
  17 :              iposf  = ivpo((2*(iblfin+1))-1)-1
  18 :              ilong = iposf - iposd + 1
  19 :              ideb0 = inumli - ilong
  20 :              do 30 ii2=ibldeb,iblfin
  21 :                icol = ivpo((2*ii2)-1) + ideb0 - iposd + 1
  22 :                ifc =  ivpo((2*(ii2+1))-1) + ideb0 - iposd
  23 :                if (ifc .lt. ipremf) GOTO 30
  24 :                ideb1 = ivpo(2*ii2)
  25 :                ifin1 = ivpo(2*(ii2+1))-1
  26 :                if (icol .lt. ipremf) then
  27 :                    ideb1 = ideb1+ipremf-icol
  28 :                    icol = ipremf
  29 :                end if
  30 :                if (ifc .eq. inumli) ifin1 = ifin1 - 1
  31 :                if (ideb1 .gt. ifin1) GOTO 31
  32 :                do 40 ii3=ideb1,ifin1
  33 :                    aux = aux + VECTBB(icol) * VAL(ii3)
  34 :                    icol = icol + 1
  35 :  40            continue
  36 :  31          continue
  37 :  30          continue
  38 :              VECTBB(inumli) = VECTBB(inumli) - aux
  39 :              inumli = inumli + 1
  40 :              if (inumli .gt. inbine) GOTO 10
  41 :  20        continue
  42 :  10        continue 
  43 :            return
  44 :            end
  45 :  
  46 :  
  47 :  
  48 :  

© Cast3M 2003 - All rights reserved.
Disclaimer