Changeset 486 for LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
- Timestamp:
- Dec 15, 2003, 6:50:41 PM (20 years ago)
- File:
-
- 1 edited
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F (modified) (39 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ.3.3/branches/rel-LF/libf/phylmd/physiq.F
r478 r486 132 132 c PARAMETER (ok_mensuel=.true.) 133 133 c 134 LOGICAL ok_mensuelNMC ! sortir le fichier mensuel niveaux NMC 135 PARAMETER (ok_mensuelNMC=.true.) 136 c save ok_mensuelNMC 137 c 134 138 LOGICAL ok_instan ! sortir le fichier instantane 135 139 save ok_instan … … 187 191 REAL d_ps(klon) 188 192 189 cccIM 190 INTEGER klevp1 191 PARAMETER(klevp1=klev+1) 193 INTEGER klevp1, klevm1 194 PARAMETER(klevp1=klev+1,klevm1=klev-1) 192 195 #include "raddim.h" 193 cc REAL*8 ZFSUP(KDLON,KFLEV+1)194 cc REAL*8 ZFSDN(KDLON,KFLEV+1)195 cc REAL*8 ZFSUP0(KDLON,KFLEV+1)196 cc REAL*8 ZFSDN0(KDLON,KFLEV+1)197 196 c 198 197 REAL swdn0(klon,2), swdn(klon,2), swup0(klon,2), swup(klon,2) 199 198 SAVE swdn0 , swdn, swup0, swup 200 199 201 cccIM cf. FH 202 real u850(klon),v850(klon),u200(klon),v200(klon) 203 real u500(klon),v500(klon),phi500(klon),w500(klon) 204 cIM 200 c vents meridien et zonal a un niveau de pression 201 real u1000(klon), v1000(klon) !vents a 1000 hPa 202 real u925(klon), v925(klon) !vents a 925 hPa 203 real u850(klon),v850(klon) !vents a 850 hPa 204 real u700(klon),v700(klon) 205 real u600(klon),v600(klon) 206 real u500(klon),v500(klon) 207 real u400(klon),v400(klon) 208 real u300(klon),v300(klon) 209 real u250(klon),v250(klon) 210 real u200(klon),v200(klon) 211 real u150(klon),v150(klon) 212 real u100(klon),v100(klon) 213 real u70(klon),v70(klon) 214 real u50(klon),v50(klon) 215 real u30(klon),v30(klon) 216 real u20(klon),v20(klon) 217 real u10(klon),v10(klon) 218 real phi500(klon),w500(klon) 219 c prw: precipitable water 205 220 real prw(klon) 206 221 207 cIM ISCCP - proprietes microphysiques des nuages convectifs208 222 REAL convliq(klon,klev) ! eau liquide nuageuse convective 209 223 REAL convfra(klon,klev) ! fraction nuageuse convective … … 214 228 REAL cldt_s(klon),cldq_s(klon) !nuage total, eau liquide integree 215 229 216 INTEGER kinv, linv 217 218 cIM ISCCP simulator BEGIN 219 INTEGER igfi2D(iim,jjmp1) 230 INTEGER linv, kp1 231 c flwp, fiwp = Liquid Water Path & Ice Water Path (kg/m2) 232 c flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg) 233 REAL flwp(klon), fiwp(klon) 234 REAL flwc(klon,klev), fiwc(klon,klev) 235 REAL flwp_c(klon), fiwp_c(klon) 236 REAL flwc_c(klon,klev), fiwc_c(klon,klev) 237 REAL flwp_s(klon), fiwp_s(klon) 238 REAL flwc_s(klon,klev), fiwc_s(klon,klev) 239 240 c ISCCP simulator v3.4 241 c dans clesphys.h top_height, overlap 220 242 cv3.4 221 243 INTEGER debug, debugcol 222 244 INTEGER npoints 223 245 PARAMETER(npoints=klon) 224 INTEGER sunlit(klon) 225 246 c 247 INTEGER sunlit(klon) !sunlit=1 if day; sunlit=0 if night 248 INTEGER nregISCtot 249 PARAMETER(nregISCtot=1) 250 c 251 c imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties sur 1 region rectangulaire 252 c y compris pour 1 point 253 c imin_debut : indice minimum de i; nbpti : nombre de points en direction i (longitude) 254 c jmin_debut : indice minimum de j; nbptj : nombre de points en direction j (latitude) 255 INTEGER imin_debut, nbpti 256 INTEGER jmin_debut, nbptj 257 c 258 REAL nbsunlit(nregISCtot,klon) !nbsunlit : moyenne de sunlit 226 259 INTEGER ncol, seed(klon) 227 260 228 c IM dans clesphys.h top_height, overlap261 c ncol = nb. de sous-colonnes pour chaque maille du GCM 229 262 c PARAMETER(ncol=100) 230 263 c PARAMETER(ncol=625) 231 PARAMETER(ncol=10) 264 c PARAMETER(ncol=10) 265 PARAMETER(ncol=25) 232 266 REAL tautab(0:255) 233 267 INTEGER invtau(-20:45000) … … 235 269 PARAMETER(emsfc_lw=0.99) 236 270 REAL ran0 ! type for random number fuction 237 271 c 272 REAL cldtot(klon,klev) 273 c variables de haut en bas pour le simulateur ISCCP 274 REAL dtau_s(klon,klev) !tau nuages startiformes 275 REAL dtau_c(klon,klev) !tau nuages convectifs 276 REAL dem_s(klon,klev) !emissivite nuages startiformes 277 REAL dem_c(klon,klev) !emissivite nuages convectifs 278 c 279 c variables de haut en bas pour le simulateur ISCCP 238 280 REAL pfull(klon,klev) 239 281 REAL phalf(klon,klev+1) 240 REAL cldtot(klon,klev)241 REAL dtau_s(klon,klev)242 REAL dtau_c(klon,klev)243 REAL dem_s(klon,klev)244 REAL dem_c(klon,klev)245 cPLUS : variables de haut en bas pour le simulateur ISCCP246 282 REAL qv(klon,klev) 247 283 REAL cc(klon,klev) … … 253 289 REAL dem_cH2B(klon,klev) 254 290 255 c output from ISCCP 291 c output from ISCCP simulator 256 292 REAL fq_isccp(klon,7,7) 257 293 REAL totalcldarea(klon) … … 260 296 REAL boxtau(klon,ncol) 261 297 REAL boxptop(klon,ncol) 262 263 c grille 4d physique 264 INTEGER l, ni, nj, kmax, lmax, nrec 265 INTEGER ni1, ni2, nj1, nj2 266 c PARAMETER(kmax=7, lmax=7) 298 c 299 INTEGER l, ni, nj, kmax, lmax 267 300 PARAMETER(kmax=8, lmax=8) 268 301 INTEGER kmaxm1, lmaxm1 269 302 PARAMETER(kmaxm1=kmax-1, lmaxm1=lmax-1) 270 c INTEGER iimx7, jjmx7, jjmp1x7 271 c PARAMETER(iimx7=iim*7, jjmx7=jjm*7, jjmp1x7=jjmp1*7) 272 c REAL fq4d(iim,jjmp1,7,7) 273 c REAL fq3d(iimx7, jjmp1x7) 274 INTEGER iimx8, jjmx8, jjmp1x8 275 PARAMETER(iimx8=iim*8, jjmx8=jjm*8, jjmp1x8=jjmp1*8) 276 REAL fq4d(iim,jjmp1,8,8) 277 REAL fq3d(iimx8, jjmp1x8) 278 cIM180603 SAVE fq3d 279 280 c REAL maxfq3d, minfq3d 303 INTEGER iimx7, jjmx7, jjmp1x7 304 PARAMETER(iimx7=iim*kmaxm1, jjmx7=jjm*lmaxm1, 305 .jjmp1x7=jjmp1*lmaxm1) 306 REAL fq4d(iim,jjmp1,kmaxm1,lmaxm1) 307 REAL fq3d(iimx7, jjmp1x7) 281 308 c 282 309 INTEGER iw, iwmax … … 285 312 PARAMETER(wmin=-200.,pas_w=10.,iwmax=40) 286 313 REAL o500(klon) 287 INTEGER nreg, nbreg 288 PARAMETER(nbreg=5) 289 c REAL histoW(iwmax,kmaxm1,lmaxm1) 290 REAL histoW(kmaxm1,lmaxm1,iwmax,nbreg) 291 REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbreg) 292 cIM180603 293 c SAVE histoW, nhistoW 294 c SAVE nhistoW 295 REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbreg) 314 c 315 cIM: nbregdyn = nbre regions pour calculs statistiques sur output du ISCCP 316 cIM: dynamiques 317 INTEGER nreg, nbregdyn 318 PARAMETER(nbregdyn=5) 319 REAL histoW(kmaxm1,lmaxm1,iwmax,nbregdyn) 320 REAL nhistoW(kmaxm1,lmaxm1,iwmax,nbregdyn) 321 REAL nhistoWt(kmaxm1,lmaxm1,iwmax,nbregdyn) 296 322 SAVE nhistoWt 297 323 298 c REAL histoWinv(kmaxm1,lmaxm1,iwmax) 299 c REAL nhistoW(kmaxm1,lmaxm1,iwmax) 300 INTEGER linv 301 c LOGICAL pct_ocean(klon,nbreg) 302 INTEGER pct_ocean(klon,nbreg) 324 INTEGER pct_ocean(klon,nbregdyn) 303 325 REAL rlonPOS(klon) 304 c CHARACTER*4 pdirect305 326 306 327 c sorties ISCCP … … 321 342 #endif 322 343 344 c sorties statistiques regime dynamique 345 logical ok_regdyn 346 real ecrit_regdyn 347 integer nid_regdyn 348 save ok_regdyn, ecrit_regdyn, nid_regdyn 349 350 #undef histREGDYN 351 #define histREGDYN 352 #ifdef histREGDYN 353 c data ok_regdyn,ecrit_regdyn/.true.,0.125/ 354 c data ok_regdyn,ecrit_regdyn/.true.,1./ 355 data ok_regdyn/.true./ 356 #else 357 data ok_regdyn/.false./ 358 #endif 359 323 360 REAL zx_tau(kmaxm1), zx_pc(lmaxm1), zx_o500(iwmax) 324 c DATA zx_tau/0.1, 1.3, 3.6, 9.4, 23., 60./ 325 c DATA zx_pc/50., 180., 310., 440., 560., 680., 800., 1015./ 326 c DATA zx_pc/50., 180., 310., 440., 560., 680., 800./ 327 cOK DATA zx_tau/0.0, 0.1, 1.3, 3.6, 9.4, 23., 60./ 328 cOK DATA zx_pc/800., 680., 560., 440., 310., 180., 50./ 329 330 c tester l'alure 331 DATA zx_tau/1., 2., 3., 4., 5., 6., 7./ 332 c DATA zx_pc/1., 2., 3., 4., 5., 6., 7./ 333 DATA zx_pc/7., 6., 5., 4., 3., 2., 1./ 361 DATA zx_tau/0.0, 0.3, 1.3, 3.6, 9.4, 23., 60./ 362 DATA zx_pc/50., 180., 310., 440., 560., 680., 800./ 363 364 c cldtopres pression au sommet des nuages 365 REAL cldtopres(lmaxm1) 366 DATA cldtopres/50., 180., 310., 440., 560., 680., 800./ 334 367 335 368 INTEGER komega, nhoriRD 336 369 337 c statistiques regime dynamique END 338 339 c REAL del_lon(iim), del_lat(jjmp1) 340 REAL del_lon, del_lat 341 c REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7) 342 REAL zx_lonx8(iimx8), zx_latx8(jjmp1x8) 343 c INTEGER nhorix7 344 INTEGER nhorix8 345 346 cIM ISCCP simulator END 347 370 c taulev: numero du niveau de tau dans les sorties ISCCP 371 CHARACTER *4 taulev(kmaxm1) 372 DATA taulev/'tau1','tau2','tau3','tau4','tau5','tau6','tau7'/ 373 374 REAL zx_lonx7(iimx7), zx_latx7(jjmp1x7) 375 INTEGER nhorix7 376 cIM: region='3d' <==> sorties en global 377 CHARACTER*3 region 378 PARAMETER(region='3d') 379 c 348 380 logical ok_hf 349 381 real ecrit_hf … … 513 545 REAL yu1(klon) ! vents dans la premiere couche U 514 546 REAL yv1(klon) ! vents dans la premiere couche V 515 cIM cf JLD 516 REAL ffonte(klon,nbsrf) !Flux thermique utilise pour fondre la neige 517 REAL fqcalving(klon,nbsrf) !Flux d'eau "perdue" par la surface 547 REAL ffonte(klon,nbsrf) !Flux thermique utilise pour fondre la neige 548 REAL fqcalving(klon,nbsrf) !Flux d'eau "perdue" par la surface 518 549 c !et necessaire pour limiter la 519 550 c !hauteur de neige, en kg/m2/s … … 539 570 REAL dlw(klon) ! derivee infra rouge 540 571 REAL bils(klon) ! bilan de chaleur au sol 541 cIM cf. JLD542 572 REAL wfbils(klon,nbsrf) ! bilan de chaleur au sol, pour chaque 543 573 C type de sous-surface et pondere par la fraction … … 574 604 EXTERNAL angle ! calculer angle zenithal du soleil 575 605 EXTERNAL alboc ! calculer l'albedo sur ocean 576 EXTERNAL albsno ! calculer albedo sur neige577 606 EXTERNAL ajsec ! ajustement sec 578 607 EXTERNAL clmain ! couche limite … … 601 630 EXTERNAL ecrirega ! ecrire le fichier binaire regional 602 631 EXTERNAL ecriregs ! ecrire le fichier binaire regional 632 cIM 633 EXTERNAL haut2bas !variables de haut en bas 603 634 c 604 635 c Variables locales … … 685 716 REAL cape(klon) ! CAPE 686 717 SAVE cape 687 cccIM 688 CHARACTER*40 capemaxcels 718 CHARACTER*40 capemaxcels !max(CAPE) 689 719 690 720 REAL pbase(klon) ! cloud base pressure … … 739 769 REAL d_u_lif(klon,klev), d_v_lif(klon,klev) 740 770 REAL d_t_lif(klon,klev) 771 REAL d_u_oli(klon,klev), d_v_oli(klon,klev) !tendances dues a oro et lif 741 772 742 773 REAL ratqs(klon,klev),ratqss(klon,klev),ratqsc(klon,klev) … … 792 823 c 793 824 INTEGER ndex2d(iim*jjmp1),ndex3d(iim*jjmp1*klev) 794 REAL zx_tmp_fi2d(klon) 825 REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique 826 REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 795 827 REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev) 796 828 REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1) 797 829 c 798 INTEGER nid_day, nid_mth, nid_ins 799 SAVE nid_day, nid_mth, nid_ins 830 INTEGER nid_day, nid_mth, nid_ins, nid_nmc 831 SAVE nid_day, nid_mth, nid_ins, nid_nmc 800 832 c 801 833 INTEGER nhori, nvert … … 841 873 REAL ZRCPD 842 874 c-jld ec_conser 843 cIM 844 REAL t2m(klon,nbsrf), q2m(klon,nbsrf) 845 REAL u10m(klon,nbsrf), v10m(klon,nbsrf) 846 REAL zt2m(klon), zq2m(klon) 847 REAL zu10m(klon), zv10m(klon) 848 CHARACTER*40 t2mincels, t2maxcels 875 cIM: t2m, q2m, u10m, v10m et t2mincels, t2maxcels 876 REAL t2m(klon,nbsrf), q2m(klon,nbsrf) !temperature, humidite a 2m 877 REAL u10m(klon,nbsrf), v10m(klon,nbsrf) !vents a 10m 878 REAL zt2m(klon), zq2m(klon) !temp., hum. 2m moyenne s/ 1 maille 879 REAL zu10m(klon), zv10m(klon) !vents a 10m moyennes s/1 maille 880 CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max 849 881 c 850 882 c Declaration des constantes et des fonctions thermodynamiques … … 1031 1063 c Initialisation des sorties 1032 1064 c============================================================= 1065 #ifdef histhf 1066 #include "ini_histhf.h" 1067 #endif 1068 1069 #include "ini_histday.h" 1070 #include "ini_histmth.h" 1071 1072 #undef histmthNMC 1073 #define histmthNMC 1074 #ifdef histmthNMC 1075 #include "ini_histmthNMC.h" 1076 #endif 1077 1078 #include "ini_histins.h" 1079 1080 #ifdef histREGDYN 1081 #include "ini_histREGDYN.h" 1082 #endif 1033 1083 1034 1084 #ifdef histISCCP 1035 1085 #include "ini_histISCCP.h" 1036 1086 #endif 1037 1038 #ifdef histhf1039 #include "ini_histhf.h"1040 #endif1041 1042 #include "ini_histday.h"1043 #include "ini_histmth.h"1044 #include "ini_histins.h"1045 1087 1046 1088 cXXXPB Positionner date0 pour initialisation de ORCHIDEE … … 1253 1295 sunlit(i)=1 1254 1296 IF(rmu0(i).EQ.0.) sunlit(i)=0 1255 c IF(rmu0(i).EQ.0.) THEN 1256 c sunlit(i)=0 1257 c PRINT*,' il fait nuit ',i,rlat(i),rlon(i) 1258 c ENDIF 1297 nbsunlit(1,i)=FLOAT(sunlit(i)) 1259 1298 ENDDO 1260 1299 cIM END … … 1289 1328 e julien, rmu0, co2_ppm, 1290 1329 e ok_veget, ocean, npas, nexca, ftsol, 1291 $ soil_model,cdmmax, cdhmax, ftsoil, qsol, 1330 $ soil_model,cdmmax, cdhmax, 1331 $ ksta, ksta_ter, ok_kzmin, ftsoil, qsol, 1292 1332 $ paprs,pplay,radsol, fsnow,fqsurf,fevap,falbe,falblw, 1293 1333 $ fluxlat, … … 1789 1829 enddo 1790 1830 1791 cIM ISCCP simulator BEGIN1831 cIM calcul nuages par le simulateur ISCCP 1792 1832 IF (ok_isccp) THEN 1793 1833 cIM calcul tau. emi nuages convectifs 1794 1834 convfra(:,:)=rnebcon(:,:) 1795 1835 convliq(:,:)=rnebcon(:,:)*clwcon(:,:) 1796 c CALL newmicro (paprs, pplay,ok_newmicro,1797 c . t_seri, cldliq, cldfra, cldtau, cldemi,1798 c . cldh, cldl, cldm, cldt, cldq)1799 1836 CALL newmicro (paprs, pplay,ok_newmicro, 1800 1837 . t_seri, convliq, convfra, dtau_c, dem_c, 1801 . cldh_c, cldl_c, cldm_c, cldt_c, cldq_c) 1802 1838 . cldh_c, cldl_c, cldm_c, cldt_c, cldq_c, 1839 . flwp_c, fiwp_c, flwc_c, fiwc_c) 1840 c 1803 1841 cIM calcul tau. emi nuages startiformes 1804 1842 CALL newmicro (paprs, pplay,ok_newmicro, 1805 1843 . t_seri, cldliq, cldfra, dtau_s, dem_s, 1806 . cldh_s, cldl_s, cldm_s, cldt_s, cldq_s) 1807 cIM calcul diagramme (PC, tau) cf. ISCCP D 1808 c seed=50 1809 c seed=ran0(klon) 1810 cT1O3 1811 c top_height=1 1812 cT3O3 1813 c top_height=3 1814 c overlap=3 1815 cIM cf GCM 1844 . cldh_s, cldl_s, cldm_s, cldt_s, cldq_s, 1845 . flwp_s, fiwp_s, flwc_s, fiwc_s) 1846 c 1816 1847 cldtot(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.) 1817 1848 1818 1849 cIM inversion des niveaux de pression ==> de haut en bas 1819 DO k=1,klev 1820 kinv=klev-k+1 1821 DO i=1,klon 1822 pfull(i,k)=pplay(i,kinv) 1823 c on met toutes les variables de Haut 2 Bas 1824 qv(i,k)=q_seri(i,kinv) 1825 cc(i,k)=cldtot(i,kinv) 1826 conv(i,k)=rnebcon(i,kinv) 1827 dtau_sH2B(i,k)=dtau_s(i,kinv) 1828 dtau_cH2B(i,k)=dtau_c(i,kinv) 1829 at(i,k)=t_seri(i,kinv) 1830 dem_sH2B(i,k)=dem_s(i,kinv) 1831 dem_cH2B(i,k)=dem_c(i,kinv) 1832 1833 ENDDO 1834 ENDDO 1835 1836 DO k=1,klev+1 1837 kinv=klev-k+2 1838 DO i=1,klon 1839 phalf(i,k)=paprs(i,kinv) 1840 ENDDO 1841 ENDDO 1850 CALL haut2bas(klon, klev, pplay, pfull) 1851 CALL haut2bas(klon, klev, q_seri, qv) 1852 CALL haut2bas(klon, klev, cldtot, cc) 1853 CALL haut2bas(klon, klev, rnebcon, conv) 1854 CALL haut2bas(klon, klev, dtau_s, dtau_sH2B) 1855 CALL haut2bas(klon, klev, dtau_c, dtau_cH2B) 1856 CALL haut2bas(klon, klev, t_seri, at) 1857 CALL haut2bas(klon, klev, dem_s, dem_sH2B) 1858 CALL haut2bas(klon, klev, dem_c, dem_cH2B) 1859 CALL haut2bas(klon, klevp1, paprs, phalf) 1842 1860 1843 1861 c open(99,file='tautab.bin',access='sequential', … … 1855 1873 close(99) 1856 1874 c 1875 cIM: calcul coordonnees regions pour statistiques distribution 1876 cIM: nuages en ftion du regime dynamique pour regions oceaniques 1877 IF (ok_regdyn) THEN !histREGDYN 1857 1878 nsrf=3 1858 DO nreg=1, nbreg 1879 DO nreg=1, nbregdyn 1859 1880 DO i=1, klon 1860 1881 … … 1867 1888 c ENDIF 1868 1889 1869 c pct_ocean(i,nreg)=.FALSE.1870 1890 pct_ocean(i,nreg)=0 1871 1872 c DO nsrf = 1, nbsrf1873 1891 1874 1892 c test si c'est 1 point d'ocean … … 1879 1897 c TROP 1880 1898 IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN 1881 c pct_ocean(i,nreg)=.TRUE.1882 1899 pct_ocean(i,nreg)=1 1883 1900 ENDIF … … 1887 1904 IF(rlat(i).GE.40.AND.rlat(i).LE.60.) THEN 1888 1905 IF(rlonPOS(i).GE.160..AND.rlonPOS(i).LE.235.) THEN 1889 c pct_ocean(i,nreg)=.TRUE.1890 1906 pct_ocean(i,nreg)=1 1891 1907 ENDIF … … 1895 1911 IF(rlonPOS(i).GE.220..AND.rlonPOS(i).LE.250.) THEN 1896 1912 IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN 1897 c pct_ocean(i,nreg)=.TRUE.1898 1913 pct_ocean(i,nreg)=1 1899 1914 ENDIF … … 1903 1918 IF(rlonPOS(i).GE.180..AND.rlonPOS(i).LE.220.) THEN 1904 1919 IF(rlat(i).GE.15.AND.rlat(i).LE.35.) THEN 1905 c pct_ocean(i,nreg)=.TRUE.1906 1920 pct_ocean(i,nreg)=1 1907 1921 ENDIF … … 1911 1925 IF(rlonPOS(i).GE.70..AND.rlonPOS(i).LE.150.) THEN 1912 1926 IF(rlat(i).GE.-5.AND.rlat(i).LE.20.) THEN 1913 c pct_ocean(i,nreg)=.TRUE.1914 1927 pct_ocean(i,nreg)=1 1915 1928 ENDIF 1916 1929 ENDIF 1917 ENDIF !nbreg 1930 ENDIF !nbregdyn 1918 1931 c TROP 1919 1932 c IF(rlat(i).GE.-30.AND.rlat(i).LE.30.) THEN … … 1924 1937 1925 1938 ENDIF !pctsrf 1926 c ENDDO1927 1939 ENDDO !klon 1928 ENDDO !nbreg 1940 ENDDO !nbregdyn 1941 ENDIF !ok_regdyn 1929 1942 1930 1943 cIM somme de toutes les nhistoW BEG 1931 DO nreg = 1, nbreg 1932 DO k = 1, kmaxm11933 DO l = 1, lmaxm11934 DO iw = 1, iwmax1935 nhistoWt(k,l,iw,nreg)=0.1936 ENDDO1937 ENDDO1938 ENDDO1939 ENDDO 1944 DO nreg = 1, nbregdyn 1945 DO k = 1, kmaxm1 1946 DO l = 1, lmaxm1 1947 DO iw = 1, iwmax 1948 nhistoWt(k,l,iw,nreg)=0. 1949 ENDDO !iw 1950 ENDDO !l 1951 ENDDO !k 1952 ENDDO !nreg 1940 1953 cIM somme de toutes les nhistoW END 1941 ENDIF 1942 1943 1944 c CALL ISCCP_CLOUD_TYPES(nlev,ncol,seed,pfull,phalf,qv, 1945 c & cc,conv,dtau_s,dtau_c,top_height,overlap, 1946 c & tautab,invtau,skt,emsfc_lw,at,dem_s,dem_c,fq_isccp, 1947 c & totalcldarea,meanptop,meantaucld,boxtau,boxptop) 1948 1949 c DO i=1, klon 1950 c i=1 1951 c1011 CONTINUE 1952 c 1953 cIM on verifie les donnees de INPUT en dehors du simulateur ISCCP 1954 cIM 1D non-vectorise (!) pour qu'on gagne du temps ... 1955 cIM 1956 c BEGIN find unpermittable data..... 1957 ! ---------------------------------------------------! 1958 ! find unpermittable data..... 1959 ! 1960 c do 13 k=1,klev 1961 c ca prend trop de temps ?? 1962 c cldtot(:,:) = min(max(cldtot(:,:),0.),1.) 1963 c rnebcon(:,:) = min(max(rnebcon(:,:),0.),1.) 1964 c dtau_s(:,:) = max(dtau_s(:,:),0.) 1965 c dem_s(:,:) = min(max(dem_s(:,:),0.),1.) 1966 c dtau_c(:,:) = max(dtau_c(:,:),0.) 1967 c dem_c(:,:) = min(max(dem_c(:,:),0.),1.) 1968 c ca prend trop de temps ?? 1969 1970 c if (cldtot(i,k) .lt. 0.) then 1971 c print *, ' error = cloud fraction less than zero' 1972 c STOP 1973 c end if 1974 c if (cldtot(i,k) .gt. 1.) then 1975 c print *, ' error = cloud fraction greater than 1' 1976 c STOP 1977 c end if 1978 c if (rnebcon(i,k) .lt. 0.) then 1979 c print *, 1980 c & ' error = convective cloud fraction less than zero' 1981 c STOP 1982 c end if 1983 c if (rnebcon(i,k) .gt. 1.) then 1984 c print *, 1985 c & ' error = convective cloud fraction greater than 1' 1986 c STOP 1987 c end if 1988 1989 c if (dtau_s(i,k) .lt. 0.) then 1990 c print *, 1991 c & ' error = stratiform cloud opt. depth less than zero' 1992 c STOP 1993 c end if 1994 c if (dem_s(i,k) .lt. 0.) then 1995 c print *, 1996 c & ' error = stratiform cloud emissivity less than zero' 1997 c STOP 1998 c end if 1999 c if (dem_s(i,k) .gt. 1.) then 2000 c print *, 2001 c & ' error = stratiform cloud emissivity greater than 1' 2002 c STOP 2003 c end if 2004 2005 c if (dtau_c(i,k) .lt. 0.) then 2006 c print *, 2007 c & ' error = convective cloud opt. depth less than zero' 2008 c STOP 2009 c end if 2010 c if (dem_c(i,k) .lt. 0.) then 2011 c print *, 2012 c & ' error = convective cloud emissivity less than zero' 2013 c STOP 2014 c end if 2015 c if (dem_c(i,k) .gt. 1.) then 2016 c print *, 2017 c & ' error = convective cloud emissivity greater than 1' 2018 c STOP 2019 c end if 2020 c13 continue 2021 2022 ! ---------------------------------------------------! 2023 c 2024 c END find unpermittable data..... 2025 cv2.2.1.1 DO i=1, klon 2026 c i=1 2027 c seed=i 2028 c 2029 cv3.4 2030 if (debut) then 1954 c 1955 cIM: initialisation de seed 2031 1956 DO i=1, klon 2032 1957 seed(i)=i+100 2033 c seed(i)=i+502034 1958 ENDDO 2035 endif 2036 c seed=aint(ran0(klon)) 2037 c CALL ISCCP_CLOUD_TYPES(klev,ncol,seed,pfull(i,:),phalf(i,:) 2038 cv2.2.1.1 2039 c CALL ISCCP_CLOUD_TYPES(klev,ncol,seed(i),pfull(i,:),phalf(i,:) 2040 c & ,q_seri(i,:), 2041 c & cldtot(i,:),rnebcon(i,:),dtau_s(i,:),dtau_c(i,:), 2042 c & top_height,overlap, 2043 c & tautab,invtau,ztsol,emsfc_lw,t_seri(i,:),dem_s(i,:), 2044 c & dem_c(i,:), 2045 c & fq_isccp(i,:,:), 2046 c & totalcldarea(i),meanptop(i),meantaucld(i), 2047 c & boxtau(i,:),boxptop(i,:)) 2048 cv2.2.1.1 2049 cv3.4 1959 ENDIF !debut 1960 cIM: pas de debug, debugcol 2050 1961 debug=0 2051 1962 debugcol=0 2052 1963 cIM260503 2053 c o500 ==> distribution nuage ftion du regime dynamique 2054 DO i=1, klon 2055 o500(i)=omega(i,8)*864. 2056 c PRINT*,'pphi8 ',pphi(i,8),'zphi8,11,12',zphi(i,8), 2057 c & zphi(i,11),zphi(i,12) 2058 ENDDO 2059 2060 c axe vertical pour les differents niveaux des histogrammes 2061 c DO iw=1, iwmax 2062 c zx_o500(iw)=wmin+(iw-1./2.)*pas_w 2063 c ENDDO 2064 c PRINT*,' phys AVANT seed(3361)=',seed(3361) 1964 c o500 ==> distribution nuage ftion du regime dynamique a 500 hPa 1965 DO k=1, klevm1 1966 kp1=k+1 1967 c PRINT*,'k, presnivs',k,presnivs(k), presnivs(kp1) 1968 if(presnivs(k).GT.50000.AND.presnivs(kp1).LT.50000.) THEN 1969 DO i=1, klon 1970 o500(i)=omega(i,k)*RDAY/100. 1971 c if(i.EQ.1) print*,' 500hPa lev',k,presnivs(k),presnivs(kp1) 1972 ENDDO 1973 GOTO 1000 1974 endif 1975 1000 continue 1976 ENDDO 1977 2065 1978 CALL ISCCP_CLOUD_TYPES( 2066 1979 & debug, … … 2073 1986 & pfull, 2074 1987 & phalf, 2075 c var de bas en haut ==> PB !2076 c & q_seri,2077 c & cldtot,2078 c & rnebcon,2079 c & dtau_s,2080 c & dtau_c,2081 c var de Haut en Bas BEG2082 1988 & qv, cc, conv, dtau_sH2B, dtau_cH2B, 2083 c var de Haut en Bas END2084 1989 & top_height, 2085 1990 & overlap, … … 2088 1993 & ztsol, 2089 1994 & emsfc_lw, 2090 c var de bas en haut ==> PB !2091 c & t_seri,2092 c & dem_s,2093 c & dem_c,2094 c var de Haut en Bas BEG2095 1995 & at, dem_sH2B, dem_cH2B, 2096 cIM2605032097 c & o500, pct_ocean,2098 c var de Haut en Bas END2099 1996 & fq_isccp, 2100 1997 & totalcldarea, … … 2103 2000 & boxtau, 2104 2001 & boxptop) 2105 c & boxptop, 2106 cIM 260503 2107 c & histoW, 2108 c & nhistoW 2109 c &) 2110 2111 cIM 200603 2112 c PRINT*,'physiq fq_isccp(6,1,1)',fq_isccp(6,1,1) 2113 2114 cIM 200603 2115 cIM somme de toutes les nhistoW BEG 2116 c DO k = 1, kmaxm1 2117 c DO l = 1, lmaxm1 2118 c DO iw = 1, iwmax 2119 c nhistoWt(k,l,iw)=nhistoWt(k,l,iw)+nhistoW(k,l,iw) 2120 ccc IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then 2121 c IF(nhistoWt(k,l,iw).NE.0.) THEN 2122 c PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw) 2123 c ENDIF 2124 c ENDDO 2125 c ENDDO 2126 c ENDDO 2127 cIM somme de toutes les nhistoW END 2128 c PRINT*,' phys APRES seed(3361)=',seed(3361) 2129 cv3.4 2130 c i=i+1 2131 c IF(i.LE.klon) THEN 2132 c GOTO 1011 2133 c ENDIF 2134 cv2.2.1.1 ENDDO 2002 2135 2003 2136 2004 c passage de la grille (klon,7,7) a (iim,jjmp1,7,7) 2137 c minfq3d=100. 2138 c maxfq3d=0. 2139 cIM calcul des correspondances entre la grille physique et 2140 cIM la grille dynamique 2141 c DO i=1, klon 2142 c grid_phys(i)=i 2143 c PRINT*,'i, grid_phys',i,grid_phys(i) 2144 c ENDDO 2145 c CALL gr_fi_dyn(1,klon,iimp1,jjmp1,grid_phys,grid_dyn) 2146 c DO j=1, jjmp1 2147 c DO i=1, iimp1 2148 c PRINT*,'i,j grid_dyn ',i,j,grid_dyn(i,j) 2149 c ENDDO 2150 c ENDDO 2151 c 2152 DO l=1, lmax 2153 DO k=1, kmax 2154 cIM grille physique ==> grille ecriture 2D (iim,jjmp1) 2155 c 2005 DO l=1, lmaxm1 2006 DO k=1, kmaxm1 2156 2007 DO i=1, iim 2157 fq4d(i,1,k,l)=fq_isccp(1,k,l) 2158 cc PRINT*,'first j=1 i =',i 2008 fq4d(i,1,k,l)=fq_isccp(1,k,l) 2159 2009 ENDDO 2160 2010 DO j=2, jjm 2161 DO i=1, iim 2162 cERROR ?? ig=i+iim*(j-1) 2011 DO i=1, iim 2163 2012 ig=i+1+(j-2)*iim 2164 cc PRINT*,'i =',i,'j =',j,'ig=',ig2165 2013 fq4d(i,j,k,l)=fq_isccp(ig,k,l) 2166 2014 ENDDO 2167 2015 ENDDO 2168 2016 DO i=1, iim 2169 fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l) 2170 cc PRINT*,'last jjmp1 i =',i 2017 fq4d(i,jjmp1,k,l)=fq_isccp(klon,k,l) 2171 2018 ENDDO 2172 IF(debut) THEN2173 DO j=1, jjmp12174 DO i=1, iim2175 IF(j.GE.2.AND.j.LE.jjm) THEN2176 igfi2D(i,j)=i+1+(j-2)*iim2177 c PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)2178 ELSEIF(j.EQ.1) THEN2179 igfi2D(i,j)=12180 c PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)2181 ELSEIF(j.EQ.jjmp1) THEN2182 igfi2D(i,j)=klon2183 c PRINT*,'i=',i,'j=',j,'ig=',igfi2D(i,j)2184 ENDIF2185 ENDDO2186 ENDDO2187 ENDIF2188 c STOP2189 c2190 c CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_isccp(:,k,l),2191 c $ fq4d(:,:,k,l))2192 2019 ENDDO 2193 2020 ENDDO 2194 DO l=1, lmax 2195 fq4d(:,:,8,l)=-1.e+10 2196 fq4d(:,:,l,8)=-1.e+10 2197 ENDDO 2198 DO l=1, lmax 2199 DO k=1, kmax 2021 c 2022 DO l=1, lmaxm1 2023 DO k=1, kmaxm1 2200 2024 DO j=1, jjmp1 2201 2025 DO i=1, iim 2202 2203 c inversion TAU ?! 2204 c ni=(i-1)*lmax+l 2205 c nj=(j-1)*kmax+kmax-k+1 2206 c 2207 c210503 inversion en PC ==> pas besoin !!! 2208 c ni=(i-1)*lmax+lmax-l+1 2209 c nj=(j-1)*kmax+k 2210 c 2211 c210503 2212 ni=(i-1)*lmax+l 2213 nj=(j-1)*kmax+k 2214 2215 c210503 if(k.EQ.8) then 2216 c fq4d(i,j,8,l)=-1.e+10 2217 c endif 2218 2219 c210503 if(l.EQ.8) then 2220 c fq4d(i,j,k,8)=-1.e+10 2221 c endif 2222 2223 fq3d(ni,nj)=fq4d(i,j,k,l) 2224 2225 c if(fq3d(ni,nj).lt.0.) then 2226 c print*,' fq3d LT ZERO ',ni,nj,fq3d(ni,nj) 2227 c endif 2228 c if(fq3d(ni,nj).gt.100.) then 2229 c print*,' fq3d GT 100 ',ni,nj,fq3d(ni,nj) 2230 c endif 2231 c max & min fq3d 2232 c if(fq3d(ni,nj).gt.maxfq3d) maxfq3d=fq3d(ni,nj) 2233 c if(fq3d(ni,nj).lt.minfq3d) minfq3d=fq3d(ni,nj) 2234 2026 ni=(i-1)*lmaxm1+l 2027 nj=(j-1)*kmaxm1+k 2028 fq3d(ni,nj)=fq4d(i,j,k,l) 2235 2029 ENDDO 2236 2030 ENDDO 2237 c fq4d(:,:,8,l)=-1.e+102238 c fq4d(:,:,k,8)=-1.e+102239 c k=k+12240 c if(k.LE.kmax) then2241 c goto 10222242 c endif2243 2031 ENDDO 2244 c l=l+1 2245 c if(l.LE.lmax) then 2246 c goto 1021 2247 c endif 2248 ENDDO 2249 2250 c print*,' minfq3d=',minfq3d,' maxfq3d=',maxfq3d 2032 ENDDO 2033 2251 2034 c 2252 2035 c calculs statistiques distribution nuage ftion du regime dynamique 2253 c DO i=1, klon 2254 c! o500(i)=omega(i,9)*864. 2255 c! PRINT*,' o500=',o500(i),' pphi(9)=',pphi(i,9) 2256 c o500(i)=omega(i,8)*864. 2257 cc PRINT*,' pphi(8)',pphi(i,8),'pphi(11)',pphi(i,11), 2258 cc .'pphi(12)',pphi(i,12) 2259 cc PRINT*,' zphi8,11,12=',zphi(i,8),zphi(i,11),zphi(i,12) 2260 cc PRINT*,' o500',o500(i),' w500',w500(i) 2261 c ENDDO 2262 2263 c axe vertical pour les differents niveaux des histogrammes 2264 c DO iw=1, iwmax 2265 c zx_o500(iw)=wmin+(iw-1./2.)*pas_w 2266 c ENDDO 2267 2268 2036 c 2269 2037 c Ce calcul doit etre fait a partir de valeurs mensuelles ?? 2270 cc CALL histo_o500_pctau(o500,fq4d,histoW) 2271 cc CALL histo_o500_pctau(paire,pctsrf,o500,fq4d,histoW) 2272 cc CALL histo_o500_pctau(pct_ocean,rlat,o500,fq4d,histoW) 2273 ccOK ??? CALL histo_o500_pctau(pct_ocean,o500,fq4d,histoW) 2274 c CALL histo_o500_pctau(klon,pct_ocean,o500,fq4d,histoW,nhistoW) 2275 c CALL histo_o500_pctau(klon,pct_ocean,o500,fq_isccp, 2276 CALL histo_o500_pctau(nbreg,pct_ocean,o500,fq_isccp, 2038 CALL histo_o500_pctau(nbregdyn,pct_ocean,o500,fq_isccp, 2277 2039 &histoW,nhistoW) 2278 2040 c 2279 cIM somme de toutes les nhistoW BEG 2280 DO nreg=1, nbreg 2281 DO k = 1, kmaxm1 2282 DO l = 1, lmaxm1 2283 DO iw = 1, iwmax 2284 nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+ 2285 & nhistoW(k,l,iw,nreg) 2286 ccc IF(k.EQ.1.AND.l.EQ.1.AND.iw.EQ.1) then 2287 c IF(nhistoWt(k,l,iw).NE.0.) THEN 2288 c PRINT*,' physiq nWt', k,l,iw,nhistoWt(k,l,iw) 2289 c ENDIF 2290 ENDDO 2291 ENDDO 2292 ENDDO 2293 ENDDO 2294 cIM somme de toutes les nhistoW END 2295 c 2296 c IF(lafin) THEN 2297 c DO nreg=1, nbreg 2298 c DO iw=1, iwmax 2299 c DO l=1,lmaxm1 2300 c DO k=1,kmaxm1 2301 c IF(histoW(k,l,iw,nreg).NE.0.) then 2302 c PRINT*,'physiq H nH',k,l,iw, 2303 c & histoW(k,l,iw,nreg), 2304 c & nhistoW(k,l,iw,nreg),nhistoWt(k,l,iw,nreg) 2305 c ENDIF 2306 c ENDDO 2307 c ENDDO 2308 c ENDDO 2309 c ENDDO 2310 cIM verif fq_isccp, fq4d, fq3d 2311 c DO l=1, lmaxm1 2312 c DO k=1,kmaxm1 2313 c i=74 2314 c j=36 2315 c DO j=1, jjmp1 2316 c DO i=1, iim 2317 c DO l=1, lmaxm1 2318 c WRITE(*,'(a,3i4,7f10.4)') 2319 c & 'fq_isccp,j,i,l=',j,i,l, 2320 c & (fq_isccp(igfi2D(i,j),k,l),k=1,kmaxm1) 2321 c WRITE(*,'(a,3i4,7f10.4)') 2322 c & 'fq4d,j,i,l=',j,i,l,(fq4d(i,j,k,l),k=1,kmaxm1) 2323 c ENDDO 2324 c ENDDO 2325 c ENDDO 2326 c ni1=(i-1)*8+1 2327 c ni2=i*8 2328 c nj1=(j-1)*8+1 2329 c nj2=j*8 2330 c DO ni=ni1,ni2 2331 c WRITE(*,'(a,2i4,7f10.4)') 2332 c & 'fq3d, ni,nj=',ni,nj, 2333 c & (fq3d(ni,nj),nj=nj1,nj2) 2334 c ENDDO 2335 c ENDIF 2336 2337 c DO iw=1, iwmax 2338 c DO l=1,lmaxm1 2339 c DO k=1,kmaxm1 2340 c PRINT*,' iw,l,k,nhistoW=',iw,l,k,nhistoW(k,l,iw) 2341 c ENDDO 2342 c ENDDO 2343 c ENDDO 2344 2345 c DO iw=1, iwmax 2346 c DO l=1, lmaxm1 2347 c linv=lmaxm1-l+1 2348 c DO k=1, kmaxm1 2349 c histoWinv(k,l,iw)=histoW(iw,k,l) 2350 c ENDDO 2351 c ENDDO 2352 c ENDDO 2353 c 2354 c pb syncronisation ?? : 48 * 30 * 7 (jour1) + 48* 29 * 7 (jour suivant) 2355 c 2356 2357 2041 c nhistoWt = somme de toutes les nhistoW 2042 DO nreg=1, nbregdyn 2043 DO k = 1, kmaxm1 2044 DO l = 1, lmaxm1 2045 DO iw = 1, iwmax 2046 nhistoWt(k,l,iw,nreg)=nhistoWt(k,l,iw,nreg)+ 2047 & nhistoW(k,l,iw,nreg) 2048 ENDDO 2049 ENDDO 2050 ENDDO 2051 ENDDO 2052 c 2358 2053 ENDIF !ok_isccp 2359 cIM ISCCP simulator END2360 2054 2361 2055 c On prend la somme des fractions nuageuses et des contenus en eau … … 2363 2057 cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:) 2364 2058 2365 2366 2059 ENDIF 2060 2367 2061 c 2368 2062 c 2. NUAGES STARTIFORMES … … 2423 2117 CALL newmicro (paprs, pplay,ok_newmicro, 2424 2118 . t_seri, cldliq, cldfra, cldtau, cldemi, 2425 . cldh, cldl, cldm, cldt, cldq) 2119 . cldh, cldl, cldm, cldt, cldq, 2120 . flwp, fiwp, flwc, fiwc) 2426 2121 else 2427 2122 CALL nuage (paprs, pplay, … … 2450 2145 ! albsollw = albsollw1 2451 2146 CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS) 2452 cIM e (dist, rmu0, fract, co2_ppm, solaire,2453 2147 e (dist, rmu0, fract, 2454 2148 e paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri, … … 2458 2152 s topsw,toplw,solsw,sollw, 2459 2153 s sollwdown, 2460 cccIMs topsw0,toplw0,solsw0,sollw0)2461 2154 s topsw0,toplw0,solsw0,sollw0, 2462 2155 s swdn0, swdn, swup0, swup ) … … 2658 2351 s ve, vq, ue, uq) 2659 2352 c 2353 c 2660 2354 c Accumuler les variables a stocker dans les fichiers histoire: 2661 2355 c … … 2692 2386 END IF 2693 2387 C 2694 cccIM cf. FH2695 2388 c======================================================================= 2696 2389 c SORTIES … … 2699 2392 c Interpollation sur quelques niveaux de pression 2700 2393 c ----------------------------------------------- 2701 2394 c 2395 cIM sorties sur les 17 niveaux de pression du NMC 2396 c 1000 hPa 2397 call plevel(klon,klev,.true. ,pplay,100000.,u_seri,u1000) 2398 call plevel(klon,klev,.false.,pplay,100000.,v_seri,v1000) 2399 c 925 hPa 2400 call plevel(klon,klev,.true. ,pplay,92500.,u_seri,u925) 2401 call plevel(klon,klev,.false.,pplay,92500.,v_seri,v925) 2402 c 850 hPa 2702 2403 call plevel(klon,klev,.true. ,pplay,85000.,u_seri,u850) 2703 2404 call plevel(klon,klev,.false.,pplay,85000.,v_seri,v850) 2405 c 700 hPa 2406 call plevel(klon,klev,.true. ,pplay,70000.,u_seri,u700) 2407 call plevel(klon,klev,.false.,pplay,70000.,v_seri,v700) 2408 c 600 hPa 2409 call plevel(klon,klev,.true. ,pplay,60000.,u_seri,u600) 2410 call plevel(klon,klev,.false.,pplay,60000.,v_seri,v600) 2411 c 500 hPa 2704 2412 call plevel(klon,klev,.true. ,pplay,50000.,u_seri,u500) 2705 2413 call plevel(klon,klev,.false.,pplay,50000.,v_seri,v500) 2414 c 400 hPa 2415 call plevel(klon,klev,.true. ,pplay,40000.,u_seri,u400) 2416 call plevel(klon,klev,.false.,pplay,40000.,v_seri,v400) 2417 c 300 hPa 2418 call plevel(klon,klev,.true. ,pplay,30000.,u_seri,u300) 2419 call plevel(klon,klev,.false.,pplay,30000.,v_seri,v300) 2420 c 250 hPa 2421 call plevel(klon,klev,.true. ,pplay,25000.,u_seri,u250) 2422 call plevel(klon,klev,.false.,pplay,25000.,v_seri,v250) 2423 c 200 hPa 2706 2424 call plevel(klon,klev,.true. ,pplay,20000.,u_seri,u200) 2707 2425 call plevel(klon,klev,.false.,pplay,20000.,v_seri,v200) 2426 c 150 hPa 2427 call plevel(klon,klev,.true. ,pplay,15000.,u_seri,u150) 2428 call plevel(klon,klev,.false.,pplay,15000.,v_seri,v150) 2429 c 100 hPa 2430 call plevel(klon,klev,.true. ,pplay,10000.,u_seri,u100) 2431 call plevel(klon,klev,.false.,pplay,10000.,v_seri,v100) 2432 c 70 hPa 2433 call plevel(klon,klev,.true. ,pplay,7000.,u_seri,u70) 2434 call plevel(klon,klev,.false.,pplay,7000.,v_seri,v70) 2435 c 50 hPa 2436 call plevel(klon,klev,.true. ,pplay,5000.,u_seri,u50) 2437 call plevel(klon,klev,.false.,pplay,5000.,v_seri,v50) 2438 c 30 hPa 2439 call plevel(klon,klev,.true. ,pplay,3000.,u_seri,u30) 2440 call plevel(klon,klev,.false.,pplay,3000.,v_seri,v30) 2441 c 20 hPa 2442 call plevel(klon,klev,.true. ,pplay,2000.,u_seri,u20) 2443 call plevel(klon,klev,.false.,pplay,2000.,v_seri,v20) 2444 c 10 hPa 2445 call plevel(klon,klev,.true. ,pplay,1000.,u_seri,u10) 2446 call plevel(klon,klev,.false.,pplay,1000.,v_seri,v10) 2447 c 2708 2448 call plevel(klon,klev,.true. ,pplay,50000.,zphi,phi500) 2709 2449 call plevel(klon,klev,.true. ,paprs,50000.,omega,w500) 2710 2711 cIM cf. FH slp(:) = paprs(:,1)*exp(pphis(:)/(289.*t_seri(:,1))) 2450 c slp sea level pressure 2712 2451 slp(:) = paprs(:,1)*exp(pphis(:)/(RD*t_seri(:,1))) 2713 c PRINT*,' physiq slp ',slp(2185),paprs(2185,1),pphis(2185),2714 c . RD,t_seri(2185,1)2715 2452 c 2716 2453 ccc prw = eau precipitable 2717 2454 DO i = 1, klon 2718 2455 prw(i) = 0. 2456 DO k = 1, klev 2457 prw(i) = prw(i) + 2458 . q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG 2459 ENDDO 2460 ENDDO 2461 c 2462 cIM sorties bilans energie cinetique et potentielle MJO 2719 2463 DO k = 1, klev 2720 prw(i) = prw(i) + 2721 . q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG 2722 ENDDO 2723 c PRINT*,' i ',i,' prw',prw(i) 2724 ENDDO 2725 c 2726 2464 DO i = 1, klon 2465 d_u_oli(i,k) = d_u_oro(i,k) + d_u_lif(i,k) 2466 d_v_oli(i,k) = d_v_oro(i,k) + d_v_lif(i,k) 2467 ENDDO 2468 ENDDO 2727 2469 c============================================================= 2728 2470 c Ecriture des sorties 2729 2471 c============================================================= 2472 #ifdef histREGDYN 2473 #include "write_histREGDYN.h" 2474 #endif 2730 2475 2731 2476 #ifdef histISCCP … … 2739 2484 #include "write_histday.h" 2740 2485 #include "write_histmth.h" 2486 2487 #ifdef histmthNMC 2488 #include "write_histmthNMC.h" 2489 #endif 2490 2741 2491 #include "write_histins.h" 2742 2492
Note: See TracChangeset
for help on using the changeset viewer.
