Télécharger ottoca.eso

Retour à la liste

Numérotation des lignes :

  1. C OTTOCA SOURCE AM 15/12/16 21:15:16 8753
  2. C responsable MILLARD
  3. SUBROUTINE OTTOCA(SIG0,DEPST,W,WMAX,XLAMC,
  4. & SMAX,WRUPT,BILIN,SBILI,XLTR,XLCS,XINVL,
  5. & WREOUV,YOUN,XNU,GFTR,GFCS,G,GS,BTR,XCOMP,
  6. & NFISSU,NVF,VF,XX,IRESU,NRESU,
  7. & SIGF,DEFP,PRECIE,PRECIZ,MFR,KERRE)
  8. C----------------------------------------------------------------------
  9. C ECOULEMENT OTTOSEN
  10. C----------------------------------------------------------------------
  11. C
  12. C ENTREES : SIG0,DEPST,PRECIE,PRECIZ,MFR,KERRE
  13. C
  14. C SORTIES : SIGF,DEFP
  15. C
  16. C
  17. C RAPPEL : EN DEFO PLANES,CONTRAINTES PLANES OU AXI,
  18. C LA DIRECTION 1 EST CELLE PERPENDICULAIRE AU MAILLAGE
  19. C
  20. C-----------------------------------------------------------------------
  21. C
  22. IMPLICIT INTEGER(I-N)
  23. IMPLICIT REAL*8(A-H,O-Z)
  24. -INC CCOPTIO
  25. *
  26. PARAMETER (XZER=0.D0,NC=4)
  27.  
  28. DIMENSION SIG0(*),DEPST(*),SIGF(*),DEFP(*),XCOMP(*)
  29. DIMENSION STOT(6),SIGEL(6),DELAS(6),DEFPLA(6),DEPSTT(6)
  30. DIMENSION DSIGT(6) ,DDPLAS(6)
  31. DIMENSION SIG1(6) ,SIG2(6)
  32. DIMENSION SAUX(6)
  33. *
  34. DIMENSION DD(18),GS(3)
  35. DIMENSION W(3),WMAX(3),BILIN(3),WREOUV(3),SMAX0(3)
  36. DIMENSION WRUPT(3),XLTR(3),XINVL(3),SBILI(3),W0(3),WMAX0(3)
  37. DIMENSION VF(3,3),JFIS(3),DXV1(3),DXV2(3)
  38. *
  39. DIMENSION DDE(18)
  40. DIMENSION DEPST0(6)
  41. *
  42. DIMENSION SMAX(*),IRESU(*)
  43. *
  44. DIMENSION NN(NC),FC(NC),FC2(NC),FCC(NC)
  45. DIMENSION MM(20),MM2(20),FCV(20),FCV1(20)
  46. *
  47. DIMENSION PENTE( 6),LEBIL( 6),ISING(NC)
  48. DIMENSION IFERM(NC),IBRUP(NC)
  49. DIMENSION PENTE2( 6),LEBIL2( 6),ISING2(NC)
  50. DIMENSION AA(NC+1,NC+1),BB1(NC+1),BB2(NC+1)
  51. DIMENSION DFDS(6,NC),DGDS(6,NC),HDFDQ(NC)
  52. DIMENSION DX(NC+1),DDX(NC+1)
  53. DIMENSION VEC1(NC+1),VEC2(NC+1)
  54. DIMENSION VAUX1(6),VAUX2(6),VAUX(6)
  55. DIMENSION DFF(6),DGG(6)
  56. *
  57. * DATA ITMAX/25/
  58. DATA ITMAX/150/
  59. DATA IRMAX/5/
  60. *
  61. * INITIALISATIONS
  62. *
  63. IRED=0
  64. REFAC=1.D0
  65. *
  66. DO I=1,3
  67. W0(I)=W(I)
  68. WMAX0(I)=WMAX(I)
  69. WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I))
  70. SMAX0(I)=SMAX(I)
  71. ENDDO
  72. XLAMC0=XLAMC
  73. *
  74.  
  75. 888 CONTINUE
  76.  
  77. *
  78. KERRE=0
  79. NC1=NC+1
  80.  
  81.  
  82. IRED=IRED+1
  83. IF(IRED.GT.IRMAX) THEN
  84. PRINT *,'&&&&&&&& OTTOCA IRED = ',IRED
  85. KERRE=2
  86. RETURN
  87. ENDIF
  88. *
  89. IF(IRED.GT.1) THEN
  90. DO I=1,3
  91. W(I)=W0(I)
  92. WMAX(I)=WMAX0(I)
  93. WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I))
  94. SMAX(I)=SMAX0(I)
  95. ENDDO
  96. XLAMC=XLAMC0
  97. REFAC=REFAC*0.5D0
  98. ENDIF
  99.  
  100. *
  101. * MATRICE ELASTIQUE
  102. *
  103. CALL OTTODD(DDE,YOUN,XNU,G,GS,XINVL,W)
  104. *
  105. CALL SHIFTD(DEPST,DEPSTT,6)
  106.  
  107. DO I=1,6
  108. DEPSTT(I)=DEPSTT(I)*REFAC
  109. ENDDO
  110.  
  111. *
  112. * SPECIAL CP
  113. *
  114. IF(IFOUR.EQ.-2) THEN
  115. DEPSTT(1)= (-DDE(6)*DEPSTT(2)-DDE(5)*DEPSTT(3))/DDE(1)
  116. ENDIF
  117. *
  118. * ON CALCULE L'INCREMENT DE CONTRAINTE EN ELASTIQUE
  119. *
  120. CALL OTTOPR(DDE,DEPSTT,DSIGT)
  121. CALL ZDANUL(PENTE,6 )
  122. CALL ZDANUL(PENTE2,6 )
  123. CALL IANUL(LEBIL,6 )
  124. CALL IANUL(LEBIL2,6 )
  125. CALL ZDANUL(AA,(NC+1)**2)
  126. CALL ZDANUL(BB1,NC+1)
  127. CALL ZDANUL(BB2,NC+1)
  128. CALL ZDANUL(DEFPLA,6)
  129. CALL ZDANUL(VAUX,6)
  130. CALL ZDANUL(VAUX1,6)
  131. CALL ZDANUL(VAUX2,6)
  132. CALL ZDANUL(DX,NC1)
  133. CALL ZDANUL(DXV1,3)
  134. CALL ZDANUL(DXV2,3)
  135. CALL IANUL(ISING2,NC)
  136.  
  137.  
  138. IF(IIMPI.EQ.42) THEN
  139. WRITE(IOIMP,76633) IRED,NFISSU,NVF,XLAMC,REFAC
  140. 76633 FORMAT(1X,' ENTREE DANS OTTOCA - IRED =',I4,2X,
  141. & ' NFISSU=',I4,2X,' NVF=',I4/
  142. & 2X,'XLAMC=',1PE12.5,2X,' REFAC=',1PE12.5//)
  143. WRITE(IOIMP,74433) (DSIGT(I),I=1,6)
  144. 74433 FORMAT(1X,' DSIGT ',6(1X,1PE12.5)/)
  145. ENDIF
  146.  
  147. *
  148. * write (6,*) ' pente avant ottoet dans ottoca ',(PENTE(IC),IC=1,4)
  149. CALL OTTOET(NC,NN,SIG0,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  150. & XLTR,XINVL,SBILI,PRECIE,PRECIZ,FC,FC2,
  151. & LEBIL,NFISSU,NVF,VF,FCV,PENTE,PENTE2,
  152. & DX,DXV1,YOUN,NCA,MC,MM,ISING,IFERM,
  153. & IBRUP,IPLAS,XCOMP,XLAMC,DFF,DGG,KERRE)
  154. IF(KERRE.NE.0) RETURN
  155. * write (6,*) ' pente apres ottoet dans ottoca ',(PENTE(IC),IC=1,4)
  156.  
  157. *
  158. IF(IIMPI.EQ.42) THEN
  159. PRINT *,' IPLAS = ',IPLAS
  160. ENDIF
  161.  
  162. *
  163. ICOCRI=0
  164. IF(ABS(FC(4)).LE.PRECIZ) ICOCRI=1
  165.  
  166. *
  167. *
  168. IF(IPLAS.NE.0) GO TO 88
  169. *
  170. *
  171. * on essaye l'ecoulement elastique pur
  172. * ------------------------------------
  173. *
  174. IF(IIMPI.EQ.42) THEN
  175. PRINT *,' ESSAI DU CAS ELASTIQUE'
  176. ENDIF
  177.  
  178. *
  179. * MLR 9/7/99
  180. *
  181. ICOMEL=0
  182. IF(ABS(FC(4)).LE.PRECIZ) THEN
  183.  
  184. IF(IIMPI.EQ.42) THEN
  185. WRITE(IOIMP,59502) (DSIGT(I),I=1,6)
  186. 59502 FORMAT(2X,' DSIGT ',6(1X,1PE12.5)/)
  187. WRITE(IOIMP,59503) (DFF(I),I=1,6)
  188. 59503 FORMAT(2X,' DFF ',6(1X,1PE12.5)/)
  189. ENDIF
  190.  
  191. *
  192. TRA=0.D0
  193. DO I=1,6
  194. TRA = TRA + DFF(I)*DSIGT(I)
  195. ENDDO
  196. IF(IIMPI.EQ.42) THEN
  197. PRINT *,' ######## TRA = ',TRA
  198. ENDIF
  199. IF(TRA.LT.0.D0) ICOMEL=1
  200. ENDIF
  201.  
  202. *
  203. * RETRAITEMENT DE MM SI IFERM=1
  204. * ET SI ICOMEL=0
  205. *
  206. MC2=0
  207. DO I=1,MC
  208. IF(MM(I).GE.4.AND.MM(I).LE.6) THEN
  209. IC=MM(I)-3
  210. IF(IFERM(IC).EQ.1) GO TO 101
  211. ENDIF
  212. *
  213. IF(MM(I).EQ.16.AND.ICOCRI.EQ.1.AND.ICOMEL.EQ.0)
  214. & GO TO 101
  215. *
  216. MC2=MC2+1
  217. MM2(MC2)=MM(I)
  218. 101 CONTINUE
  219. ENDDO
  220.  
  221. *
  222. IF(IIMPI.EQ.42) THEN
  223. WRITE(IOIMP,49102) MC2
  224. 49102 FORMAT(2X,' NOUVELLE VALEUR MC2 = ',I3/)
  225. WRITE(IOIMP,49103) (MM2(IC),IC=1,MC2)
  226. 49103 FORMAT(2X,' NOUVELLE LISTE MM2'/16(1X,I3)/)
  227. ENDIF
  228.  
  229. *
  230. CALL OTTOXX(MC2,MM2,SIG0,DSIGT,STOT,
  231. & VAUX1,VAUX2,VAUX,FCV,DX,DXV1,DXV2,
  232. & PRECIE,PRECIZ,BTR,YOUN,
  233. & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF,
  234. & XX,IRESU,NRESU,XCOMP,XLAMC,ICOMEL,LERED,KERRE)
  235. IF(KERRE.NE.0) RETURN
  236. *
  237. IF(IIMPI.EQ.42) THEN
  238. WRITE(IOIMP,44103) NRESU
  239. 44103 FORMAT(1X,' SORTIE DE OTTOXX NRESU=',I3/)
  240. WRITE(IOIMP,48103) (IRESU(I),I=1,NRESU)
  241. 48103 FORMAT(1X,' IRESU '/10I4/)
  242. PRINT *,'XX =',XX
  243. ENDIF
  244. *
  245. IF(NCA.EQ.0) THEN
  246.  
  247. IF(IIMPI.EQ.42) THEN
  248. WRITE(IOIMP,77003)
  249. 77003 FORMAT(1X,' :::::::::::::::::::::::' /
  250. & 1X,' SORTIE ELASTIQUE ' /
  251. & 1X,' :::::::::::::::::::::::' /)
  252. ENDIF
  253. *
  254. IF(XX.LE.0.D0) THEN
  255. KERRE=2
  256. PRINT *,' XX EST NEGATIF OU NUL '
  257. PRINT *,'XX=',XX
  258. RETURN
  259. ENDIF
  260. *
  261. GO TO 89
  262.  
  263. ELSE
  264. *
  265. CALL IANUL(LEBIL2,NC)
  266. * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  267.  
  268. CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  269. & XLTR,XINVL,SBILI,FCC,PENTE2,LEBIL2,
  270. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  271. IF(KERRE.NE.0) RETURN
  272. * write (6,*) ' pente apres ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  273.  
  274. *
  275. IF(IIMPI.EQ.42) THEN
  276. WRITE(IOIMP,72093) (FCC(IJ),IJ=1,NC)
  277. 72093 FORMAT(1X,' FCC ',(4(1X,1PE12.5))/)
  278. ENDIF
  279. *
  280. IELAS=1
  281. DO IJ=1,NCA
  282. JJ=NN(IJ)
  283. IF (FCC(JJ).GT.PRECIZ) IELAS=0
  284. ENDDO
  285. *
  286. IF(IELAS.EQ.1) THEN
  287.  
  288. IF(IIMPI.EQ.42) THEN
  289. WRITE(IOIMP,77003)
  290. ENDIF
  291. *
  292. GO TO 89
  293. ENDIF
  294. *
  295. ENDIF
  296. *
  297. *
  298. * cas de l'ecoulement elastoplastique
  299. * -----------------------------------
  300. *
  301. 88 CONTINUE
  302.  
  303. IF(IIMPI.EQ.42) THEN
  304. WRITE(IOIMP,70378)
  305. 70378 FORMAT(/2X,' ON ATTAQUE LE CAS PLASTIQUE '//)
  306. ENDIF
  307.  
  308. *
  309. * INITIALISATIONS
  310. *
  311. ITER =0
  312. DO I=1,6
  313. DEPST0(I)=DEPSTT(I)
  314. STOT(I)=SIG0(I)
  315. ENDDO
  316. *
  317. DO I=1,NC
  318. ISING(I)=0
  319. IF(LEBIL(I).EQ.2) ISING(I)=1
  320. ENDDO
  321. *
  322. * write (6,*) ' pente avant ottoin dans ottoca ',(PENTE(IC),IC=1,4)
  323.  
  324. IF(ISING(1)+ISING(2)+ISING(3).NE.0.OR.
  325. & (IFERM(4).EQ.1.AND.NCA.GE.2)) THEN
  326. CALL OTTOIN(ISING,IFERM,IBRUP,LEBIL,PENTE,PENTE2,
  327. & NCA,NN,MC,MM,STOT,DSIGT,DDE,GS,FC,
  328. & XINVL,SMAX,XLTR,PRECIZ,XCOMP,XLAMC,KERRE)
  329. IF(KERRE.NE.0) RETURN
  330. * write (6,*) ' pente apres ottoin dans ottoca ',(PENTE(IC),IC=1,4)
  331.  
  332. ENDIF
  333.  
  334.  
  335. *
  336. 444 CONTINUE
  337. *
  338. IF(ITER.NE.0) THEN
  339. *
  340. IF(IIMPI.EQ.42) THEN
  341. WRITE(IOIMP,74078)
  342. 74078 FORMAT(/2X,' ON REINITIALISE LE PROCESSUS'//)
  343. ENDIF
  344. *
  345. DO I=1,6
  346. DEPSTT(I)=DEPST0(I)
  347. STOT(I)=SIG0(I)
  348. ENDDO
  349. CALL ZDANUL(DEFPLA,6)
  350. CALL ZDANUL(VAUX,6)
  351. CALL ZDANUL(VAUX1,6)
  352. CALL ZDANUL(VAUX2,6)
  353. *
  354. DO I=1,3
  355. IF (XINVL(I).NE.XZER) THEN
  356. W(I)=W0(I)
  357. WMAX(I)=WMAX0(I)
  358. WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I))
  359. SMAX(I)=SMAX0(I)
  360. ENDIF
  361. ENDDO
  362. XLAMC=XLAMC0
  363. *
  364. *******
  365. ******* REACTUALISATION DE DDE ?
  366. ******* CALL OTTODD(DDE,YOUN,XNU,G,GS,XINVL,W)
  367. *******
  368. *
  369. * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  370.  
  371. CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  372. & XLTR,XINVL,SBILI,FC,PENTE,LEBIL,
  373. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  374. IF(KERRE.NE.0) RETURN
  375. * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  376. *
  377. ENDIF
  378.  
  379. *
  380. XX=0.D0
  381. DO IC=1,NC+1
  382. DX(IC)=0.D0
  383. DDX(IC)=0.D0
  384. ENDDO
  385.  
  386. *
  387. * MLR 9/7/99
  388. * RETRAITEMENT DE MM SI ICOMPL=1
  389. *
  390.  
  391. ICOMPL=0
  392. DO IJ=1,NCA
  393. IF(NN(IJ).EQ.4.AND.ICOCRI.EQ.1) ICOMPL=1
  394. ENDDO
  395. *
  396.  
  397. MC2=0
  398. DO I=1,MC
  399. IF(ICOMPL.EQ.1.AND.MM(I).EQ.16) GO TO 102
  400. *
  401. MC2=MC2+1
  402. MM2(MC2)=MM(I)
  403. 102 CONTINUE
  404. ENDDO
  405.  
  406. *
  407. *
  408. * -------------------------------
  409. * | LES ITERATIONS INTERNES |
  410. * -------------------------------
  411. 555 CONTINUE
  412. ITER=ITER+1
  413. IF(IIMPI.EQ.42) THEN
  414. WRITE(IOIMP,77888) ITER
  415. 77888 FORMAT(1X,' >>>>>>>>>>> OTTOCA - ITER =',I4/)
  416. ENDIF
  417. *
  418. IF(ITER.GT.ITMAX) THEN
  419. KERRE=2
  420. RETURN
  421. ENDIF
  422. *
  423. CALL SHIFTD(STOT,SIGEL,6)
  424. CALL ZDANUL(DDPLAS,6)
  425.  
  426. IF(IIMPI.EQ.42) THEN
  427. WRITE(IOIMP,60081) (SIGEL(I),I=1,6)
  428. 60081 FORMAT(1X,' SIGEL '/(6(1X,1PE12.5))/)
  429. ENDIF
  430. *
  431. * write (6,*) ' pente avant ottofl dans ottoca ',(PENTE(IC),IC=1,4)
  432. CALL OTTOFL(NCA,NN,XINVL,PENTE,SIGEL,GS,SMAX,XLTR,
  433. & DFDS,DGDS,HDFDQ,XCOMP,XLAMC,PRECIE,
  434. & PRECIZ,KERRE)
  435. IF(KERRE.NE.0) RETURN
  436. * write (6,*) ' pente avant ottofl dans ottoca ',(PENTE(IC),IC=1,4)
  437. *
  438. *
  439. *
  440. * REMPLISSAGES
  441. *
  442. NDIM=NCA
  443. IF(IFOUR.EQ.-2) NDIM=NCA+1
  444. *
  445. IF(IIMPI.EQ.42) THEN
  446. WRITE(IOIMP,77010) NCA,NDIM
  447. 77010 FORMAT(5X,'NCA=',I3,2X,'NDIM =',I3/)
  448. WRITE(IOIMP,77018) (NN(IJ),IJ=1,NCA)
  449. 77018 FORMAT(5X,'NN ',5(1X,I3))
  450. ENDIF
  451. *
  452. DO IJ=1,NCA
  453. *
  454. JJ=NN(IJ)
  455. CALL OTTOPR(DDE,DGDS(1,JJ),VAUX1)
  456. *
  457. DO IK=1,NCA
  458. JK=NN(IK)
  459. AA(IK,IJ)= SDOT(6,DFDS(1,JK),1,VAUX1,1)
  460. IF(IK.EQ.IJ) AA(IK,IJ)=AA(IK,IJ)-HDFDQ(JK)
  461. ENDDO
  462. BB1(IJ)=FC(JJ)
  463. BB2(IJ)=SDOT(6,DFDS(1,JJ),1,DSIGT,1)
  464.  
  465. *
  466. * SPECIAL CP
  467. *
  468. IF(IFOUR.EQ.-2) THEN
  469. * LA COMPOSANTE EPS 33 EST EN POSITION 1 ( CF RAPPEL )
  470. AA(IJ,NDIM)=-(DFDS(1,JJ)*DDE(1)+DFDS(2,JJ)*DDE(6)
  471. * +DFDS(3,JJ)*DDE(5)+DFDS(4,JJ)*DDE(10))
  472. AA(NDIM,IJ)=VAUX1(1)
  473. ENDIF
  474. ENDDO
  475.  
  476. *
  477. DO IK=1,NCA
  478. IF(AA(IK,IK).LT.0.D0) THEN
  479. PRINT *,' OTTOCA - TERME DIAGONAL NEGATIF'
  480. KERRE=61
  481. WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5)
  482. RETURN
  483. ENDIF
  484. ENDDO
  485. *
  486. IF(IFOUR.EQ.-2) THEN
  487. AA(NDIM,NDIM)=-DDE(1)
  488. BB1(NDIM)=SIGEL(1)
  489. BB2(NDIM)=DSIGT(1)
  490. ENDIF
  491.  
  492. *
  493. * SPECIAL XX(N+1)
  494. *
  495. DO I=1,NDIM
  496. BB1(I)=BB1(I) - XX*BB2(I)
  497. ENDDO
  498. *
  499. IF(IIMPI.EQ.42) THEN
  500. WRITE(IOIMP,77011) ((AA(I,J),J=1,5),I=1,5)
  501. 77011 FORMAT(5X,' MATRICE AA'/(5(1X,1PE12.5)))
  502. WRITE(IOIMP,77012) (BB1(I),I=1,5)
  503. 77012 FORMAT(5X,' VECTEUR BB1'/(5(1X,1PE12.5)))
  504. WRITE(IOIMP,70012) (BB2(I),I=1,5)
  505. 70012 FORMAT(5X,' VECTEUR BB2'/(5(1X,1PE12.5)))
  506. ENDIF
  507. *
  508. * RESOLUTION
  509. *
  510. KERRE=0
  511. CALL INVALM(AA,NC1,NDIM,KERRE,PRECIZ)
  512. IF(KERRE.NE.0) THEN
  513. RETURN
  514. ENDIF
  515. IF(IIMPI.EQ.42) THEN
  516. WRITE(IOIMP,77013) ((AA(I,J),J=1,5),I=1,5)
  517. 77013 FORMAT(5X,' MATRICE AA INVERSEE '/(5(1X,1PE12.5)))
  518. ENDIF
  519. *
  520. CALL MULMA2(VEC1,AA,BB1,NDIM,1,NDIM,NC1,NC1)
  521. CALL MULMA2(VEC2,AA,BB2,NDIM,1,NDIM,NC1,NC1)
  522. *
  523. CALL ZDANUL(VAUX1,6)
  524. CALL ZDANUL(VAUX2,6)
  525. *
  526. DO IJ=1,NCA
  527. JJ=NN(IJ)
  528. DO I=1,6
  529. VAUX1(I)=VAUX1(I)+DGDS(I,JJ)*VEC1(IJ)
  530. VAUX2(I)=VAUX2(I)+DGDS(I,JJ)*VEC2(IJ)
  531. ENDDO
  532. IF(JJ.LE.3) THEN
  533. DXV1(JJ)=VEC1(IJ)
  534. DXV2(JJ)=VEC2(IJ)
  535. ENDIF
  536. ENDDO
  537. *
  538. IF(IFOUR.EQ.-2) THEN
  539. VAUX1(1)=VAUX1(1)-VEC1(NDIM)
  540. VAUX2(1)=VAUX2(1)-VEC2(NDIM)
  541. ENDIF
  542. *
  543.  
  544. CALL OTTOPR(DDE,VAUX1,SIG1)
  545. CALL OTTOPR(DDE,VAUX2,SIG2)
  546.  
  547. IF(IIMPI.EQ.42) THEN
  548. WRITE(IOIMP,77081) (SIG1(I),I=1,6)
  549. 77081 FORMAT(5X,' VECTEUR SIG1'/(6(1X,1PE12.5)))
  550. WRITE(IOIMP,70082) (SIG2(I),I=1,6)
  551. 70082 FORMAT(5X,' VECTEUR SIG2'/(6(1X,1PE12.5)))
  552. ENDIF
  553.  
  554. DO I=1,6
  555. SIG1(I)=SIGEL(I)-SIG1(I)-XX*DSIGT(I)
  556. SIG2(I)=DSIGT(I) - SIG2(I)
  557. ENDDO
  558. *
  559. IF(IIMPI.EQ.42) THEN
  560. WRITE(IOIMP,73312) (VEC1(I),I=1,5)
  561. 73312 FORMAT(5X,' VECTEUR VEC1'/(5(1X,1PE12.5)))
  562. WRITE(IOIMP,73313) (VEC2(I),I=1,5)
  563. 73313 FORMAT(5X,' VECTEUR VEC2'/(5(1X,1PE12.5)))
  564. WRITE(IOIMP,74412) (VAUX1(I),I=1,6)
  565. 74412 FORMAT(5X,' VECTEUR VAUX1'/(6(1X,1PE12.5)))
  566. WRITE(IOIMP,74413) (VAUX2(I),I=1,6)
  567. 74413 FORMAT(5X,' VECTEUR VAUX2'/(6(1X,1PE12.5)))
  568. WRITE(IOIMP,77014) (SIG1(I),I=1,6)
  569. 77014 FORMAT(5X,' VECTEUR SIG1'/(6(1X,1PE12.5)))
  570. WRITE(IOIMP,70014) (SIG2(I),I=1,6)
  571. 70014 FORMAT(5X,' VECTEUR SIG2'/(6(1X,1PE12.5)))
  572. ENDIF
  573. *
  574. *
  575. ICOMEL=0
  576. CALL OTTOCE(MC2,MM2,SIG1,DX,DXV1,W,WMAX,SMAX,WRUPT,
  577. & XLTR,XINVL,BTR,NFISSU,NVF,FCV1,VF,YOUN,
  578. & PRECIZ,JFIS,XCOMP,XLAMC,DFF,DGG,KERRE)
  579. IF(KERRE.NE.0) RETURN
  580. *
  581. * MLR 9/7/99
  582. *
  583. IF(ICOCRI.EQ.1.AND.ICOMPL.EQ.0.AND.
  584. & ABS(FCV1(16)).LE.PRECIZ) THEN
  585. ICOMEL=1
  586. ENDIF
  587. *
  588. CALL OTTOXX(MC2,MM2,SIG1,SIG2,STOT,
  589. & VAUX1,VAUX2,VAUX,FCV1,DX,DXV1,DXV2,
  590. & PRECIE,PRECIZ,BTR,YOUN,
  591. & W,WMAX,SMAX,WRUPT,XLTR,XINVL,NFISSU,NVF,VF,
  592. & XXX,IRESU,NRESU,XCOMP,XLAMC,ICOMEL,LERED,KERRE)
  593. *
  594. IF(KERRE.NE.0) RETURN
  595. IF(LERED.EQ.1) GO TO 888
  596. *
  597. DO IJ=1,NCA
  598. DDX(IJ)=VEC1(IJ)+XXX*VEC2(IJ)
  599. ENDDO
  600. *
  601. * TESTS
  602. *
  603. IF(XXX.LE.0.D0) THEN
  604. KERRE=2
  605. PRINT *,' XXX EST NEGATIF OU NUL '
  606. RETURN
  607. ENDIF
  608. *
  609. *
  610. NCAA=0
  611. DO IJ=1,NCA
  612. JJ=NN(IJ)
  613. DXSOM=DX(JJ)+DDX(IJ)
  614. *
  615. IF(DXSOM.GE.0.D0) THEN
  616. NCAA=NCAA+1
  617. NN(NCAA)=JJ
  618.  
  619. ELSE IF(DXSOM.LT.0.D0) THEN
  620.  
  621. IF(LEBIL(JJ).EQ.1) THEN
  622. IF(IFERM(JJ).NE.1) THEN
  623. NCAA=NCAA+1
  624. NN(NCAA)=JJ
  625. *
  626. ELSE IF(IFERM(JJ).EQ.1) THEN
  627. IF(W0(JJ)+DXSOM/XINVL(JJ).GT.WREOUV(JJ)) THEN
  628. NCAA=NCAA+1
  629. NN(NCAA)=JJ
  630. ENDIF
  631. ENDIF
  632. *
  633. ENDIF
  634. ENDIF
  635. ENDDO
  636. *
  637. *
  638. IF(IIMPI.EQ.42) THEN
  639. WRITE(IOIMP,77008) NCA,NCAA,(NN(IJ),IJ=1,NCAA)
  640. 77008 FORMAT(5X,'NCA=',I3,2X,'NCAA=',I3/2X,'NN ' ,8I3/)
  641. WRITE(IOIMP,77607) (DDX(IJ),IJ=1,NC+1)
  642. 77607 FORMAT(5X,'DDX '/(8(1X,1PE12.5))/)
  643. ENDIF
  644. *
  645. * QUELQUES TESTS SUPPLEMENTAIRES
  646. *
  647. IF(NCAA.EQ.0) THEN
  648. IF(IIMPI.EQ.42) THEN
  649. PRINT *,' OTTOCA - NCAA EST NUL '
  650. ENDIF
  651. GO TO 888
  652. ENDIF
  653. *
  654. *
  655. IF(NCA.NE.NCAA) THEN
  656. *
  657. IF(NCAA.GT.NCA) THEN
  658. KERRE=7
  659. PRINT *,' OTTOCA - NCAA EST SUPERIEUR A NCA '
  660. RETURN
  661. ENDIF
  662. NCA=NCAA
  663. GO TO 444
  664. ENDIF
  665. *
  666. * ON ENQUILLE
  667. *
  668. XX=XXX
  669. DO IJ=1,NCA
  670. JJ=NN(IJ)
  671. DX(JJ)=DX(JJ)+DDX(IJ)
  672. DO I=1,6
  673. DDPLAS(I)=DDPLAS(I)+DGDS(I,JJ)*DDX(IJ)
  674. DEFPLA(I)=DEFPLA(I)+DGDS(I,JJ)*DDX(IJ)
  675. ENDDO
  676. *
  677. IF(JJ.EQ.4) THEN
  678. XLAMC=XLAMC0+DX(4)
  679. ENDIF
  680. ENDDO
  681. *
  682. DO I=1,3
  683. IF (XINVL(I).NE.XZER) W(I)=W0(I)+DX(I)/XINVL(I)
  684. IF (W(I).GT.WMAX0(I)) THEN
  685. IF(LEBIL(I).NE.1.OR.WMAX0(I).GE.WRUPT(I)) THEN
  686. WMAX(I)=W(I)
  687. WREOUV(I) = BTR*MIN(WMAX(I),WRUPT(I))
  688. ENDIF
  689. ENDIF
  690. ENDDO
  691. *
  692. IF(IFOUR.EQ.-2) THEN
  693. DEPSTT(1)=DEPSTT(1)+DDX(NDIM)
  694. STOT(1)=STOT(1)-DDE(1)*DDX(NDIM)
  695. STOT(2)=STOT(2)-DDE(6)*DDX(NDIM)
  696. STOT(3)=STOT(3)-DDE(5)*DDX(NDIM)
  697. STOT(4)=STOT(4)-DDE(10)*DDX(NDIM)
  698. ENDIF
  699. *
  700. IF(IIMPI.EQ.42) THEN
  701. WRITE(IOIMP,77991) (DEFPLA(IJ),IJ=1,6)
  702. 77991 FORMAT(1X,' DEFPLA '/(6(1X,1PE12.5))/)
  703. WRITE(IOIMP,60091) (DDPLAS(IJ),IJ=1,6)
  704. 60091 FORMAT(1X,' DDPLAS '/(6(1X,1PE12.5))/)
  705. WRITE(IOIMP,60095) (DX(IJ),IJ=1,NC+1)
  706. 60095 FORMAT(1X,' DX '/(6(1X,1PE12.5))/)
  707. WRITE(IOIMP,60096) XLAMC
  708. 60096 FORMAT(1X,' XLAMC=',1PE12.5/)
  709. WRITE(IOIMP,60901) (W0(IJ),IJ=1,3)
  710. 60901 FORMAT(1X,' W0 '/(3(1X,1PE12.5))/)
  711. WRITE(IOIMP,70901) (W(IJ),IJ=1,3),(WMAX(IJ),IJ=1,3)
  712. 70901 FORMAT(1X,' W '/(3(1X,1PE12.5))/
  713. & 1X,' WMAX '/(3(1X,1PE12.5))/)
  714. WRITE(IOIMP,70091) (STOT(IJ),IJ=1,6)
  715. 70091 FORMAT(1X,' ENFIN STOT '/(6(1X,1PE12.5))/)
  716. WRITE(IOIMP,70080)
  717. 70080 FORMAT(1X,' FIN DE L ITERATION - AVANT TESTS ' /)
  718. WRITE(IOIMP,77806) (STOT(I),I=1,6)
  719. 77806 FORMAT(1X,' STOT ' /(6(1X,1PE12.5))/)
  720. ENDIF
  721.  
  722. *
  723. * TESTS DE CONVERGENCE
  724. *
  725. * write (6,*) ' pente avant ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  726.  
  727. CALL OTTOCR(NCA,NN,STOT,W,WMAX,SMAX,BILIN,WRUPT,BTR,
  728. & XLTR,XINVL,SBILI,FC,PENTE,LEBIL,
  729. & PRECIE,PRECIZ,XCOMP,XLAMC,KERRE)
  730. IF(KERRE.NE.0) RETURN
  731. * write (6,*) ' pente apres ottocr dans ottoca ',(PENTE(IC),IC=1,4)
  732. *
  733. IF(IIMPI.EQ.42) THEN
  734. WRITE(IOIMP,77903) (LEBIL(IJ),IJ=1,NC)
  735. 77903 FORMAT(1X,' TESTS DE CONVERGENCE - SORTIE DE OTTOCR '/
  736. & 2X,' LEBIL ' , (4(1X,I4))/)
  737. WRITE(IOIMP,77093) (FC(IJ),IJ=1,NC)
  738. 77093 FORMAT(1X,' FC ',(4(1X,1PE12.5))/)
  739. ENDIF
  740. *
  741. DO IJ=1,NCA
  742. JJ=NN(IJ)
  743. IF (ABS(FC(JJ)).GT.PRECIZ) GO TO 555
  744. ENDDO
  745. IF(IFOUR.EQ.-2) THEN
  746. IF(ABS(STOT(1)).GT.PRECIZ) GO TO 555
  747. ENDIF
  748.  
  749. *
  750. * MISE A JOUR DE WMAX ET SMAX
  751. *
  752. DO I=1,3
  753. IF(W(I).GT.WMAX(I)) THEN
  754. WMAX(I)=W(I)
  755. * write (6,*) ' pente avant ottofu dans ottoca ',(PENTE(IC),IC=1,4)
  756.  
  757. CALL OTTOFU(XINVL,XLTR,WRUPT,BTR,BILIN,
  758. & SBILI,W,WMAX,SMAX,PENTE,I)
  759. * write (6,*) ' pente apres ottofu dans ottoca ',(PENTE(IC),IC=1,4)
  760. ENDIF
  761.  
  762. ENDDO
  763. *
  764. *
  765. 89 CONTINUE
  766. *
  767. *
  768. * ENCORE QUELQUES TESTS
  769. *
  770. CALL OTTOVE(NRESU,IRESU,STOT,W,WMAX,WRUPT,SMAX,
  771. & BTR,XLTR,XINVL,BILIN,SBILI,PRECIE,PRECIZ,DEFPLA,
  772. & NN,NC,NCA,FC,FC2,PENTE,PENTE2,LEBIL,ISING,
  773. & XCOMP,XLAMC,KERRE)
  774. IF(KERRE.NE.0) RETURN
  775.  
  776. *
  777. * SORTIE - REMPLISSAGE
  778. *
  779. DO I=1,6
  780. SIGF(I)=STOT(I)
  781. DEFP(I)=DEFPLA(I)
  782. ENDDO
  783. *
  784.  
  785. XX=XX*REFAC
  786. *
  787. *
  788. IF(IIMPI.EQ.42) THEN
  789. WRITE(IOIMP,77895) (SIGF(IJ),IJ=1,6)
  790. 77895 FORMAT(1X,' OTTOCA - SIGF '/(6(1X,1PE12.5))/)
  791. WRITE(IOIMP,77896) (DEFP(IJ),IJ=1,6)
  792. 77896 FORMAT(1X,' OTTOCA - DEFP '/(6(1X,1PE12.5))/)
  793. ENDIF
  794. *
  795. RETURN
  796. END
  797.  
  798.  
  799.  
  800.  
  801.  
  802.  
  803.  

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