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