Download clebl4.eso

Back to the list

   1 : C CLEBL4    SOURCE    KICH      09/09/11    21:16:07     6505           
   2 : C====================================================================
   3 : C
   4 :       SUBROUTINE CLEBL4(iwrk52,VWRK1,DTPS,VWRK2)
   5 : C
   6 : C====================================================================
   7 : C     LB, 06/97
   8 : C     =========
   9 : C         Modele de Leblond et Devaux
  10 : C         Un seul chgt de phase - cas du refroidissement
  11 : C     Pour le moment zeq et tau sont calcules en local
  12 : C
  13 :       IMPLICIT INTEGER(I-N)
  14 :        IMPLICIT REAL*8(A-H,O-Z)
  15 : -INC DECHE
  16 : C
  17 :       REAL*8 VWRK1(*),VWRK2(7)
  18 : C
  19 :       T0  =VWRK1(1)
  20 :       TP0 =VWRK1(2)
  21 :       ZA0 =VWRK1(3)
  22 :       ZF0 =VWRK1(4)
  23 :       VMS1=VWRK1(7)
  24 : 
  25 :        wrk52 = iwrk52
  26 :       AC1 = xmat(1)
  27 :       AC2 = xmat(2)
  28 :       AC3 = xmat(3)
  29 :       AC4 = xmat(4)
  30 :       TAU1 = xmat(5)
  31 :       TAU2 = xmat(6)
  32 :       TAU3 = xmat(7)
  33 :       TAU4 = xmat(8)
  34 : C
  35 : C     Calcul de Zeq
  36 : C
  37 : c       if (T0.LE.600.) then
  38 : c          zeq = 1.
  39 : c       else if ((T0.GT.600.).AND.(T0.LT.800.)) then
  40 : c          zeq = (800. - T0) / 200.
  41 : c       else if (T0.GE.800.) then
  42 : c          zeq = 0.
  43 : c       endif
  44 :        if (T0.LE.AC1) then
  45 :           zeq = 1.
  46 :        else if ((T0.GT.AC1).AND.(T0.LT.AC2).and.(AC3.ne.0.)) then
  47 :           zeq = (AC2 - T0) / AC3
  48 :        else if (T0.GE.AC2) then
  49 :           zeq = 0.
  50 :        endif
  51 : C
  52 : C      Calcul de tau
  53 : C
  54 : c       if (T0.LE.600.) then
  55 : c          tau = 100000.
  56 : c       else if ((T0.GT.600.).AND.(T0.LT.620.)) then
  57 : c         tau = 100000. - (T0 - 600.) * 95000. / 20.
  58 : c       else if (T0.GE.620.) then
  59 : c          tau = 500.
  60 : c       endif
  61 :        if (T0.LE.AC1) then
  62 :           tau = TAU1
  63 :        else if ((T0.GT.AC1).AND.(T0.LT.(AC1+AC4)).and.(AC4.ne.0.)) then
  64 :           tau = TAU1 - (T0 - AC1) * TAU2 / AC4
  65 :        else if (T0.GE.620.) then
  66 :           tau = TAU3
  67 :        endif
  68 : C
  69 : C     Calcul de zpoint
  70 : C
  71 :       zpoint = (zeq - ZF0) / tau
  72 : C
  73 :         VWRK1(1)=T0
  74 :         VWRK2(2)=TP0
  75 :         VWRK2(3)=VWRK1(3) - zpoint * DTPS
  76 :         VWRK2(4)=VWRK1(4) + zpoint * DTPS
  77 :         VWRK2(5)=0.D0
  78 :         VWRK2(6)=0.D0
  79 :         VWRK2(7)=VWRK1(7)
  80 : C
  81 :       RETURN
  82 :       END
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :  

© Cast3M 2003 - All rights reserved.
Disclaimer