Changeset 5082 for LMDZ6/branches/Amaury_dev/libf/phylmdiso
- Timestamp:
- Jul 19, 2024, 5:41:58 PM (5 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/phylmdiso
- Files:
-
- 13 edited
-
add_wake_tend.F90 (modified) (3 diffs)
-
calwake.F90 (modified) (1 diff)
-
change_srf_frac_mod.F90 (modified) (1 diff)
-
climb_hq_mod.F90 (modified) (4 diffs)
-
cv3_routines.F90 (modified) (16 diffs)
-
cv3p_mixing.F90 (modified) (4 diffs)
-
cva_driver.F90 (modified) (1 diff)
-
lmdz_lscp_old.F90 (modified) (18 diffs)
-
phyetat0_mod.F90 (modified) (8 diffs)
-
phyredem.F90 (modified) (3 diffs)
-
phys_output_mod.F90 (modified) (4 diffs)
-
physiq_mod.F90 (modified) (74 diffs)
-
reevap.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_wake_tend.F90
r4982 r5082 5 5 ) 6 6 !=================================================================== 7 ! Ajoute les tendances li ées aux diverses parametrisations physiques aux7 ! Ajoute les tendances li�es aux diverses parametrisations physiques aux 8 8 ! variables d'etat des poches froides. 9 9 !=================================================================== … … 57 57 DO l = 1, klev 58 58 DO i = 1, klon 59 IF (zoccur(i) .GE.1) THEN59 IF (zoccur(i) >= 1) THEN 60 60 wake_deltat(i, l) = wake_deltat(i, l) + zddeltat(i,l) 61 61 wake_deltaq(i, l) = wake_deltaq(i, l) + zddeltaq(i,l) … … 77 77 END DO 78 78 DO i = 1, klon 79 IF (zoccur(i) .GE.1) THEN79 IF (zoccur(i) >= 1) THEN 80 80 wake_s(i) = wake_s(i) + zds(i) 81 81 awake_s(i) = awake_s(i) + zdas(i) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90
r4783 r5082 396 396 397 397 !jyg< 398 IF (iflag_wake_tend .EQ.0) THEN398 IF (iflag_wake_tend == 0) THEN 399 399 ! Update State variables 400 400 DO l = 1, klev -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/change_srf_frac_mod.F90
r4143 r5082 171 171 END WHERE 172 172 ! Send fractions back to slab ocean if needed 173 IF (type_ocean == 'slab'.AND. version_ocean .NE.'sicINT') THEN173 IF (type_ocean == 'slab'.AND. version_ocean/='sicINT') THEN 174 174 WHERE (1.-zmasq(:)>EPSFRA) 175 175 fsic(:)=pctsrf(:,is_sic)/(1.-zmasq(:)) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/climb_hq_mod.F90
r4143 r5082 376 376 !!! jyg le 07/02/2012 377 377 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN 378 IF (mod(iflag_pbl_split,10) .ge.1) THEN378 IF (mod(iflag_pbl_split,10) >=1) THEN 379 379 !!! nrlmd le 02/05/2011 380 380 DO k= 1, klev … … 391 391 enddo 392 392 #endif 393 IF (k .eq.1) THEN393 IF (k==1) THEN 394 394 gama_h_out(i,k) = 0. 395 395 gama_q_out(i,k) = 0. … … 600 600 !!! jyg le 07/02/2012 601 601 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN 602 IF (mod(iflag_pbl_split,10) .ge.1) THEN602 IF (mod(iflag_pbl_split,10) >=1) THEN 603 603 !!! nrlmd le 02/05/2011 604 604 DO i = 1, knon … … 627 627 enddo 628 628 #endif 629 IF (k .gt.1) THEN629 IF (k>1) THEN 630 630 gamah(i,k)=gama_h_in(i,k) 631 631 gamaq(i,k)=gama_q_in(i,k) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3_routines.F90
r4776 r5082 613 613 END DO 614 614 ENDIF 615 IF (prt_level .GE.10) THEN615 IF (prt_level >= 10) THEN 616 616 print *,'cv3_feed : iflag(1), pfeed(1), plcl(1), wghti(1,k) ', & 617 617 iflag(1), pfeed(1), plcl(1), (wghti(1,k),k=1,10) … … 1711 1711 IF (k>=(icbs(i)+1)) THEN ! convect3 1712 1712 tg = tp(i, k) 1713 IF (tg .gt.Tx) THEN1713 IF (tg > Tx) THEN 1714 1714 es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15)) 1715 1715 qg = eps*es/(p(i,k)-es*(1.-eps)) … … 1738 1738 coefx = aa 1739 1739 coefm = aa + dd 1740 IF (tg .gt.Tx) THEN1740 IF (tg > Tx) THEN 1741 1741 Zx = ahg + coefx*(Tx - tg) 1742 1742 Zm = ahg - ddelta + coefm*(Tm - tg) 1743 1743 ELSE 1744 IF (tg .gt.Tm) THEN1744 IF (tg > Tm) THEN 1745 1745 Zx = ahg + (coefx +fp*ddelta)*(Tx - Tg) 1746 1746 Zm = ahg + (coefm +fp*ddelta)*(Tm - Tg) … … 1755 1755 U = (1. - Um)*(1. - Ux) 1756 1756 ! Compute the updated parcell temperature Tp : 3 cases depending on tg value 1757 IF (tg .gt.Tx) THEN1757 IF (tg > Tx) THEN 1758 1758 discr = bb*bb - 4*dd*fp*(ah0(i) - ahg + ddelta*fp*(Tx-tg)) 1759 1759 Tp(i,k) = tg + & … … 1761 1761 U *2*(ah0(i) - ahg + ddelta*fp*(Tx-tg))/(bb + sqrt(discr)) + & 1762 1762 Ux* (ah0(i) - ahg) /aa 1763 ELSEIF (tg .gt.Tm) THEN1763 ELSEIF (tg > Tm) THEN 1764 1764 discr = bb*bb - 4*dd*fp*(ah0(i) - ahg) 1765 1765 Tp(i,k) = tg + & … … 1783 1783 IF (k>=(icbs(i)+1)) THEN ! convect3 1784 1784 tg = tp(i, k) 1785 IF (tg .gt.Tx) THEN1785 IF (tg > Tx) THEN 1786 1786 es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15)) 1787 1787 qg = eps*es/(p(i,k)-es*(1.-eps)) … … 1822 1822 IF (k>=(icbs(i)+1)) THEN ! convect3 1823 1823 tg = tp(i, k) 1824 IF (tg .gt.Tx .OR. .NOT.cvflag_ice) THEN1824 IF (tg > Tx .OR. .NOT.cvflag_ice) THEN 1825 1825 es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15)) 1826 1826 qg = eps*es/(p(i,k)-es*(1.-eps)) … … 1847 1847 IF (k>=(icbs(i)+1)) THEN ! convect3 1848 1848 tg = tp(i, k) 1849 IF (tg .gt.Tx .OR. .NOT.cvflag_ice) THEN1849 IF (tg > Tx .OR. .NOT.cvflag_ice) THEN 1850 1850 es = 6.112*exp(17.67*(tg - 273.15)/(tg + 243.5 - 273.15)) 1851 1851 qg = eps*es/(p(i,k)-es*(1.-eps)) … … 2317 2317 !CR fix computation of inb 2318 2318 !keep flag or modify in all cases? 2319 IF (iflag_mix_adiab .eq.1) THEN2319 IF (iflag_mix_adiab==1) THEN 2320 2320 DO i = 1, ncum 2321 2321 cape(i)=0. … … 2328 2328 deltap = min(plcl(i), ph(i,k-1)) - min(plcl(i), ph(i,k)) 2329 2329 cape(i) = cape(i) + rrd*buoy(i, k-1)*deltap/p(i, k-1) 2330 IF (cape(i) .gt.0.) THEN2330 IF (cape(i)>0.) THEN 2331 2331 inb(i) = max(inb(i), k) 2332 2332 END IF … … 3698 3698 3699 3699 ! ------------------------------------------------------ 3700 IF (prt_level .GE.10) print *,' ->cv3_unsat, iflag(1) ', iflag(1)3700 IF (prt_level >= 10) print *,' ->cv3_unsat, iflag(1) ', iflag(1) 3701 3701 3702 3702 smallestreal=tiny(smallestreal) … … 4280 4280 4281 4281 END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1) 4282 IF (prt_level .GE.20) THEN4282 IF (prt_level >= 20) THEN 4283 4283 PRINT *,'cv3_unsat, mp hydrostatic ', i, mp(il,i) 4284 4284 ENDIF … … 4329 4329 END IF 4330 4330 mp(il, i) = max(0.0, mp(il,i)) 4331 IF (prt_level .GE.20) THEN4331 IF (prt_level >= 20) THEN 4332 4332 PRINT *,'cv3_unsat, mp cubic ', i, mp(il,i) 4333 4333 ENDIF … … 6815 6815 END DO 6816 6816 ! 6817 IF (prt_level .GE.5) THEN6817 IF (prt_level >= 5) THEN 6818 6818 print *,' CV3_YIELD : alpha_qpos ',alpha_qpos(1) 6819 6819 ENDIF … … 7646 7646 real cape(nloc) 7647 7647 7648 if (coef_epmax_cape .gt.1e-12) then7648 if (coef_epmax_cape>1e-12) then 7649 7649 7650 7650 ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne … … 7700 7700 do k=minorig+1,nl 7701 7701 do i=1,ncum 7702 if((k .ge.icb(i)).and.(k.le.inb(i)))then7702 if((k>=icb(i)).and.(k<=inb(i)))then 7703 7703 hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* & 7704 7704 ep(i, k)*clw(i, k) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/cv3p_mixing.F90
r4491 r5082 478 478 IF (prt_level >= 10) THEN 479 479 print *,'cv3p_mixing i, nent(i), icb, inb ',i, nent(igout,i), icb(igout), inb(igout) 480 IF (nent(igout,i) .gt.0) THEN480 IF (nent(igout,i) > 0) THEN 481 481 print *,'i,(j,Sij(i,j),j=icb-1,inb) ',i,(j,Sij(igout,i,j),j=icb(igout)-1,inb(igout)) 482 482 ENDIF … … 499 499 uent(il, i, i) = unk(il) 500 500 vent(il, i, i) = vnk(il) 501 IF (fl_cor_ebil .GE.2) THEN501 IF (fl_cor_ebil >= 2) THEN 502 502 hent(il, i, i) = hp(il,i) 503 503 ENDIF … … 821 821 cpm = cpd+Qent(il,i,j)*(cpv-cpd) 822 822 ! 823 IF (cvflag_ice .and. frac(il,j) .gt.0.) THEN823 IF (cvflag_ice .and. frac(il,j) > 0.) THEN 824 824 elij(il, i, j) = Qent(il, i, j) - rs(il, j) 825 825 elij(il, i, j) = elij(il, i, j) + & … … 856 856 ! hent(il, i, j) = hent(il, i, j) + (lv(il,j)+(cpd-cpv)*t(il,j))*awat 857 857 ! Mixed draught temperature at level j 858 IF (cvflag_ice .and. frac(il,j) .gt.0.) THEN858 IF (cvflag_ice .and. frac(il,j) > 0.) THEN 859 859 Tm = t(il,j) + (Qent(il,i,j)-elij(il,i,j)-rs(il,j))*rrv*t(il,j)*t(il,j)/(lv(il,j)*rs(il,j)) 860 860 hent(il, i, j) = hent(il, i, j) + (lv(il,j)+frac(il,j)*lf(il,j)+(cpd-cpv)*Tm)*awat -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/cva_driver.F90
r4613 r5082 1067 1067 ! is assumed useless. 1068 1068 ! 1069 compress = ncum .lt.len*comp_threshold1069 compress = ncum < len*comp_threshold 1070 1070 ! 1071 1071 IF (.not. compress) THEN -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/lmdz_lscp_old.F90
r4831 r5082 326 326 znebprecip(:)=0. 327 327 328 ice_thermo = (iflag_ice_thermo .EQ. 1).OR.(iflag_ice_thermo .GE.3)328 ice_thermo = (iflag_ice_thermo == 1).OR.(iflag_ice_thermo >= 3) 329 329 zdelq=0.0 330 330 ctot_vol(1:klon,1:klev)=0.0 … … 342 342 WRITE(lunout,*) 'fisrtilp, cpartiel:', cpartiel 343 343 344 IF (ABS(dtime/REAL(ninter)-360.0) .GT.0.001) THEN344 IF (ABS(dtime/REAL(ninter)-360.0)>0.001) THEN 345 345 WRITE(lunout,*) 'fisrtilp: Ce n est pas prevu, voir Z.X.Li', dtime 346 346 WRITE(lunout,*) 'Je prefere un sous-intervalle de 6 minutes' … … 407 407 ! 408 408 !CR: on est oblige de definir des valeurs fisrt car les valeurs de newmicro ne sont pas les memes par defaut 409 IF (iflag_t_glace .EQ.0) THEN409 IF (iflag_t_glace==0) THEN 410 410 ! ztglace = RTT - 15.0 411 411 t_glace_min_old = RTT - 15.0 … … 605 605 ! - zmqc: masse de precip qui doit etre thermalisee 606 606 ! 607 IF(k .LE.klevm1) THEN607 IF(k<=klevm1) THEN 608 608 DO i = 1, klon 609 609 !IM … … 612 612 zcpair=RCPD*(1.0+RVTMP2*zq(i)) 613 613 zcpeau=RCPD*RVTMP2 614 if (fl_cor_ebil .GT.0) then614 if (fl_cor_ebil > 0) then 615 615 ! zmqc: masse de precip qui doit etre thermalisee avec l'air de la couche atm 616 616 ! pour s'assurer que la precip arrivant au sol aura bien la temperature de la … … 679 679 DO i = 1, klon 680 680 ! S'il y a des precipitations 681 IF (zrfl(i)+zifl(i) .GT.0.) THEN681 IF (zrfl(i)+zifl(i)>0.) THEN 682 682 ! Calcul du qsat 683 683 IF (thermcep) THEN … … 688 688 zqs(i)=zqs(i)*zcor 689 689 ELSE 690 IF (zt(i) .LT.t_coup) THEN690 IF (zt(i) < t_coup) THEN 691 691 zqs(i) = qsats(zt(i)) / pplay(i,k) 692 692 ELSE … … 701 701 DO i = 1, klon 702 702 ! S'il y a des precipitations 703 IF (zrfl(i)+zifl(i) .GT.0.) THEN703 IF (zrfl(i)+zifl(i)>0.) THEN 704 704 ! Evap max pour ne pas saturer la fraction sous le nuage 705 705 ! Evap max jusqu'à atteindre la saturation dans la partie … … 710 710 ! Ajout de la prise en compte des precip a thermiser 711 711 ! avec petite reecriture 712 if (fl_cor_ebil .GT.0) then ! nouveau712 if (fl_cor_ebil > 0) then ! nouveau 713 713 ! Calcul de l'evaporation du flux de precip herite 714 714 ! d'au-dessus … … 721 721 zrfln(i) = zrfl(i) - zqev*zmair(i)/dtime 722 722 ! Aucun flux liquide pour T < t_coup, on reevapore tout. 723 IF (zt(i) .LT.t_coup.and.reevap_ice) THEN723 IF (zt(i) < t_coup.and.reevap_ice) THEN 724 724 zrfln(i)=0. 725 725 zqev = (zrfl(i)-zrfln(i))/zmair(i)*dtime … … 745 745 /RG/dtime 746 746 ! Aucun flux liquide pour T < t_coup 747 IF (zt(i) .LT.t_coup.and.reevap_ice) zrfln(i)=0.747 IF (zt(i) < t_coup.and.reevap_ice) zrfln(i)=0. 748 748 ! Nouvelle vapeur 749 749 zq(i) = zq(i) - (zrfln(i)-zrfl(i)) & … … 788 788 !AJ< 789 789 ! S'il y a des precipitations 790 IF (zrfl(i)+zifl(i) .GT.0.) THEN790 IF (zrfl(i)+zifl(i)>0.) THEN 791 791 792 792 IF (iflag_evap_prec==1) THEN … … 850 850 ! en conservant la proportion liquide / glace 851 851 852 IF (zqevt+zqevti .GT.zqev0) THEN852 IF (zqevt+zqevti>zqev0) THEN 853 853 zqev=zqev0*zqevt/(zqevt+zqevti) 854 854 zqevi=zqev0*zqevti/(zqevt+zqevti) … … 859 859 ! zqev=zqevt 860 860 ! zqevi=zqevti 861 IF (zqevt+zqevti .GT.0.) THEN861 IF (zqevt+zqevti>0.) THEN 862 862 zqev=MIN(zqev0*zqevt/(zqevt+zqevti),zqevt) 863 863 zqevi=MIN(zqev0*zqevti/(zqevt+zqevti),zqevti) … … 876 876 zq(i) = zq(i) - (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) & 877 877 * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime 878 if (fl_cor_ebil .GT.0) then ! avec correction thermalisation des precips878 if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips 879 879 zmqc(i) = zmqc(i) + (zrfln(i)+zifln(i)-zrfl(i)-zifl(i)) & 880 880 * (RG/(paprs(i,k)-paprs(i,k+1)))*dtime … … 907 907 ! Fusion de la glace 908 908 zrfl(i)=zrfl(i)+zmelt*zifl(i) 909 if (fl_cor_ebil .LE.0) then909 if (fl_cor_ebil <= 0) then 910 910 ! the following line should not be here. Indeed, if zifl is modified 911 911 ! now, zifl(i)*zmelt is no more the amount of ice that has melt … … 914 914 end if 915 915 ! Chaleur latente de fusion 916 if (fl_cor_ebil .GT.0) then ! avec correction thermalisation des precips916 if (fl_cor_ebil > 0) then ! avec correction thermalisation des precips 917 917 zt(i)=zt(i)-zifl(i)*zmelt*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) & 918 918 *RLMLT/RCPD/(1.0+RVTMP2*(zq(i)+zmqc(i))) … … 921 921 *RLMLT/RCPD/(1.0+RVTMP2*zq(i)) 922 922 end if 923 if (fl_cor_ebil .GT.0) then ! correction bug, deplacement ligne precedente923 if (fl_cor_ebil > 0) then ! correction bug, deplacement ligne precedente 924 924 zifl(i)=zifl(i)*(1.-zmelt) 925 925 end if -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyetat0_mod.F90
r5075 r5082 173 173 tab_cntrl(6)=nbapp_rad 174 174 175 IF (iflag_cycle_diurne .GE.1) tab_cntrl( 7) = iflag_cycle_diurne175 IF (iflag_cycle_diurne>=1) tab_cntrl( 7) = iflag_cycle_diurne 176 176 IF (soil_model) tab_cntrl( 8) =1. 177 177 IF (new_oliq) tab_cntrl( 9) =1. … … 272 272 + pctsrf(1 : klon, is_lic) 273 273 DO i = 1 , klon 274 IF ( abs(fractint(i) - zmasq(i) ) .GT.EPSFRA ) THEN274 IF ( abs(fractint(i) - zmasq(i) ) > EPSFRA ) THEN 275 275 WRITE(*, *) 'phyetat0: attention fraction terre pas ', & 276 276 'coherente ', i, zmasq(i), pctsrf(i, is_ter) & … … 283 283 + pctsrf(1 : klon, is_sic) 284 284 DO i = 1 , klon 285 IF ( abs( fractint(i) - (1. - zmasq(i))) .GT.EPSFRA ) THEN285 IF ( abs( fractint(i) - (1. - zmasq(i))) > EPSFRA ) THEN 286 286 WRITE(*, *) 'phyetat0 attention fraction ocean pas ', & 287 287 'coherente ', i, zmasq(i) , pctsrf(i, is_oce) & … … 311 311 DO nsrf = 1, nbsrf 312 312 DO isw=1, nsw 313 IF (isw .GT.99) THEN313 IF (isw>99) THEN 314 314 PRINT*, "Trop de bandes SW" 315 315 call abort_physic("phyetat0", "", 1) … … 334 334 335 335 DO isoil=1, nsoilmx 336 IF (isoil .GT.99) THEN336 IF (isoil>99) THEN 337 337 PRINT*, "Trop de couches " 338 338 call abort_physic("phyetat0", "", 1) … … 439 439 ! dummy values (as is the case when generated by ce0l, 440 440 ! or by iniaqua) 441 IF ( (maxval(q_ancien) .EQ.minval(q_ancien)) .OR. &442 (maxval(ql_ancien) .EQ.minval(ql_ancien)) .OR. &443 (maxval(qs_ancien) .EQ.minval(qs_ancien)) .OR. &444 (maxval(rneb_ancien) .EQ.minval(rneb_ancien)) .OR. &445 (maxval(prw_ancien) .EQ.minval(prw_ancien)) .OR. &446 (maxval(prlw_ancien) .EQ.minval(prlw_ancien)) .OR. &447 (maxval(prsw_ancien) .EQ.minval(prsw_ancien)) .OR. &448 (maxval(t_ancien) .EQ.minval(t_ancien)) ) THEN441 IF ( (maxval(q_ancien)==minval(q_ancien)) .OR. & 442 (maxval(ql_ancien)==minval(ql_ancien)) .OR. & 443 (maxval(qs_ancien)==minval(qs_ancien)) .OR. & 444 (maxval(rneb_ancien)==minval(rneb_ancien)) .OR. & 445 (maxval(prw_ancien)==minval(prw_ancien)) .OR. & 446 (maxval(prlw_ancien)==minval(prlw_ancien)) .OR. & 447 (maxval(prsw_ancien)==minval(prsw_ancien)) .OR. & 448 (maxval(t_ancien)==minval(t_ancien)) ) THEN 449 449 ancien_ok=.false. 450 450 ENDIF 451 451 452 452 IF (ok_bs) THEN 453 IF ( (maxval(qbs_ancien) .EQ.minval(qbs_ancien)) .OR. &454 (maxval(prbsw_ancien) .EQ.minval(prbsw_ancien)) ) THEN453 IF ( (maxval(qbs_ancien)==minval(qbs_ancien)) .OR. & 454 (maxval(prbsw_ancien)==minval(prbsw_ancien)) ) THEN 455 455 ancien_ok=.false. 456 456 ENDIF … … 592 592 IF ( type_ocean == 'slab' ) THEN 593 593 CALL ocean_slab_init(phys_tstep, pctsrf) 594 IF (nslay .EQ.1) THEN594 IF (nslay==1) THEN 595 595 found=phyetat0_get(tslab,["tslab01","tslab "],"tslab",0.) 596 596 ELSE … … 621 621 PRINT*, "Initialisation a 0/1m suivant fraction glace" 622 622 seaice(:)=0. 623 WHERE (pctsrf(:,is_sic) .GT.EPSFRA)623 WHERE (pctsrf(:,is_sic)>EPSFRA) 624 624 seaice=917. 625 625 ENDWHERE -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/phyredem.F90
r4613 r5082 119 119 tab_cntrl(6) = nbapp_rad 120 120 121 IF( iflag_cycle_diurne .GE.1 ) tab_cntrl( 7 ) = iflag_cycle_diurne121 IF( iflag_cycle_diurne>=1 ) tab_cntrl( 7 ) = iflag_cycle_diurne 122 122 IF( soil_model ) tab_cntrl( 8 ) = 1. 123 123 IF( new_oliq ) tab_cntrl( 9 ) = 1. … … 154 154 ! Get last fractions from slab ocean 155 155 IF (type_ocean == 'slab' .AND. version_ocean == "sicINT") THEN 156 WHERE (1.-zmasq(:) .GT.EPSFRA)156 WHERE (1.-zmasq(:)>EPSFRA) 157 157 pctsrf(:,is_oce)=(1.-fsic(:))*(1.-zmasq(:)) 158 158 pctsrf(:,is_sic)=fsic(:)*(1.-zmasq(:)) … … 373 373 ! Restart variables for Slab ocean 374 374 IF (type_ocean == 'slab') THEN 375 IF (nslay .EQ.1) THEN375 IF (nslay==1) THEN 376 376 CALL put_field(pass,"tslab", "Slab ocean temperature", tslab) 377 377 ELSE -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/phys_output_mod.F90
r5023 r5082 347 347 348 348 ! Calculate ecrit_files for all files 349 IF ( chtimestep(iff) .eq.'Default' ) THEN349 IF ( chtimestep(iff)=='Default' ) THEN 350 350 ! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf 351 351 ! ...)*86400. 352 352 ecrit_files(iff)=ecrit_files(iff)*86400. 353 ELSE IF (chtimestep(iff) .eq.'-1') THEN353 ELSE IF (chtimestep(iff)=='-1') THEN 354 354 PRINT*,'ecrit_files(',iff,') < 0 so IOIPSL work on different' 355 355 PRINT*,'months length' … … 377 377 ENDIF 378 378 379 IF (iff .LE.6.OR.iff.EQ.10) THEN379 IF (iff<=6.OR.iff==10) THEN 380 380 CALL wxios_add_vaxis("presnivs", & 381 381 levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff))) … … 436 436 DO i=1,nbp_lon 437 437 WRITE(lunout,*)'io_lon(i)=',io_lon(i) 438 IF (io_lon(i) .le.phys_out_lonmin(iff)) imin_ins=i439 IF (io_lon(i) .le.phys_out_lonmax(iff)) imax_ins=i+1438 IF (io_lon(i)<=phys_out_lonmin(iff)) imin_ins=i 439 IF (io_lon(i)<=phys_out_lonmax(iff)) imax_ins=i+1 440 440 ENDDO 441 441 442 442 DO j=1,jjmp1 443 443 WRITE(lunout,*)'io_lat(j)=',io_lat(j) 444 IF (io_lat(j) .ge.phys_out_latmin(iff)) jmax_ins=j+1445 IF (io_lat(j) .ge.phys_out_latmax(iff)) jmin_ins=j444 IF (io_lat(j)>=phys_out_latmin(iff)) jmax_ins=j+1 445 IF (io_lat(j)>=phys_out_latmax(iff)) jmin_ins=j 446 446 ENDDO 447 447 … … 479 479 480 480 #ifndef CPP_IOIPSL_NO_OUTPUT 481 IF (iff .LE.6.OR.iff.EQ.10) THEN481 IF (iff<=6.OR.iff==10) THEN 482 482 CALL histvert(nid_files(iff), "presnivs", "Vertical levels", "Pa", & 483 483 levmax(iff) - levmin(iff) + 1, & -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
r5081 r5082 1448 1448 ! en imposant la valeur de igout. 1449 1449 !====================================================================== 1450 IF (prt_level .ge.1) THEN1450 IF (prt_level>=1) THEN 1451 1451 igout=klon/2+1/klon 1452 1452 write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' … … 1524 1524 ! 1525 1525 !CR: check sur le nb de traceurs de l eau 1526 IF ((iflag_ice_thermo .gt.0).and.(nqo==2)) THEN1526 IF ((iflag_ice_thermo>0).and.(nqo==2)) THEN 1527 1527 WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', & 1528 1528 '(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.' … … 1531 1531 ENDIF 1532 1532 1533 IF (ok_ice_sursat.AND.(iflag_ice_thermo .EQ.0)) THEN1533 IF (ok_ice_sursat.AND.(iflag_ice_thermo==0)) THEN 1534 1534 WRITE (lunout, *) ' ok_ice_sursat=y requires iflag_ice_thermo=1 as well' 1535 1535 abort_message='see above' … … 1537 1537 ENDIF 1538 1538 1539 IF (ok_ice_sursat.AND.(nqo .LT.4)) THEN1539 IF (ok_ice_sursat.AND.(nqo<4)) THEN 1540 1540 WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', & 1541 1541 '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.' … … 1561 1561 CALL abort_physic(modname,abort_message, 1) 1562 1562 #endif 1563 IF ((ok_ice_sursat.AND.nqo .LT.5).OR.(.NOT.ok_ice_sursat.AND.nqo.LT.4)) THEN1563 IF ((ok_ice_sursat.AND.nqo <5).OR.(.NOT.ok_ice_sursat.AND.nqo<4)) THEN 1564 1564 WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', & 1565 1565 'but nqo=', nqo … … 1680 1680 ENDIF 1681 1681 1682 IF (prt_level .ge.1) print *,'CONVERGENCE PHYSIQUE THERM 1 '1682 IF (prt_level>=1) print *,'CONVERGENCE PHYSIQUE THERM 1 ' 1683 1683 1684 1684 !====================================================================== … … 1749 1749 print*,'iflag_cycle_diurne', iflag_cycle_diurne 1750 1750 ! 1751 IF (iflag_con .EQ.2.AND.iflag_cld_th.GT.-1) THEN1751 IF (iflag_con==2.AND.iflag_cld_th>-1) THEN 1752 1752 abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1' 1753 1753 CALL abort_physic (modname,abort_message,1) … … 1818 1818 ENDIF 1819 1819 !>jyg 1820 IF (MOD(NINT(86400./phys_tstep),nbapp_rad) .EQ.0) THEN1820 IF (MOD(NINT(86400./phys_tstep),nbapp_rad)==0) THEN 1821 1821 radpas = NINT( 86400./phys_tstep)/nbapp_rad 1822 1822 ELSE … … 1829 1829 CALL abort_physic(modname,abort_message,1) 1830 1830 ENDIF 1831 IF (nbapp_cv .EQ.0) nbapp_cv=86400./phys_tstep1832 IF (nbapp_wk .EQ.0) nbapp_wk=86400./phys_tstep1831 IF (nbapp_cv == 0) nbapp_cv=86400./phys_tstep 1832 IF (nbapp_wk == 0) nbapp_wk=86400./phys_tstep 1833 1833 print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk 1834 IF (MOD(NINT(86400./phys_tstep),nbapp_cv) .EQ.0) THEN1834 IF (MOD(NINT(86400./phys_tstep),nbapp_cv)==0) THEN 1835 1835 cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv 1836 1836 cvpas = cvpas_0 … … 1845 1845 CALL abort_physic(modname,abort_message,1) 1846 1846 ENDIF 1847 IF (MOD(NINT(86400./phys_tstep),nbapp_wk) .EQ.0) THEN1847 IF (MOD(NINT(86400./phys_tstep),nbapp_wk)==0) THEN 1848 1848 wkpas = NINT( 86400./phys_tstep)/nbapp_wk 1849 1849 ! print *,'physiq, wkpas ',wkpas … … 1870 1870 CLOSE(98) 1871 1871 CONTINUE 1872 IF(nCFMIP .GT.npCFMIP) THEN1872 IF(nCFMIP>npCFMIP) THEN 1873 1873 print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler' 1874 1874 CALL abort_physic("physiq", "", 1) … … 2031 2031 ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop 2032 2032 IF (ok_newmicro) then 2033 IF (iflag_rrtm .EQ.1) THEN2033 IF (iflag_rrtm==1) THEN 2034 2034 #ifdef CPP_RRTM 2035 2035 IF (ok_cdnc.AND.NRADLP.NE.3) THEN … … 2122 2122 ! on remet le calendrier a zero 2123 2123 ! 2124 IF (raz_date .eq.1) THEN2124 IF (raz_date == 1) THEN 2125 2125 itau_phy = 0 2126 2126 ENDIF … … 2133 2133 ! phys_tstep=pdtphys 2134 2134 ! ENDIF 2135 IF (nlon .NE.klon) THEN2135 IF (nlon /= klon) THEN 2136 2136 WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, & 2137 2137 klon … … 2139 2139 CALL abort_physic(modname,abort_message,1) 2140 2140 ENDIF 2141 IF (nlev .NE.klev) THEN2141 IF (nlev /= klev) THEN 2142 2142 WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, & 2143 2143 klev … … 2146 2146 ENDIF 2147 2147 ! 2148 IF (phys_tstep*REAL(radpas) .GT.21600..AND.iflag_cycle_diurne.GE.1) THEN2148 IF (phys_tstep*REAL(radpas)>21600..AND.iflag_cycle_diurne>=1) THEN 2149 2149 WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant' 2150 2150 WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne" … … 2163 2163 !KE43 2164 2164 ! Initialisation pour la convection de K.E. (sb): 2165 IF (iflag_con .GE.3) THEN2165 IF (iflag_con>=3) THEN 2166 2166 2167 2167 WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3 " … … 2250 2250 zuthe(i)=0. 2251 2251 zvthe(i)=0. 2252 IF (zstd(i) .gt.10.) THEN2252 IF (zstd(i)>10.) THEN 2253 2253 zuthe(i)=(1.-zgam(i))*cos(zthe(i)) 2254 2254 zvthe(i)=(1.-zgam(i))*sin(zthe(i)) … … 2617 2617 qbs_seri(i,k) = 0. 2618 2618 !CR: ATTENTION, on rajoute la variable glace 2619 IF (nqo .EQ.2) THEN !--vapour and liquid only2619 IF (nqo==2) THEN !--vapour and liquid only 2620 2620 qs_seri(i,k) = 0. 2621 2621 rneb_seri(i,k) = 0. 2622 ELSE IF (nqo .EQ.3) THEN !--vapour, liquid and ice2622 ELSE IF (nqo==3) THEN !--vapour, liquid and ice 2623 2623 qs_seri(i,k) = qx(i,k,isol) 2624 2624 rneb_seri(i,k) = 0. 2625 ELSE IF (nqo .GE.4) THEN !--vapour, liquid, ice and rneb and blowing snow2625 ELSE IF (nqo>=4) THEN !--vapour, liquid, ice and rneb and blowing snow 2626 2626 qs_seri(i,k) = qx(i,k,isol) 2627 2627 IF (ok_ice_sursat) THEN … … 2738 2738 ENDDO 2739 2739 ! Initialize variables used for diagnostic purpose 2740 IF (flag_inhib_tend .ne.0) CALL init_cmp_seri2740 IF (flag_inhib_tend /= 0) CALL init_cmp_seri 2741 2741 2742 2742 ! Diagnostiquer la tendance dynamique … … 3128 3128 ENDIF 3129 3129 3130 IF (prt_level .ge.1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist3130 IF (prt_level>=1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist 3131 3131 3132 3132 … … 3139 3139 ! non nul aux poles. 3140 3140 IF (abs(solarlong0-1000.)<1.e-4) THEN 3141 CALL zenang_an(iflag_cycle_diurne .GE.1,jH_cur, &3141 CALL zenang_an(iflag_cycle_diurne>=1,jH_cur, & 3142 3142 latitude_deg,longitude_deg,rmu0,fract) 3143 3143 swradcorr(:) = 1.0 … … 3164 3164 ! Calcul du flag jour-nuit 3165 3165 JrNt = 0.0 3166 WHERE (fract .GT.0.0) JrNt = 1.03166 WHERE (fract>0.0) JrNt = 1.0 3167 3167 CASE(2) 3168 3168 ! Avec cycle diurne sans application des poids … … 3186 3186 latitude_deg,longitude_deg,zrmu0,zfract) 3187 3187 swradcorr = 0.0 3188 WHERE (rmu0 .GE.1.e-10 .OR. fract.GE.1.e-10) &3188 WHERE (rmu0>=1.e-10 .OR. fract>=1.e-10) & 3189 3189 swradcorr=zfract/fract*zrmu0/rmu0 3190 3190 ! Calcul du flag jour-nuit 3191 3191 JrNt = 0.0 3192 WHERE (zfract .GT.0.0) JrNt = 1.03192 WHERE (zfract>0.0) JrNt = 1.0 3193 3193 END SELECT 3194 3194 ENDIF … … 3254 3254 !jyg+nrlmd< 3255 3255 !!jyg IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN 3256 IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,10) .ge.1) THEN3256 IF (prt_level >= 2 .and. mod(iflag_pbl_split,10) >= 1) THEN 3257 3257 print *,'debut du splitting de la PBL, wake_s = ', wake_s(:) 3258 3258 print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1) … … 3431 3431 ! Add turbulent diffusion tendency to the wake difference variables 3432 3432 !!jyg IF (mod(iflag_pbl_split,2) .NE. 0) THEN 3433 IF (mod(iflag_pbl_split,10) .NE.0) THEN3433 IF (mod(iflag_pbl_split,10) /= 0) THEN 3434 3434 !jyg< 3435 3435 d_deltat_vdf(:,:) = d_t_vdf_w(:,:)-d_t_vdf_x(:,:) … … 3559 3559 ELSE 3560 3560 !! IF (zx_t.LT.t_coup) THEN !jyg 3561 IF (zx_t .LT.rtt) THEN !jyg3561 IF (zx_t<rtt) THEN !jyg 3562 3562 zx_qs = qsats(zx_t)/pplay(i,k) 3563 3563 ELSE … … 3569 3569 ENDDO 3570 3570 3571 IF (prt_level .ge.1) THEN3571 IF (prt_level>=1) THEN 3572 3572 write(lunout,*) 'L qsat (g/kg) avant clouds_gno' 3573 3573 write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev) … … 3589 3589 ENDIF 3590 3590 zx_ajustq = .FALSE. 3591 IF (iflag_con .EQ.2) zx_ajustq=.TRUE.3591 IF (iflag_con==2) zx_ajustq=.TRUE. 3592 3592 IF (zx_ajustq) THEN 3593 3593 DO i = 1, klon … … 3609 3609 ENDDO 3610 3610 3611 IF (prt_level .ge.1) write(lunout,*) 'omega(igout, :) = ', &3611 IF (prt_level>=1) write(lunout,*) 'omega(igout, :) = ', & 3612 3612 omega(igout, :) 3613 3613 ! … … 3617 3617 !! print *,' physiq : itapcv, cvpas, itap-1, cvpas_0 ', & 3618 3618 !! itapcv, cvpas, itap-1, cvpas_0 3619 IF (MOD(itapcv,cvpas) .EQ.0 .OR. MOD(itap-1,cvpas_0).EQ.0) THEN3619 IF (MOD(itapcv,cvpas)==0 .OR. MOD(itap-1,cvpas_0)==0) THEN 3620 3620 3621 3621 ! … … 3650 3650 #endif 3651 3651 ! 3652 IF (iflag_con .EQ.1) THEN3652 IF (iflag_con==1) THEN 3653 3653 abort_message ='reactiver le call conlmd dans physiq.F' 3654 3654 CALL abort_physic (modname,abort_message,1) … … 3656 3656 ! . d_t_con, d_q_con, 3657 3657 ! . rain_con, snow_con, ibas_con, itop_con) 3658 ELSE IF (iflag_con .EQ.2) THEN3658 ELSE IF (iflag_con==2) THEN 3659 3659 #ifdef ISO 3660 3660 CALL abort_gcm('physiq 2770','isos pas prevus ici',1) … … 3674 3674 itop_con(i) = klev+1 - kctop(i) 3675 3675 ENDDO 3676 ELSE IF (iflag_con .GE.3) THEN3676 ELSE IF (iflag_con>=3) THEN 3677 3677 ! nb of tracers for the KE convection: 3678 3678 ! MAF la partie traceurs est faite dans phytrac … … 3813 3813 DO k=1,klev 3814 3814 DO i=1,klon 3815 IF (wake_s(i) .GT.1.e-3) THEN3815 IF (wake_s(i) > 1.e-3) THEN 3816 3816 t_w(i,k) = t_w(i,k) + d_t_adjwk(i,k) 3817 3817 q_w(i,k) = q_w(i,k) + d_q_adjwk(i,k) … … 3964 3964 IF (-7*log(presnivs(k)/presnivs(1)) > 25.) k_upper_cv = k 3965 3965 ENDDO 3966 IF (prt_level .ge.5) THEN3966 IF (prt_level >= 5) THEN 3967 3967 Print *, 'upmost level of deep convection loops: k_upper_cv = ', & 3968 3968 k_upper_cv … … 4080 4080 ! 4081 4081 DO i = 1, klon 4082 IF (iflagctrl(i) .le.1) itau_con(i)=itau_con(i)+cvpas4082 IF (iflagctrl(i)<=1) itau_con(i)=itau_con(i)+cvpas 4083 4083 ENDDO 4084 4084 ! … … 4175 4175 ema_pct(i) = paprs(i,itop_con(i)+1) 4176 4176 4177 IF (itop_con(i) .gt.klev-3) THEN4177 IF (itop_con(i)>klev-3) THEN 4178 4178 IF (prt_level >= 9) THEN 4179 4179 write(lunout,*)'La convection monte trop haut ' … … 4182 4182 ENDIF 4183 4183 ENDDO 4184 ELSE IF (iflag_con .eq.0) THEN4184 ELSE IF (iflag_con==0) THEN 4185 4185 write(lunout,*) 'On n appelle pas la convection' 4186 4186 clwcon0=0. … … 4314 4314 DO k = 1, klev 4315 4315 DO i = 1, klon 4316 IF (z_factor(i) .GT.(1.0+1.0E-08) .OR. &4317 z_factor(i) .LT.(1.0-1.0E-08)) THEN4316 IF (z_factor(i)>(1.0+1.0E-08) .OR. & 4317 z_factor(i)<(1.0-1.0E-08)) THEN 4318 4318 q_seri(i,k) = q_seri(i,k) * z_factor(i) 4319 4319 #ifdef ISO … … 4363 4363 ! Call wakes every "wkpas" step 4364 4364 ! 4365 IF (MOD(itapwk,wkpas) .EQ.0) THEN4365 IF (MOD(itapwk,wkpas)==0) THEN 4366 4366 ! 4367 4367 DO k=1,klev … … 4486 4486 4487 4487 ! Increment Wake state variables 4488 IF (iflag_wake_tend .GT.0.) THEN4488 IF (iflag_wake_tend > 0.) THEN 4489 4489 4490 4490 CALL add_wake_tend & … … 4498 4498 ENDIF ! (iflag_wake_tend .GT. 0.) 4499 4499 ! 4500 IF (prt_level .GE.10) THEN4500 IF (prt_level >= 10) THEN 4501 4501 print *,' physiq, after calwake, wake_s: ',wake_s(:) 4502 4502 print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1) … … 4504 4504 ENDIF 4505 4505 4506 IF (iflag_alp_wk_cond .GT.0.) THEN4506 IF (iflag_alp_wk_cond > 0.) THEN 4507 4507 4508 4508 CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, & … … 4689 4689 !jyg< 4690 4690 !! IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN 4691 IF (mod(iflag_pbl_split/10,10) .GE.1) THEN4691 IF (mod(iflag_pbl_split/10,10) >= 1) THEN 4692 4692 ! Appel des thermiques avec les profils exterieurs aux poches 4693 4693 DO k=1,klev … … 4773 4773 !jyg< 4774 4774 !!jyg IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN 4775 IF (mod(iflag_pbl_split/10,10) .GE.1) THEN4775 IF (mod(iflag_pbl_split/10,10) >= 1) THEN 4776 4776 ! Si les thermiques ne sont presents que hors des 4777 4777 ! poches, la tendance moyenne associ\'ee doit etre … … 4857 4857 IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN 4858 4858 4859 IF (iflag_thermals .eq.0) THEN4859 IF (iflag_thermals==0) THEN 4860 4860 IF (prt_level>9) WRITE(lunout,*)'ajsec' 4861 4861 limbas(:)=1 … … 4981 4981 ! et le processus de precipitation 4982 4982 !------------------------------------------------------------------------- 4983 IF (prt_level .GE.10) THEN4983 IF (prt_level >=10) THEN 4984 4984 print *,'itap, ->fisrtilp ',itap 4985 4985 ENDIF … … 5347 5347 !IM cf FH 5348 5348 ! IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke 5349 IF (iflag_cld_th .le.-1) THEN ! seulement pour Tiedtke5349 IF (iflag_cld_th<=-1) THEN ! seulement pour Tiedtke 5350 5350 snow_tiedtke=0. 5351 5351 ! print*,'avant calcul de la pseudo precip ' 5352 5352 ! print*,'iflag_cld_th',iflag_cld_th 5353 IF (iflag_cld_th .eq.-1) THEN5353 IF (iflag_cld_th==-1) THEN 5354 5354 rain_tiedtke=rain_con 5355 5355 ELSE … … 5359 5359 DO k=1,klev 5360 5360 DO i=1,klon 5361 IF (d_q_con(i,k) .lt.0.) THEN5361 IF (d_q_con(i,k)<0.) THEN 5362 5362 rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys & 5363 5363 *(paprs(i,k)-paprs(i,k+1))/rg … … 5377 5377 DO k = 1, klev 5378 5378 DO i = 1, klon 5379 IF (diafra(i,k) .GT.cldfra(i,k)) THEN5379 IF (diafra(i,k)>cldfra(i,k)) THEN 5380 5380 radocond(i,k) = dialiq(i,k) 5381 5381 cldfra(i,k) = diafra(i,k) … … 5384 5384 ENDDO 5385 5385 5386 ELSE IF (iflag_cld_th .ge.3) THEN5386 ELSE IF (iflag_cld_th>=3) THEN 5387 5387 ! On prend pour les nuages convectifs le max du calcul de la 5388 5388 ! convection et du calcul du pas de temps precedent diminue d'un facteur … … 5392 5392 DO i=1,klon 5393 5393 rnebcon(i,k)=rnebcon(i,k)*facteur 5394 IF (rnebcon0(i,k)*clwcon0(i,k) .GT.rnebcon(i,k)*clwcon(i,k)) THEN5394 IF (rnebcon0(i,k)*clwcon0(i,k)>rnebcon(i,k)*clwcon(i,k)) THEN 5395 5395 rnebcon(i,k)=rnebcon0(i,k) 5396 5396 clwcon(i,k)=clwcon0(i,k) … … 5476 5476 DO k = 1, klev 5477 5477 DO i = 1, klon 5478 IF (diafra(i,k) .GT.cldfra(i,k)) THEN5478 IF (diafra(i,k)>cldfra(i,k)) THEN 5479 5479 radocond(i,k) = dialiq(i,k) 5480 5480 cldfra(i,k) = diafra(i,k) … … 5574 5574 ELSE 5575 5575 !! IF (zx_t.LT.t_coup) THEN !jyg 5576 IF (zx_t .LT.rtt) THEN !jyg5576 IF (zx_t<rtt) THEN !jyg 5577 5577 zx_qs = qsats(zx_t)/pplay(i,k) 5578 5578 ELSE … … 5581 5581 ENDIF 5582 5582 zx_rh(i,k) = q_seri(i,k)/zx_qs 5583 IF (iflag_ice_thermo .GT.0) THEN5583 IF (iflag_ice_thermo > 0) THEN 5584 5584 zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k)) 5585 5585 zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k)) … … 5595 5595 tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA 5596 5596 IF (thermcep) THEN 5597 IF(zt2m(i) .LT.RTT) then5597 IF(zt2m(i)<RTT) then 5598 5598 Lheat=RLSTT 5599 5599 ELSE … … 5601 5601 ENDIF 5602 5602 ELSE 5603 IF (zt2m(i) .LT.RTT) THEN5603 IF (zt2m(i)<RTT) THEN 5604 5604 Lheat=RLSTT 5605 5605 ELSE … … 5677 5677 ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol. 5678 5678 ! 5679 IF (MOD(itaprad,radpas) .EQ.0) THEN5679 IF (MOD(itaprad,radpas)==0) THEN 5680 5680 5681 5681 ! 5682 5682 !jq - introduce the aerosol direct and first indirect radiative forcings 5683 5683 !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr) 5684 IF (flag_aerosol .GT.0) THEN5685 IF (iflag_rrtm .EQ.0) THEN !--old radiation5684 IF (flag_aerosol > 0) THEN 5685 IF (iflag_rrtm == 0) THEN !--old radiation 5686 5686 IF (.NOT. aerosol_couple) THEN 5687 5687 ! … … 5693 5693 tausum_aero, tau3d_aero) 5694 5694 ENDIF 5695 ELSE IF (iflag_rrtm .EQ.1) THEN ! RRTM radiation5695 ELSE IF (iflag_rrtm ==1) THEN ! RRTM radiation 5696 5696 IF (aerosol_couple .AND. config_inca == 'aero' ) THEN 5697 5697 abort_message='config_inca=aero et rrtm=1 impossible' … … 5759 5759 ! 5760 5760 ENDIF 5761 ELSE IF (iflag_rrtm .EQ.2) THEN ! ecrad RADIATION5761 ELSE IF (iflag_rrtm ==2) THEN ! ecrad RADIATION 5762 5762 #ifdef CPP_ECRAD 5763 5763 !--climatologies or INCA aerosols … … 5776 5776 mass_solu_aero(:,:) = 0. 5777 5777 mass_solu_aero_pi(:,:) = 0. 5778 IF (iflag_rrtm .EQ.0) THEN !--old radiation5778 IF (iflag_rrtm == 0) THEN !--old radiation 5779 5779 tau_aero(:,:,:,:) = 1.e-15 5780 5780 piz_aero(:,:,:,:) = 1. … … 5793 5793 !--STRAT AEROSOL 5794 5794 !--updates tausum_aero,tau_aero,piz_aero,cg_aero 5795 IF (flag_aerosol_strat .GT.0) THEN5796 IF (prt_level .GE.10) THEN5795 IF (flag_aerosol_strat>0) THEN 5796 IF (prt_level >=10) THEN 5797 5797 PRINT *,'appel a readaerosolstrat', mth_cur 5798 5798 ENDIF 5799 IF (iflag_rrtm .EQ.0) THEN5800 IF (flag_aerosol_strat .EQ.1) THEN5799 IF (iflag_rrtm==0) THEN 5800 IF (flag_aerosol_strat==1) THEN 5801 5801 CALL readaerosolstrato(debut) 5802 5802 ELSE … … 5867 5867 5868 5868 ! 5869 IF (lon1_beta .EQ.-180..AND.lon2_beta.EQ.180..AND. &5870 lat1_beta .EQ.90..AND.lat2_beta.EQ.-90.) THEN5869 IF (lon1_beta==-180..AND.lon2_beta==180..AND. & 5870 lat1_beta==90..AND.lat2_beta==-90.) THEN 5871 5871 ! 5872 5872 ! global … … 5877 5877 DO k=1, klev 5878 5878 DO i=1, klon 5879 IF (pplay(i,k) .GE.pfree) THEN5879 IF (pplay(i,k)>=pfree) THEN 5880 5880 beta(i,k) = beta_pbl 5881 5881 ELSE … … 5899 5899 DO i=1,klon 5900 5900 ! 5901 IF (longitude_deg(i) .ge.lon1_beta.AND. &5902 longitude_deg(i) .le.lon2_beta.AND. &5903 latitude_deg(i) .le.lat1_beta.AND. &5904 latitude_deg(i) .ge.lat2_beta) THEN5905 IF (pplay(i,k) .GE.pfree) THEN5901 IF (longitude_deg(i)>=lon1_beta.AND. & 5902 longitude_deg(i)<=lon2_beta.AND. & 5903 latitude_deg(i)<=lat1_beta.AND. & 5904 latitude_deg(i)>=lat2_beta) THEN 5905 IF (pplay(i,k)>=pfree) THEN 5906 5906 beta(i,k) = beta_pbl 5907 5907 ELSE … … 5932 5932 !--this is needed for CMIP6 runs 5933 5933 !--and only possible for new radiation scheme 5934 IF (iflag_rrtm .EQ.1.AND.ok_suntime_rrtm) THEN5934 IF (iflag_rrtm==1.AND.ok_suntime_rrtm) THEN 5935 5935 #ifdef CPP_RRTM 5936 5936 CALL read_rsun_rrtm(debut) … … 5949 5949 !input to radiation (DICE) 5950 5950 ! 5951 IF (iflag_radia .ge.2) THEN5951 IF (iflag_radia >= 2) THEN 5952 5952 zsav_tsol (:) = zxtsol(:) 5953 5953 CALL perturb_radlwsw(zxtsol,iflag_radia) … … 5989 5989 IF (carbon_cycle_rad) RCO2=RCO2_glo 5990 5990 ! 5991 IF (prt_level .GE.10) THEN5991 IF (prt_level >=10) THEN 5992 5992 print *,' ->radlwsw, number 1 ' 5993 5993 ENDIF … … 6004 6004 t_seri,q_seri,wo, & 6005 6005 cldfrarad, cldemirad, cldtaurad, & 6006 ok_ade.OR.flag_aerosol_strat .GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &6006 ok_ade.OR.flag_aerosol_strat>0, ok_aie, ok_volcan, flag_volc_surfstrat, & 6007 6007 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & 6008 6008 tau_aero, piz_aero, cg_aero, & … … 6053 6053 !IM Par defaut on a les taux perturbes egaux aux taux actuels 6054 6054 ! 6055 IF (RCO2_per .NE.RCO2_act.OR. &6056 RCH4_per .NE.RCH4_act.OR. &6057 RN2O_per .NE.RN2O_act.OR. &6058 RCFC11_per .NE.RCFC11_act.OR. &6059 RCFC12_per .NE.RCFC12_act) ok_4xCO2atm =.TRUE.6055 IF (RCO2_per/=RCO2_act.OR. & 6056 RCH4_per/=RCH4_act.OR. & 6057 RN2O_per/=RN2O_act.OR. & 6058 RCFC11_per/=RCFC11_act.OR. & 6059 RCFC12_per/=RCFC12_act) ok_4xCO2atm =.TRUE. 6060 6060 ENDIF 6061 6061 ! … … 6068 6068 RCFC12 = RCFC12_per 6069 6069 ! 6070 IF (prt_level .GE.10) THEN6070 IF (prt_level >=10) THEN 6071 6071 print *,' ->radlwsw, number 2 ' 6072 6072 ENDIF … … 6083 6083 t_seri,q_seri,wo, & 6084 6084 cldfrarad, cldemirad, cldtaurad, & 6085 ok_ade.OR.flag_aerosol_strat .GT.0, ok_aie, ok_volcan, flag_volc_surfstrat, &6085 ok_ade.OR.flag_aerosol_strat>0, ok_aie, ok_volcan, flag_volc_surfstrat, & 6086 6086 flag_aerosol, flag_aerosol_strat, flag_aer_feedback, & 6087 6087 tau_aero, piz_aero, cg_aero, & … … 6169 6169 ! If Iflag_radia >=2, reset pertubed variables 6170 6170 ! 6171 IF (iflag_radia .ge.2) THEN6171 IF (iflag_radia >= 2) THEN 6172 6172 zxtsol(:) = zsav_tsol (:) 6173 6173 ENDIF -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90
r4982 r5082 45 45 DO i = 1, klon 46 46 47 if (ixt .eq.1) then48 if (fl_cor_ebil .GT.0) then47 if (ixt==1) then 48 if (fl_cor_ebil > 0) then 49 49 !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) 50 50 !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) … … 58 58 zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur)) 59 59 end if 60 IF (iflag_ice_thermo .EQ.0) THEN60 IF (iflag_ice_thermo == 0) THEN 61 61 zlsdcp=zlvdcp 62 62 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
