Changeset 2253 for LMDZ5/trunk/libf/phylmd/cv3_routines.F90
- Timestamp:
- Mar 30, 2015, 11:08:45 AM (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/phylmd/cv3_routines.F90
r2208 r2253 264 264 265 265 !inputs: 266 INTEGER len, nd 267 LOGICAL ok_conserv_q 268 REAL t(len, nd), q(len, nd), p(len, nd) 269 REAL u(len, nd), v(len, nd) 270 REAL hm(len, nd), gz(len, nd) 271 REAL ph(len, nd+1) 272 REAL p1feed(len) 273 ! , wght(len) 274 REAL wght(nd) 266 INTEGER, INTENT (IN) :: len, nd 267 LOGICAL, INTENT (IN) :: ok_conserv_q 268 REAL, DIMENSION (len, nd), INTENT (IN) :: t, q, p 269 REAL, DIMENSION (len, nd), INTENT (IN) :: u, v 270 REAL, DIMENSION (len, nd), INTENT (IN) :: hm, gz 271 REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph 272 REAL, DIMENSION (len), INTENT (IN) :: p1feed 273 REAL, DIMENSION (nd), INTENT (IN) :: wght 275 274 !input-output 276 REAL p2feed(len)275 REAL, DIMENSION (len), INTENT (INOUT) :: p2feed 277 276 !outputs: 278 INTEGER iflag(len), nk(len), icb(len),icbmax279 ! real wghti(len) 280 REAL wghti(len, nd)281 REAL tnk(len), thnk(len), qnk(len), qsnk(len)282 REAL unk(len), vnk(len)283 REAL cpnk(len), hnk(len), gznk(len)284 REAL plcl(len)277 INTEGER, INTENT (OUT) :: icbmax 278 INTEGER, DIMENSION (len), INTENT (OUT) :: iflag, nk, icb 279 REAL, DIMENSION (len, nd), INTENT (OUT) :: wghti 280 REAL, DIMENSION (len), INTENT (OUT) :: tnk, thnk, qnk, qsnk 281 REAL, DIMENSION (len), INTENT (OUT) :: unk, vnk 282 REAL, DIMENSION (len), INTENT (OUT) :: cpnk, hnk, gznk 283 REAL, DIMENSION (len), INTENT (OUT) :: plcl 285 284 286 285 !local variables: … … 514 513 515 514 ! inputs: 516 INTEGER len, nd517 INTEGER icb(len)518 REAL t(len, nd), qs(len, nd), gz(len, nd)519 REAL tnk(len), qnk(len), gznk(len)520 REAL p(len, nd)521 REAL plcl(len)! convect3515 INTEGER, INTENT (IN) :: len, nd 516 INTEGER, DIMENSION (len), INTENT (IN) :: icb 517 REAL, DIMENSION (len, nd), INTENT (IN) :: t, qs, gz 518 REAL, DIMENSION (len), INTENT (IN) :: tnk, qnk, gznk 519 REAL, DIMENSION (len, nd), INTENT (IN) :: p 520 REAL, DIMENSION (len), INTENT (IN) :: plcl ! convect3 522 521 523 522 ! outputs: 524 REAL tp(len, nd), tvp(len, nd), clw(len, nd) 523 INTEGER, DIMENSION (len), INTENT (OUT) :: icbs 524 REAL, DIMENSION (len, nd), INTENT (OUT) :: tp, tvp, clw 525 525 526 526 ! local variables: 527 527 INTEGER i, k 528 INTEGER icb1(len), icbs (len), icbsmax2! convect3528 INTEGER icb1(len), icbsmax2 ! convect3 529 529 REAL tg, qg, alv, s, ahg, tc, denom, es, rg 530 530 REAL ah0(len), cpp(len) 531 531 REAL ticb(len), gzicb(len) 532 REAL qsicb(len) ! convect3533 REAL cpinv(len) ! convect3532 REAL qsicb(len) ! convect3 533 REAL cpinv(len) ! convect3 534 534 535 535 ! ------------------------------------------------------------------- … … 1051 1051 1052 1052 !inputs: 1053 INTEGER ncum, nd, nloc, j 1054 INTEGER icb(nloc), icbs(nloc), nk(nloc) 1055 REAL t(nloc, nd), q(nloc, nd), qs(nloc, nd), gz(nloc, nd) 1056 REAL p(nloc, nd) 1057 REAL tnk(nloc), qnk(nloc), gznk(nloc) 1058 REAL hnk(nloc) 1059 REAL lv(nloc, nd), lf(nloc, nd), tv(nloc, nd), h(nloc, nd) 1060 REAL pbase(nloc), buoybase(nloc), plcl(nloc) 1053 INTEGER, INTENT (IN) :: ncum, nd, nloc 1054 INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, icbs, nk 1055 REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, q, qs, gz 1056 REAL, DIMENSION (nloc, nd), INTENT (IN) :: p 1057 REAL, DIMENSION (nloc), INTENT (IN) :: tnk, qnk, gznk 1058 REAL, DIMENSION (nloc), INTENT (IN) :: hnk 1059 REAL, DIMENSION (nloc, nd), INTENT (IN) :: lv, lf, tv, h 1060 REAL, DIMENSION (nloc), INTENT (IN) :: pbase, buoybase, plcl 1061 1062 !input/outputs: 1063 REAL, DIMENSION (nloc, nd), INTENT (INOUT) :: tp, tvp, clw ! Input for k = 1, icb+1 (computed in cv3_undilute1) 1064 ! Output above 1061 1065 1062 1066 !outputs: 1063 INTEGER inb(nloc) 1064 REAL tp(nloc, nd), tvp(nloc, nd), clw(nloc, nd) 1065 REAL ep(nloc, nd), sigp(nloc, nd), hp(nloc, nd) 1066 REAL buoy(nloc, nd) 1067 INTEGER, DIMENSION (nloc), INTENT (OUT) :: inb 1068 REAL, DIMENSION (nloc, nd), INTENT (OUT) :: ep, sigp, hp 1069 REAL, DIMENSION (nloc, nd), INTENT (OUT) :: buoy 1067 1070 1068 1071 !local variables: 1069 INTEGER i, k1072 INTEGER i, j, k 1070 1073 REAL tg, qg, ahg, alv, alf, s, tc, es, esi, denom, rg, tca, elacrit 1071 1074 REAL als … … 1084 1087 DO k = 1, nl 1085 1088 DO i = 1, ncum 1086 ep(i, k) = 0.01087 sigp(i, k) = spfac1088 1089 qi(i, k) = 0. 1089 1090 END DO … … 1187 1188 END IF 1188 1189 END IF 1189 END IF 1190 !jyg< 1191 !! END IF ! Endif moved to the end of the loop 1192 !>jyg 1190 1193 1191 1194 IF (cvflag_ice) THEN … … 1258 1261 END IF 1259 1262 END IF ! (cvflag_ice) 1260 1263 !jyg< 1264 END IF ! (k>=(icbs(i)+1)) 1265 !>jyg 1261 1266 END DO 1262 1267 END DO … … 1267 1272 ! --- THESE MAY BE FUNCTIONS OF TP(I), P(I) AND CLW(I) 1268 1273 ! ===================================================================== 1269 1274 ! 1275 !jyg< 1276 DO k = 1, nl 1277 DO i = 1, ncum 1278 ep(i, k) = 0.0 1279 sigp(i, k) = spfac 1280 END DO 1281 END DO 1282 !>jyg 1283 ! 1270 1284 IF (flag_epkeorig/=1) THEN 1271 1285 DO k = 1, nl ! convect3 1272 1286 DO i = 1, ncum 1273 pden = ptcrit - pbcrit 1274 ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax 1275 ep(i, k) = max(ep(i,k), 0.0) 1276 ep(i, k) = min(ep(i,k), epmax) 1277 sigp(i, k) = spfac 1287 !jyg< 1288 IF(k>=icb(i)) THEN 1289 !>jyg 1290 pden = ptcrit - pbcrit 1291 ep(i, k) = (plcl(i)-p(i,k)-pbcrit)/pden*epmax 1292 ep(i, k) = max(ep(i,k), 0.0) 1293 ep(i, k) = min(ep(i,k), epmax) 1294 !! sigp(i, k) = spfac ! jyg 1295 ENDIF ! (k>=icb(i)) 1278 1296 END DO 1279 1297 END DO … … 1281 1299 DO k = 1, nl 1282 1300 DO i = 1, ncum 1283 IF (k>=(nk(i)+1)) THEN 1301 IF(k>=icb(i)) THEN 1302 !! IF (k>=(nk(i)+1)) THEN 1303 !>jyg 1284 1304 tca = tp(i, k) - t0 1285 1305 IF (tca>=0.0) THEN … … 1292 1312 ep(i, k) = max(ep(i,k), 0.0) 1293 1313 ep(i, k) = min(ep(i,k), epmax) 1294 sigp(i, k) = spfac 1295 END IF 1314 !! sigp(i, k) = spfac ! jyg 1315 END IF ! (k>=icb(i)) 1296 1316 END DO 1297 1317 END DO 1298 1318 END IF 1319 ! 1299 1320 ! ===================================================================== 1300 1321 ! --- CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL … … 1768 1789 1769 1790 !inputs: 1770 INTEGER ncum, nd, na, ntra, nloc1771 INTEGER icb(nloc), inb(nloc), nk(nloc)1772 REAL sig(nloc, nd)1773 REAL qnk(nloc), unk(nloc), vnk(nloc)1774 REAL ph(nloc, nd+1)1775 REAL t(nloc, nd), rr(nloc, nd), rs(nloc, nd)1776 REAL u(nloc, nd), v(nloc, nd)1777 REAL tra(nloc, nd, ntra)! input of convect31778 REAL lv(nloc, na), h(nloc, na), hp(nloc, na)1779 REAL lf(nloc, na), frac(nloc, na)1780 REAL tv(nloc, na), tvp(nloc, na), ep(nloc, na), clw(nloc, na)1781 REAL m(nloc, na)! input of convect31791 INTEGER, INTENT (IN) :: ncum, nd, na, ntra, nloc 1792 INTEGER, DIMENSION (nloc), INTENT (IN) :: icb, inb, nk 1793 REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig 1794 REAL, DIMENSION (nloc), INTENT (IN) :: qnk, unk, vnk 1795 REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: ph 1796 REAL, DIMENSION (nloc, nd), INTENT (IN) :: t, rr, rs 1797 REAL, DIMENSION (nloc, nd), INTENT (IN) :: u, v 1798 REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: tra ! input of convect3 1799 REAL, DIMENSION (nloc, na), INTENT (IN) :: lv, h, hp 1800 REAL, DIMENSION (nloc, na), INTENT (IN) :: lf, frac 1801 REAL, DIMENSION (nloc, na), INTENT (IN) :: tv, tvp, ep, clw 1802 REAL, DIMENSION (nloc, na), INTENT (IN) :: m ! input of convect3 1782 1803 1783 1804 !outputs: 1784 REAL ment(nloc, na, na), qent(nloc, na, na) 1785 REAL uent(nloc, na, na), vent(nloc, na, na) 1786 REAL sij(nloc, na, na), elij(nloc, na, na) 1787 REAL traent(nloc, nd, nd, ntra) 1788 REAL ments(nloc, nd, nd), qents(nloc, nd, nd) 1789 REAL sigij(nloc, nd, nd) 1790 INTEGER nent(nloc, nd) 1805 REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: ment, qent 1806 REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: uent, vent 1807 REAL, DIMENSION (nloc, na, na), INTENT (OUT) :: sij, elij 1808 REAL, DIMENSION (nloc, nd, nd, ntra), INTENT (OUT) :: traent 1809 REAL, DIMENSION (nloc, nd, nd), INTENT (OUT) :: ments, qents 1810 INTEGER, DIMENSION (nloc, nd), INTENT (OUT) :: nent 1791 1811 1792 1812 !local variables: … … 1797 1817 REAL asij(nloc), smax(nloc), scrit(nloc) 1798 1818 REAL asum(nloc, nd), bsum(nloc, nd), csum(nloc, nd) 1819 REAL sigij(nloc, nd, nd) 1799 1820 REAL wgh 1800 1821 REAL zm(nloc, na) … … 3588 3609 ! *** reset counter and return *** 3589 3610 3611 ! Reset counter only for points actually convective (jyg) 3612 ! In order take into account the possibility of changing the compression, 3613 ! reset m, sig and w0 to zero for non-convecting points. 3590 3614 DO il = 1, ncum 3591 sig(il, nd) = 2.0 3615 IF (iflag(il) < 3) THEN 3616 sig(il, nd) = 2.0 3617 ENDIF 3592 3618 END DO 3593 3619
Note: See TracChangeset
for help on using the changeset viewer.