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