Download graco9.eso

Back to the list

   1 : C GRACO9    SOURCE    PV        09/11/05    21:15:19     6535           
   2 :       SUBROUTINE GRACO9(ith)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   5 : *                                                                               
   6 : *  extrait de graco7 pour pouvoir //
   7 : *                                                                               
   8 : -INC SMMATRI                                                                    
   9 : -INC SMVECTD
  10 : -INC CCOPTIO                                                                    
  11 :       common/cgraco9c/milign,mvect1,mvect2,inc,nbthr
  12 :       ithr=ith-1
  13 :       ino=ilign(/1)
  14 :       DO 2 I=1+ithr,INO,nbthr
  15 :       LLIGN=ILIGN(I)                                                            
  16 :       NA=IMMMM(/1)                   
  17 :       DO 121 JPA=1,IMMMM(/1)  
  18 :       P=0.D0 
  19 :       IPP=IPPO(JPA)                                       
  20 :       KPA=IPPO(JPA+1)-IPP                                 
  21 :       idli=0
  22 :       do ii=1,kpa
  23 :        idli=max(idli,linc(ippo(jpa)+ii))
  24 :       enddo
  25 :       Q=mvect2.VECTBb(IDLI)
  26 :       DO 122 MPA=1,KPA          
  27 :       LL=LINC(MPA+IPP) 
  28 :       if (ll.ne.idli)
  29 :      >mvect1.VECTBb(LL+inc*ithr)=mvect1.VECTBb(LL+inc*ithr)+ 
  30 :      >  Q*XXVA(MPA+IPP)
  31 :       P = P + mvect2.VECTBb(LL)*XXVA(MPA+IPP)
  32 : 122   CONTINUE  
  33 :       mvect1.VECTBb(IDLI+inc*ithr)=mvect1.vectbb(idli+inc*ithr)+p
  34 : 121   CONTINUE                                                                  
  35 :   2   CONTINUE                                                                                                                                                                                
  36 :       RETURN                                                                    
  37 :       END       
  38 :                                                                  
  39 :  
  40 :  

© Cast3M 2003 - All rights reserved.
Disclaimer