Télécharger cal2s3.eso

Retour à la liste

Numérotation des lignes :

  1. C CAL2S3 SOURCE CB215821 16/04/21 21:15:27 8920
  2. SUBROUTINE CAL2S3(G,NAM,AM,NBM,BM,N,F3,NYA,NYB,EDIS)
  3. C---------------------------------------------------------------------
  4. C 3D : CALCUL DE ' SI.FIJ '
  5. C
  6. C INTEGRATION EN SEMI-ANALYTIQUE
  7. C
  8. C---------------------------------------------------------------------
  9. IMPLICIT INTEGER(I-N)
  10. IMPLICIT REAL*8 (A-H,O-Z)
  11. C Include contenant quelques constantes dont XPI :
  12. -INC CCREEL
  13. C
  14. DIMENSION G(11,10),AM(3,5),BM(3,5),A(3),B(3),C(3),D(3),E(3)
  15. DIMENSION NYA(5),NYB(5)
  16. C
  17. DO 40 K=1,3
  18. AM(K,NAM+1)=AM(K,1)
  19. BM(K,NBM+1)=BM(K,1)
  20. 40 CONTINUE
  21. NYA(NAM+1)=NYA(1)
  22. NYB(NBM+1)=NYB(1)
  23. F3=0.D0
  24. C BOUCLE SUR LA FACE 1
  25. DO 51 I=1,NAM
  26. D1=0.D0
  27. DO 54 K=1,3
  28. A(K)=AM(K,I)
  29. B(K)=AM(K,I+1)
  30. D1=D1+(B(K)-A(K))**2
  31. 54 CONTINUE
  32. D1=SQRT(D1)
  33. C BOUCLE SUR LA FACE 2
  34. DO 52 J=1,NBM
  35. D2=0.D0
  36. PR=0.D0
  37. DO 53 K=1,3
  38. C(K)=BM(K,J)
  39. D(K)=BM(K,J+1)
  40. D2=D2+(D(K)-C(K))**2
  41. PR=PR+(B(K)-A(K))*(D(K)-C(K))
  42. 53 CONTINUE
  43. D2=SQRT(D2)
  44. CO=PR/D1/D2
  45. C>>>
  46. IF( ABS(CO).LT.(1.D-5)) THEN
  47. F2 = 0.D0
  48. GOTO 17
  49. ELSE
  50. DAC = CALDIS(A,C,3)
  51. DAD = CALDIS(A,D,3)
  52. DBC = CALDIS(B,C,3)
  53. DBD = CALDIS(B,D,3)
  54. C
  55. IF(DAC.LT.EDIS) GOTO 9
  56. IF(DAD.LT.EDIS) GOTO 9
  57. IF(DBC.LT.EDIS) GOTO 9
  58. IF(DBD.LT.EDIS) GOTO 9
  59. CALL INTEGA(G,F2,A,B,C,D,N,D2,CO)
  60. GOTO 18
  61. C
  62. C TEST
  63. C
  64. 9 CONTINUE
  65. IF( (DAC.LT.EDIS).AND.(DBD.LT.EDIS) ) THEN
  66. F2=(3-2*LOG(D1))/2
  67. GOTO 18
  68. ELSE
  69. IF( (DAD.LT.EDIS).AND.(DBC.LT.EDIS) ) THEN
  70. F2=-(3-2*LOG(D1))/2
  71. GOTO 18
  72. ELSE
  73. IF(ABS(D1-D2).LT.1.D-5)THEN
  74. IF( (DAC.LT.EDIS).OR.(DBD.LT.EDIS) ) THEN
  75. XCO=-CO
  76. CALL ILIN(XCO,D1,F2)
  77. ELSE
  78. CALL ILIN(CO,D1,F2)
  79. ENDIF
  80. GOTO 18
  81. ELSE
  82. IF(D1.GT.D2)THEN
  83. DM=D2
  84. IF(DAC.LT.EDIS) THEN
  85. DO 21 K=1,3
  86. E(K)=B(K)-(D1-D2)/D1*(B(K)-A(K))
  87. 21 CONTINUE
  88. CALL INTEGA(G,F2S,E,B,C,D,N,D2,CO)
  89. XCO=-CO
  90. CALL ILIN(XCO,D2,FE)
  91. GOTO 19
  92. ENDIF
  93. IF(DAD.LT.EDIS) THEN
  94. DO 22 K=1,3
  95. E(K)=B(K)-(D1-D2)/D1*(B(K)-A(K))
  96. 22 CONTINUE
  97. CALL INTEGA(G,F2S,E,B,C,D,N,D2,CO)
  98. CALL ILIN(CO,D2,FE)
  99. GOTO 19
  100. ENDIF
  101. IF(DBC.LT.EDIS) THEN
  102. DO 23 K=1,3
  103. E(K)=A(K)+(D1-D2)/D1*(B(K)-A(K))
  104. 23 CONTINUE
  105. CALL INTEGA(G,F2S,A,E,C,D,N,D2,CO)
  106. CALL ILIN(CO,D2,FE)
  107. GOTO 19
  108. ENDIF
  109. IF(DBD.LT.EDIS) THEN
  110. DO 24 K=1,3
  111. E(K)=A(K)+(D1-D2)/D1*(B(K)-A(K))
  112. 24 CONTINUE
  113. CALL INTEGA(G,F2S,A,E,C,D,N,D2,CO)
  114. XCO=-CO
  115. CALL ILIN(XCO,D2,FE)
  116. GOTO 19
  117. ENDIF
  118. ELSE
  119. DM=D1
  120. D2M=D2-D1
  121. IF(DAC.LT.EDIS) THEN
  122. DO 31 K=1,3
  123. E(K)=D(K)-(D2-D1)/D2*(D(K)-C(K))
  124. 31 CONTINUE
  125. CALL INTEGA(G,F2S,A,B,E,D,N,D2M,CO)
  126. XCO=-CO
  127. CALL ILIN(XCO,D1,FE)
  128. GOTO 19
  129. ENDIF
  130. IF(DAD.LT.EDIS) THEN
  131. DO 32 K=1,3
  132. E(K)=C(K)+(D2-D1)/D2*(D(K)-C(K))
  133. 32 CONTINUE
  134. CALL INTEGA(G,F2S,A,B,C,E,N,D2M,CO)
  135. CALL ILIN(CO,D1,FE)
  136. GOTO 19
  137. ENDIF
  138. IF(DBC.LT.EDIS) THEN
  139. DO 33 K=1,3
  140. E(K)=D(K)-(D2-D1)/D2*(D(K)-C(K))
  141. 33 CONTINUE
  142. CALL INTEGA(G,F2S,A,B,E,D,N,D2M,CO)
  143. CALL ILIN(CO,D1,FE)
  144. GOTO 19
  145. ENDIF
  146. IF(DBD.LT.EDIS) THEN
  147. DO 34 K=1,3
  148. E(K)=C(K)+(D2-D1)/D2*(D(K)-C(K))
  149. 34 CONTINUE
  150. CALL INTEGA(G,F2S,A,B,C,E,N,D2M,CO)
  151. XCO=-CO
  152. CALL ILIN(XCO,D1,FE)
  153. GOTO 19
  154. ENDIF
  155. ENDIF
  156. ENDIF
  157. ENDIF
  158. ENDIF
  159. C>>>
  160. ENDIF
  161. C
  162. C FIN DU TEST
  163. C
  164. 19 CONTINUE
  165. F2=(FE*DM+F2S*ABS(D1-D2))*DM*CO
  166. GOTO 17
  167. 18 CONTINUE
  168. F2=F2*CO*D1*D2
  169. 17 CONTINUE
  170. F3=F3+F2
  171. 52 CONTINUE
  172. 51 CONTINUE
  173. F3=F3/2/XPI
  174. RETURN
  175. END
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  
  185.  

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