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. *
  256. *
  257. IF(FF.GT.0.D0) THEN
  258. XX=XX/2.D0
  259. GO TO 600
  260. ELSE
  261. XXDEP=XX
  262. F1=FF
  263. ENDIF
  264. *
  265. ENDIF
  266. *
  267. IF(IIMPI.EQ.42) THEN
  268. PRINT *,'VALEUR DE DEPART XXDEP = ',XXDEP
  269. ENDIF
  270.  
  271.  
  272.  
  273. *
  274. XX1=XXDEP
  275. XX2=1.D0
  276.  
  277. * AM 3/12/15
  278.  
  279.  
  280. IF(ABS(F1).LT.PRECIZ.AND.ABS(F2).LT.PRECIZ) THEN
  281. XX=1.D0
  282. GO TO 1234
  283. ENDIF
  284.  
  285. IF(F2-F1.EQ.0.D0) THEN
  286. IF(IIMPI.EQ.42) THEN
  287. PRINT *,'F1 = ', F1, ' F2= ',F2
  288. ENDIF
  289. LERED=1
  290. RETURN
  291. ENDIF
  292.  
  293. XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  294.  
  295. 1234 CONTINUE
  296.  
  297. IF(IIMPI.EQ.42) THEN
  298. PRINT *,'ESTIMATION SECANTE XX = ',XX
  299. PRINT *,'JC=',JC,' JFIS(JC)=',JFIS(JC)
  300. ENDIF
  301. *
  302. *
  303. IF(JC.GE.1.AND.JC.LE.3.AND.LAPPEL.EQ.1) THEN
  304. IF(JFIS(JC).GE.2) THEN
  305. *
  306. IF(IIMPI.EQ.42) THEN
  307. PRINT *,'VALEUR CALCULEE XX = ',XXFIS
  308. ENDIF
  309. *
  310. * MLR 9/7/99
  311. *
  312. IF(XX.LE.1.D0.AND.XXFIS.LE.1.D0) THEN
  313. XX=XXFIS
  314. GO TO 200
  315. *
  316. ELSE
  317. LAPPEL=0
  318. ENDIF
  319. *
  320. ENDIF
  321. ENDIF
  322. *
  323. ITER=0
  324. *
  325. IF(IIMPI.EQ.42) THEN
  326. PRINT *,'PREMIERE ESTIMATION XX = ',XX
  327. ENDIF
  328. *
  329. * ITERATIONS
  330. *
  331. 100 CONTINUE
  332. ITER=ITER+1
  333. *
  334. *
  335. IF(ITER.GT.2500) THEN
  336. PRINT *,' 2500 ITERATIONS DANS OTTOXX'
  337. KERRE=1
  338. RETURN
  339. ENDIF
  340. DO I=1,6
  341. STOT(I)=SIG0(I)+XX*DSIGT(I)
  342. VAUX(I)=VAUX1(I)+XX*VAUX2(I)
  343. ENDDO
  344. *
  345. DO I=1,3
  346. DXVV(I)=DXV1(I)+XX*DXV2(I)
  347. ENDDO
  348. *
  349. *
  350. JCDUM(1)=JC
  351. CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  352. & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  353. & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  354. IF(KERRE.NE.0) RETURN
  355. FF=FC2(JC)
  356. IF(ABS(FF).LT.PRECIZ) GO TO 200
  357. *
  358. IF(IIMPI.EQ.42) THEN
  359. ZOB1 = F1
  360. ZOB2 = F2
  361. ENDIF
  362. *
  363. IF(FF*F2.GE.0.D0) THEN
  364. XX2=XX
  365. F2=FF
  366. ELSE
  367. XX1=XX
  368. F1=FF
  369. ENDIF
  370. *
  371. XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  372. *
  373. IF(IIMPI.EQ.42) THEN
  374. WRITE(IOIMP,75461) ITER, ZOB1,ZOB2,XX
  375. 75461 FORMAT( 2X, 'I=',I3,2X,'F1=',1PE12.5,2X,
  376. & 'F2=',1PE12.5,2X,'XX=',1PE12.5)
  377. ENDIF
  378.  
  379. GO TO 100
  380. *
  381. 200 CONTINUE
  382. *
  383. IF(XX.LT.XXMIN) THEN
  384. XXMIN=XX
  385. ENDIF
  386. *
  387. ENDDO
  388.  
  389.  
  390. *
  391. * ON IMPRIME XXMIN
  392. *
  393. IF(IIMPI.EQ.42) THEN
  394. WRITE(IOIMP,73361) XXMIN
  395. 73361 FORMAT( 2X, ' OTTOXX APRES BOUCLE - XXMIN= ',1PE12.5/)
  396. ENDIF
  397.  
  398.  
  399. *
  400. * MISES A JOUR ( NCRIT )
  401. *
  402.  
  403. DO I=1,6
  404. STOT(I)=SIG0(I)+XXMIN*DSIGT(I)
  405. VAUX(I)=VAUX1(I)+XXMIN*VAUX2(I)
  406. ENDDO
  407. *
  408. DO I=1,3
  409. DXVV(I)=DXV1(I)+XXMIN*DXV2(I)
  410. ENDDO
  411. *
  412. CALL OTTOCE(MCA,MMA,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  413. & XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  414. & JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  415. IF(KERRE.NE.0) RETURN
  416. DO IC=1,MCA
  417. JC=MMA(IC)
  418. *
  419. * TEST SUPPLEMENTAIRE
  420. *
  421. IF(FC2(JC).GT.PRECIZ) THEN
  422. PRINT *,'######### OTTOXX CRITERE INCOHERENT JC = ',JC
  423. PRINT *,' FC2 = ',FC2(JC), ' PRECIZ=',PRECIZ
  424. KERRE=2
  425. RETURN
  426. ENDIF
  427. *
  428. IF(ABS(FC2(JC)).LT.PRECIZ) THEN
  429. NCRIT=NCRIT+1
  430. JCRIT(NCRIT)=JC
  431. ENDIF
  432. ENDDO
  433. *
  434. 300 CONTINUE
  435. *
  436. ENDIF
  437.  
  438. *
  439. * SORTIE
  440. *
  441. IF(IIMPI.EQ.42) THEN
  442. WRITE(IOIMP,77000) NCRIT,(JCRIT(I),I=1,NCRIT)
  443. 77000 FORMAT( 2X, ' OTTOXX - NCRIT =',I3,4X,'JCRIT = ',15I3/)
  444. WRITE(IOIMP,77001) XXMIN
  445. 77001 FORMAT( 2X, ' OTTOXX - XXMIN= ',1PE12.5/)
  446. ENDIF
  447. *
  448. RETURN
  449. END
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  

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