Changeset 5840 for LMDZ6/trunk/libf/phylmd/cva_driver.f90
- Timestamp:
- Sep 25, 2025, 10:57:40 AM (2 months ago)
- File:
-
- 1 edited
-
LMDZ6/trunk/libf/phylmd/cva_driver.f90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/cva_driver.f90
r5766 r5840 71 71 END SUBROUTINE cva_driver_post 72 72 73 SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, & 73 !!SUBROUTINE cva_driver(len, nd, ndp1, ntra, nloc, k_upper, & !jyg: get rid of ntra 74 SUBROUTINE cva_driver(len, nd, ndp1, nloc, k_upper, & 74 75 iflag_con, iflag_mix, iflag_ice_thermo, iflag_clos, ok_conserv_q, & 75 76 !! delt, t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg 76 77 delt, comp_threshold, & ! jyg 77 78 t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & ! jyg 78 u1, v1, tra1, & 79 !! u1, v1, tra1, & !jyg: get rid of ntra 80 u1, v1, & 79 81 p1, ph1, & 80 82 Ale1, Alp1, omega1, & 81 83 sig1feed1, sig2feed1, wght1, & 82 iflag1, ft1, fq1, fqcomp1, fu1, fv1, ftra1, & 84 !! iflag1, ft1, fq1, fqcomp1, fu1, fv1, ftra1, & !jyg: get rid of ntra 85 iflag1, ft1, fq1, fqcomp1, fu1, fv1, & 83 86 precip1, kbas1, ktop1, & 84 87 cbmf1, plcl1, plfc1, wbeff1, & … … 126 129 127 130 128 ! All argument names (except len,nd,n tra,nloc,delt and the flags) have a "1" appended.131 ! All argument names (except len,nd,nloc,delt and the flags) have a "1" appended. 129 132 ! The "1" is removed for the corresponding compressed variables. 130 133 ! PARAMETERS: … … 135 138 ! nd Integer Input vertical (k) dimension 136 139 ! ndp1 Integer Input nd + 1 137 ! ntra Integer Input number of tracors138 140 ! nloc Integer Input dimension of arrays for compressed fields 139 141 ! k_upper Integer Input upmost level for vertical loops … … 157 159 ! u1 Real Input u-wind 158 160 ! v1 Real Input v-wind 159 ! tra1 Real Input tracors160 161 ! p1 Real Input full level pressure 161 162 ! ph1 Real Input half level pressure … … 171 172 ! fu1 Real Output u-wind tend 172 173 ! fv1 Real Output v-wind tend 173 ! ftra1 Real Output tracor tend174 174 ! precip1 Real Output precipitation 175 175 ! kbas1 Integer Output cloud base level … … 251 251 INTEGER, INTENT (IN) :: nd 252 252 INTEGER, INTENT (IN) :: ndp1 253 INTEGER, INTENT (IN) ::ntra253 !! INTEGER, INTENT (IN) :: ntra !jyg: get rid of ntra 254 254 INTEGER, INTENT(IN) :: nloc ! (nloc=len) pour l'instant 255 255 INTEGER, INTENT (IN) :: k_upper … … 272 272 REAL, DIMENSION (len, nd), INTENT (IN) :: u1 273 273 REAL, DIMENSION (len, nd), INTENT (IN) :: v1 274 REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1 274 !! REAL, DIMENSION (len, nd, ntra), INTENT (IN) :: tra1 !jyg: get rid of ntra 275 275 REAL, DIMENSION (len, nd), INTENT (IN) :: p1 276 276 REAL, DIMENSION (len, ndp1), INTENT (IN) :: ph1 … … 294 294 REAL, DIMENSION (len, nd), INTENT (OUT) :: fu1 295 295 REAL, DIMENSION (len, nd), INTENT (OUT) :: fv1 296 REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1 296 !! REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1 !jyg: get rid of ntra 297 297 REAL, DIMENSION (len), INTENT (OUT) :: precip1 298 298 INTEGER, DIMENSION (len), INTENT (OUT) :: kbas1 … … 398 398 ! v: Same as u but for meridional velocity. 399 399 400 ! tra: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),401 ! where NTRA is the number of different tracers. If no402 ! convective tracer transport is needed, define a dummy403 ! input array of dimension (ND,1). Tracers are defined at404 ! same vertical levels as T. Note that this array will be altered405 ! if dry convective adjustment occurs and if IPBL is not equal to 0.406 407 400 ! p: Array of pressure (mb) of dimension ND, with first 408 401 ! index corresponding to lowest model level. Must be defined … … 460 453 461 454 ! fv: Same as FU, but for forcing of meridional velocity. 462 463 ! ftra: Array of forcing of tracer content, in tracer mixing ratio per464 ! second, defined at same levels as T. Dimensioned (ND,NTRA).465 455 466 456 ! precip: Scalar convective precipitation rate (mm/day). … … 596 586 REAL vprecip(nloc, nd+1) 597 587 REAL vprecipi(nloc, nd+1) 598 REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra) 599 REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra) 588 !! REAL tra(nloc, nd, ntra), trap(nloc, nd, ntra) !jyg: get rid of ntra 589 !! REAL ftra(nloc, nd, ntra), traent(nloc, nd, nd, ntra) !jyg: get rid of ntra 600 590 REAL qcondc(nloc, nd) ! cld 601 591 REAL wd(nloc) ! gust … … 641 631 nword1 = len 642 632 nword2 = len*nd 643 nword3 = len*nd*ntra633 !! nword3 = len*nd*ntra !jyg: get rid of ntra 644 634 nword4 = len*nd*nd 645 635 … … 651 641 fqcomp1(:, :) = 0.0 652 642 fu1(:, :) = 0.0 653 fv1(:, :) = 0.0 654 ftra1(:, :, :) = 0. 643 fv1(:, :) = 0.0 644 !! ftra1(:, :, :) = 0. !jyg: get rid of ntra 655 645 precip1(:) = 0. 656 646 cbmf1(:) = 0. … … 933 923 IF (iflag_con==3) THEN 934 924 if (prt_level >= 9) PRINT *, 'cva_driver -> cv3a_compress' 935 CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, & 925 !! CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, & !jyg: get rid of ntra 926 CALL cv3a_compress(len, nloc, ncum, nd, compress, & 936 927 iflag1, nk1, icb1, icbs1, & 937 928 plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & … … 939 930 t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & 940 931 u1, v1, gz1, th1, th1_wake, & 941 tra1, & 932 !! tra1, & !jyg: get rid of ntra 942 933 h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & 943 934 h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, & … … 949 940 t, q, qs, t_wake, q_wake, qs_wake, s_wake, & 950 941 u, v, gz, th, th_wake, & 951 tra, & 942 !! tra, & !jyg: get rid of ntra 952 943 h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, & 953 944 h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, & … … 1022 1013 if (prt_level >= 9) & 1023 1014 PRINT *, 'cva_driver -> cv3p_mixing' 1024 CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd 1015 !! CALL cv3p_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd !jyg: get rid of ntra 1016 CALL cv3p_mixing(nloc, ncum, nd, nd, icb, nk, inb, & ! na->nd 1025 1017 !! ph, t, q, qs, u, v, tra, h, lv, lf, frac, qnk, & 1026 ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, & !!jygprl 1018 !! ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qta, & !!jygprl !jyg: get rid of ntra 1019 ph, t, q, qs, u, v, h, lv, lf, frac_s, qta, & !!jygprl 1027 1020 unk, vnk, hp, tv, tvp, ep, clw, sig, & 1028 1021 ment, qent, hent, uent, vent, nent, & 1029 sigij, elij, supmax, ments, qents, traent) 1022 !! sigij, elij, supmax, ments, qents, traent) !jyg: get rid of ntra 1023 sigij, elij, supmax, ments, qents) 1030 1024 ! print*, 'cv3p_mixing-> supmax ', (supmax(1,k), k=1,nd) 1031 1025 … … 1104 1098 if (prt_level >= 9) & 1105 1099 PRINT *, 'cva_driver -> cv3_mixing' 1106 CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd 1107 ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, & 1100 !! CALL cv3_mixing(nloc, ncum, nd, nd, ntra, icb, nk, inb, & ! na->nd !jyg: get rid of ntra 1101 CALL cv3_mixing(nloc, ncum, nd, nd, icb, nk, inb, & ! na->nd 1102 !! ph, t, q, qs, u, v, tra, h, lv, lf, frac_s, qnk, & !jyg: get rid of ntra 1103 ph, t, q, qs, u, v, h, lv, lf, frac_s, qnk, & 1108 1104 unk, vnk, hp, tv, tvp, ep, clw, m, sig, & 1109 ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent) 1105 !! ment, qent, uent, vent, nent, sigij, elij, ments, qents, traent) !jyg: get rid of ntra 1106 ment, qent, uent, vent, nent, sigij, elij, ments, qents) 1110 1107 hent(1:nloc,1:nd,1:nd) = 0. 1111 1108 ELSE … … 1149 1146 if (prt_level >= 9) & 1150 1147 PRINT *, 'cva_driver -> cv3_unsat' 1151 CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd 1152 t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, & 1148 !! CALL cv3_unsat(nloc, ncum, nd, nd, ntra, icb, inb, iflag, & ! na->nd !jyg: get rid of ntra 1149 CALL cv3_unsat(nloc, ncum, nd, nd, icb, inb, iflag, & ! na->nd 1150 !! t_wake, q_wake, qs_wake, gz, u, v, tra, p, ph, & !jyg: get rid of ntra 1151 t_wake, q_wake, qs_wake, gz, u, v, p, ph, & 1153 1152 th_wake, tv_wake, lv_wake, lf_wake, cpn_wake, & 1154 1153 ep, sigp, clw, frac_s, qpreca, frac_a, qta, & !!jygprl 1155 1154 m, ment, elij, delt, plcl, coef_clos_eff, & 1156 mp, qp, up, vp, trap, wt, water, evap, fondue, ice, & 1155 !! mp, qp, up, vp, trap, wt, water, evap, fondue, ice, & !jyg: get rid of ntra 1156 mp, qp, up, vp, wt, water, evap, fondue, ice, & 1157 1157 faci, b, sigd, & 1158 1158 !! wdtrainA, wdtrainM) ! RomP … … 1199 1199 if (prt_level >= 9) & 1200 1200 PRINT *, 'cva_driver -> cv3_yield' 1201 CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd 1201 !! CALL cv3_yield(nloc, ncum, nd, nd, ntra, ok_conserv_q, & ! na->nd !jyg: get rid of ntra 1202 CALL cv3_yield(nloc, ncum, nd, nd, ok_conserv_q, & ! na->nd 1202 1203 icb, inb, delt, & 1203 t, q, t_wake, q_wake, s_wake, u, v, tra, & 1204 !! t, q, t_wake, q_wake, s_wake, u, v, tra, & !jyg: get rid of ntra 1205 t, q, t_wake, q_wake, s_wake, u, v, & 1204 1206 gz, p, ph, h, hp, lv, lf, cpn, th, th_wake, & 1205 ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, & 1207 !! ep, clw, qpreca, m, tp, mp, qp, up, vp, trap, & !jyg: get rid of ntra 1208 ep, clw, qpreca, m, tp, mp, qp, up, vp, & 1206 1209 wt, water, ice, evap, fondue, faci, b, sigd, & 1207 1210 ment, qent, hent, iflag_mix, uent, vent, & 1208 nent, elij, traent, sig, & 1211 !! nent, elij, traent, sig, & !jyg: get rid of ntra 1212 nent, elij, sig, & 1209 1213 tv, tvp, wghti, & 1210 iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, & ! jyg 1214 !! iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, ftra, & !jyg: get rid of ntra 1215 iflag, precip, Vprecip, Vprecipi, ft, fq, fqcomp, fu, fv, & 1211 1216 cbmf, upwd, dnwd, dnwd0, ma, mip, & 1212 1217 !! tls, tps, & ! useless . jyg … … 1270 1275 if (prt_level >= 9) & 1271 1276 PRINT *, 'cva_driver -> cv3a_uncompress' 1272 CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, is_convect, compress, & 1277 !! CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, is_convect, compress, & !jyg: get rid of ntra 1278 CALL cv3a_uncompress(nloc, len, ncum, nd, idcum, is_convect, compress, & 1273 1279 iflag, icb, inb, & 1274 1280 precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & 1275 ft, fq, fqcomp, fu, fv, ftra, & 1281 !! ft, fq, fqcomp, fu, fv, ftra, & !jyg: get rid of ntra 1282 ft, fq, fqcomp, fu, fv, & 1276 1283 sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, & 1277 1284 qcondc, wd, cape, cin, & … … 1287 1294 iflag1, kbas1, ktop1, & 1288 1295 precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, & 1289 ft1, fq1, fqcomp1, fu1, fv1, ftra1, & 1296 !! ft1, fq1, fqcomp1, fu1, fv1, ftra1, & !jyg: get rid of ntra 1297 ft1, fq1, fqcomp1, fu1, fv1, & 1290 1298 sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, & 1291 1299 qcondc1, wd1, cape1, cin1, &
Note: See TracChangeset
for help on using the changeset viewer.
