Changeset 230 for LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
- Timestamp:
- Jun 20, 2001, 3:29:52 PM (23 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r223 r230 281 281 SAVE agesno ! age de la neige 282 282 c 283 REAL alb_neig(klon) 284 SAVE alb_neig ! albedo de la neige 285 cKE43 286 c Variables liees a la convection de K. Emanuel (sb): 287 c 288 REAL ema_workcbmf(klon) ! cloud base mass flux 289 SAVE ema_workcbmf 290 291 REAL ema_cbmf(klon) ! cloud base mass flux 292 SAVE ema_cbmf 293 294 REAL ema_pcb(klon) ! cloud base pressure 295 SAVE ema_pcb 296 297 REAL ema_pct(klon) ! cloud top pressure 298 SAVE ema_pct 299 300 REAL bas, top ! cloud base and top levels 301 SAVE bas 302 SAVE top 303 304 REAL Ma(klon,klev) ! undilute upward mass flux 305 SAVE Ma 306 REAL ema_work1(klon, klev), ema_work2(klon, klev) 307 SAVE ema_work1, ema_work2 308 REAL wdn(klon), tdn(klon), qdn(klon) 309 c Variables locales pour la couche limite (al1): 310 c 311 cAl1 REAL pblh(klon) ! Hauteur de couche limite 312 cAl1 SAVE pblh 313 c34EK 283 314 c 284 315 c Variables locales: … … 346 377 EXTERNAL condsurf ! lire les conditions aux limites 347 378 EXTERNAL conlmd ! convection (schema LMD) 379 cKE43 380 EXTERNAL conema ! convect4.3 348 381 EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie) 349 382 cAA … … 426 459 c 427 460 REAL zphi(klon,klev) 461 REAL zx_tmp_x(iim), zx_tmp_yjjmp1 462 REAL zx_relief(iim,jjmp1) 463 REAL zx_aire(iim,jjmp1) 464 cKE43 465 c Variables locales pour la convection de K. Emanuel (sb): 466 c 467 REAL upwd(klon,klev) ! saturated updraft mass flux 468 REAL dnwd(klon,klev) ! saturated downdraft mass flux 469 REAL dnwd0(klon,klev) ! unsaturated downdraft mass flux 470 REAL tvp(klon,klev) ! virtual temp of lifted parcel 471 REAL cape(klon) ! CAPE 472 SAVE cape 473 REAL pbase(klon) ! cloud base pressure 474 SAVE pbase 475 REAL bbase(klon) ! cloud base buoyancy 476 SAVE bbase 477 REAL rflag(klon) ! flag fonctionnement de convect 478 c -- convect43: 479 INTEGER ntra ! nb traceurs pour convect4.3 480 REAL pori_con(klon) ! pressure at the origin level of lifted parcel 481 REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon) 482 REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev) 483 REAL dplcldt(klon), dplcldr(klon) 484 c? . condm_con(klon,klev),conda_con(klon,klev), 485 c? . mr_con(klon,klev),ep_con(klon,klev) 486 c? . ,sadiab(klon,klev),wadiab(klon,klev) 487 c -- 488 c34EK 428 489 c 429 490 c Variables du changement … … 460 521 REAL d_u_lif(klon,klev), d_v_lif(klon,klev) 461 522 REAL d_t_lif(klon,klev) 523 524 REAL ratqs(klon,klev) 525 LOGICAL zpt_conv(klon,klev) 526 462 527 c 463 528 c Variables liees a l'ecriture de la bande histoire physique … … 595 660 PRINT*, "Clef pour la convection, iflag_con=", iflag_con 596 661 c 662 cKE43 663 c Initialisation pour la convection de K.E. (sb): 664 IF (iflag_con.EQ.4) THEN 665 666 PRINT*, "*** Convection de Kerry Emanuel 4.3 " 667 PRINT*, "On va utiliser le melange convectif des traceurs qui" 668 PRINT*, "est calcule dans convect4.3" 669 PRINT*, " !!! penser aux logical flags de phytrac" 670 671 DO i = 1, klon 672 ema_cbmf(i) = 0. 673 ema_pcb(i) = 0. 674 ema_pct(i) = 0. 675 ema_workcbmf(i) = 0. 676 ENDDO 677 ENDIF 678 c34EK 597 679 IF (ok_orodr) THEN 598 680 DO i=1,klon … … 665 747 . 1,iim,1,jjmp1, 0, zjulian, dtime, 666 748 . nhori, nid_day) 667 cCALL histvert(nid_day, "presnivs", "Vertical levels", "mb",668 c. klev, presnivs, nvert)669 670 749 CALL histvert(nid_day, "presnivs", "Vertical levels", "mb", 750 . klev, presnivs, nvert) 751 c call histvert(nid_day, 'sig_s', 'Niveaux sigma','-', 752 c . klev, znivsig, nvert) 671 753 c 672 754 zsto = dtime … … 888 970 . 1,iim,1,jjmp1, 0, zjulian, dtime, 889 971 . nhori, nid_mth) 890 cCALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",891 c. klev, presnivs, nvert)892 893 972 CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb", 973 . klev, presnivs, nvert) 974 c call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-', 975 c . klev, znivsig, nvert) 894 976 c 895 977 zsto = dtime … … 1097 1179 . "ave(X)", zsto,zout) 1098 1180 c 1181 cKE43 1182 IF (iflag_con .EQ. 4) THEN ! sb 1183 c 1184 CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg", 1185 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1186 . "ave(X)", zsto,zout) 1187 c 1188 CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa", 1189 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1190 . "ave(X)", zsto,zout) 1191 c 1192 CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa", 1193 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1194 . "ave(X)", zsto,zout) 1195 c 1196 CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s", 1197 . iim,jjmp1,nhori, 1,1,1, -99, 32, 1198 . "ave(X)", zsto,zout) 1199 c 1200 c 1201 ENDIF 1202 c34EK 1203 c 1099 1204 c Champs 3D: 1100 1205 c … … 1178 1283 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 1179 1284 . "ave(X)", zsto,zout) 1285 1286 CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ", 1287 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 1288 . "ave(X)", zsto,zout) 1289 1290 CALL histdef(nid_mth, "ratqs", "RATQS"," ", 1291 . iim,jjm+1,nhori, klev,1,klev,nvert, 32, 1292 . "ave(X)", zsto,zout) 1293 1180 1294 c 1181 1295 CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s", … … 1250 1364 ENDIF 1251 1365 c 1366 cKE43 1367 IF (iflag_con.EQ.4) THEN ! (sb) 1368 c 1369 CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s", 1370 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 1371 . "ave(X)", zsto,zout) 1372 c 1373 CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s", 1374 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 1375 . "ave(X)", zsto,zout) 1376 c 1377 CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s", 1378 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 1379 . "ave(X)", zsto,zout) 1380 c 1381 CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s", 1382 . iim,jjmp1,nhori, klev,1,klev,nvert, 32, 1383 . "ave(X)", zsto,zout) 1384 c 1385 c 1386 ENDIF 1387 c34EK 1252 1388 CALL histend(nid_mth) 1253 1389 c … … 1275 1411 . 1,iim,1,jjmp1, 0, zjulian, dtime, 1276 1412 . nhori, nid_ins) 1277 cCALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",1278 c. klev, presnivs, nvert)1279 1280 1413 CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb", 1414 . klev, presnivs, nvert) 1415 c call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-', 1416 c . klev, znivsig, nvert) 1281 1417 c 1282 1418 c … … 1685 1821 c 1686 1822 DO nsrf = 1, nbsrf 1687 DO i = 1, klon1688 IF (pctsrf(i,nsrf).LT.epsfra) ftsol(i,nsrf) = zxtsol(i)1689 ENDDO1823 DO i = 1, klon 1824 IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i) 1825 ENDDO 1690 1826 ENDDO 1691 1827 … … 1750 1886 c s d_t_con, d_q_con, 1751 1887 c s rain_con, snow_con, ibas_con, itop_con) 1888 cKE43 1889 ELSE IF (iflag_con.EQ.4) THEN 1890 c nb of tracers for the KE convection: 1891 if (nqmax .GE. 4) then 1892 ntra = nbtr 1893 else 1894 ntra = 1 1895 endif 1896 cke43 (arguments inutiles enleves => des SAVE dans conema43?) 1897 c$$$ CALL conema43(dtime,paprs,pplay,t_seri,q_seri, 1898 c$$$ $ u_seri,v_seri,tr_seri,nbtr, 1899 c$$$ . ema_workcbmf, 1900 c$$$ . d_t_con,d_q_con,d_u_con,d_v_con,d_tr, 1901 c$$$ . wdn, tdn, qdn, 1902 c$$$ . rain_con, snow_con, ibas_con, itop_con, 1903 c$$$ . upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag, 1904 c$$$ . pbase 1905 c$$$ . ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr, 1906 c$$$ . pori_con,plcl_con,dtma_con,dtlcl_con) 1907 CALL conema (dtime,paprs,pplay,t_seri,q_seri, 1908 $ u_seri,v_seri,tr_seri,nbtr, 1909 . ema_work1,ema_work2, 1910 . d_t_con,d_q_con,d_u_con,d_v_con,d_tr, 1911 c$$$ . wdn, tdn, qdn, 1912 . rain_con, snow_con, ibas_con, itop_con, 1913 . upwd,dnwd,dnwd0,bas,top,Ma,cape,tvp,rflag, 1914 . pbase 1915 . ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr) 1916 c$$$ . pori_con,plcl_con,dtma_con,dtlcl_con) 1917 DO i = 1, klon 1918 ema_pcb(i) = pbase(i) 1919 ENDDO 1920 DO i = 1, klon 1921 ema_pct(i) = paprs(i,itop_con(i)) 1922 ENDDO 1923 DO i = 1, klon 1924 ema_cbmf(i) = ema_workcbmf(i) 1925 ENDDO 1752 1926 ELSE 1753 PRINT*, "iflag_con non-prevu", iflag_con1754 CALL abort1927 PRINT*, "iflag_con non-prevu", iflag_con 1928 CALL abort 1755 1929 ENDIF 1756 1930 … … 1766 1940 ENDDO 1767 1941 IF (check) THEN 1768 za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)1769 PRINT*, "aprescon=", za1770 zx_t = 0.01771 za = 0.01772 DO i = 1, klon1942 za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire) 1943 PRINT*, "aprescon=", za 1944 zx_t = 0.0 1945 za = 0.0 1946 DO i = 1, klon 1773 1947 za = za + paire(i)/FLOAT(klon) 1774 1948 zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon) 1775 ENDDO1776 zx_t = zx_t/za*dtime1777 PRINT*, "Precip=", zx_t1949 ENDDO 1950 zx_t = zx_t/za*dtime 1951 PRINT*, "Precip=", zx_t 1778 1952 ENDIF 1779 1953 IF (zx_ajustq) THEN 1780 DO i = 1, klon1954 DO i = 1, klon 1781 1955 z_apres(i) = 0.0 1782 ENDDO1783 DO k = 1, klev1784 DO i = 1, klon1785 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))1786 . 1787 ENDDO1788 ENDDO1789 DO i = 1, klon1790 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)1791 . 1792 ENDDO1793 DO k = 1, klev1794 DO i = 1, klon1795 IF (z_factor(i).GT.(1.0+1.0E-08) .OR.1796 . z_factor(i).LT.(1.0-1.0E-08)) THEN1797 q_seri(i,k) = q_seri(i,k) * z_factor(i)1798 ENDIF1799 ENDDO1800 ENDDO1956 ENDDO 1957 DO k = 1, klev 1958 DO i = 1, klon 1959 z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) 1960 . *(paprs(i,k)-paprs(i,k+1))/RG 1961 ENDDO 1962 ENDDO 1963 DO i = 1, klon 1964 z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) 1965 . /z_apres(i) 1966 ENDDO 1967 DO k = 1, klev 1968 DO i = 1, klon 1969 IF (z_factor(i).GT.(1.0+1.0E-08) .OR. 1970 . z_factor(i).LT.(1.0-1.0E-08)) THEN 1971 q_seri(i,k) = q_seri(i,k) * z_factor(i) 1972 ENDIF 1973 ENDDO 1974 ENDDO 1801 1975 ENDIF 1802 1976 zx_ajustq=.FALSE. … … 1804 1978 IF (nqmax.GT.2) THEN !--melange convectif de traceurs 1805 1979 c 1806 IF (iflag_con.NE.2) THEN 1807 PRINT*, "Pour l instant, seul conflx fonctionne avec traceurs" 1808 PRINT*,' Mettre iflag_con = 2 dans run.def et repasser !' 1809 CALL abort 1810 ENDIF 1980 IF (iflag_con .NE. 2 .AND. iflag_con .NE. 4 ) THEN 1981 PRINT*, 'Pour l instant, seul conflx fonctionne ', 1982 $ 'avec traceurs', iflag_con 1983 PRINT*,' Mettre iflag_con', 1984 $ ' = 2 ou 4 dans run.def et repasser' 1985 CALL abort 1986 ENDIF 1811 1987 c 1812 1988 ENDIF !--nqmax.GT.2 … … 1821 1997 ENDDO 1822 1998 ENDDO 1999 2000 c RATQS 2001 call calcratqs ( 2002 I paprs,pplay,q_seri,d_t_con,d_t_ajs 2003 O ,ratqs,zpt_conv) 1823 2004 c 1824 2005 c Appeler le processus de condensation a grande echelle … … 1826 2007 c 1827 2008 CALL fisrtilp_tr(dtime,paprs,pplay, 1828 . t_seri, q_seri, 2009 . t_seri, q_seri,ratqs, 1829 2010 . d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq, 1830 2011 . rain_lsc, snow_lsc, … … 2060 2241 c Calcul des tendances traceurs 2061 2242 c==================================================================== 2243 C Pascale : il faut quand meme apeller phytrac car il gere les sorties 2244 cKE43 des traceurs => il faut donc mettre des flags a .false. 2245 IF (iflag_con.EQ.4) THEN 2246 c on ajoute les tendances calculees par KE43 2247 DO iq=1, nqmax-2 ! Sandrine a -3 ??? 2248 DO k = 1, nlev 2249 DO i = 1, klon 2250 tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq) 2251 ENDDO 2252 ENDDO 2253 WRITE(iqn,'(i2.2)') iq 2254 CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn) 2255 ENDDO 2062 2256 CMAF modif pour garder info du nombre de traceurs auxquels 2063 2257 C la physique s'applique 2258 ELSE 2259 CMAF modif pour garder info du nombre de traceurs auxquels 2260 C la physique s'applique 2064 2261 C 2065 2262 call phytrac (rnpb, 2066 I debut, 2263 I debut,lafin, 2067 2264 I nqmax-2, 2068 2265 I nlon,nlev,dtime, … … 2073 2270 I rlon,presnivs,paire,pphis, 2074 2271 O tr_seri) 2272 ENDIF 2075 2273 2076 2274 IF (offline) THEN … … 2078 2276 call phystokenc ( 2079 2277 I nlon,nlev,pdtphys,rlon,rlat, 2080 I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,2278 I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, 2081 2279 I ycoefh,yu1,yv1,ftsol,pctsrf, 2082 2280 I frac_impa, frac_nucl, 2083 I pphis,paire,dtime,itap ,2084 O physid) 2281 I pphis,paire,dtime,itap) 2282 2085 2283 2086 2284 ENDIF … … 2475 2673 CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d) 2476 2674 CALL histwrite(nid_mth,"vq",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2675 cKE43 2676 IF (iflag_con .EQ. 4) THEN ! sb 2677 c 2678 CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d) 2679 CALL histwrite(nid_mth,"cape",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2680 c 2681 CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d) 2682 CALL histwrite(nid_mth,"pbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2683 c 2684 CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d) 2685 CALL histwrite(nid_mth,"ptop",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2686 c 2687 CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d) 2688 CALL histwrite(nid_mth,"fbase",itap,zx_tmp_2d,iim*jjmp1,ndex2d) 2689 c 2690 c 2691 ENDIF 2692 c34EK 2477 2693 c 2478 2694 c Champs 3D: … … 2557 2773 CALL histwrite(nid_mth,"dqeva",itap,zx_tmp_3d, 2558 2774 . iim*jjmp1*klev,ndex3d) 2775 c 2776 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, zpt_conv, zx_tmp_3d) 2777 CALL histwrite(nid_mth,"ptconv",itap,zx_tmp_3d, 2778 . iim*(jjm+1)*klev,ndex3d) 2779 c 2780 CALL gr_fi_ecrit(klev,klon,iim,jjm+1, ratqs, zx_tmp_3d) 2781 CALL histwrite(nid_mth,"ratqs",itap,zx_tmp_3d, 2782 . iim*(jjm+1)*klev,ndex3d) 2559 2783 c 2560 2784 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d) … … 2628 2852 ENDDO 2629 2853 ENDIF 2854 cKE43 2855 IF (iflag_con.EQ.4) THEN ! (sb) 2856 c 2857 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d) 2858 CALL histwrite(nid_mth,"upwd",itap,zx_tmp_3d, 2859 . iim*jjmp1*klev,ndex3d) 2860 c 2861 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d) 2862 CALL histwrite(nid_mth,"dnwd",itap,zx_tmp_3d, 2863 . iim*jjmp1*klev,ndex3d) 2864 c 2865 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d) 2866 CALL histwrite(nid_mth,"dnwd0",itap,zx_tmp_3d, 2867 . iim*jjmp1*klev,ndex3d) 2868 c 2869 CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d) 2870 CALL histwrite(nid_mth,"Ma",itap,zx_tmp_3d, 2871 . iim*jjmp1*klev,ndex3d) 2872 c 2873 c 2874 ENDIF 2875 c34EK 2630 2876 c 2631 2877 if (ok_sync) then
Note: See TracChangeset
for help on using the changeset viewer.
