1 : C GFLEX1 SOURCE CHAT 05/01/13 00:18:02 5004 2 : SUBROUTINE GFLEX1(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 CREATION : 21/09/87 10 : C PROGRAMMEUR : GUILBAUD 11 : C ===================================================================== 12 : -INC CCOPTIO 13 : -INC CCREEL 14 : DIMENSION AB(10,*) 15 : WRITE(IOIMP,*) ' DEBUT DE GFLEX1 ' 16 : PIS4=XPI*0.25D0 17 : RPI=1.D0/SQRT(XPI) 18 : XP=1.D0 19 : XG=20.D0 20 : XTG=200.D0 21 : C 22 : C--------BOUCLE SUR LES PAS DE TEMPS ------------------------- 23 : C 24 : GP4=0.D0 25 : GP3=0.D0 26 : GP2=0.D0 27 : GP1=0.D0 28 : GP0=0.D0 29 : GPL0=0.D0 30 : G4P=0.D0 31 : G3P=0.D0 32 : G2P=0.D0 33 : G1P=0.D0 34 : G0P=0.D0 35 : DTM=DLL*DLL/(3.D0*CTC*RF*XPI) 36 : LANBN1=LANBN+1 37 : DO 40 L=1,LANBN1 38 : T=L*DELTAT 39 : C 40 : C--------BOUCLE SUR LES EXTREMITES---------------------------- 41 : C 42 : DO 20 NE=1,2 43 : DL=0.D0 44 : IF(NE.EQ.2) DL=DLL 45 : DKSI=DL/RF 46 : CSRF=CTC/RF 47 : TETA=CSRF*T 48 : RTETA=SQRT(TETA) 49 : STK=0.5D0/RTETA 50 : U2=DKSI*DKSI/(4.D0*TETA) 51 : SDK=RPI*SIN(U2-PIS4) 52 : CDK=RPI*COS(U2-PIS4) 53 : IF(NE.EQ.1) THEN 54 : C 55 : C PREMIERE EXTREMITE 56 : C 57 : G4=-STK*CDK 58 : G3=0.5D0 59 : G2=RTETA*SDK 60 : G1=0.D0 61 : G0=(2.D0/3.D0)*RTETA*TETA*CDK 62 : AB4=G4-GP4 63 : GP4=G4 64 : AB3=G3-GP3 65 : GP3=G3 66 : AB2=G2-GP2 67 : GP2=G2 68 : AB1=G1-GP1 69 : GP1=G1 70 : AB0=G0-GP0 71 : GP0=G0 72 : AB(1,L)=AB0 73 : AB(2,L)=AB1 74 : AB(3,L)=AB2 75 : AB(4,L)=AB3 76 : AB(5,L)=AB4 77 : ELSE 78 : C 79 : C SECONDE EXTREMITE 80 : C 81 : IF(U2.GT.XTG) THEN 82 : TK=2.D0*TETA/DKSI 83 : TK1=STK*TK 84 : TK2=TK1*TK 85 : TK3=TK2*TK 86 : TK4=TK3*TK 87 : TK5=TK4*TK 88 : TK6=TK5*TK 89 : G3=-TK1*SDK 90 : G2=TK2*CDK 91 : G1=TK3*SDK 92 : G0=-TK4*CDK 93 : GG3=-TK3*CDK 94 : GG2=-TK4*SDK 95 : GG1= TK5*CDK 96 : ELSE 97 : IF(T.EQ.DELTAT) THEN 98 : U2P=XG+1.D0 99 : ELSE 100 : U2P=DKSI*DKSI/(4.D0*CSRF*(T-DELTAT)) 101 : ENDIF 102 : IF(U2.GT.XP.AND.U2P.LT.XG) THEN 102 : CALL INTFR2(DCC,DSS,U2P,U2) 103 : SS=SS-DSS 104 : CC=CC-DCC 105 : ELSE 105 : CALL INTFRE(CC,SS,U2) 106 : ENDIF 107 : SC=SS-CC 108 : SC1=1.D0-SS-CC 109 : U=SQRT(U2) 110 : U3=U*U2 111 : U4=U*U3 112 : GG4=-RTETA*(U*SC+CDK) 113 : G3=0.5D0*SC1 114 : G2=RTETA*(SDK+U*SC1) 115 : G1=RTETA*(0.5D0*RTETA*SC+U*G2) 116 : G0=(2.D0/3.D0)*RTETA*(-RTETA*GG4+U*G1) 117 : GG3=TETA*(0.5D0*SC1-U*CDK-U2*SC) 118 : GG2=(2.D0/3.D0)*TETA*RTETA*(SDK+1.5D0*U*SC1-U2*CDK-U3*SC) 119 : GG1=TETA*RTETA*(1.5D0*SC+U*SDK+2.D0*(U3*CDK+U4*SC))/6.D0 120 : GG1=RTETA*(GG1+U*GG2) 121 : ENDIF 122 : IF(DELTAT.LE.DTM) THEN 123 : AB0=G0-GPL0 124 : GPL0=G0 125 : DELT=CSRF*DELTAT 126 : DELT2=DELT*DELT 127 : AB(6,L)=AB0 128 : AB(7,L)=GG1/DELT 129 : AB(8,L)=GG2/DELT 130 : AB(9,L)=GG3/DELT 131 : AB(10,L)=-AB0/DELT2 132 : ELSE 133 : G4=-STK*CDK 134 : AB(10,L)=G4-G4P 135 : G4P=G4 136 : AB(9,L)=G3-G3P 137 : G3P=G3 138 : AB(8,L)=G2-G2P 139 : G2P=G2 140 : AB(7,L)=G1-G1P 141 : G1P=G1 142 : AB(6,L)=G0-G0P 143 : G0P=G0 144 : ENDIF 145 : ENDIF 146 : 20 CONTINUE 147 : 40 CONTINUE 148 : C 149 : IF(DELTAT.GT.DTM) RETURN 150 : DO 70 I=7,10 151 : GP=AB(I,2)-2.D0*AB(I,1) 152 : DO 50 L=2,LANBN 153 : GA=AB(I,L+1)-2.D0*AB(I,L)+AB(I,L-1) 154 : AB(I,L-1)=GP 155 : GP=GA 156 : 50 CONTINUE 157 : AB(I,LANBN)=GP 158 : GP=0.D0 159 : DO 60 L=2,LANBN 160 : GA=0.5D0*(AB(I,L-1)+AB(I,L)) 161 : AB(I,L-1)=GP 162 : GP=GA 163 : 60 CONTINUE 164 : AB(I,LANBN)=GP 165 : 70 CONTINUE 166 : C 167 : WRITE(IOIMP,*)' FIN DE GFLEX1 ' 168 : RETURN 169 : END 170 : 171 : 172 :
© Cast3M 2003 - All rights reserved.
Disclaimer