1 : C RICOQ SOURCE CHAT 05/01/13 02:56:17 5004 2 : SUBROUTINE RICOQ(RE,XA,HM,E,RIGL,REP,REM,P,XE,YE,ZE,XX,YY,RAI) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : DIMENSION E(3,3),RIGL(18,18),REP(9,9),REM(6,6), 6 : 1P(3,3),XE(3),YE(3),ZE(3),XX(3,3),YY(3,3) 7 : DIMENSION RE(18,18),XA(3,3) 8 : DATA EPSI/1.E-9/ 9 : * 10 : DO9I=1,18 11 : DO9J=1,18 12 : RE(I,J)=0.D0 13 : 9 RIGL(I,J)=0.D0 14 : DO 1 I=1,3 15 : XE(I)=XA(1,I) 16 : YE(I)=XA(2,I) 17 : 1 ZE(I)=XA(3,I) 17 : CALL PASSA(XE,YE,ZE, P,X13,X23,Y13,Y23) 18 : S=0.5*Y13*(X13-X23) 19 : * SPECIAL RIGI PSI Z 20 : RKZ= RAI*HM*S*EPSI 20 : CALL RICOQ0(RIGL,X13,X23,Y13,Y23,RKZ) 21 : * 21 : CALL RIMT6(REM,E,RAI,X13,X23,Y13,HM,S) 22 : DO100I=1,6 23 : DO100J=I,6 24 : 100 REM(J,I)=REM(I,J) 24 : CALL RIPP9(REP,E,RAI,X13,X23,Y13,HM,S) 25 : DO101I=1,9 26 : DO101J=I,9 27 : 101 REP(J,I)=REP(I,J) 28 : DO2K=1,3 29 : K1=K-1 30 : DO2L=K,3 31 : L1=L-1 32 : DO 3 I=1,2 33 : M=6*K1+I 34 : ML=2*K1+I 35 : DO 3 J=1,2 36 : N=6*L1+J 37 : NL=2*L1+J 38 : 3 RIGL(M,N)=RIGL(M,N)+REM(ML,NL) 39 : DO 4 I=1,3 40 : M=6*K1+2+I 41 : ML=3*K1+I 42 : DO 4 J=1,3 43 : N=6*L1+J+2 44 : NL=3*L1+J 45 : 4 RIGL(M,N)=RIGL(M,N)+REP(ML,NL) 46 : 2 CONTINUE 47 : DO 6 K=1,6 48 : K1=3*(K-1) 49 : DO6L=K,6 50 : L1=3*(L-1) 51 : DO 7 I=1,3 52 : IM=I+K1 53 : DO 7 J=1,3 54 : JM=J+L1 55 : 7 XX(I,J)=RIGL(IM,JM) 55 : CALL PRODT(YY,XX,P,3,3) 56 : DO 8 I=1,3 57 : IM=I+K1 58 : DO 8 J=1,3 59 : JM=J+L1 60 : 8 RE(IM,JM)=YY(I,J) 61 : 6 CONTINUE 62 : DO 10 I=1,18 63 : DO 10 J=1,I 64 : 10 RE(I,J)=RE(J,I) 65 : * DO 555 I=1,18 66 : * WRITE(6,77882) I 67 : *77882 FORMAT('0 LIGNE ',I4//) 68 : * WRITE(6,77881) ( RE(I,J),J=1,18) 69 : *77881 FORMAT(1X,6(1X,1PE12.5)/) 70 : *555 CONTINUE 71 : RETURN 72 : END 73 :
© Cast3M 2003 - All rights reserved.
Disclaimer