| Directory: | ./ |
|---|---|
| File: | phys/cv3_inip.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 27 | 30 | 90.0% |
| Branches: | 7 | 10 | 70.0% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | 19998 | SUBROUTINE cv3_inip() | |
| 2 | ! ******************************************************************* | ||
| 3 | ! * * | ||
| 4 | ! CV3_INIP Input = choice of mixing probability laws * | ||
| 5 | ! Output = normalized coefficients of the probability laws. * | ||
| 6 | ! * * | ||
| 7 | ! written by : Jean-Yves Grandpeix, 06/06/2006, 19.39.27 * | ||
| 8 | ! modified by : * | ||
| 9 | ! ******************************************************************* | ||
| 10 | ! | ||
| 11 | !---------------------------------------------- | ||
| 12 | ! INPUT (from Common YOMCST2 in "YOMCST2.h") : | ||
| 13 | ! iflag_mix | ||
| 14 | ! gammas | ||
| 15 | ! alphas | ||
| 16 | ! betas | ||
| 17 | ! Fmax | ||
| 18 | ! scut | ||
| 19 | ! | ||
| 20 | !---------------------------------------------- | ||
| 21 | ! INPUT/OUTPUT (from and to Common YOMCST2 in "YOMCST2.h") : | ||
| 22 | ! qqa1 | ||
| 23 | ! qqa2 | ||
| 24 | ! | ||
| 25 | !---------------------------------------------- | ||
| 26 | ! OUTPUT (to Common YOMCST2 in "YOMCST2.h") : | ||
| 27 | ! Qcoef1max | ||
| 28 | ! Qcoef2max | ||
| 29 | ! | ||
| 30 | !---------------------------------------------- | ||
| 31 | |||
| 32 | USE print_control_mod, ONLY: prt_level, lunout | ||
| 33 | IMPLICIT NONE | ||
| 34 | |||
| 35 | include "YOMCST2.h" | ||
| 36 | |||
| 37 | !---------------------------------------------- | ||
| 38 | ! Local variables : | ||
| 39 | CHARACTER (LEN=20) :: modname = 'cv3_inip' | ||
| 40 | CHARACTER (LEN=80) :: abort_message | ||
| 41 | |||
| 42 | REAL :: sumcoef | ||
| 43 | REAL :: sigma, aire, pdf, mu, df | ||
| 44 | REAL :: ff | ||
| 45 | |||
| 46 | |||
| 47 | ! -- Mixing probability distribution functions | ||
| 48 | |||
| 49 | REAL qcoef1, qcoef2, qff, qfff, qmix, rmix, qmix1, rmix1, qmix2, rmix2, f | ||
| 50 | |||
| 51 | qcoef1(f) = tanh(f/gammas) | ||
| 52 | qcoef2(f) = (tanh(f/gammas)+gammas*log(cosh((1.-f)/gammas)/cosh(f/gammas))) | ||
| 53 | qff(f) = max(min(f,1.), 0.) | ||
| 54 | qfff(f) = min(qff(f), scut) | ||
| 55 | qmix1(f) = (tanh((qff(f)-fmax)/gammas)+qcoef1max)/qcoef2max | ||
| 56 | rmix1(f) = (gammas*log(cosh((qff(f)-fmax)/gammas))+qff(f)*qcoef1max)/ & | ||
| 57 | qcoef2max | ||
| 58 | qmix2(f) = -log(1.-qfff(f))/scut | ||
| 59 | rmix2(f) = (qfff(f)+(1.-qff(f))*log(1.-qfff(f)))/scut | ||
| 60 | qmix(f) = qqa1*qmix1(f) + qqa2*qmix2(f) | ||
| 61 | rmix(f) = qqa1*rmix1(f) + qqa2*rmix2(f) | ||
| 62 | |||
| 63 | ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc | ||
| 64 | |||
| 65 | |||
| 66 | ! =========================================================================== | ||
| 67 | ! READ IN PARAMETERS FOR THE MIXING DISTRIBUTION | ||
| 68 | ! AND PASS THESE THROUGH A COMMON BLOCK TO SUBROUTINE CONVECT etc. | ||
| 69 | ! (Written by V.T.J. Phillips, 20-30/Jan/99) | ||
| 70 | ! =========================================================================== | ||
| 71 | |||
| 72 | ! line 1: a flag (0 or 1) to decide whether P(F) = 1 or the general P(F) | ||
| 73 | ! is to be | ||
| 74 | ! used, followed by SCUT, which is the cut-off value of F in CONVECT | ||
| 75 | ! line 2: blank | ||
| 76 | ! line 3: the coefficients for the linear combination of P(F)s to | ||
| 77 | ! make the general P(F) | ||
| 78 | ! line 4: blank | ||
| 79 | ! line 5: gammas, Fmax for the cosh^2 component of P(F) | ||
| 80 | ! line 6: blank | ||
| 81 | ! line 7: alphas for the 1st irrational P(F) | ||
| 82 | ! line 8: blank | ||
| 83 | ! line 9: betas for the 2nd irrational P(F) | ||
| 84 | |||
| 85 | |||
| 86 | ! c$$$ open(57,file='parameter_mix.data') | ||
| 87 | ! c$$$ | ||
| 88 | ! c$$$ read(57,*) iflag_mix, scut | ||
| 89 | ! c$$$ read(57,*) | ||
| 90 | ! c$$$ if(iflag_mix .gt. 0) then | ||
| 91 | ! c$$$ read(57,*) qqa1, qqa2 | ||
| 92 | ! c$$$ read(57,*) | ||
| 93 | ! c$$$ read(57,*) gammas, Fmax | ||
| 94 | ! c$$$ read(57,*) | ||
| 95 | ! c$$$ read(57,*) alphas | ||
| 96 | ! c$$$ endif | ||
| 97 | ! c$$$ close(57) | ||
| 98 | |||
| 99 | |||
| 100 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (iflag_mix>0) THEN |
| 101 | |||
| 102 | ! -- Normalize Pdf weights | ||
| 103 | |||
| 104 | 1 | sumcoef = qqa1 + qqa2 | |
| 105 | 1 | qqa1 = qqa1/sumcoef | |
| 106 | 1 | qqa2 = qqa2/sumcoef | |
| 107 | |||
| 108 | 1 | qcoef1max = qcoef1(fmax) | |
| 109 | 1 | qcoef2max = qcoef2(fmax) | |
| 110 | |||
| 111 | 1 | sigma = 0. | |
| 112 | 1 | aire = 0.0 | |
| 113 | 1 | pdf = 0.0 | |
| 114 | 1 | mu = 0.0 | |
| 115 | df = 0.0001 | ||
| 116 | |||
| 117 | ! do ff = 0.0 + df, 1.0 - 2.*df, df | ||
| 118 | 1 | ff = df | |
| 119 |
2/2✓ Branch 0 taken 9998 times.
✓ Branch 1 taken 1 times.
|
9999 | DO WHILE (ff<=1.0-2.*df) |
| 120 | 9998 | pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df | |
| 121 | 9998 | aire = aire + (qmix(ff+df)-qmix(ff))*(1.-ff) | |
| 122 | 9998 | mu = mu + pdf*ff*df | |
| 123 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 9998 times.
|
9998 | IF (prt_level>9) WRITE (lunout, *) pdf, qmix(ff), aire, ff |
| 124 | 9998 | ff = ff + df | |
| 125 | END DO | ||
| 126 | |||
| 127 | ! do ff=0.0+df,1.0 - 2.*df,df | ||
| 128 | 1 | ff = df | |
| 129 |
2/2✓ Branch 0 taken 9998 times.
✓ Branch 1 taken 1 times.
|
9999 | DO WHILE (ff<=1.0-2.*df) |
| 130 | 9998 | pdf = (qmix(ff+df)-qmix(ff))*(1.-ff)/df | |
| 131 | 9998 | sigma = sigma + pdf*(ff-mu)*(ff-mu)*df | |
| 132 | 9998 | ff = ff + df | |
| 133 | END DO | ||
| 134 | 1 | sigma = sqrt(sigma) | |
| 135 | |||
| 136 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (abs(aire-1.0)>0.02) THEN |
| 137 | ✗ | WRITE (lunout, *) 'WARNING:: AREA OF MIXING PDF IS::', aire | |
| 138 | ✗ | abort_message = '' | |
| 139 | ✗ | CALL abort_physic(modname, abort_message, 1) | |
| 140 | ELSE | ||
| 141 | 1 | PRINT *, 'Area, mean & std deviation are ::', aire, mu, sigma | |
| 142 | END IF | ||
| 143 | END IF ! (iflag_mix .gt. 0) | ||
| 144 | |||
| 145 | 1 | RETURN | |
| 146 | END SUBROUTINE cv3_inip | ||
| 147 |