1 : C GFLEX0 SOURCE CHAT 05/01/13 00:17:58 5004 2 : SUBROUTINE GFLEX0(AB,DLL,RF,CTC,DELTAT,LANBN) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C ===================================================================== 7 : C SOUS-PROGRAMME FORTRAN APPELE PAR GREEN1 POUR CALCULER LES FCTS DE 8 : C GREEN EN FLEXION 9 : C 10 : C LES MODIFICATIONS APPORTEES AU PROGRAMME GFLEX1 SONT LES SUIVANTES: 11 : C LE CALCUL DES INTEGRALES DE FRESNEL EST REALISE PAR LA METHODE 12 : C DE LANCZOS (SUBROUTINE FRESNE) 13 : C 14 : C LES VALEURS DE LA FONCTION DE GREEN ET DE SES DERIVEES EN L AU 15 : C PREMIER PAS DE TEMPS NE SONT PAS NULLES 16 : C 17 : C CREATION : 21/09/87 18 : C PROGRAMMEUR : VACELET (10/03/89) 19 : C ===================================================================== 20 : -INC CCOPTIO 21 : -INC CCREEL 22 : DIMENSION AB(10,*),CC(1),SS(1),U2(1) 23 : WRITE(IOIMP,*) ' DEBUT DE GFLEX0 ' 24 : PIS4=XPI*0.25D0 25 : RPI=1.D0/SQRT(XPI) 26 : C 27 : C--------BOUCLE SUR LES PAS DE TEMPS ------------------------- 28 : C 29 : GP4=0.D0 30 : GP3=0.D0 31 : GP2=0.D0 32 : GP1=0.D0 33 : GP0=0.D0 34 : GPL0=0.D0 35 : G4P=0.D0 36 : G3P=0.D0 37 : G2P=0.D0 38 : G1P=0.D0 39 : G0P=0.D0 40 : DTM=DLL*DLL/(3.D0*CTC*RF*XPI) 41 : LANBN1=LANBN+1 42 : DO 40 L=1,LANBN1 43 : T=L*DELTAT 44 : C 45 : C--------ETUDE DES DEUX EXTREMITES---------------------------- 46 : C 47 : DO 20 NE=1,2 48 : C 49 : C PREMIERE EXTREMITE 50 : C 51 : C 52 : IF(NE.EQ.1) THEN 53 : C 54 : DL=0.D0 55 : DKSI=DL/RF 56 : CSRF=CTC/RF 57 : TETA=CSRF*T 58 : RTETA=SQRT(TETA) 59 : STK=0.5D0/RTETA 60 : U2(1)=DKSI*DKSI/(4.D0*TETA) 61 : SDK=RPI*SIN(U2(1)-PIS4) 62 : CDK=RPI*COS(U2(1)-PIS4) 63 : C 64 : G4=-STK*CDK 65 : G3=0.5D0 66 : G2=RTETA*SDK 67 : G1=0.D0 68 : G0=(2.D0/3.D0)*RTETA*TETA*CDK 69 : C 70 : AB4=G4-GP4 71 : GP4=G4 72 : AB3=G3-GP3 73 : GP3=G3 74 : AB2=G2-GP2 75 : GP2=G2 76 : AB1=G1-GP1 77 : GP1=G1 78 : AB0=G0-GP0 79 : GP0=G0 80 : C 81 : AB(1,L)=AB0 82 : AB(2,L)=AB1 83 : AB(3,L)=AB2 84 : AB(4,L)=AB3 85 : AB(5,L)=AB4 86 : ELSE 87 : C 88 : C SECONDE EXTREMITE 89 : C 90 : DL=DLL 91 : DKSI=DL/RF 92 : CSRF=CTC/RF 93 : TETA=CSRF*T 94 : RTETA=SQRT(TETA) 95 : STK=0.5D0/RTETA 96 : U2(1)=DKSI*DKSI/(4.D0*TETA) 97 : SDK=RPI*SIN(U2(1)-PIS4) 98 : CDK=RPI*COS(U2(1)-PIS4) 99 : C 99 : CALL FRESNE(CC,SS,U2,1) 100 : C 101 : U=SQRT(U2(1)) 102 : U3=U*U2(1) 103 : U4=U*U3 104 : SC=SS(1)-CC(1) 105 : SC1=1.D0-SS(1)-CC(1) 106 : C 107 : GG=RTETA*(CDK+U*SC) 108 : G4=-STK*CDK 109 : G3=0.5D0*SC1 110 : G2=RTETA*(SDK+U*SC1) 111 : G1=RTETA*(0.5D0*RTETA*SC+U*G2) 112 : G0=(2.D0/3.D0)*RTETA*(RTETA*GG+U*G1) 113 : C 114 : GG3=TETA*(0.5D0*SC1-U*CDK-U2(1)*SC) 115 : GG2=(2.D0/3.D0)*TETA*RTETA*(SDK+1.5D0*U*SC1-U2(1)*CDK-U3*SC) 116 : GG1=TETA*RTETA*(1.5D0*SC+U*SDK+2.D0*(U3*CDK+U4*SC))/6.D0 117 : GG1=RTETA*(GG1+U*GG2) 118 : C 119 : IF(DELTAT.LE.DTM) THEN 120 : AB0=G0-GPL0 121 : GPL0=G0 122 : DELT=CSRF*DELTAT 123 : DELT2=DELT*DELT 124 : AB(6,L)=AB0 125 : AB(7,L)=GG1/DELT 126 : AB(8,L)=GG2/DELT 127 : AB(9,L)=GG3/DELT 128 : AB(10,L)=-AB0/DELT2 129 : ELSE 130 : AB(10,L)=G4-G4P 131 : G4P=G4 132 : AB(9,L)=G3-G3P 133 : G3P=G3 134 : AB(8,L)=G2-G2P 135 : G2P=G2 136 : AB(7,L)=G1-G1P 137 : G1P=G1 138 : AB(6,L)=G0-G0P 139 : G0P=G0 140 : ENDIF 141 : ENDIF 142 : 20 CONTINUE 143 : 40 CONTINUE 144 : C 145 : IF(DELTAT.GT.DTM) RETURN 146 : DO 70 I=7,10 147 : GP=AB(I,2)-2.D0*AB(I,1) 148 : DO 50 L=2,LANBN 149 : GA=AB(I,L+1)-2.D0*AB(I,L)+AB(I,L-1) 150 : AB(I,L-1)=GP 151 : GP=GA 152 : 50 CONTINUE 153 : AB(I,LANBN)=GP 154 : GP=AB(I,1) 155 : DO 60 L=2,LANBN 156 : GA=0.5D0*(AB(I,L-1)+AB(I,L)) 157 : AB(I,L-1)=GP 158 : GP=GA 159 : 60 CONTINUE 160 : AB(I,LANBN)=GP 161 : 70 CONTINUE 162 : C 163 : C 164 : C 165 : WRITE(IOIMP,*)' FIN DE GFLEX0 ' 166 : RETURN 167 : END 168 : 169 : 170 :
© Cast3M 2003 - All rights reserved.
Disclaimer