| 1 | |
|---|
| 2 | ! $Header$ |
|---|
| 3 | |
|---|
| 4 | |
|---|
| 5 | ! ================================================================================ |
|---|
| 6 | !$gpum horizontal klon |
|---|
| 7 | MODULE clouds_bigauss_mod |
|---|
| 8 | |
|---|
| 9 | PRIVATE |
|---|
| 10 | |
|---|
| 11 | PUBLIC clouds_bigauss |
|---|
| 12 | |
|---|
| 13 | CONTAINS |
|---|
| 14 | |
|---|
| 15 | SUBROUTINE clouds_bigauss(klon, nd, r, rs, qtc, sigt, ptconv, ratqsc, cldf) |
|---|
| 16 | IMPLICIT NONE |
|---|
| 17 | |
|---|
| 18 | ! -------------------------------------------------------------------------------- |
|---|
| 19 | |
|---|
| 20 | ! Inputs: |
|---|
| 21 | |
|---|
| 22 | ! ND----------: Number of vertical levels |
|---|
| 23 | ! R--------ND-: Domain-averaged mixing ratio of total water |
|---|
| 24 | ! RS-------ND-: Mean saturation humidity mixing ratio within the gridbox |
|---|
| 25 | ! QSUB-----ND-: Mixing ratio of condensed water within clouds associated |
|---|
| 26 | ! with SUBGRID-SCALE condensation processes (here, it is |
|---|
| 27 | ! predicted by the convection scheme) |
|---|
| 28 | ! Outputs: |
|---|
| 29 | |
|---|
| 30 | ! PTCONV-----ND-: Point convectif = TRUE |
|---|
| 31 | ! RATQSC-----ND-: Largeur normalisee de la distribution |
|---|
| 32 | ! CLDF-----ND-: Fraction nuageuse |
|---|
| 33 | |
|---|
| 34 | ! -------------------------------------------------------------------------------- |
|---|
| 35 | |
|---|
| 36 | |
|---|
| 37 | INTEGER klon, nd |
|---|
| 38 | REAL r(klon, nd), rs(klon, nd), qtc(klon, nd), sigt(klon, nd) |
|---|
| 39 | LOGICAL ptconv(klon, nd) |
|---|
| 40 | REAL ratqsc(klon, nd) |
|---|
| 41 | REAL cldf(klon, nd) |
|---|
| 42 | |
|---|
| 43 | ! -- parameters controlling the iteration: |
|---|
| 44 | ! -- nmax : maximum nb of iterations (hopefully never reached) |
|---|
| 45 | ! -- epsilon : accuracy of the numerical resolution |
|---|
| 46 | ! -- vmax : v-value above which we use an asymptotic expression for |
|---|
| 47 | ! ERF(v) |
|---|
| 48 | |
|---|
| 49 | INTEGER nmax |
|---|
| 50 | PARAMETER (nmax=10) |
|---|
| 51 | REAL epsilon, vmax0, vmax(klon) |
|---|
| 52 | PARAMETER (epsilon=0.02, vmax0=2.0) |
|---|
| 53 | |
|---|
| 54 | REAL min_mu, min_q |
|---|
| 55 | PARAMETER (min_mu=1.E-12, min_q=1.E-12) |
|---|
| 56 | |
|---|
| 57 | INTEGER i, k, n, m |
|---|
| 58 | REAL mu, qsat, delta |
|---|
| 59 | REAL sigma1, sigma2, alpha, qconv |
|---|
| 60 | REAL xconv, xenv |
|---|
| 61 | REAL cconv, cenv |
|---|
| 62 | REAL pi, u, v |
|---|
| 63 | REAL sqrtpi, sqrt2 |
|---|
| 64 | ! lconv = true si le calcul a converge (entre autre si qsub < min_q) |
|---|
| 65 | LOGICAL lconv(klon) |
|---|
| 66 | |
|---|
| 67 | |
|---|
| 68 | cldf(1:klon, 1:nd) = 0.0 ! cym |
|---|
| 69 | ratqsc(1:klon, 1:nd) = 0.0 |
|---|
| 70 | ptconv(1:klon, 1:nd) = .FALSE. |
|---|
| 71 | ! cdir end arraycomb |
|---|
| 72 | |
|---|
| 73 | pi = acos(-1.) |
|---|
| 74 | sqrtpi = sqrt(pi) |
|---|
| 75 | sqrt2 = sqrt(2.) |
|---|
| 76 | |
|---|
| 77 | |
|---|
| 78 | DO k = 1, nd |
|---|
| 79 | |
|---|
| 80 | DO i = 1, klon ! vector |
|---|
| 81 | |
|---|
| 82 | mu = r(i, k) |
|---|
| 83 | mu = max(mu, min_mu) |
|---|
| 84 | qsat = rs(i, k) |
|---|
| 85 | qsat = max(qsat, min_mu) |
|---|
| 86 | delta = log(mu/qsat) |
|---|
| 87 | qconv=qtc(i,k) |
|---|
| 88 | alpha=sigt(i,k) |
|---|
| 89 | |
|---|
| 90 | IF (qconv<min_q) THEN |
|---|
| 91 | ptconv(i, k) = .FALSE. |
|---|
| 92 | ratqsc(i, k) = 0. |
|---|
| 93 | |
|---|
| 94 | ! Rien on a deja initialise |
|---|
| 95 | |
|---|
| 96 | ELSE |
|---|
| 97 | |
|---|
| 98 | sigma1=0.1*((qconv-mu)**2)**0.5+0.002*mu |
|---|
| 99 | sigma2=0.1*((qconv-mu)**2)**0.5+0.002*qconv |
|---|
| 100 | |
|---|
| 101 | ! sigma2=0.09*((qconv-mu)**2)**0.5/(alpha+0.01)**0.5+0.002*qconv |
|---|
| 102 | !----------------------------------------------------------------------------------------------------------------- |
|---|
| 103 | ! Calcul de la couverture nuageuse et de ratqs |
|---|
| 104 | !----------------------------------------------------------------------------------------------------------------- |
|---|
| 105 | |
|---|
| 106 | xconv=(qsat-qconv)/(sqrt(2.)*sigma2) |
|---|
| 107 | xenv=(qsat-mu)/(sqrt(2.)*sigma1) |
|---|
| 108 | |
|---|
| 109 | cconv=0.5*(1.-1.*erf(xconv)) |
|---|
| 110 | cenv=0.5*(1.-1.*erf(xenv)) |
|---|
| 111 | cldf(i,k)=alpha*cconv+(1.-1.*alpha)*cenv |
|---|
| 112 | ratqsc(i,k)= alpha*sigma1+(1.-1.*alpha)*sigma2 |
|---|
| 113 | ptconv(i,k)= .TRUE. |
|---|
| 114 | |
|---|
| 115 | END IF |
|---|
| 116 | |
|---|
| 117 | END DO ! vector |
|---|
| 118 | |
|---|
| 119 | |
|---|
| 120 | END DO ! K |
|---|
| 121 | |
|---|
| 122 | RETURN |
|---|
| 123 | END SUBROUTINE clouds_bigauss |
|---|
| 124 | |
|---|
| 125 | END MODULE clouds_bigauss_mod |
|---|
