Download kaam.eso

Back to the list

   1 : C KAAM      SOURCE    CHAT      05/01/13    00:50:19     5004           
   2 :       SUBROUTINE KAAM(FN,HR,PG,PGSQ,AM,K,NEL,NP,NPG,IES,IAXI,RPG)
   3 : C************************************************************************       
   4 : C   CALCUL DE LA MATRICE M ( P*DIV(U) )  --> AM(NEL,NP,IES)
   5 : C                                                                               
   6 : C************************************************************************       
   7 :       IMPLICIT INTEGER(I-N)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   9 :                                                                                 
  10 : C***                                                                            
  11 :       DIMENSION FN(NP,NPG),HR(IES,NP,NPG),PG(NPG),PGSQ(NPG),RPG(NPG)            
  12 :       DIMENSION AM(NEL,NP,IES)
  13 : C?    DIMENSION PORO(NPR,*)                                                     
  14 : C?    DIMENSION LE(NP),IPADL(*)                                                 
  15 : C***                                                                            
  16 :                                                                                 
  16 :       IF(IAXI.EQ.0)CALL INITD(RPG,NPG,1.D30)                                    
  17 :                                                                                 
  18 :       DO 20 N=1,IES                                                             
  19 :       IAX=0                                                                     
  20 :       IF((3-IAXI).EQ.N)IAX=1                                                    
  21 :       IF(IES.EQ.3)IAX=0                                                         
  22 :                                                                                 
  23 :       IF(IAX.EQ.0)THEN                                                          
  24 :                                                                                 
  25 :       DO 2 J=1,NP                                                               
  26 :       SJ=0.D0                                                                   
  27 : C?    NF=IPADL(LE(J))                                                           
  28 : C?    NFP=IPOR*(NF-1)+1                                                         
  29 :       DO 1 L=1,NPG                                                              
  30 :  1    SJ=SJ+HR(N,J,L)*PGSQ(L)                                                   
  31 :       AM(K,J,N)=SJ
  32 : C?    AM(K,J,N)=SJ*PORO(N,NFP)
  33 :  2    CONTINUE                                                                  
  34 :                                                                                 
  35 :       ELSE                                                                      
  36 :                                                                                 
  37 :       DO 12 J=1,NP                                                              
  38 :       SJ=0.D0                                                                   
  39 : C?    NF=IPADL(LE(J))                                                           
  40 : C?    NFP=IPOR*(NF-1)+1                                                         
  41 :       DO 11 L=1,NPG                                                             
  42 :  11   SJ=SJ+(HR(N,J,L)+FN(J,L)/RPG(L))*PGSQ(L)                                  
  43 :       AM(K,J,N)=SJ
  44 : C?    AM(K,J,N)=SJ*PORO(N,NFP)
  45 :  12   CONTINUE                                                                  
  46 :                                                                                 
  47 :       ENDIF                                                                     
  48 :  20   CONTINUE                                                                  
  49 :                                                                                 
  50 : C                                                                               
  51 : C                                                                               
  52 :       RETURN                                                                    
  53 :  1001 FORMAT(20(1X,I5))                                                         
  54 :  1002 FORMAT(10(1X,1PE11.4))                                                    
  55 :       END                                                                       
  56 :  

© Cast3M 2003 - All rights reserved.
Disclaimer