My Project
 All Classes Files Functions Variables Macros
cv3_inicp.F
Go to the documentation of this file.
1  SUBROUTINE cv3_inicp()
2 *
3 ***************************************************************
4 * *
5 * cv3_inip lecture des choix de lois de probabilité de mélange*
6 * et calcul de leurs coefficients normalisés. *
7 * *
8 * written by : jean-yves grandpeix, 06/06/2006, 19.39.27 *
9 * modified by : *
10 ***************************************************************
11 *
12 #include "YOMCST2.h"
13 c
14  INTEGER iflag_clos
15  CHARACTER (LEN=20) :: modname='cv3_inicp'
16  CHARACTER (LEN=80) :: abort_message
17 c
18 c -- mixing probability distribution functions
19 c
20  real qcoef1,qcoef2,qff,qfff,qmix,rmix,qmix1,rmix1,qmix2,rmix2,f
21  qcoef1(f) = tanh(f/gammas)
22  qcoef2(f) = ( tanh(f/gammas) + gammas *
23  $ log(cosh((1.- f)/gammas)/cosh(f/gammas)))
24  qff(f) = max(min(f,1.),0.)
25  qfff(f) = min(qff(f),scut)
26  qmix1(f) = ( tanh((qff(f) - fmax)/gammas)+qcoef1max )/
27  $ qcoef2max
28  rmix1(f) = ( gammas*log(cosh((qff(f)-fmax)/gammas))
29  1 +qff(f)*qcoef1max ) / qcoef2max
30  qmix2(f) = -log(1.-qfff(f))/scut
31  rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut
32  qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f)
33  rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f)
34 c
35 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
36 c
37 c
38 c===========================================================================
39 c READ in parameters for the mixing distribution
40 c and pass these through a COMMON block to SUBROUTINE convect etc.
41 c(written by v.t.j. phillips, 20-30/jan/99)
42 c===========================================================================
43 c
44 c line 1: a flag(0 or 1) to decide whether p(f) = 1 or the general p(f) is to be
45 c used, followed by scut, which is the cut-off value of f in convect
46 c line 2: blank
47 c line 3: the coefficients for the linear combination of p(f)s to
48 c make the general p(f)
49 c line 4: blank
50 c line 5: gammas, fmax for the cosh^2 component of p(f)
51 c line 6: blank
52 c line 7: alphas for the 1st irrational p(f)
53 c line 8: blank
54 c line 9: betas for the 2nd irrational p(f)
55 c
56 
57 c open(57,file='parameter_mix.data')
58 
59 c read(57,*) iflag_clos
60 c read(57,*) iflag_mix, scut
61 c read(57,*)
62 c if(iflag_mix .gt. 0) then
63 c read(57,*) qqa1, qqa2
64 c read(57,*)
65 c read(57,*) gammas, fmax
66 c read(57,*)
67 c read(57,*) alphas
68 c endif
69 c close(57)
70 c
71  if(iflag_mix .gt. 0) then
72 c
73 c-- normalize pdf weights
74 c
75  sumcoef=qqa1+qqa2
76  qqa1=qqa1/sumcoef
77  qqa2=qqa2/sumcoef
78 c
79  qcoef1max = qcoef1(fmax)
80  qcoef2max = qcoef2(fmax)
81 c
82  sigma = 0.
83  aire=0.0
84  pdf=0.0
85  mu=0.0
86  df = 0.0001
87 c
88 c do ff = 0.0 + df, 1.0 - 2.*df, df
89  ff=df
90  dowhile( ff .le. 1.0 - 2.*df )
91  pdf = (qmix(ff+df) - qmix(ff)) * (1.-ff) / df
92  aire=aire+(qmix(ff+df) - qmix(ff)) * (1.-ff)
93  mu = mu + pdf * ff * df
94 cc write(*,*) pdf, qmix(ff), aire, ff
95  ff=ff+df
96  enddo
97 c
98 c do ff=0.0+df,1.0 - 2.*df,df
99  ff=df
100  dowhile( ff .le. 1.0 - 2.*df )
101  pdf = (qmix(ff+df)- qmix(ff)) * (1.-ff) / df
102  sigma = sigma+pdf*(ff - mu)*(ff - mu)*df
103  ff=ff+df
104  enddo
105  sigma = sqrt(sigma)
106 c
107  if (abs(aire-1.0) .gt. 0.02) then
108  print *,'WARNING:: AREA OF MIXING PDF IS::', aire
109  abort_message = ''
110  CALL abort_gcm(modname,abort_message,1)
111  else
112  print *,'Area, mean & std deviation are ::', aire,mu,sigma
113  endif
114  endif ! (iflag_mix .gt. 0)
115 
116  RETURN
117  END