Télécharger la plaquette Cast3M


fr en

Télécharger ottval.eso

Retour à la liste

Numérotation des lignes : 

ottval

  1. C OTTVAL    SOURCE    PV        21/10/28    21:15:07     11152          
  2.       SUBROUTINE OTTVAL(SIGG0,VAR01,NVAR1,DEPSTT,
  3.      &    NDEF,SIGG,VAR1,XVAL,NVAL,VAR02,VAR2,NVAR2,IERUT)
  4. *
  5.       IMPLICIT INTEGER (I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7. -INC CCREEL
  8.       PARAMETER ( TOL1 = 1.D-16 )
  9.       PARAMETER ( TOL2 = 5.D-3 )
  10.       PARAMETER ( TOL3 = 5.D0 )
  11.       PARAMETER ( TOL4 = 1.D-6 )
  12.       PARAMETER ( TOL5 = 1.D-3 )          
  13.       PARAMETER ( XUN   = 1.D0)
  14.       PARAMETER ( XZER  = 0.D0)
  15.       PARAMETER ( MAXINT= 500)
  16.       PARAMETER ( NAUX= 20 )
  17.       PARAMETER ( MCN = 10)
  18.       DIMENSION SIGG0(*),SIGG(*),DEPSTT(*),XVAL(*),VAR01(*),VAR1(*)
  19.       DIMENSION VAR02(*),VAR2(*)
  20.       DIMENSION DD1(6),DD2(6),DD3(6)
  21.       DIMENSION XSM(6),XRM(7),PWX0(10),PWX(10),TAIL(6),P(6)
  22.       DIMENSION SS0(6),SS1(6),SS2(6),SS3(6),SS4(6),SS5(6),SS6(6)
  23.       DIMENSION VV0(7),VV1(7),VV2(7),VV3(7),VV4(7)
  24.       DIMENSION RCZ(10),QV1(10,6),QV2(10,6),QV3(10),XC(10)
  25.       DIMENSION PWY(10),PWY1(10),PWY2(10),PWY3(10),PWY4(10)
  26.       DIMENSION KR1(10),KR2(10),KR3(10),KR5(10),KR2N(10)
  27.       DIMENSION VCA1(3),VCA2(3),VCA3(3),RCZ0(10),PWY5(10)
  28.       DIMENSION VF1(3),VF2(3),VF3(3),FIL(3),OO(3,3),VERIN(3)
  29.  
  30. *  initialisations
  31.  
  32.       do i=1,10
  33.         pwx(i)=0.d0
  34.         pwy(i)=0.d0
  35.       enddo
  36.       do i=1,6
  37.         ss1(i)=0.d0
  38.         ss2(i)=0.d0
  39.         ss3(i)=0.d0
  40.         ss4(i)=0.d0
  41.         ss5(i)=0.d0
  42.         ss6(i)=0.d0
  43.       enddo
  44.       rsso= xpetit
  45.       rssn= xpetit
  46.       rttt= xpetit
  47.       rpv = xpetit
  48.       cu  = xpetit
  49.       YOUN  = XVAL(1)
  50.       XNU   = XVAL(2)
  51.       RTRAC = XVAL(3)
  52.       BETA  = XVAL(5)
  53.       IF(NVAL.GE.6) THEN
  54.         RCOMP = XVAL(6)
  55.       ELSE
  56.         RCOMP = 10.D0 * RTRAC
  57.       ENDIF
  58.       TOL6 = RTRAC*TOL4
  59.       CALL OTTVAA(YOUN,RCOMP,XC)
  60.          DO 15 I=1,6
  61.             TAIL(I)=XVAL(I+6)
  62.             P(I)=XVAL(I+12)
  63.   15     CONTINUE
  64.       KFN=0
  65.       KFJ=0
  66.       KFL=0     
  67.       ZSV=XZER
  68.       USV=XUN
  69.       CALL ZERO(SIGG,6,1)
  70.       CALL ZERO(SS6,6,1)
  71.       CALL ZERO(DD1,6,1)
  72.       CALL ZERO(DD3,6,1)
  73.       DO I=1,NDEF
  74.         SIGG(I)=SIGG0(I)
  75.       ENDDO
  76.       DO I=1,NVAR1
  77.         VAR1(I)=VAR01(I)
  78.       ENDDO
  79.       DO I=1,NVAR2
  80.         VAR2(I)=VAR02(I)
  81.       ENDDO
  82.       DO I=1,3
  83.         VF1(I)=VAR2(I)
  84.         VF2(I)=VAR2(I+4)
  85.         VF3(I)=VAR2(I+8)
  86.       ENDDO
  87.       XNF1 = VAR2( 4)
  88.       XNF2 = VAR2( 8)
  89.       XNF3 = VAR2(12)
  90.       FIL(1)= VAR2(13)
  91.       FIL(2)= VAR2(14)
  92.       FIL(3)= VAR2(15)
  93.  
  94. *   iterations internes
  95.  
  96. 111   CONTINUE
  97.       IF(ZSV.GE.1.D0) GO TO 888
  98.       KFN=KFN+1
  99.       IF((USV.LE.0.).OR.(KFN.GT.MAXINT)) THEN
  100.          IERUT=3
  101.          RETURN
  102.       ENDIF
  103.       DO I=1,NDEF
  104.         DD1(I)= USV*DEPSTT(I)
  105.       ENDDO
  106.  
  107. *   repere de calcul
  108.  
  109.       IF (XNF1.NE.XZER) THEN
  110.          VCA1(1)=VF1(1)
  111.          VCA1(2)=VF1(2)
  112.          VCA1(3)=VF1(3)
  113.          IF (XNF3.NE.XZER) THEN
  114.             VCA2(1)=VF2(1)
  115.             VCA2(2)=VF2(2)
  116.             VCA2(3)=VF2(3)
  117.             VCA3(1)=VF3(1)
  118.             VCA3(2)=VF3(2)
  119.             VCA3(3)=VF3(3)
  120.          ELSEIF (XNF2.NE.XZER) THEN
  121.              VCA2(1)=VF2(1)
  122.              VCA2(2)=VF2(2)
  123.              VCA2(3)=VF2(3)
  124.              VCA3(1)=VF1(2)*VF2(3)-VF1(3)*VF2(2)
  125.              VCA3(2)=VF1(3)*VF2(1)-VF1(1)*VF2(3)
  126.              VCA3(3)=VF1(1)*VF2(2)-VF1(2)*VF2(1)
  127.          ELSE
  128.              IF (ABS(VCA1(2)).GE.XSZPRE.OR.
  129.      &           ABS(VCA1(3)).GE.XSZPRE) THEN
  130.                VCA2(1)=XZER
  131.                VCA2(2)=-VCA1(3)
  132.                VCA2(3)=VCA1(2)
  133.                XVCA=SQRT(VCA2(1)*VCA2(1)+VCA2(2)*VCA2(2)
  134.      .                                  +VCA2(3)*VCA2(3))
  135.                VCA2(1)=VCA2(1)/XVCA
  136.                VCA2(2)=VCA2(2)/XVCA
  137.                VCA2(3)=VCA2(3)/XVCA
  138.              ELSE
  139.                VCA2(1)=XZER
  140.                VCA2(2)=XUN
  141.                VCA2(3)=XZER
  142.              ENDIF
  143.              VCA3(1)=VF1(2)*VCA2(3)-VF1(3)*VCA2(2)
  144.              VCA3(2)=VF1(3)*VCA2(1)-VF1(1)*VCA2(3)
  145.              VCA3(3)=VF1(1)*VCA2(2)-VF1(2)*VCA2(1)
  146.          ENDIF
  147.       ELSE
  148.         VCA1(1)=XUN
  149.         VCA1(2)=XZER
  150.         VCA1(3)=XZER
  151.         VCA2(1)=XZER
  152.         VCA2(2)=XUN
  153.         VCA2(3)=XZER
  154.         VCA3(1)=XZER
  155.         VCA3(2)=XZER
  156.         VCA3(3)=XUN
  157.       ENDIF
  158.          DO I=1,3
  159.            IF(I.EQ.1) THEN
  160.              XNFF=SQRT(VCA1(1)*VCA1(1)+VCA1(2)*VCA1(2)
  161.      &                +VCA1(3)*VCA1(3))
  162.            ELSE IF(I.EQ.2) THEN 
  163.              XNFF=SQRT(VCA2(1)*VCA2(1)+VCA2(2)*VCA2(2)
  164.      &                +VCA2(3)*VCA2(3))
  165.            ELSE IF(I.EQ.3) THEN
  166.              XNFF=SQRT(VCA3(1)*VCA3(1)+VCA3(2)*VCA3(2)
  167.      &                +VCA3(3)*VCA3(3))
  168.            ENDIF
  169.            IF((XNFF.GE.XSZPRE).AND.
  170.      &             (ABS(XNFF-1.).GE.XSZPRE)) THEN
  171.              IERUT=2
  172.              RETURN 
  173.            ENDIF
  174.          ENDDO
  175.  
  176. *   sortie elastique ?
  177.  
  178.       KFR=1
  179.       CALL OTTVAH(SIGG,DD1,SS6,DD3,VCA1,VCA2,VCA3,KFR)
  180.       CALL OTTVAE(XUN,DD3,XVAL,NDEF,SS4,IERUT)
  181.       IF(IERUT.NE.0) RETURN
  182.       CALL OTTVAB(SS6,VAR1,XVAL,NDEF,MCN,KFQ,SS4,VAR2,OO,TOL6,
  183.      &        RCZ0,KR1,KR2,KR3,QV1,QV2,QV3,PWX0,XC,IERUT)
  184.       IF(IERUT.NE.0) RETURN
  185.       IF(KFQ.EQ.0) THEN 
  186.         DO I=1,NDEF
  187.           SS5(I)=SS6(I)+SS4(I)
  188.         ENDDO
  189.         DO I=1,NVAR1
  190.           VV4(I)=VAR1(I)
  191.         ENDDO
  192.         KFM=0
  193.         DO I=1,NDEF
  194.           SS0(I)=SS4(I)
  195.         ENDDO
  196.         GO TO 222              
  197.       ENDIF 
  198.  
  199. *   ecoulement - etape1 (predicteur)
  200.  
  201.        KFM=1
  202.        DO KV1=1,KFQ
  203.          KV0=KR2(KV1)
  204.          IF(KV0.NE.2.AND.KV0.NE.3.AND.KV0.NE.5.AND.KV0.NE.6
  205.      &             .AND.KV0.NE.8.AND.KV0.NE.9) THEN
  206. *          PWX(KV0)=PWX0(KV0)+RCZ0(KV0)
  207.            PWX(KV0)=PWX0(KV0)
  208.          ELSE
  209.            PWX(KV0)=PWX0(KV0)
  210.          ENDIF
  211.        ENDDO
  212.       KV1SF=1
  213.       CALL OTTVAG(XUN,SS6,VAR1,NVAR1,SS4,NDEF,MCN,
  214.      &   XVAL,SS0,VV0,VAR2,KR2,QV1,QV2,QV3,PWX,XC,
  215.      &   PWY1,KFQ,KV1SF,IERUT)
  216.       IF(IERUT.NE.0) RETURN
  217.        KFK=0
  218.        KFP=0
  219.        DO I=1,MCN
  220.           KR2N(I)=0
  221.        ENDDO
  222.  
  223. *   tris avant etape2
  224.  
  225.        DO KV1=1,KFQ
  226.          KV0 = KR2(KV1)
  227.          IF(PWY1(KV1).GT.0.) THEN
  228.            KFK=KFK+1
  229.            KR2N(KFK)=KV0
  230.          ELSE
  231.            IF(KV0.EQ.1.OR.KV0.EQ.4.OR.KV0.EQ.7) THEN
  232.              KFP=1
  233.              KFK=KFK+1
  234.              KR2N(KFK)=KV0 + 1
  235.            ENDIF
  236.            IF(KV0.EQ.2.OR.KV0.EQ.5.OR.KV0.EQ.8) THEN
  237.              KFP=1
  238.              KFK=KFK+1
  239.              KR2N(KFK)=KV0 + 1
  240.            ENDIF
  241.            IF(KV0.EQ.3.OR.KV0.EQ.6.OR.KV0.EQ.9) THEN
  242.              KFP=1
  243.              KFK=KFK+1
  244.              KR2N(KFK)=KV0 - 1
  245.            ENDIF
  246.          ENDIF
  247.        ENDDO
  248.        IF (KFK.EQ.0) THEN
  249.           IERUT=2
  250.                   RETURN
  251.        ENDIF
  252.        IF(KFK.LT.KFQ.OR.KFP.NE.0) THEN
  253.           DO I=1,MCN
  254.              KR2(I)=0
  255.           ENDDO
  256.           KFQ = KFK
  257.           DO KV1=1,KFQ
  258.              KR2(KV1)=KR2N(KV1)
  259.           ENDDO
  260.        DO KV1=1,KFQ
  261.          KV0=KR2(KV1)
  262.          IF(KV0.NE.2.AND.KV0.NE.3.AND.KV0.NE.5.AND.KV0.NE.6
  263.      &             .AND.KV0.NE.8.AND.KV0.NE.9) THEN
  264. *          PWX(KV0)=PWX0(KV0)+RCZ0(KV0)
  265.            PWX(KV0)=PWX0(KV0)
  266.          ELSE
  267.            PWX(KV0)=PWX0(KV0)
  268.          ENDIF
  269.        ENDDO
  270.           CALL OTTVAG(XUN,SS6,VAR1,NVAR1,SS4,NDEF,MCN,
  271.      &       XVAL,SS0,VV0,VAR2,KR2,QV1,QV2,QV3,PWX,XC,
  272.      &       PWY1,KFQ,KV1SF,IERUT)
  273.           IF(IERUT.NE.0) RETURN
  274.        ENDIF
  275.       FRG1 = VV0(1)
  276.       IF(ABS(FRG1).GE.10.D0) THEN
  277.           USV = MAX(0.5D0*USV,TOL4)
  278.           KFJ=1
  279.           GO TO 111
  280.       ENDIF
  281.  
  282. *  ecoulement - etape2 (correcteur)
  283.  
  284.       DO I=1,NDEF
  285.          SS3(I)=SS6(I)+SS0(I)
  286.       ENDDO
  287.       DO I=1,NVAR1
  288.          VV3(I)=VAR1(I)+VV0(I)
  289.       ENDDO
  290.       DO  KV1=1,KFQ
  291.         KV0=KR2(KV1)
  292.         CALL OTTVAD(SS3,VV3,XVAL,NDEF,VAR2,XC,
  293.      &        TOL6,QV1,QV2,QV3,KV0,KR1,MCN,IERUT)
  294.         IF(IERUT.NE.0) RETURN
  295.         KFH=1
  296.         CALL OTTVAC(SS3,VV3,XVAL,NDEF,VAR2,OO,
  297.      &         XC,RCZ,KV0,KFH,TOL6,IERUT)
  298.         IF(IERUT.NE.0) RETURN
  299.          IF(KV0.NE.2.AND.KV0.NE.3.AND.KV0.NE.5.AND.KV0.NE.6
  300.      &             .AND.KV0.NE.8.AND.KV0.NE.9) THEN
  301. *         PWX(KV0)=PWX0(KV0)+RCZ(KV0)
  302. *         PWX(KV0)=PWX0(KV0)+RCZ0(KV0)
  303.           PWX(KV0)=PWX0(KV0)
  304.         ELSE
  305.           PWX(KV0)=PWX0(KV0)
  306.         ENDIF
  307.       ENDDO
  308.       CALL OTTVAG(XUN,SS3,VV3,NVAR1,SS4,NDEF,MCN,
  309.      &   XVAL,SS1,VV1,VAR2,KR2,QV1,QV2,QV3,PWX,XC,
  310.      &   PWY2,KFQ,KV1SF,IERUT)
  311.       IF(IERUT.NE.0) RETURN
  312.       FRG2 = VV1(1)
  313.       IF(ABS(FRG2).GE.10.D0) THEN
  314.           USV = MAX(0.5D0*USV,TOL4)
  315.           KFJ=1
  316.           GO TO 111 
  317.       ENDIF
  318.  
  319. *   preparation des tests 
  320.  
  321.       DO I=1,NDEF
  322.          SS5(I)=SS6(I)+0.5D0*(SS0(I)+SS1(I))
  323.       ENDDO
  324.       DO I=1,NVAR1
  325.          VV4(I)=VAR1(I)+0.5D0*(VV0(I)+VV1(I))
  326.       ENDDO
  327.       DO I=1,MCN 
  328.          IF (PWY1(I)+PWY2(I).LT.0.) THEN
  329.            IF(USV.EQ.TOL4) THEN
  330.              IERUT=3
  331.              RETURN
  332.            ENDIF
  333.            USV = MAX(0.5D0*USV,TOL4)
  334.            KFJ=1
  335.            GO TO 111
  336.          ENDIF
  337.       ENDDO
  338.         KFQP = 0
  339.         DO I=1,MCN
  340.           KR5(I)=0
  341.         ENDDO
  342.        VCR = 0.
  343.        DO KV1=1,KFQ
  344.          KV0=KR2(KV1)
  345.         KFH=1
  346.         CALL OTTVAC(SS5,VV4,XVAL,NDEF,VAR2,OO,
  347.      &        XC,RCZ,KV0,KFH,TOL6,IERUT)
  348.         IF(IERUT.NE.0) RETURN
  349.            KFQP=KFQP+1
  350.            KR5(KFQP)=KV0
  351.            VCR = MAX(VCR,ABS(RCZ(KV0)))
  352.        ENDDO
  353.  
  354. *  affinage si besoin   
  355.  
  356.        IF(VCR.LE.TOL6) THEN
  357.          GO TO 333
  358.        ENDIF
  359.        KFI=0
  360. 444    CONTINUE
  361.          KFI = KFI + 1
  362.          IF(KFI.GT.NAUX) THEN
  363.                    USV = MAX(0.5D0*USV,TOL4)
  364.            KFJ=1
  365.            GO TO 111
  366.          ENDIF
  367.          DO  KV1=1,KFQP
  368.            KV0=KR5(KV1)
  369.            PWX(KV0)=RCZ(KV0)
  370.            CALL OTTVAD(SS5,VV4,XVAL,NDEF,VAR2,XC,
  371.      &        TOL6,QV1,QV2,QV3,KV0,KR1,MCN,IERUT)
  372.             IF(IERUT.NE.0) RETURN
  373.          ENDDO
  374.          KV1SF=2
  375.          CALL OTTVAG(XUN,SS5,VV4,NVAR1,SS4,NDEF,MCN,
  376.      &        XVAL,SS2,VV2,VAR2,KR5,QV1,QV2,QV3,PWX,XC,
  377.      &        PWY3,KFQP,KV1SF,IERUT)
  378.          IF(IERUT.NE.0) RETURN
  379.          DO I=1,NDEF
  380.            SS1(I) = SS1(I) + 2.*SS2(I)
  381.            SS5(I)=SS6(I)+0.5D0*(SS0(I)+SS1(I))
  382.          ENDDO
  383.          DO I=1,NVAR1
  384.            VV1(I) = VV1(I) + 2.*VV2(I)
  385.            VV4(I)=VAR1(I)+0.5D0*(VV0(I)+VV1(I))
  386.          ENDDO
  387.          DO  KV1=1,KFQP
  388.            KV0=KR5(KV1)
  389.            PWY2(KV0) = PWY2(KV0) + 2.*PWY3(KV0)
  390.          ENDDO
  391.          VCS=0.
  392.          DO  KV1=1,KFQP
  393.            KV0=KR5(KV1)
  394.            KFH=1
  395.            CALL OTTVAC(SS5,VV4,XVAL,NDEF,VAR2,OO,
  396.      &          XC,RCZ,KV0,KFH,TOL6,IERUT)
  397.             IF(IERUT.NE.0) RETURN
  398.             VCS = MAX(VCS,ABS(RCZ(KV0)))
  399.          ENDDO
  400.          IF(VCS.LE.VCR) THEN
  401.            DO KV1=1,KFQP
  402.              KV0=KR5(KV1)
  403.              IF(PWY1(KV0)+PWY2(KV0).LT.0.D0) THEN        
  404.                USV = MAX(0.5D0*USV,TOL4)
  405.                KFJ=1
  406.                GO TO 111         
  407.              ENDIF
  408.            ENDDO
  409.            GO TO 777
  410.          ENDIF
  411.          DO I=1,NDEF
  412.            SS1(I) = SS1(I) + SS2(I)
  413.            SS5(I)=SS6(I)+0.5D0*(SS0(I)+SS1(I))
  414.          ENDDO
  415.          VCS=0.
  416.          DO  KV1=1,KFQP
  417.            KV0=KR5(KV1)
  418.            KFH=1
  419.            CALL OTTVAC(SS5,VV4,XVAL,NDEF,VAR2,OO,
  420.      &         XC,RCZ,KV0,KFH,TOL6,IERUT)
  421.             IF(IERUT.NE.0) RETURN
  422.             VCS = MAX(VCS,ABS(RCZ(KV0)))
  423.          ENDDO
  424. 777      CONTINUE
  425.          IF(VCS.LE.TOL6) THEN
  426.            GO TO 333
  427.          ELSE
  428.            VCR = VCS
  429.            GO TO 444
  430.          ENDIF
  431.  
  432. *   fin d'iteration
  433.  
  434.  333  CONTINUE
  435.       DO I=1,NDEF
  436. *        SS5(I)=SS6(I)+0.5D0*(SS0(I)+SS1(I))
  437.          XSM(I)=0.5D0*(SS0(I)+SS1(I))
  438.       ENDDO
  439.       DO I=1,NVAR1
  440. *        VV4(I)=VAR1(I)+0.5D0*(VV0(I)+VV1(I))
  441.          XRM(I)=0.5D0*(VV0(I)+VV1(I))
  442.       ENDDO
  443.       DO I=1,MCN 
  444.          PWY(I)=0.5*(PWY1(I)+PWY2(I))
  445.          IF(PWY(I).LT.0.D0) THEN
  446.            IF(USV.EQ.TOL4) THEN
  447.              IERUT=3
  448.              RETURN
  449.            ENDIF
  450.            USV = MAX(0.5D0*USV,TOL4)
  451.            KFJ=1
  452.            GO TO 111
  453.          ENDIF
  454.       ENDDO
  455.       RSSN=0.D0
  456.       RSSO=0.D0
  457.       DO I=1,NDEF
  458.         RSSN = MAX(RSSN,ABS(SS1(I)-SS0(I)))
  459.         RSSO = MAX(RSSO,2.D0*ABS(SS5(I)))
  460.       ENDDO
  461.       RSSO = MAX(RSSO,TOL3)
  462.       FHPT = VV4(1)
  463.       FHPF = TOL2
  464.       RPV = (ABS(FRG2-FRG1))/MAX(2.D0*ABS(FHPT),FHPF)
  465.       RTTT = MAX(RSSN/RSSO,RPV)
  466.       RTTT = MAX(RTTT, TOL1)
  467.       CU = 0.9D0*SQRT(TOL5/RTTT)
  468.       IF(RTTT.GT.TOL5) THEN
  469.         IF(USV.LE.TOL4) THEN
  470.            IERUT=3
  471.            RETURN
  472.         ENDIF
  473.         QQ = MAX(CU,0.1D0)
  474.         USV = MAX(QQ*USV,TOL4)
  475.         KFJ=1 
  476.         GO TO 111
  477.       ENDIF
  478. 222   CONTINUE
  479.  
  480. *    mise à jour 
  481.  
  482.       VBS = 1.D0
  483.       DO 399 KV1=1,KFQ
  484.         KV0=KR2(KV1)
  485.         IF(KR1(KV0).GT.0) GO TO 399
  486.         CALL OTTVAF(X,KV0,XVAL,VAR1,NVAR1,VV4,VV0,VV1,
  487.      &              VAR2,TOL6,IERUT)
  488.         IF(IERUT.NE.0) RETURN
  489.         VBS = MIN(VBS,X)
  490. 399   CONTINUE
  491.       X=VBS
  492.       IF(X.LT.1.D0) THEN
  493.          USV = X*USV
  494.          KFJ = 1
  495.          GO TO 111
  496.       ENDIF
  497.       VBS = 1.D0
  498.       KFH=0
  499.       DO 400  KV0=1,MCN
  500.         CALL OTTVAC(SS5,VV4,XVAL,NDEF,VAR2,OO,
  501.      &       XC,RCZ,KV0,KFH,TOL6,IERUT)
  502.         IF(IERUT.NE.0) RETURN
  503.         IF(KR3(KV0).EQ.0) THEN
  504.           IF(RCZ(KV0).GT.TOL6) THEN
  505.             CALL OTTVAK(KV0,SS6,SS0,SS1,XVAL,VAR1,NVAR1,
  506.      &          VV0,VV1,VAR2,OO,TOL6,NDEF,X,RCZ0,RCZ,XC,
  507.      &          KFM,IERUT)
  508.             IF(IERUT.NE.0) RETURN
  509.             VBS = MIN(VBS,X)
  510.           ENDIF
  511.         ENDIF
  512. 400   CONTINUE 
  513.       X = VBS
  514.       IF(X.LT.1.D0) THEN
  515.            USV = X*USV
  516.            KFJ = 1
  517.           GO TO 111
  518.       ENDIF
  519. 555   CONTINUE 
  520.       ZSV=ZSV+USV 
  521.       QQ = MIN(CU,1.1D0)
  522.       IF(KFJ.EQ.1) THEN
  523.         QQ = MIN(QQ,1.D0)
  524.       ENDIF
  525.       USV = QQ*USV
  526.       KFJ=0
  527.       USV =  MAX(USV,TOL4)
  528.       USV =  MIN(USV,1.D0-ZSV)
  529.       DO I=1,3
  530.         I2=2*(I-1)
  531.         VV4(I2+1)= MAX(VV4(I2+1),BETA*VV4(I2+2))
  532.       ENDDO
  533.       DO I=1,3
  534.         I2=2*(I-1)
  535.         VV4(I2+2)=MAX(VV4(I2+1),VV4(I2+2))
  536.       ENDDO
  537.       DO I=1,NDEF
  538.         SS6(I)=SS5(I)
  539.       ENDDO
  540.       DO I=1,NVAR1
  541.         VAR1(I)=VV4(I)
  542.       ENDDO
  543. *   nouvelle fissure?
  544.  
  545.          KFH=0
  546.          DO  KV0=1,7,3 
  547.            CALL OTTVAC(SS6,VAR1,XVAL,NDEF,VAR2,OO,
  548.      &         XC,RCZ,KV0,KFH,TOL6,IERUT)
  549.            IF(IERUT.NE.0) RETURN
  550.          ENDDO
  551.            IF(ABS(RCZ(1)).LE.TOL6.AND.XNF1.EQ.0.) THEN
  552.              XNF1 = 1.D0
  553.              DO I=1,3
  554.                 VF1(I)=OO(I,1)
  555.              ENDDO
  556.             IF (FIL(1).EQ.XZER) THEN
  557.                KFV=1
  558.                CALL OTTVAJ(FIL,XVAL,VF1,TAIL,P,KFV,IERUT)
  559.                IF(IERUT.NE.0) RETURN
  560.             ENDIF
  561.              IF(ABS(RCZ(4)).LE.TOL6.AND.XNF2.EQ.0.) THEN
  562.                XNF2 = 1.D0
  563.                DO I=1,3
  564.                  VF2(I)=OO(I,2)
  565.                ENDDO
  566.                IF (FIL(2).EQ.XZER) THEN
  567.                   KFV=2
  568.                   CALL OTTVAJ(FIL,XVAL,VF2,TAIL,P,KFV,IERUT)
  569.                   IF(IERUT.NE.0) RETURN
  570.                ENDIF
  571.                IF(ABS(RCZ(7)).LE.TOL6.AND.XNF3.EQ.0.) THEN
  572.                  XNF3 = 1.D0
  573.                  DO I=1,3
  574.                    VF3(I)=OO(I,3)
  575.                  ENDDO
  576.                  IF (FIL(3).EQ.XZER) THEN
  577.                     KFV=3
  578.                     CALL OTTVAJ(FIL,XVAL,VF3,TAIL,P,KFV,IERUT)
  579.                     IF(IERUT.NE.0) RETURN
  580.                  ENDIF
  581.                ENDIF
  582.              ENDIF
  583.            ENDIF
  584.            IF(ABS(RCZ(4)).LE.TOL6.AND.XNF2.EQ.0.D0) THEN
  585.                IF(XNF1.EQ.0.D0) THEN
  586.                   IERUT = 2
  587.                   RETURN
  588.                ENDIF
  589.              XNF2 = 1.D0 
  590.              DO I=1,3
  591.                 VF2(I)=VCA2(I)*OO(1,1)+VCA3(I)*OO(2,1)
  592.              ENDDO
  593.              IF (FIL(2).EQ.XZER) THEN
  594.                 KFV=2
  595.                 CALL OTTVAJ(FIL,XVAL,VF2,TAIL,P,KFV,IERUT)
  596.                 IF(IERUT.NE.0) RETURN
  597.              ENDIF
  598.              IF(ABS(RCZ(7)).LE.TOL6.AND.XNF3.EQ.0.) THEN
  599.                XNF3 = 1.D0
  600.                CALL VECTVE(VF1,VF2,3,VF3)
  601.                IF (FIL(3).EQ.XZER) THEN
  602.                   KFV=3
  603.                   CALL OTTVAJ(FIL,XVAL,VF3,TAIL,P,KFV,IERUT)
  604.                   IF(IERUT.NE.0) RETURN
  605.                ENDIF
  606.              ENDIF
  607.            ENDIF
  608.            IF(ABS(RCZ(7)).LE.TOL6.AND.XNF3.EQ.0.) THEN
  609.                IF(XNF1.EQ.0.D0 .OR.XNF2.EQ.0.D0) THEN
  610.                   IERUT = 2
  611.                   RETURN
  612.                ENDIF
  613.              XNF3 = 1.D0
  614.              DO I=1,3
  615.                 VF3(I)=VCA3(I)
  616.              ENDDO
  617.              IF (FIL(3).EQ.XZER) THEN
  618.                 KFV=3
  619.                 CALL OTTVAJ(FIL,XVAL,VF3,TAIL,P,KFV,IERUT)
  620.                 IF(IERUT.NE.0) RETURN
  621.              ENDIF
  622.            ENDIF
  623.       DO I=1,3
  624.         VAR2(I)  =VF1(I)
  625.         VAR2(I+4)=VF2(I)
  626.         VAR2(I+8)=VF3(I)
  627.       ENDDO
  628.       VAR2( 4)=XNF1
  629.       VAR2( 8)=XNF2
  630.       VAR2(12)=XNF3
  631.       VAR2(13)=FIL(1)
  632.       VAR2(14)=FIL(2)
  633.       VAR2(15)=FIL(3)
  634.       KFR=2
  635.       CALL OTTVAH(SS6,DD3,SIGG,DD2,VCA1,VCA2,VCA3,KFR)
  636.  
  637. *    passage a l'itération suivante      
  638.  
  639.       GO TO 111  
  640. 888   CONTINUE
  641.       RETURN
  642.       END
  643.  
  644.  
  645.  
  646.  

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