Télécharger la plaquette Cast3M


fr en

Télécharger ottoxx.eso

Retour à la liste

Numérotation des lignes : 

ottoxx

  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 PPARAM
  22. -INC CCOPTIO
  23. C
  24.       PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  25. C
  26.       DIMENSION SIG0(6),DSIGT(6),STOT(6),XCOMP(*)
  27.       DIMENSION VAUX1(6),VAUX2(6),VAUX(6)
  28.       DIMENSION DX(*),DXV1(*),DXV2(*)
  29.       DIMENSION DXVV(3)
  30.       DIMENSION W(3),WMAX(3),WREOUV(3),
  31.      &          WRUPT(3),XLTR(3),XINVL(3),XXF(3)
  32.       DIMENSION MM(*),SMAX(*)
  33.       DIMENSION FC0(*),JCRIT(*)
  34.       DIMENSION VF(3,3),JFIS(3),JFIS2(3)
  35.       DIMENSION JCDUM(1)
  36.       DIMENSION FC2(16),FCT(16),MMA(20)
  37.  
  38.       DIMENSION DFF(6),DGG(6)
  39.  
  40.       IF(IIMPI.EQ.42) THEN
  41.           WRITE(IOIMP,55446) ICOMEL
  42. 55446     FORMAT(/2X,' ENTREE OTTOXX - ICOMEL =',I4/)
  43.       ENDIF
  44.  
  45. C
  46. C     INITIALISATIONS
  47. C
  48.       KERRE=0
  49.       LERED=0
  50.       XXMIN=1.D0
  51.       NCRIT=0
  52.       CALL IANUL(JCRIT,20)
  53. *
  54. *
  55.       DO I=1,6
  56.          STOT(I)=SIG0(I)+DSIGT(I)
  57.          VAUX(I)=VAUX1(I)+VAUX2(I)
  58.       ENDDO
  59. *
  60.       DO I=1,3
  61.          DXVV(I)=DXV1(I)+DXV2(I)
  62.       ENDDO
  63.  
  64. *
  65. *     APPEL A OTTOCE
  66. *
  67.  
  68.          IF(IIMPI.EQ.42) THEN
  69.            WRITE(IOIMP,32246)
  70. 32246      FORMAT(/2X,'  DANS OTTOXX - APPEL A OTTOCE POUR FCT'//)
  71.          ENDIF
  72.  
  73.  
  74.       CALL OTTOCE(MC,MM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  75.      &       XLTR,XINVL,BTR,NFISSU,NVF,FCT,VF,YOUN,PRECIZ,
  76.      &       JFIS,XCOMP,XLAMC,DFF,DGG,KERRE)
  77.       IF(KERRE.NE.0) RETURN
  78. *
  79. *
  80.       MCA=0
  81.       DO IC=1,MC
  82.          JC=MM(IC)
  83. *
  84.          IF(IIMPI.EQ.42) THEN
  85.            WRITE(IOIMP,30446) IC,JC,FC0(JC),FCT(JC)
  86. 30446      FORMAT(/2X,' OTTOXX - IC=',I4,2X,' JC=',I4,2X,
  87.      &         ' FC0(JC)=',1PE12.5,2X,'FCT(JC)=',1PE12.5/)
  88.          ENDIF
  89. *
  90.          IF(FCT(JC).GT.0.D0)THEN
  91.            MCA=MCA+1
  92.            MMA(MCA)=JC
  93.          ELSE IF(ABS(FCT(JC)).LE.PRECIZ)THEN
  94.            MCA=MCA+1
  95.            MMA(MCA)=JC
  96.            IF(FCT(JC).LT.0.D0) FCT(JC)=0.D0
  97.          ENDIF
  98.       ENDDO
  99. *
  100.  
  101.       IF(IIMPI.EQ.42) THEN
  102.           WRITE(IOIMP,50446) MCA
  103. 50446     FORMAT(/2X,' DANS OTTOXX - MCA =',I4/)
  104.           WRITE(IOIMP,40446) (MMA(I),I=1,MCA)
  105. 40446     FORMAT(/2X,' OTTOXX - MMA =',5I4/)
  106.           PRINT *, ' PRECIZ = ', PRECIZ
  107.       ENDIF
  108. *
  109. *
  110.       IF(MCA.NE.0) THEN
  111. *
  112. *     FAUT-IL APPELER OTTOXF ?
  113. *
  114.          LAPPEL=0
  115.  
  116.          IZOB = 0
  117.          IF(IZOB.GT.0) THEN
  118.          DO IC=1,MCA
  119.             JC=MMA(IC)
  120. *
  121.             IF(JC.GE.1.AND.JC.LE.3) THEN
  122. *
  123.               IF(FC0(JC).GT.0.D0.AND.FC0(JC).LT.PRECIZ) THEN
  124. *
  125.                  XXMIN=0.D0
  126.                  JCRIT(1)=JC
  127.                  NCRIT=1
  128.                  DO I=1,6
  129.                     STOT(I)=SIG0(I)
  130.                     VAUX(I)=VAUX1(I)
  131.                  ENDDO
  132.                  GO TO 300
  133.               ENDIF
  134.               IF(JFIS(JC).GT.1) LAPPEL=1
  135.             ENDIF
  136.          ENDDO
  137.          ENDIF
  138. *
  139. *       MLR  9/7/99
  140. *
  141.          DO IC=1,MCA
  142.             JC=MMA(IC)
  143.             IF(ICOMEL.EQ.1.AND.JC.EQ.16) GO TO 77
  144. *           IF(FC0(JC)*FCT(JC).GT.0.D0) THEN
  145.             IF((FC0(JC)*FCT(JC).GT.0.D0).AND.
  146.      &   (ABS(FC0(JC)).GT.PRECIZ.AND.ABS(FCT(JC)).GT.PRECIZ))THEN
  147.               IF(IIMPI.EQ.42) THEN
  148.                 PRINT *,'##### OTTOXX CRITERES INCOMPATIBLES JC = ',JC
  149.                 PRINT *,' FC0 = ',FC0(JC), ' FCT = ', FCT(JC)
  150.               ENDIF
  151.               LERED=1
  152.               RETURN
  153.             ENDIF
  154.  77         CONTINUE
  155.          ENDDO
  156.  
  157.  
  158. *
  159. *    APPEL A OTTOXF
  160. *
  161.          IF(LAPPEL.EQ.1) THEN
  162.             CALL OTTOXF(SIG0,DSIGT,XINVL,XLTR,
  163.      &                  NFISSU,NVF,XXF,PRECIZ,KERRE)
  164.             IF(KERRE.NE.0) RETURN
  165. *
  166.             IF(IIMPI.EQ.42) THEN
  167.                WRITE(IOIMP,44556) (XXF(I),I=1,3)
  168. 44556          FORMAT(/2X,' APRES OTTOXF : XXF ',3(1X,1PE12.5)/)
  169.             ENDIF
  170. *
  171. ****  MLR 9/7/99
  172. *
  173.             IF(XXF(2).EQ.1.D4.AND.XXF(3).EQ.1.D4) THEN
  174.               LAPPEL=0
  175.               GO TO 50
  176.             ENDIF
  177. *
  178. *
  179.             IF(JFIS(2).GT.1) THEN
  180.               I1=1
  181.               IF(JFIS(2).EQ.2) I1=2
  182.               DO I=I1,3
  183.                 IF(XXF(I).GT.0.D0) THEN
  184.                    XXFIS=XXF(I)
  185.                    GO TO 50
  186.                 ENDIF
  187.               ENDDO
  188.               IF(IIMPI.EQ.42) THEN
  189.                 WRITE(IOIMP,77453)
  190. 77453           FORMAT(2X,'#######  PAS DE RACINE POSITIVE  #######'/)
  191.               ENDIF
  192. ******        KERRE=70
  193. ******        RETURN
  194. *  ON SE DONNE UNE DERNIERE CHANCE
  195. *
  196.               LAPPEL=0
  197.             ENDIF
  198. *
  199.   50        CONTINUE
  200. *
  201.          ENDIF
  202. *
  203. *
  204.          DO IC=1,MCA
  205.             JC=MMA(IC)
  206.             F1=FC0(JC)
  207.             F2=FCT(JC)
  208.             IF(IIMPI.EQ.42) THEN
  209.                PRINT *,' IC=',IC
  210.                PRINT *,' JC=',JC
  211.                PRINT *,' FC0=',FC0(JC)
  212.                PRINT *,' FCT=',FCT(JC)
  213.             ENDIF
  214.  
  215. *
  216. *   MLR 9/7/99
  217. *
  218.             XXDEP=0.D0
  219.  
  220.             IF(ICOMEL.EQ.1.AND.JC.EQ.16) THEN
  221. *
  222. *  SPECIAL RETRAITEMENT DU POINT INITIAL
  223. *
  224.               IF(ABS(F2).LE.PRECIZ) THEN
  225.                  XX=1.D0
  226.                  GO TO 200
  227.               ENDIF
  228. *
  229.               IDITER=0
  230.               XX=0.5D0
  231.  
  232. 600           IDITER=IDITER+1
  233.               IF(IDITER.GT.100) THEN
  234.                  PRINT *,'IDITER=100 '
  235.                  KERRE=1
  236.                  RETURN
  237.               ENDIF
  238. *
  239.               DO I=1,6
  240.                  STOT(I)=SIG0(I)+XX*DSIGT(I)
  241.                  VAUX(I)=VAUX1(I)+XX*VAUX2(I)
  242.               ENDDO
  243. *
  244.               DO I=1,3
  245.                  DXVV(I)=DXV1(I)+XX*DXV2(I)
  246.               ENDDO
  247. *
  248. *
  249.               JCDUM(1)=JC
  250.               CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  251.      &          XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  252.      &          JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  253.               IF(KERRE.NE.0) RETURN
  254.               FF=FC2(JC)
  255.               IF(ABS(FF).LT.PRECIZ) GO TO 200
  256. *
  257. *
  258.               IF(FF.GT.0.D0) THEN
  259.                  XX=XX/2.D0
  260.                  GO TO 600
  261.               ELSE
  262.                  XXDEP=XX
  263.                  F1=FF
  264.               ENDIF
  265. *
  266.             ENDIF
  267. *
  268.             IF(IIMPI.EQ.42) THEN
  269.                PRINT *,'VALEUR DE DEPART  XXDEP = ',XXDEP
  270.             ENDIF
  271.  
  272.  
  273.  
  274. *
  275.             XX1=XXDEP
  276.             XX2=1.D0
  277.  
  278. *  AM  3/12/15
  279.  
  280.  
  281.             IF(ABS(F1).LT.PRECIZ.AND.ABS(F2).LT.PRECIZ) THEN
  282.               XX=1.D0
  283.               GO TO 1234
  284.             ENDIF
  285.  
  286.             IF(F2-F1.EQ.0.D0) THEN
  287.               IF(IIMPI.EQ.42) THEN
  288.                  PRINT *,'F1 = ', F1, '  F2= ',F2
  289.               ENDIF
  290.               LERED=1
  291.               RETURN
  292.             ENDIF
  293.  
  294.             XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  295.  
  296. 1234        CONTINUE
  297.  
  298.             IF(IIMPI.EQ.42) THEN
  299.                PRINT *,'ESTIMATION SECANTE  XX = ',XX
  300.                PRINT *,'JC=',JC,'  JFIS(JC)=',JFIS(JC)
  301.             ENDIF
  302. *
  303. *
  304.             IF(JC.GE.1.AND.JC.LE.3.AND.LAPPEL.EQ.1) THEN
  305.                IF(JFIS(JC).GE.2) THEN
  306. *
  307.                  IF(IIMPI.EQ.42) THEN
  308.                     PRINT *,'VALEUR CALCULEE XX = ',XXFIS
  309.                  ENDIF
  310. *
  311. *  MLR  9/7/99
  312. *
  313.                  IF(XX.LE.1.D0.AND.XXFIS.LE.1.D0) THEN
  314.                     XX=XXFIS
  315.                     GO TO 200
  316. *
  317.                  ELSE
  318.                     LAPPEL=0
  319.                  ENDIF
  320. *
  321.                ENDIF
  322.             ENDIF
  323. *
  324.             ITER=0
  325. *
  326.             IF(IIMPI.EQ.42) THEN
  327.                PRINT *,'PREMIERE ESTIMATION XX  = ',XX
  328.             ENDIF
  329. *
  330. *       ITERATIONS
  331. *
  332.   100       CONTINUE
  333.             ITER=ITER+1
  334. *
  335. *
  336.             IF(ITER.GT.2500) THEN
  337.               PRINT *,' 2500 ITERATIONS DANS OTTOXX'
  338.               KERRE=1
  339.               RETURN
  340.             ENDIF
  341.             DO I=1,6
  342.                STOT(I)=SIG0(I)+XX*DSIGT(I)
  343.                VAUX(I)=VAUX1(I)+XX*VAUX2(I)
  344.             ENDDO
  345. *
  346.             DO I=1,3
  347.                DXVV(I)=DXV1(I)+XX*DXV2(I)
  348.             ENDDO
  349. *
  350. *
  351.             JCDUM(1)=JC
  352.             CALL OTTOCE(1,JCDUM,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  353.      &        XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  354.      &        JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  355.             IF(KERRE.NE.0) RETURN
  356.             FF=FC2(JC)
  357.             IF(ABS(FF).LT.PRECIZ) GO TO 200
  358. *
  359.             IF(IIMPI.EQ.42) THEN
  360.                ZOB1 = F1
  361.                ZOB2 = F2
  362.             ENDIF
  363. *
  364.             IF(FF*F2.GE.0.D0) THEN
  365.                XX2=XX
  366.                F2=FF
  367.             ELSE
  368.                XX1=XX
  369.                F1=FF
  370.             ENDIF
  371. *
  372.             XX= XX2 - F2*(XX2-XX1)/(F2-F1)
  373. *
  374.             IF(IIMPI.EQ.42) THEN
  375.               WRITE(IOIMP,75461) ITER, ZOB1,ZOB2,XX
  376. 75461         FORMAT( 2X, 'I=',I3,2X,'F1=',1PE12.5,2X,
  377.      &              'F2=',1PE12.5,2X,'XX=',1PE12.5)
  378.             ENDIF
  379.  
  380.             GO TO 100
  381. *
  382.   200       CONTINUE
  383. *
  384.             IF(XX.LT.XXMIN) THEN
  385.               XXMIN=XX
  386.             ENDIF
  387. *
  388.          ENDDO
  389.  
  390.  
  391. *
  392. *    ON IMPRIME XXMIN
  393. *
  394.       IF(IIMPI.EQ.42) THEN
  395.          WRITE(IOIMP,73361) XXMIN
  396. 73361    FORMAT( 2X, ' OTTOXX APRES BOUCLE - XXMIN= ',1PE12.5/)
  397.       ENDIF
  398.  
  399.  
  400. *
  401. *     MISES A JOUR ( NCRIT )
  402. *
  403.  
  404.          DO I=1,6
  405.             STOT(I)=SIG0(I)+XXMIN*DSIGT(I)
  406.             VAUX(I)=VAUX1(I)+XXMIN*VAUX2(I)
  407.          ENDDO
  408. *
  409.          DO I=1,3
  410.             DXVV(I)=DXV1(I)+XXMIN*DXV2(I)
  411.          ENDDO
  412. *
  413.          CALL OTTOCE(MCA,MMA,STOT,DX,DXVV,W,WMAX,SMAX,WRUPT,
  414.      &        XLTR,XINVL,BTR,NFISSU,NVF,FC2,VF,YOUN,PRECIZ,
  415.      &        JFIS2,XCOMP,XLAMC,DFF,DGG,KERRE)
  416.          IF(KERRE.NE.0) RETURN
  417.          DO IC=1,MCA
  418.             JC=MMA(IC)
  419. *
  420. *           TEST SUPPLEMENTAIRE
  421. *
  422.             IF(FC2(JC).GT.PRECIZ) THEN
  423.               PRINT *,'######### OTTOXX CRITERE INCOHERENT JC = ',JC
  424.               PRINT *,' FC2 = ',FC2(JC), ' PRECIZ=',PRECIZ
  425.               KERRE=2
  426.               RETURN
  427.             ENDIF
  428. *
  429.             IF(ABS(FC2(JC)).LT.PRECIZ) THEN
  430.               NCRIT=NCRIT+1
  431.               JCRIT(NCRIT)=JC
  432.             ENDIF
  433.          ENDDO
  434. *
  435.   300    CONTINUE
  436. *
  437.       ENDIF
  438.  
  439. *
  440. *     SORTIE
  441. *
  442.       IF(IIMPI.EQ.42) THEN
  443.          WRITE(IOIMP,77000) NCRIT,(JCRIT(I),I=1,NCRIT)
  444. 77000    FORMAT( 2X, ' OTTOXX - NCRIT =',I3,4X,'JCRIT = ',15I3/)
  445.          WRITE(IOIMP,77001) XXMIN
  446. 77001    FORMAT( 2X, ' OTTOXX - XXMIN= ',1PE12.5/)
  447.       ENDIF
  448. *
  449.       RETURN
  450.       END
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  

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