Download supde1.eso

Back to the list

   1 : C SUPDE1    SOURCE    CHAT      05/01/13    03:26:41     5004           
   2 :       SUBROUTINE SUPDE1(IPPVV,IVPO,VAL,VECTBB,VECTAA,
   3 :      > na,inumli,inbine,iprel,ifib)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8 (A-H,O-Z)
   6 :       DIMENSION IPPVV(1),IVPO(1),VAL(1),VECTBB(1),VECTAA(1)
   7 : c procedure complémentaire de SUPDEP
   8 : c
   9 :       IMOI1 = IVPO(2*IPPVV(NA+1)-1)                                             
  10 :       DO 50 ILM=NA,1,-1                                                         
  11 :        II=IPREL-1+ILM                                                           
  12 :        IDEB2=IPPVV(ILM)*2                                                       
  13 :        IMOI2= IVPO(IDEB2-1)                                                     
  14 :        LLOM=IMOI1-IMOI2-1                                                       
  15 :        IF (LLOM.GT.0) THEN                                                      
  16 :         IPOSM=IMOI2-1                                                           
  17 :         VKON=VECTAA(II)                                                         
  18 :         IPLAC=IVPO(IDEB2)-1                                                     
  19 :         IDEBZ=1                                                                 
  20 :         IPLAC2=II-LLOM-1                                                        
  21 :         DO 2 IDEB3=IDEB2,IFIB,2                                                 
  22 :         IMOI = IVPO ( IDEB3 +2)                                                 
  23 :         ILONZ=IMOI -IPLAC-IDEBZ                                                 
  24 :         IPLAC=IPLAC-IPLAC2                                                      
  25 :         IDEBZC=IDEBZ+IPLAC2
  26 :         ifu = MIN(IDEBZC+ILONZ,II)-1    
  27 :         ifu = min( ifu,inbine)                                                     
  28 :         DO 1 L=IDEBZC,ifu                                  
  29 :          VECTBB(L)=VECTBB(L)-VKON*VAL(IPLAC+L)                                  
  30 :    1    CONTINUE                                                                
  31 :         IF (IDEBZ.GE.LLOM) GOTO 3                                               
  32 :         IDEBZ=IVPO(IDEB3+1)-IPOSM                                               
  33 :         IPLAC=IMOI-IDEBZ                                                        
  34 :    2    CONTINUE                                                                
  35 :    3    CONTINUE   
  36 :        ENDIF                                                                    
  37 :       IMOI1=IMOI2    
  38 :           if ((inumli.le.(inbine+1)) .and. (inumli .ne. 1))
  39 :      &    VECTAA(inumli-1) = VECTBB(inumli-1)
  40 :           inumli = inumli - 1                                                           
  41 :   50  CONTINUE      
  42 : 
  43 :   
  44 : 
  45 :            return
  46 :            end
  47 :  
  48 :  
  49 :  
  50 :  

© Cast3M 2003 - All rights reserved.
Disclaimer