[1992] | 1 | SUBROUTINE cv3_vertmix(len, nd, iflag, plim1, plim2, p, ph, t, q, u, v, w, & |
---|
| 2 | wi, nk, tmix, thmix, qmix, qsmix, umix, vmix, plcl) |
---|
| 3 | ! ************************************************************** |
---|
| 4 | ! * |
---|
| 5 | ! CV3_VERTMIX Brassage adiabatique d'une couche d'epaisseur * |
---|
| 6 | ! arbitraire. * |
---|
| 7 | ! * |
---|
| 8 | ! written by : Grandpeix Jean-Yves, 28/12/2001, 13.14.24 * |
---|
| 9 | ! modified by : Filiberti M-A 06/2005 vectorisation * |
---|
| 10 | ! ************************************************************** |
---|
[879] | 11 | |
---|
[1992] | 12 | IMPLICIT NONE |
---|
| 13 | ! ============================================================== |
---|
[879] | 14 | |
---|
[1992] | 15 | ! vertmix : determine theta et r du melange obtenu en brassant |
---|
| 16 | ! adiabatiquement entre plim1 et plim2, avec une ponderation w. |
---|
[879] | 17 | |
---|
[1992] | 18 | ! =============================================================== |
---|
[879] | 19 | |
---|
[1992] | 20 | include "cvthermo.h" |
---|
| 21 | include "YOETHF.h" |
---|
| 22 | include "YOMCST.h" |
---|
| 23 | include "FCTTRE.h" |
---|
| 24 | ! input : |
---|
| 25 | INTEGER nd, len |
---|
| 26 | INTEGER nk(len), iflag(len) |
---|
| 27 | REAL t(len, nd), q(len, nd), w(nd) |
---|
| 28 | REAL u(len, nd), v(len, nd) |
---|
| 29 | REAL p(len, nd), ph(len, nd+1) |
---|
| 30 | REAL plim1(len), plim2(len) |
---|
| 31 | ! output : |
---|
| 32 | REAL tmix(len), thmix(len), qmix(len), wi(len, nd) |
---|
| 33 | REAL umix(len), vmix(len) |
---|
| 34 | REAL qsmix(len) |
---|
| 35 | REAL plcl(len) |
---|
| 36 | ! internal variables : |
---|
| 37 | INTEGER j1(len), j2(len), niflag7 |
---|
| 38 | REAL a, b |
---|
| 39 | REAL ahm(len), dpw(len), coef(len) |
---|
| 40 | REAL p1(len, nd), p2(len, nd) |
---|
| 41 | REAL rdcp(len), a2(len), b2(len), pnk(len) |
---|
| 42 | REAL rh(len), chi(len) |
---|
| 43 | REAL cpn |
---|
| 44 | REAL x, y, p0, p0m1, zdelta, zcor |
---|
[879] | 45 | |
---|
[1992] | 46 | INTEGER i, j |
---|
[879] | 47 | |
---|
[1992] | 48 | DO j = 1, nd |
---|
| 49 | DO i = 1, len |
---|
| 50 | IF (plim1(i)<=ph(i,j)) j1(i) = j |
---|
| 51 | IF (plim2(i)>=ph(i,j+1) .AND. plim2(i)<ph(i,j)) j2(i) = j |
---|
| 52 | END DO |
---|
| 53 | END DO |
---|
[879] | 54 | |
---|
[1992] | 55 | DO j = 1, nd |
---|
| 56 | DO i = 1, len |
---|
| 57 | wi(i, j) = 0. |
---|
| 58 | END DO |
---|
| 59 | END DO |
---|
| 60 | DO i = 1, len |
---|
| 61 | ahm(i) = 0. |
---|
| 62 | qmix(i) = 0. |
---|
| 63 | umix(i) = 0. |
---|
| 64 | vmix(i) = 0. |
---|
| 65 | dpw(i) = 0. |
---|
| 66 | a2(i) = 0.0 |
---|
| 67 | b2(i) = 0. |
---|
| 68 | pnk(i) = p(i, nk(i)) |
---|
| 69 | END DO |
---|
[879] | 70 | |
---|
[1992] | 71 | p0 = 1000. |
---|
| 72 | p0m1 = 1./p0 |
---|
[879] | 73 | |
---|
[1992] | 74 | DO i = 1, len |
---|
| 75 | coef(i) = 1./(plim1(i)-plim2(i)) |
---|
| 76 | END DO |
---|
[879] | 77 | |
---|
[1992] | 78 | DO j = 1, nd |
---|
| 79 | DO i = 1, len |
---|
| 80 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
---|
| 81 | p1(i, j) = min(ph(i,j), plim1(i)) |
---|
| 82 | p2(i, j) = max(ph(i,j+1), plim2(i)) |
---|
| 83 | ! CRtest:couplage thermiques: deja normalise |
---|
| 84 | ! wi(i,j) = w(j) |
---|
| 85 | ! print*,'wi',wi(i,j) |
---|
| 86 | wi(i, j) = w(j)*(p1(i,j)-p2(i,j))*coef(i) |
---|
| 87 | dpw(i) = dpw(i) + wi(i, j) |
---|
| 88 | END IF |
---|
| 89 | END DO |
---|
| 90 | END DO |
---|
| 91 | ! CR:print |
---|
| 92 | ! do i=1,len |
---|
| 93 | ! print*,'plim',plim1(i),plim2(i) |
---|
| 94 | ! enddo |
---|
| 95 | DO j = 1, nd |
---|
| 96 | DO i = 1, len |
---|
| 97 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
---|
| 98 | wi(i, j) = wi(i, j)/dpw(i) |
---|
| 99 | ahm(i) = ahm(i) + (cpd*(1.-q(i,j))+q(i,j)*cpv)*t(i, j)*wi(i, j) |
---|
| 100 | qmix(i) = qmix(i) + q(i, j)*wi(i, j) |
---|
| 101 | umix(i) = umix(i) + u(i, j)*wi(i, j) |
---|
| 102 | vmix(i) = vmix(i) + v(i, j)*wi(i, j) |
---|
| 103 | END IF |
---|
| 104 | END DO |
---|
| 105 | END DO |
---|
[879] | 106 | |
---|
[1992] | 107 | DO i = 1, len |
---|
| 108 | rdcp(i) = (rrd*(1.-qmix(i))+qmix(i)*rrv)/(cpd*(1.-qmix(i))+qmix(i)*cpv) |
---|
| 109 | END DO |
---|
[879] | 110 | |
---|
| 111 | |
---|
| 112 | |
---|
[1992] | 113 | DO j = 1, nd |
---|
| 114 | DO i = 1, len |
---|
| 115 | IF (j>=j1(i) .AND. j<=j2(i)) THEN |
---|
| 116 | ! c x=(.5*(p1(i,j)+p2(i,j))*p0m1)**rdcp(i) |
---|
| 117 | y = (.5*(p1(i,j)+p2(i,j))/pnk(i))**rdcp(i) |
---|
| 118 | ! c a2(i)=a2(i)+(cpd*(1.-qmix(i))+qmix(i)*cpv)*x*wi(i,j) |
---|
| 119 | b2(i) = b2(i) + (cpd*(1.-qmix(i))+qmix(i)*cpv)*y*wi(i, j) |
---|
| 120 | END IF |
---|
| 121 | END DO |
---|
| 122 | END DO |
---|
| 123 | |
---|
| 124 | DO i = 1, len |
---|
| 125 | tmix(i) = ahm(i)/b2(i) |
---|
| 126 | thmix(i) = tmix(i)*(p0/pnk(i))**rdcp(i) |
---|
| 127 | ! print*,'thmix ahm',ahm(i),b2(i) |
---|
| 128 | ! print*,'thmix t',tmix(i),p0 |
---|
| 129 | ! print*,'thmix p',pnk(i),rdcp(i) |
---|
| 130 | ! print*,'thmix',thmix(i) |
---|
| 131 | ! c thmix(i) = ahm(i)/a2(i) |
---|
| 132 | ! c tmix(i)= thmix(i)*(pnk(i)*p0m1)**rdcp(i) |
---|
| 133 | zdelta = max(0., sign(1.,rtt-tmix(i))) |
---|
| 134 | qsmix(i) = r2es*foeew(tmix(i), zdelta)/(pnk(i)*100.) |
---|
| 135 | qsmix(i) = min(0.5, qsmix(i)) |
---|
| 136 | zcor = 1./(1.-retv*qsmix(i)) |
---|
| 137 | qsmix(i) = qsmix(i)*zcor |
---|
| 138 | END DO |
---|
| 139 | |
---|
| 140 | ! ------------------------------------------------------------------- |
---|
| 141 | ! --- Calculate lifted condensation level of air at parcel origin level |
---|
| 142 | ! --- (Within 0.2% of formula of Bolton, MON. WEA. REV.,1980) |
---|
| 143 | ! ------------------------------------------------------------------- |
---|
| 144 | |
---|
| 145 | a = 1669.0 ! convect3 |
---|
| 146 | b = 122.0 ! convect3 |
---|
| 147 | |
---|
| 148 | |
---|
| 149 | niflag7 = 0 |
---|
| 150 | DO i = 1, len |
---|
| 151 | |
---|
| 152 | IF (iflag(i)/=7) THEN ! modif sb Jun7th 2002 |
---|
| 153 | |
---|
| 154 | rh(i) = qmix(i)/qsmix(i) |
---|
| 155 | chi(i) = tmix(i)/(a-b*rh(i)-tmix(i)) ! convect3 |
---|
| 156 | ! ATTENTION, la LIGNE DESSOUS A ETE RAJOUTEE ARBITRAIREMENT ET |
---|
| 157 | ! MASQUE UN PB POTENTIEL |
---|
| 158 | chi(i) = max(chi(i), 0.) |
---|
| 159 | rh(i) = max(rh(i), 0.) |
---|
| 160 | plcl(i) = pnk(i)*(rh(i)**chi(i)) |
---|
| 161 | IF (((plcl(i)<200.0) .OR. (plcl(i)>=2000.0)) .AND. (iflag(i)==0)) iflag & |
---|
| 162 | (i) = 8 |
---|
| 163 | |
---|
| 164 | ELSE |
---|
| 165 | |
---|
| 166 | niflag7 = niflag7 + 1 |
---|
| 167 | plcl(i) = plim2(i) |
---|
| 168 | |
---|
| 169 | END IF ! iflag=7 |
---|
| 170 | |
---|
| 171 | ! print*,'NIFLAG7 =',niflag7 |
---|
| 172 | |
---|
| 173 | END DO |
---|
| 174 | |
---|
| 175 | RETURN |
---|
| 176 | END SUBROUTINE cv3_vertmix |
---|
| 177 | |
---|