Télécharger elpd99.eso

Retour à la liste

Numérotation des lignes :

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

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