GCC Code Coverage Report


Directory: ./
File: phys/cv3_inicp.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 26 0.0%
Branches: 0 8 0.0%

Line Branch Exec Source
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 IMPLICIT NONE
12 include "YOMCST2.h"
13
14 INTEGER iflag_clos
15 CHARACTER (LEN=20) :: modname = 'cv3_inicp'
16 CHARACTER (LEN=80) :: abort_message
17
18 ! -- Mixing probability distribution functions
19
20 REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f
21 REAL :: sumcoef,sigma,aire,pdf,mu,df,ff
22
23 qcoef1(f) = tanh(f/gammas)
24 qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas)))
25 qff(f) = max(min(f,1.), 0.)
26 qfff(f) = min(qff(f), scut)
27 qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max
28 rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ &
29 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
35 ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
36
37
38 ! ===========================================================================
39 ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION
40 ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc.
41 ! (Written by V.T.J. Phillips, 20-30/Jan/99)
42 ! ===========================================================================
43
44 ! line 1: a flag (0 or 1) to decide whether P(F) = 1 or the general P(F)
45 ! is to be
46 ! used, followed by SCUT, which is the cut-off value of F in CONVECT
47 ! line 2: blank
48 ! line 3: the coefficients for the linear combination of P(F)s to
49 ! make the general P(F)
50 ! line 4: blank
51 ! line 5: gammas, Fmax for the cosh^2 component of P(F)
52 ! line 6: blank
53 ! line 7: alphas for the 1st irrational P(F)
54 ! line 8: blank
55 ! line 9: betas for the 2nd irrational P(F)
56
57
58 ! open(57,file='parameter_mix.data')
59
60 ! read(57,*) iflag_clos
61 ! read(57,*) iflag_mix, scut
62 ! read(57,*)
63 ! if(iflag_mix .gt. 0) then
64 ! read(57,*) qqa1, qqa2
65 ! read(57,*)
66 ! read(57,*) gammas, Fmax
67 ! read(57,*)
68 ! read(57,*) alphas
69 ! endif
70 ! close(57)
71
72 IF (iflag_mix>0) THEN
73
74 ! -- Normalize Pdf weights
75
76 sumcoef = qqa1 + qqa2
77 qqa1 = qqa1/sumcoef
78 qqa2 = qqa2/sumcoef
79
80 qcoef1max = qcoef1(fmax)
81 qcoef2max = qcoef2(fmax)
82
83 sigma = 0.
84 aire = 0.0
85 pdf = 0.0
86 mu = 0.0
87 df = 0.0001
88
89 ! do ff = 0.0 + df, 1.0 - 2.*df, df
90 ff = df
91 DO WHILE (ff<=1.0-2.*df)
92 pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
93 aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff)
94 mu = mu + pdf*ff*df
95 ! c write(*,*) pdf, Qmix(ff), aire, ff
96 ff = ff + df
97 END DO
98
99 ! do ff=0.0+df,1.0 - 2.*df,df
100 ff = df
101 DO WHILE (ff<=1.0-2.*df)
102 pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df
103 sigma = sigma + pdf*(ff-mu)*(ff-mu)*df
104 ff = ff + df
105 END DO
106 sigma = sqrt(sigma)
107
108 IF (abs(aire-1.0)>0.02) THEN
109 PRINT *, 'WARNING:: AREA OF MIXING PDF IS::', aire
110 abort_message = ''
111 CALL abort_physic(modname, abort_message, 1)
112 ELSE
113 PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma
114 END IF
115 END IF ! (iflag_mix .gt. 0)
116
117 RETURN
118 END SUBROUTINE cv3_inicp
119