Télécharger elpd99.eso

Retour à la liste

Numérotation des lignes :

  1. C ELPD99 SOURCE KK2000 14/04/09 21:15:23 8027
  2. SUBROUTINE ELPD99(XBORD,IBORD,NS
  3. & ,XCOIN,ICOIN,NC,NC1
  4. & ,CRE,CPOST,CRP ,NS4
  5. & ,XD,XNU,NTRAP,PF0,XF0,PP0,NP0,CB,ISTAT )
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8(A-B,D-H,O-Z)
  8. IMPLICIT COMPLEX*16(C)
  9. ************************************************************************
  10. *
  11. * PLAQUES PAR EQUATION INTEGRALE:
  12. *
  13. * CALCUL DU DEPLACEMENT EN UN POINT
  14. * OU UN MAILLAGE PAR POST-TRAITEMENT
  15. *
  16. *
  17. ************************************************************************
  18. -INC CCOPTIO
  19. *
  20. DIMENSION XBORD(15,*)
  21. DIMENSION IBORD (2 ,*)
  22. DIMENSION XCOIN(14,*)
  23. DIMENSION ICOIN(4 ,*)
  24. DIMENSION CRE (*)
  25. DIMENSION CRP (*)
  26. DIMENSION CPOST (*)
  27. *
  28. DIMENSION PP0(2,*)
  29. DIMENSION PF0(2)
  30. C DIMENSION P0(2)
  31. DIMENSION PP1(2)
  32. DIMENSION A (2)
  33. DIMENSION B (2)
  34. DIMENSION OAB (2)
  35. DIMENSION Q (2)
  36. *
  37. DIMENSION XN (2)
  38. DIMENSION XN0(2)
  39. DIMENSION XN1(2)
  40. DIMENSION XN2(2)
  41. *
  42. DIMENSION XT (2)
  43. DIMENSION XT0(2)
  44. DIMENSION XT1(2)
  45. DIMENSION XT2(2)
  46. *
  47. *
  48. DIMENSION COP0(8)
  49. DIMENSION CS1 (8)
  50. DIMENSION CS2 (12)
  51. DIMENSION XLCOIN (4)
  52. *
  53. *-- BOUCLE SUR LES POINTS
  54. *
  55. DO 10 IP = 1,NP0
  56. PP1(1) = PP0(1,IP)
  57. PP1(2) = PP0(2,IP)
  58. *--0. MISE A 0
  59. CI = (0d0,1d0)
  60. DO 100 J=1,NS4
  61. CPOST(J) = CMPLX(0D0)*ci
  62. 100 CONTINUE
  63. *
  64. *--- INITIALISATION BIDON
  65. *
  66. XN0(1) = 1D0
  67. XN0(2) = 0d0
  68. XT0(1) = 0d0
  69. XT0(2) = 1D0
  70. *
  71. *- 1.1 BOUCLE SUR LES BORDS
  72. *
  73. DO 200 JQ=1,NS
  74. XN (1) = XBORD(1,JQ)
  75. XN (2) = XBORD(2,JQ)
  76. XT (1) = XBORD(3,JQ)
  77. XT (2) = XBORD(4,JQ)
  78. A (1) = XBORD(5,JQ)
  79. A (2) = XBORD(6,JQ)
  80. B (1) = XBORD(7,JQ)
  81. B (2) = XBORD(8,JQ)
  82. Q (1) = XBORD(9,JQ)
  83. Q (2) = XBORD(10,JQ)
  84. XLQ = XBORD(11,JQ)
  85. OAB(1) = XBORD(12,JQ)
  86. OAB(2) = XBORD(13,JQ)
  87. TETA = XBORD(14,JQ)
  88. R = XBORD(15,JQ)
  89. CALL ELPDI1(PP1,XN0,XT0
  90. & ,Q,XN,XT,A,B,OAB,TETA,R,XLQ
  91. & ,XD,XNU
  92. & ,NTRAP,CS1,CB,ISTAT)
  93. JCOL= 4* (JQ - 1)
  94.  
  95. CPOST(JCOL+1) = CS1(4) / XD
  96. CPOST(JCOL+2) =-CS1(3) / XD
  97. CPOST(JCOL+3) = CS1(2) / XD
  98. CPOST(JCOL+4) =-CS1(1) / XD
  99. 200 CONTINUE
  100. *
  101. *- 1.2 TERMES BORDS-COINS
  102. *
  103. IF ( NC1.NE.0) THEN
  104. DO 220 JC=1,NC
  105. A (1) = XCOIN(1,JC)
  106. A (2) = XCOIN(2,JC)
  107. XN1(1) = XCOIN(3,JC)
  108. XN1(2) = XCOIN(4,JC)
  109. XT1(1) = XCOIN(5,JC)
  110. XT1(2) = XCOIN(6,JC)
  111. XN2(1) = XCOIN(7,JC)
  112. XN2(2) = XCOIN(8,JC)
  113. XT2(1) = XCOIN(9,JC)
  114. XT2(2) = XCOIN(10,JC)
  115. XLCOIN(1) = XCOIN(11,JC)
  116. XLCOIN(2) = XCOIN(12,JC)
  117. XLCOIN(3) = XCOIN(13,JC)
  118. XLCOIN(4) = XCOIN(14,JC)
  119. CALL ELPDI3(PP1,XN0
  120. & ,A,XN1,XN2,XT1,XT2,XLCOIN
  121. & ,XD,XNU
  122. & ,CS2,CB,ISTAT)
  123.  
  124. I1 = ICOIN(1,JC)
  125. I2 = ICOIN(2,JC)
  126. I3 = ICOIN(3,JC)
  127. I4 = ICOIN(4,JC)
  128. J1 = 4*(I1 - 1)
  129. J2 = 4*(I2 - 1)
  130. J3 = 4*(I3 - 1)
  131. J4 = 4*(I4 - 1)
  132.  
  133. *
  134. * TERMES MULTIPLIANT DES W,N SUR LES 2 LIGNES
  135. *
  136. CPOST(J1+2) = CPOST(J1+2) - CS2(4)/XD
  137. CPOST(J2+2) = CPOST(J2+2) - CS2(3)/XD
  138. CPOST(J3+2) = CPOST(J3+2) - CS2(2)/XD
  139. CPOST(J4+2) = CPOST(J4+2) - CS2(1)/XD
  140. *
  141. * TERMES MULTIPLIANT DES W SUR LES 2 LIGNES
  142. *
  143. CPOST(J2+1) = CPOST(J2+1) - CS2(6)/XD
  144. CPOST(J3+1) = CPOST(J3+1) - CS2(5)/XD
  145.  
  146. 220 CONTINUE
  147. *
  148. *
  149. *
  150. ENDIF
  151.  
  152. *
  153. *-1.4 SECOND MEMBRE(SI PP0 NEG PF0)
  154. *
  155. RR= ( PP1(2)-PF0(2)) ** 2
  156. & + ( PP1(1)-PF0(1)) ** 2
  157. IF ( ISTAT.NE.1) THEN
  158. IF ( RR .GT. 1E-4 ) THEN
  159. CALL ELPDOP (PP1,XN0,PF0,XN0,XT0,XD,XNU,COP0,CB,ISTAT)
  160. ELSE
  161. COP0(1) = CI/( CMPLX(8d0) *CB * CB )
  162. ENDIF
  163. ELSE
  164. COP0(1) = CMPLX(0D0)
  165. ENDIF
  166. CSM0 = COP0(1) *XF0 / XD
  167. *
  168. *-1.5 CALCUL DU DEPLACEMENT
  169. *
  170. CRP(IP) =(0D0,0d0)
  171. DO 300 J=1,NS4
  172. CRP(IP) = CRP(IP) - CPOST(J)*CRE(J)
  173. 300 CONTINUE
  174. CRP(IP) = CRP(IP) + CSM0
  175. *
  176. 10 CONTINUE
  177. *
  178. RETURN
  179. END
  180.  
  181.  
  182.  

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