Télécharger gflex0.eso

Retour à la liste

Numérotation des lignes :

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

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