Télécharger la plaquette Cast3M


fr en

Télécharger ottvad.eso

Retour à la liste

Numérotation des lignes : 

ottvad

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

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