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

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