Télécharger la plaquette Cast3M


fr en

Télécharger ottoca.eso

Retour à la liste

Numérotation des lignes : 

ottoca

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

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