1 | SUBROUTINE reevap(klon,klev,iflag_ice_thermo,t_seri,qx, & |
---|
2 | d_t_eva,d_qx_eva) |
---|
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 |
---|
7 | USE infotrac_phy, ONLY: ntiso,nqtot,ivap,iliq,isol,iqWIsoPha |
---|
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 |
---|
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 |
---|
25 | |
---|
26 | REAL za,zb,zdelta,zlvdcp,zlsdcp |
---|
27 | INTEGER i,k,ixt,ivapcur,iliqcur,isolcur |
---|
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 | |
---|
37 | DO ixt=1,1+ntiso |
---|
38 | ! Re-evaporer l'eau liquide nuageuse |
---|
39 | |
---|
40 | iliqcur= iqWIsoPha(ixt,iliq) |
---|
41 | ivapcur= iqWIsoPha(ixt,ivap) |
---|
42 | isolcur= iqWIsoPha(ixt,isol) |
---|
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 |
---|
46 | |
---|
47 | IF (ixt==1) THEN |
---|
48 | IF (fl_cor_ebil > 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 == 0) THEN |
---|
61 | zlsdcp=zlvdcp |
---|
62 | ENDIF |
---|
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) |
---|
70 | za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp & |
---|
71 | - MAX(0.0,qx(i,k,iliqcur))*zlsdcp |
---|
72 | d_t_eva(i,k) = za |
---|
73 | |
---|
74 | endif !if (ixt.EQ.1) THEN |
---|
75 | !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k)) |
---|
76 | !d_q_eva(i,k) = zb |
---|
77 | !d_ql_eva(i,k) = -ql_seri(i,k) |
---|
78 | !d_qs_eva(i,k) = -qs_seri(i,k) |
---|
79 | |
---|
80 | zb = MAX(0.0,qx(i,k,iliqcur)+qx(i,k,isolcur)) |
---|
81 | d_qx_eva(i,k,ivapcur) = zb |
---|
82 | d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur) |
---|
83 | d_qx_eva(i,k,isolcur) = -qx(i,k,isolcur) |
---|
84 | |
---|
85 | |
---|
86 | ENDDO |
---|
87 | ENDDO |
---|
88 | |
---|
89 | enddo ! do ixt=1,1+niso*(nzone +1) |
---|
90 | |
---|
91 | |
---|
92 | |
---|
93 | |
---|
94 | END SUBROUTINE reevap |
---|