Télécharger la plaquette Cast3M


fr en

Télécharger ottvac.eso

Retour à la liste

Numérotation des lignes : 

ottvac

  1. C OTTVAC    SOURCE    PV        21/10/28    21:15:06     11152          
  2.       SUBROUTINE OTTVAC(SIG,VAR1,XVAL,NDEF,VAR2,OO,
  3.      &     XCC,RCZ,KV0,KV1,TOL,IERUT)
  4. *
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8 (A-H,O-Z)
  7.       PARAMETER (UN=1.D0, DEUX=2.D0, TROIS=3.D0, UNDEMI=0.5D0)
  8.       PARAMETER (XPI = 3.1415926535897931D0)
  9.       DIMENSION SIG(*),VAR1(*),XVAL(*),VAR2(*)
  10.       DIMENSION XCC(*),RCZ(*)
  11.       DIMENSION AA(3,3),BB(3),OO(3,3),S(6)
  12. *
  13.         IERUT=0
  14.         GO TO  (1,2,3,4,5,6,7,8,9,10),KV0
  15. *               
  16.  1      CONTINUE
  17.           RTRAC  = XVAL(3)
  18.                   GFTR   = XVAL(4)
  19.           XNF1  = VAR2(4)
  20.                   FIL = VAR2(13)
  21.           IF(XNF1.EQ.0.D0) THEN
  22.             AA(1,1)=SIG(1)
  23.             AA(1,2)=SIG(4)
  24.             AA(1,3)=SIG(5)
  25.             AA(2,1)=SIG(4)
  26.             AA(2,2)=SIG(2)
  27.             AA(2,3)=SIG(6)
  28.             AA(3,1)=SIG(5)
  29.             AA(3,2)=SIG(6)
  30.             AA(3,3)=SIG(3)
  31.             CALL JACOB4(AA,3,BB,OO)
  32.             RCZ(KV0) = BB(1) - RTRAC
  33.           ELSE
  34.                         WO0= RTRAC*RTRAC/(2.D0*GFTR*FIL)                  
  35.             WO2= VAR1(2)
  36.             WO1= RTRAC - WO0 * WO2
  37.             WO1= MAX(WO1,0.D0)
  38.             RCZ(KV0) = SIG(1) - WO1 
  39.           ENDIF
  40.         GO TO 20
  41. *
  42.  2      CONTINUE
  43.           RTRAC  = XVAL(3)
  44.                   GFTR   = XVAL(4)
  45.           BETA   = XVAL(5)
  46.           WO31= VAR1(1)
  47.           WO2= VAR1(2)
  48.  
  49.           IF(WO2.GT.0.D0) THEN
  50.                         FIL  = VAR2(13)
  51.                         WO0= RTRAC*RTRAC/(2.D0*GFTR*FIL)
  52.                     WO4= RTRAC - WO0 * WO2
  53.             WO4=  MAX(WO4,0.D0)
  54.             WO1= WO4*(BETA - WO31/WO2)/(1.-BETA)
  55.             IF(KV1.EQ.0) THEN
  56.               WO1 = MIN (WO1,0.D0)
  57.               RCZ(KV0) = -ABS(SIG(1)) - WO1
  58.             ELSE
  59.               RCZ(KV0) = -SIG(1) - WO1
  60.             ENDIF
  61.           ELSE
  62.             RCZ(KV0) = - RTRAC 
  63.           ENDIF
  64.         GO TO 20
  65. *
  66.  3      CONTINUE
  67.           RTRAC  = XVAL(3)
  68.           GFTR   = XVAL(4)
  69.           BETA   = XVAL(5)
  70.           WO31  = VAR1(1)
  71.           WO2 = VAR1(2)
  72.           IF(WO2.GT.0.D0) THEN      
  73.                     FIL= VAR2(13)
  74.                         WO0= RTRAC*RTRAC/(2.D0*GFTR*FIL)
  75.                         WO4= RTRAC - WO0 * WO2
  76.             WO4=  MAX(WO4,0.D0)
  77.             WO1= WO4*(WO31/WO2-BETA)/(1.-BETA)
  78.             IF(KV1.EQ.0) THEN
  79.               WO1 = MAX (WO1,0.D0)
  80.               WO1 = MIN (WO1,WO4)
  81.             ENDIF
  82.             RCZ(KV0) = SIG(1) - WO1
  83.           ELSE
  84.             RCZ(KV0) = - RTRAC 
  85.           ENDIF
  86.         GO TO 20
  87. *
  88.  4      CONTINUE
  89.           RTRAC = XVAL(3)
  90.                   GFTR  = XVAL(4)                 
  91.           XNF1  = VAR2(4)
  92.           XNF2  = VAR2(8)
  93.                   FIL = VAR2(14)                  
  94.           IF(XNF1.EQ.0.D0) THEN
  95.             AA(1,1)=SIG(1)
  96.             AA(1,2)=SIG(4)
  97.             AA(1,3)=SIG(5)
  98.             AA(2,1)=SIG(4)
  99.             AA(2,2)=SIG(2)
  100.             AA(2,3)=SIG(6)
  101.             AA(3,1)=SIG(5)
  102.             AA(3,2)=SIG(6)
  103.             AA(3,3)=SIG(3)
  104.             CALL JACOB4(AA,3,BB,OO)
  105.             RCZ(KV0) = BB(2) - RTRAC
  106.           ELSE 
  107.             IF(XNF2.EQ.0.D0) THEN
  108.               CALL ZERO(AA,3,3)
  109.               AA(1,1)=SIG(2)
  110.               AA(1,2)=SIG(6)
  111.               AA(2,1)=SIG(6)
  112.               AA(2,2)=SIG(3)
  113.               CALL JACOB4(AA,2,BB,OO)
  114.               WO51= BB(1) - RTRAC 
  115.               WO52= BB(2) - RTRAC 
  116.               RCZ(KV0) = WO51
  117.               IF(WO51.LT.WO52) THEN
  118.                 RCZ(KV0) = WO52
  119.                 OO(1,1) = OO(2,1)
  120.                 OO(2,1) = OO(2,2)
  121.               ENDIF
  122.             ELSE
  123.                           WO0  = RTRAC*RTRAC/(2.D0*GFTR*FIL)    
  124.               WO2= VAR1(4)
  125.               WO1 = RTRAC - WO0 * WO2
  126.               WO1 = MAX(WO1,0.D0)
  127.               RCZ(KV0) = SIG(2) - WO1 
  128.             ENDIF
  129.           ENDIF
  130.         GO TO 20
  131. *
  132.  5      CONTINUE
  133.           RTRAC  = XVAL(3)
  134.                   GFTR   = XVAL(4)
  135.           BETA   = XVAL(5)
  136.           WO31= VAR1(3)
  137.           WO2= VAR1(4)
  138.           IF(WO2.GT.0.D0) THEN      
  139.                     FIL  = VAR2(14)
  140.                         WO0  = RTRAC*RTRAC/(2.D0*GFTR*FIL)
  141.                     WO4 = RTRAC - WO0 * WO2
  142.             WO4=  MAX(WO4,0.D0)
  143.             WO1 = WO4*(BETA - WO31/WO2)/(1.-BETA)
  144.             IF(KV1.EQ.0) THEN
  145.               WO1 = MIN (WO1,0.D0)
  146.             RCZ(KV0) = -ABS(SIG(2)) - WO1
  147.             ELSE
  148.               RCZ(KV0) = -SIG(2) - WO1
  149.             ENDIF
  150.           ELSE
  151.             RCZ(KV0) = - RTRAC 
  152.           ENDIF
  153.         GO TO 20
  154. *
  155.  6      CONTINUE
  156.           RTRAC  = XVAL(3)
  157.                   GFTR   = XVAL(4)
  158.           BETA   = XVAL(5)
  159.           WO31= VAR1(3)
  160.           WO2= VAR1(4)
  161.           IF(WO2.GT.0.D0) THEN
  162.                         FIL  = VAR2(14)
  163.                         WO0  = RTRAC*RTRAC/(2.D0*GFTR*FIL)
  164.                         WO4 = RTRAC - WO0 * WO2
  165.             WO4=  MAX(WO4,0.D0)
  166.             WO1 = WO4*(WO31/WO2-BETA)/(1.-BETA)
  167.             IF(KV1.EQ.0) THEN
  168.               WO1 = MAX (WO1,0.D0)
  169.               WO1 = MIN (WO1,WO4)
  170.             ENDIF
  171.             RCZ(KV0) = SIG(2) - WO1
  172.           ELSE
  173.             RCZ(KV0) = - RTRAC 
  174.           ENDIF
  175.         GO TO 20
  176. *
  177.  7      CONTINUE
  178.           RTRAC = XVAL(3)
  179.                   GFTR  = XVAL(4)                 
  180.           XNF1  = VAR2( 4)
  181.           XNF2  = VAR2( 8)
  182.           XNF3  = VAR2(12)
  183.                   FIL = VAR2(15)
  184.           IF(XNF1.EQ.0.D0.AND.XNF2.EQ.0.D0) THEN
  185.             AA(1,1)=SIG(1)
  186.             AA(1,2)=SIG(4)
  187.             AA(1,3)=SIG(5)
  188.             AA(2,1)=SIG(4)
  189.             AA(2,2)=SIG(2)
  190.             AA(2,3)=SIG(6)
  191.             AA(3,1)=SIG(5)
  192.             AA(3,2)=SIG(6)
  193.             AA(3,3)=SIG(3)
  194.             CALL JACOB4(AA,3,BB,OO)
  195.             RCZ(KV0) = BB(3) - RTRAC
  196.           ELSE IF(XNF1.NE.0.D0) THEN
  197.             IF(XNF2.EQ.0.D0) THEN
  198.               CALL ZERO(AA,3,3)
  199.               AA(1,1)=SIG(2)
  200.               AA(1,2)=SIG(6)
  201.               AA(2,1)=SIG(6)
  202.               AA(2,2)=SIG(3)
  203.               CALL JACOB4(AA,2,BB,OO)
  204.               WO51= BB(1) - RTRAC 
  205.               WO52= BB(2) - RTRAC 
  206.               RCZ(KV0) = WO52
  207.               IF(WO51.LT.WO52) THEN
  208.                 RCZ(KV0) = WO51
  209.               ENDIF
  210.             ELSE
  211.                           FIL = VAR2(15)
  212.                       IF(FIL.EQ.0.D0) THEN
  213.                         WO0 = 0.D0
  214.                       ELSE      
  215.                         WO0  = RTRAC*RTRAC/(2.D0*GFTR*FIL)
  216.               ENDIF     
  217.               WO2= VAR1(6)
  218.               WO1 = RTRAC - WO0 * WO2
  219.               WO1 = MAX(WO1,0.D0)
  220.               RCZ(KV0) = SIG(3) - WO1 
  221.             ENDIF
  222.           ENDIF
  223.         GO TO 20
  224. *               
  225.  8      CONTINUE
  226.           RTRAC  = XVAL(3)
  227.           GFTR   = XVAL(4)
  228.           BETA   = XVAL(5)
  229.           WO31= VAR1(5)
  230.           WO2= VAR1(6)
  231.           IF(WO2.GT.0.D0) THEN              
  232.                     FIL= VAR2(15)
  233.                         WO0= RTRAC*RTRAC/(2.D0*GFTR*FIL)
  234.                     WO4= RTRAC - WO0 * WO2
  235.             WO4=  MAX(WO4,0.D0)
  236.             WO1= WO4*(BETA - WO31/WO2)/(1.-BETA)
  237.             IF(KV1.EQ.0) THEN
  238.               WO1= MIN (WO1,0.D0)
  239.               RCZ(KV0) = -ABS(SIG(3)) - WO1
  240.             ELSE
  241.               RCZ(KV0) = -SIG(3) - WO1
  242.             ENDIF
  243.           ELSE
  244.             RCZ(KV0) = - RTRAC 
  245.           ENDIF
  246.         GO TO 20
  247. *               
  248.  9      CONTINUE
  249.           RTRAC  = XVAL(3)
  250.                   GFTR   = XVAL(4)                
  251.           BETA   = XVAL(5)
  252.           WO31= VAR1(5)
  253.           WO2= VAR1(6)
  254.           IF(WO2.GT.0.D0) THEN              
  255.                         FIL= VAR2(15)
  256.                         WO0= RTRAC*RTRAC/(2.D0*GFTR*FIL)
  257.                         WO4= RTRAC - WO0 * WO2
  258.             WO4=  MAX(WO4,0.D0)
  259.             WO1= WO4*(WO31/WO2-BETA)/(1.-BETA)
  260.             IF(KV1.EQ.0) THEN
  261.               WO1 = MAX (WO1,0.D0)
  262.               WO1 = MIN (WO1,WO4)
  263.             ENDIF
  264.             RCZ(KV0) = SIG(3) - WO1
  265.           ELSE
  266.             RCZ(KV0) = - RTRAC 
  267.           ENDIF
  268.         GO TO 20
  269. *
  270.  10     CONTINUE
  271.          XLC=VAR1(7)
  272.          RAC3=SQRT(TROIS)
  273.          EPCMAX=XCC(1)
  274.          EPCULT=XCC(2)
  275.          RCBI  =XCC(3)
  276.          XALFA =XCC(4)
  277.          XALFAG=XCC(5)
  278.          XDC   =XCC(6)
  279.          RCMAX =XCC(7)
  280.          XKC1  =XCC(8)
  281.          XBC   =XCC(9)
  282.          XFC0  =XCC(10)
  283.          IF(XLC.LE.XKC1) THEN
  284.            WO1=XFC0 + 2.*(RCMAX-XFC0)*XLC/XKC1/(1.+(XLC/XKC1)**2)
  285.          ELSE IF(XLC.GT.XKC1) THEN
  286.            WO1=RCMAX*(1.+XBC*(XLC-XKC1))*EXP(-XBC*(XLC-XKC1))
  287.          ENDIF
  288.          WO1=WO1*(1.-XALFA)
  289.          XI1=TRACE(SIG)
  290.          PP=XI1/TROIS
  291.          S(5)=0.D0
  292.          S(6)=0.D0
  293.          DO I=1,3
  294.             S(I)=SIG(I)-PP
  295.          ENDDO
  296.          DO I=4,NDEF
  297.             S(I)=SIG(I)
  298.          ENDDO
  299.          XJ2=UNDEMI*(S(1)*S(1) + S(2)*S(2) + S(3)*S(3))
  300.      &            +  S(4)*S(4) + S(5)*S(5) + S(6)*S(6)
  301.          TAU=SQRT(XJ2)
  302.          RCZ(KV0)=RAC3*TAU + XALFA*XI1 - WO1
  303.   20  CONTINUE 
  304.       RETURN
  305.       END
  306.  
  307.  
  308.  
  309.  

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