Download zgmv.eso

Back to the list

   1 : C ZGMV      SOURCE    CHAT      05/01/13    04:22:59     5004           
   2 :       SUBROUTINE ZGMV(LE,NEL,K0,NPT,IES,NP,IAXI,IPADL,
   3 :      &                 COEF,XNM,GX,VOL)
   4 : C                                                                               
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   7 : C***********************************************************************        
   8 : C                                                                               
   9 : C                                                BETA                           
  10 : C     CALCUL LE TENSEUR DE PERTE DE CHARGE    K U           I KX       I        
  11 : C                                                     K-->  I    KY    I        
  12 : C                                                           I       KZ I        
  13 : C                                                                               
  14 : C     COEFF    :  K                                                             
  15 : C     COG1     :  BETA                                                          
  16 : C     P        :  MATRICE DE ROTATION (INDG3 NE 0)                              
  17 : C                                                                               
  18 : C     PORO     :  POROSITES SI IPOR=1                                           
  19 : C                                                                               
  20 : C                                                                               
  21 : C                                                                               
  22 : C***********************************************************************        
  23 : C                                                                               
  24 :       DIMENSION LE(NP,*),IPADL(*)
  25 :       DIMENSION XNM(NPT,IES),GX(NPT,IES)
  26 :       DIMENSION COEF(IES)
  27 :       DIMENSION VOL(*)                                                          
  28 : C                                                                               
  29 :                                                                                 
  30 :                                                                                 
  31 :       IF(IES.EQ.2) THEN                                                         
  32 : C                                                                               
  33 : C                 *******                                                       
  34 : C                 * 2 D *                                                       
  35 : C                 *******                                                       
  36 : C                                                                               
  37 : C     write(6,*)' NPT=',NPT,' IES=',IES
  38 : C     write(6,*)' NEL=',NEL,KJG1,KJTT,KJG3,INDG3
  39 :       DO 502 K=1,NEL                                                            
  40 :       NK=K+K0                                                                   
  41 :       S=VOL(NK)/NP
  42 :       S1=-COEF(1)*S
  43 :       S2=-COEF(2)*S
  44 :                                                                                 
  45 :       DO 572 I=1,NP                                                             
  46 :       IU=IPADL(LE(I,K))                                                         
  47 :       GX(IU,1)=GX(IU,1)+S1
  48 :       GX(IU,2)=GX(IU,2)+S2
  49 :  572  CONTINUE                                                                  
  50 : C                                                                               
  51 :  502  CONTINUE                                                                  
  52 : 
  53 : C     write(6,*)' S1 et s2=',S1,S2
  54 : C     write(6,1002)GX
  55 : 
  56 :       ELSEIF(IES.EQ.3)THEN                                                      
  57 :                                                                                 
  58 : C                                                                               
  59 : C                 *******                                                       
  60 : C                 * 3 D *                                                       
  61 : C                 *******                                                       
  62 : C                                                                               
  63 :       DO 602 K=1,NEL
  64 :       NK=K+K0                                                                   
  65 :       S=VOL(NK)/NP
  66 :       S1=-COEF(1)*S
  67 :       S2=-COEF(2)*S
  68 :       S3=-COEF(3)*S
  69 :                                                                                 
  70 :       DO 672 I=1,NP
  71 :       IU=IPADL(LE(I,K))                                                         
  72 :       GX(IU,1)=GX(IU,1)+S1
  73 :       GX(IU,2)=GX(IU,2)+S2
  74 :       GX(IU,3)=GX(IU,3)+S3
  75 :  672  CONTINUE
  76 : C                                                                               
  77 :  602  CONTINUE
  78 :       RETURN
  79 :       ENDIF                                                                     
  80 :                                                                                 
  81 :                                                                                 
  82 : C     WRITE(6,*)' GX         ',((GX(I,J),I=1,N1),J=1,N2)                        
  83 : C                                                                               
  84 :       RETURN                                                                    
  85 :  110  FORMAT(2X,'ZGMV',I4,4E13.5)
  86 :  1001 FORMAT(20(1X,I5))                                                         
  87 :  1002 FORMAT(10(1X,1PE11.4))                                                    
  88 :       END                                                                       
  89 :  

© Cast3M 2003 - All rights reserved.
Disclaimer