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

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