Télécharger ottoxx.eso

Retour à la liste

Numérotation des lignes :

  1. C OTTOXX SOURCE AM 15/12/16 21:15:20 8753
  2. SUBROUTINE OTTOXX(MC,MM,SIG0,DSIGT,STOT,
  3. & VAUX1,VAUX2,VAUX,FC0,DX,DXV1,DXV2,
  4. & PRECIE,PRECIZ,BTR,YOUN,
  5. & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF,
  6. & XXMIN,JCRIT,NCRIT,XCOMP,XLAMC,ICOMEL,LERED,KERRE)
  7. C=========================================================================
  8. C
  9. C ENTREES :
  10. C SIG0,DSIGT,FC0,PRECIZ
  11. C W,WMAX,SMAX,WRUPT,BTR,XLTR,XINVL
  12. C VAUX1,VAUX2
  13. C
  14. C SORTIES :
  15. C JCRIT,XXMIN,STOT,VAUX
  16. C
  17. C==========================================================================
  18. C
  19. IMPLICIT INTEGER(I-N)
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. -INC CCOPTIO
  22. C
  23. PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  24. C
  25. DIMENSION SIG0(6),DSIGT(6),STOT(6),XCOMP(*)
  26. DIMENSION VAUX1(6),VAUX2(6),VAUX(6)
  27. DIMENSION DX(*),DXV1(*),DXV2(*)
  28. DIMENSION DXVV(3)
  29. DIMENSION W(3),WMAX(3),WREOUV(3),
  30. & WRUPT(3),XLTR(3),XINVL(3),XXF(3)
  31. DIMENSION MM(*),SMAX(*)
  32. DIMENSION FC0(*),JCRIT(*)
  33. DIMENSION VF(3,3),JFIS(3),JFIS2(3)
  34. DIMENSION JCDUM(1)
  35. DIMENSION FC2(16),FCT(16),MMA(20)
  36.  
  37. DIMENSION DFF(6),DGG(6)
  38.  
  39. IF(IIMPI.EQ.42) THEN
  40. WRITE(IOIMP,55446) ICOMEL
  41. 55446 FORMAT(/2X,' ENTREE OTTOXX - ICOMEL =',I4/)
  42. ENDIF
  43.  
  44. C
  45. C INITIALISATIONS
  46. C
  47. KERRE=0
  48. LERED=0
  49. XXMIN=1.D0
  50. NCRIT=0
  51. CALL IANUL(JCRIT,20)
  52. *
  53. *
  54. DO I=1,6
  55. STOT(I)=SIG0(I)+DSIGT(I)
  56. VAUX(I)=VAUX1(I)+VAUX2(I)
  57. ENDDO
  58. *
  59. DO I=1,3
  60. DXVV(I)=DXV1(I)+DXV2(I)
  61. ENDDO
  62.  
  63. *
  64. * APPEL A OTTOCE
  65. *
  66.  
  67. IF(IIMPI.EQ.42) THEN
  68. WRITE(IOIMP,32246)
  69. 32246 FORMAT(/2X,' DANS OTTOXX - APPEL A OTTOCE POUR FCT'//)
  70. ENDIF
  71.  
  72.  
  73. CALL OTTOCE(MC,MM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  74. & XLTR,XINVL,BTR,NFISSU,NVF,FCT,VF,YOUN,PRECIZ,
  75. & JFIS,XCOMP,XLAMC,DFF,DGG,KERRE)
  76. IF(KERRE.NE.0) RETURN
  77. *
  78. *
  79. MCA=0
  80. DO IC=1,MC
  81. JC=MM(IC)
  82. *
  83. IF(IIMPI.EQ.42) THEN
  84. WRITE(IOIMP,30446) IC,JC,FC0(JC),FCT(JC)
  85. 30446 FORMAT(/2X,' OTTOXX - IC=',I4,2X,' JC=',I4,2X,
  86. & ' FC0(JC)=',1PE12.5,2X,'FCT(JC)=',1PE12.5/)
  87. ENDIF
  88. *
  89. IF(FCT(JC).GT.0.D0)THEN
  90. MCA=MCA+1
  91. MMA(MCA)=JC
  92. ELSE IF(ABS(FCT(JC)).LE.PRECIZ)THEN
  93. MCA=MCA+1
  94. MMA(MCA)=JC
  95. IF(FCT(JC).LT.0.D0) FCT(JC)=0.D0
  96. ENDIF
  97. ENDDO
  98. *
  99.  
  100. IF(IIMPI.EQ.42) THEN
  101. WRITE(IOIMP,50446) MCA
  102. 50446 FORMAT(/2X,' DANS OTTOXX - MCA =',I4/)
  103. WRITE(IOIMP,40446) (MMA(I),I=1,MCA)
  104. 40446 FORMAT(/2X,' OTTOXX - MMA =',5I4/)
  105. PRINT *, ' PRECIZ = ', PRECIZ
  106. ENDIF
  107. *
  108. *
  109. IF(MCA.NE.0) THEN
  110. *
  111. * FAUT-IL APPELER OTTOXF ?
  112. *
  113. LAPPEL=0
  114.  
  115. IZOB = 0
  116. IF(IZOB.GT.0) THEN
  117. DO IC=1,MCA
  118. JC=MMA(IC)
  119. *
  120. IF(JC.GE.1.AND.JC.LE.3) THEN
  121. *
  122. IF(FC0(JC).GT.0.D0.AND.FC0(JC).LT.PRECIZ) THEN
  123. *
  124. XXMIN=0.D0
  125. JCRIT(1)=JC
  126. NCRIT=1
  127. DO I=1,6
  128. STOT(I)=SIG0(I)
  129. VAUX(I)=VAUX1(I)
  130. ENDDO
  131. GO TO 300
  132. ENDIF
  133. IF(JFIS(JC).GT.1) LAPPEL=1
  134. ENDIF
  135. ENDDO
  136. ENDIF
  137. *
  138. * MLR 9/7/99
  139. *
  140. DO IC=1,MCA
  141. JC=MMA(IC)
  142. IF(ICOMEL.EQ.1.AND.JC.EQ.16) GO TO 77
  143. * IF(FC0(JC)*FCT(JC).GT.0.D0) THEN
  144. IF((FC0(JC)*FCT(JC).GT.0.D0).AND.
  145. & (ABS(FC0(JC)).GT.PRECIZ.AND.ABS(FCT(JC)).GT.PRECIZ))THEN
  146. IF(IIMPI.EQ.42) THEN
  147. PRINT *,'##### OTTOXX CRITERES INCOMPATIBLES JC = ',JC
  148. PRINT *,' FC0 = ',FC0(JC), ' FCT = ', FCT(JC)
  149. ENDIF
  150. LERED=1
  151. RETURN
  152. ENDIF
  153. 77 CONTINUE
  154. ENDDO
  155.  
  156.  
  157. *
  158. * APPEL A OTTOXF
  159. *
  160. IF(LAPPEL.EQ.1) THEN
  161. CALL OTTOXF(SIG0,DSIGT,XINVL,XLTR,
  162. & NFISSU,NVF,XXF,PRECIZ,KERRE)
  163. IF(KERRE.NE.0) RETURN
  164. *
  165. IF(IIMPI.EQ.42) THEN
  166. WRITE(IOIMP,44556) (XXF(I),I=1,3)
  167. 44556 FORMAT(/2X,' APRES OTTOXF : XXF ',3(1X,1PE12.5)/)
  168. ENDIF
  169. *
  170. **** MLR 9/7/99
  171. *
  172. IF(XXF(2).EQ.1.D4.AND.XXF(3).EQ.1.D4) THEN
  173. LAPPEL=0
  174. GO TO 50
  175. ENDIF
  176. *
  177. *
  178. IF(JFIS(2).GT.1) THEN
  179. I1=1
  180. IF(JFIS(2).EQ.2) I1=2
  181. DO I=I1,3
  182. IF(XXF(I).GT.0.D0) THEN
  183. XXFIS=XXF(I)
  184. GO TO 50
  185. ENDIF
  186. ENDDO
  187. IF(IIMPI.EQ.42) THEN
  188. WRITE(IOIMP,77453)
  189. 77453 FORMAT(2X,'####### PAS DE RACINE POSITIVE #######'/)
  190. ENDIF
  191. ****** KERRE=70
  192. ****** RETURN
  193. * ON SE DONNE UNE DERNIERE CHANCE
  194. *
  195. LAPPEL=0
  196. ENDIF
  197. *
  198. 50 CONTINUE
  199. *
  200. ENDIF
  201. *
  202. *
  203. DO IC=1,MCA
  204. JC=MMA(IC)
  205. F1=FC0(JC)
  206. F2=FCT(JC)
  207. IF(IIMPI.EQ.42) THEN
  208. PRINT *,' IC=',IC
  209. PRINT *,' JC=',JC
  210. PRINT *,' FC0=',FC0(JC)
  211. PRINT *,' FCT=',FCT(JC)
  212. ENDIF
  213.  
  214. *
  215. * MLR 9/7/99
  216. *
  217. XXDEP=0.D0
  218.  
  219. IF(ICOMEL.EQ.1.AND.JC.EQ.16) THEN
  220. *
  221. * SPECIAL RETRAITEMENT DU POINT INITIAL
  222. *
  223. IF(ABS(F2).LE.PRECIZ) THEN
  224. XX=1.D0
  225. GO TO 200
  226. ENDIF
  227. *
  228. IDITER=0
  229. XX=0.5D0
  230.  
  231. 600 IDITER=IDITER+1
  232. IF(IDITER.GT.100) THEN
  233. PRINT *,'IDITER=100 '
  234. KERRE=1
  235. RETURN
  236. ENDIF
  237. *
  238. DO I=1,6
  239. STOT(I)=SIG0(I)+XX*DSIGT(I)
  240. VAUX(I)=VAUX1(I)+XX*VAUX2(I)
  241. ENDDO
  242. *
  243. DO I=1,3
  244. DXVV(I)=DXV1(I)+XX*DXV2(I)
  245. ENDDO
  246. *
  247. *
  248. JCDUM(1)=JC
  249. CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  250. & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  251. & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  252. IF(KERRE.NE.0) RETURN
  253. FF=FC2(JC)
  254. IF(ABS(FF).LT.PRECIZ) GO TO 200
  255. *
  • *
  • IF(FF.GT.0.D0) THEN
  • XX=XX/2.D0
  • GO TO 600
  • ELSE
  • XXDEP=XX
  • F1=FF
  • ENDIF
  • *
  • ENDIF
  • *
  • IF(IIMPI.EQ.42) THEN
  • PRINT *,'VALEUR DE DEPART XXDEP = ',XXDEP
  • ENDIF
  •  
  •  
  •  
  • *
  • XX1=XXDEP
  • XX2=1.D0
  •  
  • * AM 3/12/15
  •  
  •  
  • IF(ABS(F1).LT.PRECIZ.AND.ABS(F2).LT.PRECIZ) THEN
  • XX=1.D0
  • GO TO 1234
  • ENDIF
  •  
  • IF(F2-F1.EQ.0.D0) THEN
  • IF(IIMPI.EQ.42) THEN
  • PRINT *,'F1 = ', F1, ' F2= ',F2
  • ENDIF
  • LERED=1
  • RETURN
  • ENDIF
  •  
  • XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  •  
  • 1234 CONTINUE
  •  
  • IF(IIMPI.EQ.42) THEN
  • PRINT *,'ESTIMATION SECANTE XX = ',XX
  • PRINT *,'JC=',JC,' JFIS(JC)=',JFIS(JC)
  • ENDIF
  • *
  • *
  • IF(JC.GE.1.AND.JC.LE.3.AND.LAPPEL.EQ.1) THEN
  • IF(JFIS(JC).GE.2) THEN
  • *
  • IF(IIMPI.EQ.42) THEN
  • PRINT *,'VALEUR CALCULEE XX = ',XXFIS
  • ENDIF
  • *
  • * MLR 9/7/99
  • *
  • IF(XX.LE.1.D0.AND.XXFIS.LE.1.D0) THEN
  • XX=XXFIS
  • GO TO 200
  • *
  • ELSE
  • LAPPEL=0
  • ENDIF
  • *
  • ENDIF
  • ENDIF
  • *
  • ITER=0
  • *
  • IF(IIMPI.EQ.42) THEN
  • PRINT *,'PREMIERE ESTIMATION XX = ',XX
  • ENDIF
  • *
  • * ITERATIONS
  • *
  • 100 CONTINUE
  • ITER=ITER+1
  • *
  • *
  • IF(ITER.GT.2500) THEN
  • PRINT *,' 2500 ITERATIONS DANS OTTOXX'
  • KERRE=1
  • RETURN
  • ENDIF
  • DO I=1,6
  • STOT(I)=SIG0(I)+XX*DSIGT(I)
  • VAUX(I)=VAUX1(I)+XX*VAUX2(I)
  • ENDDO
  • *
  • DO I=1,3
  • DXVV(I)=DXV1(I)+XX*DXV2(I)
  • ENDDO
  • *
  • *
  • JCDUM(1)=JC
  • CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  • & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  • & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  • IF(KERRE.NE.0) RETURN
  • FF=FC2(JC)
  • IF(ABS(FF).LT.PRECIZ) GO TO 200
  • *
  • IF(IIMPI.EQ.42) THEN
  • ZOB1 = F1
  • ZOB2 = F2
  • ENDIF
  • *
  • IF(FF*F2.GE.0.D0) THEN
  • XX2=XX
  • F2=FF
  • ELSE
  • XX1=XX
  • F1=FF
  • ENDIF
  • *
  • XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  • *
  • IF(IIMPI.EQ.42) THEN
  • WRITE(IOIMP,75461) ITER, ZOB1,ZOB2,XX
  • 75461 FORMAT( 2X, 'I=',I3,2X,'F1=',1PE12.5,2X,
  • & 'F2=',1PE12.5,2X,'XX=',1PE12.5)
  • ENDIF
  •  
  • GO TO 100
  • *
  • 200 CONTINUE
  • *
  • IF(XX.LT.XXMIN) THEN
  • XXMIN=XX
  • ENDIF
  • *
  • ENDDO
  •  
  •  
  • *
  • * ON IMPRIME XXMIN
  • *
  • IF(IIMPI.EQ.42) THEN
  • WRITE(IOIMP,73361) XXMIN
  • 73361 FORMAT( 2X, ' OTTOXX APRES BOUCLE - XXMIN= ',1PE12.5/)
  • ENDIF
  •  
  •  
  • *
  • * MISES A JOUR ( NCRIT )
  • *
  •  
  • DO I=1,6
  • STOT(I)=SIG0(I)+XXMIN*DSIGT(I)
  • VAUX(I)=VAUX1(I)+XXMIN*VAUX2(I)
  • ENDDO
  • *
  • DO I=1,3
  • DXVV(I)=DXV1(I)+XXMIN*DXV2(I)
  • ENDDO
  • *
  • CALL OTTOCE(MCA,MMA,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  • & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  • & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  • IF(KERRE.NE.0) RETURN
  • DO IC=1,MCA
  • JC=MMA(IC)
  • *
  • * TEST SUPPLEMENTAIRE
  • *
  • IF(FC2(JC).GT.PRECIZ) THEN
  • PRINT *,'######### OTTOXX CRITERE INCOHERENT JC = ',JC
  • PRINT *,' FC2 = ',FC2(JC), ' PRECIZ=',PRECIZ
  • KERRE=2
  • RETURN
  • ENDIF
  • *
  • IF(ABS(FC2(JC)).LT.PRECIZ) THEN
  • NCRIT=NCRIT+1
  • JCRIT(NCRIT)=JC
  • ENDIF
  • ENDDO
  • *
  • 300 CONTINUE
  • *
  • ENDIF
  •  
  • *
  • * SORTIE
  • *
  • IF(IIMPI.EQ.42) THEN
  • WRITE(IOIMP,77000) NCRIT,(JCRIT(I),I=1,NCRIT)
  • 77000 FORMAT( 2X, ' OTTOXX - NCRIT =',I3,4X,'JCRIT = ',15I3/)
  • WRITE(IOIMP,77001) XXMIN
  • 77001 FORMAT( 2X, ' OTTOXX - XXMIN= ',1PE12.5/)
  • ENDIF
  • *
  • RETURN
  • END
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  • © Cast3M 2003 - Tous droits réservés.
    Mentions légales