[4982] | 1 | SUBROUTINE reevap (klon,klev,iflag_ice_thermo,t_seri,qx, & |
---|
| 2 | & d_t_eva,d_qx_eva) |
---|
[3927] | 3 | |
---|
| 4 | ! flag to include modifications to ensure energy conservation (if flag >0) |
---|
| 5 | USE add_phys_tend_mod, only : fl_cor_ebil |
---|
| 6 | #ifdef ISO |
---|
[4982] | 7 | USE infotrac_phy, ONLY: ntiso,nqtot,ivap,iliq,isol,iqWIsoPha |
---|
[3927] | 8 | #ifdef ISOVERIF |
---|
| 9 | USE isotopes_verif_mod |
---|
| 10 | !, ONLY: errmax,errmaxrel, iso_verif_o18_aberrant_nostop,deltaD,deltaO |
---|
| 11 | USE isotopes_mod, ONLY: iso_eau,iso_hdo,iso_o18,ridicule |
---|
| 12 | #ifdef ISOTRAC |
---|
| 13 | USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille |
---|
| 14 | #endif |
---|
| 15 | #endif |
---|
| 16 | #endif |
---|
| 17 | IMPLICIT none |
---|
| 18 | !>====================================================================== |
---|
| 19 | |
---|
| 20 | INTEGER klon,klev,iflag_ice_thermo |
---|
[4982] | 21 | REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri |
---|
| 22 | REAL, DIMENSION(klon,klev,nqtot), INTENT(in) :: qx |
---|
| 23 | REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva |
---|
| 24 | REAL, DIMENSION(klon,klev,nqtot), INTENT(out) :: d_qx_eva |
---|
[3927] | 25 | |
---|
| 26 | REAL za,zb,zdelta,zlvdcp,zlsdcp |
---|
[4982] | 27 | INTEGER i,k,ixt,ivapcur,iliqcur,isolcur |
---|
[3927] | 28 | |
---|
| 29 | |
---|
| 30 | !--------Stochastic Boundary Layer Triggering: ALE_BL-------- |
---|
| 31 | !---Propri\'et\'es du thermiques au LCL |
---|
| 32 | include "YOMCST.h" |
---|
| 33 | include "YOETHF.h" |
---|
| 34 | include "FCTTRE.h" |
---|
| 35 | !IM 100106 BEG : pouvoir sortir les ctes de la physique |
---|
| 36 | ! |
---|
[4982] | 37 | do ixt=1,1+ntiso |
---|
[3927] | 38 | ! Re-evaporer l'eau liquide nuageuse |
---|
| 39 | ! |
---|
[4982] | 40 | iliqcur= iqWIsoPha(ixt,iliq) |
---|
| 41 | ivapcur= iqWIsoPha(ixt,ivap) |
---|
| 42 | isolcur= iqWIsoPha(ixt,isol) |
---|
[3927] | 43 | !print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2 |
---|
| 44 | DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse |
---|
| 45 | DO i = 1, klon |
---|
[4982] | 46 | |
---|
| 47 | if (ixt.eq.1) then |
---|
| 48 | if (fl_cor_ebil .GT. 0) then |
---|
| 49 | !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) |
---|
| 50 | !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) |
---|
| 51 | zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur))) |
---|
| 52 | zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur))) |
---|
| 53 | else |
---|
| 54 | zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur)) |
---|
| 55 | !jyg< |
---|
| 56 | ! Attention : Arnaud a propose des formules completement differentes |
---|
| 57 | ! A verifier !!! |
---|
| 58 | zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur)) |
---|
| 59 | end if |
---|
| 60 | IF (iflag_ice_thermo .EQ. 0) THEN |
---|
[3927] | 61 | zlsdcp=zlvdcp |
---|
[4982] | 62 | ENDIF |
---|
[3927] | 63 | !>jyg |
---|
| 64 | !CR: on r\'e-\'evapore eau liquide et glace |
---|
| 65 | |
---|
| 66 | ! zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k))) |
---|
| 67 | ! zb = MAX(0.0,ql_seri(i,k)) |
---|
| 68 | ! za = - MAX(0.0,ql_seri(i,k)) & |
---|
| 69 | ! * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta) |
---|
[4982] | 70 | za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp & |
---|
| 71 | - MAX(0.0,qx(i,k,iliqcur))*zlsdcp |
---|
[3927] | 72 | d_t_eva(i,k) = za |
---|
| 73 | |
---|
[4982] | 74 | endif !if (ixt.eq.1) then |
---|
[3927] | 75 | |
---|
[4982] | 76 | !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k)) |
---|
| 77 | !d_q_eva(i,k) = zb |
---|
| 78 | !d_ql_eva(i,k) = -ql_seri(i,k) |
---|
| 79 | !d_qs_eva(i,k) = -qs_seri(i,k) |
---|
[3927] | 80 | |
---|
[4982] | 81 | zb = MAX(0.0,qx(i,k,iliqcur)+qx(i,k,isolcur)) |
---|
| 82 | d_qx_eva(i,k,ivapcur) = zb |
---|
| 83 | d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur) |
---|
| 84 | d_qx_eva(i,k,isolcur) = -qx(i,k,isolcur) |
---|
[3927] | 85 | |
---|
[4982] | 86 | |
---|
[3927] | 87 | ENDDO |
---|
| 88 | ENDDO |
---|
| 89 | |
---|
[4982] | 90 | enddo ! do ixt=1,1+niso*(nzone +1) |
---|
| 91 | |
---|
| 92 | |
---|
[3927] | 93 | RETURN |
---|
| 94 | |
---|
| 95 | END SUBROUTINE reevap |
---|