Télécharger gflex1.eso

Retour à la liste

Numérotation des lignes :

  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
  103. CALL INTFR2(DCC,DSS,U2P,U2)
  104. SS=SS-DSS
  105. CC=CC-DCC
  106. ELSE
  107. CALL INTFRE(CC,SS,U2)
  108. ENDIF
  109. SC=SS-CC
  110. SC1=1.D0-SS-CC
  111. U=SQRT(U2)
  112. U3=U*U2
  113. U4=U*U3
  114. GG4=-RTETA*(U*SC+CDK)
  115. G3=0.5D0*SC1
  116. G2=RTETA*(SDK+U*SC1)
  117. G1=RTETA*(0.5D0*RTETA*SC+U*G2)
  118. G0=(2.D0/3.D0)*RTETA*(-RTETA*GG4+U*G1)
  119. GG3=TETA*(0.5D0*SC1-U*CDK-U2*SC)
  120. GG2=(2.D0/3.D0)*TETA*RTETA*(SDK+1.5D0*U*SC1-U2*CDK-U3*SC)
  121. GG1=TETA*RTETA*(1.5D0*SC+U*SDK+2.D0*(U3*CDK+U4*SC))/6.D0
  122. GG1=RTETA*(GG1+U*GG2)
  123. ENDIF
  124. IF(DELTAT.LE.DTM) THEN
  125. AB0=G0-GPL0
  126. GPL0=G0
  127. DELT=CSRF*DELTAT
  128. DELT2=DELT*DELT
  129. AB(6,L)=AB0
  130. AB(7,L)=GG1/DELT
  131. AB(8,L)=GG2/DELT
  132. AB(9,L)=GG3/DELT
  133. AB(10,L)=-AB0/DELT2
  134. ELSE
  135. G4=-STK*CDK
  136. AB(10,L)=G4-G4P
  137. G4P=G4
  138. AB(9,L)=G3-G3P
  139. G3P=G3
  140. AB(8,L)=G2-G2P
  141. G2P=G2
  142. AB(7,L)=G1-G1P
  143. G1P=G1
  144. AB(6,L)=G0-G0P
  145. G0P=G0
  146. ENDIF
  147. ENDIF
  148. 20 CONTINUE
  149. 40 CONTINUE
  150. C
  151. IF(DELTAT.GT.DTM) RETURN
  152. DO 70 I=7,10
  153. GP=AB(I,2)-2.D0*AB(I,1)
  154. DO 50 L=2,LANBN
  155. GA=AB(I,L+1)-2.D0*AB(I,L)+AB(I,L-1)
  156. AB(I,L-1)=GP
  157. GP=GA
  158. 50 CONTINUE
  159. AB(I,LANBN)=GP
  160. GP=0.D0
  161. DO 60 L=2,LANBN
  162. GA=0.5D0*(AB(I,L-1)+AB(I,L))
  163. AB(I,L-1)=GP
  164. GP=GA
  165. 60 CONTINUE
  166. AB(I,LANBN)=GP
  167. 70 CONTINUE
  168. C
  169. WRITE(IOIMP,*)' FIN DE GFLEX1 '
  170. RETURN
  171. END
  172.  
  173.  
  174.  
  175.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales