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 | |
---|
18 | USE lmdz_yoethf |
---|
19 | |
---|
20 | USE lmdz_yomcst |
---|
21 | |
---|
22 | IMPLICIT NONE |
---|
23 | INCLUDE "FCTTRE.h" |
---|
24 | !>====================================================================== |
---|
25 | |
---|
26 | INTEGER klon,klev,iflag_ice_thermo |
---|
27 | REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri |
---|
28 | REAL, DIMENSION(klon,klev,nqtot), INTENT(IN) :: qx |
---|
29 | REAL, DIMENSION(klon,klev), INTENT(OUT) :: d_t_eva |
---|
30 | REAL, DIMENSION(klon,klev,nqtot), INTENT(OUT) :: d_qx_eva |
---|
31 | |
---|
32 | REAL za,zb,zdelta,zlvdcp,zlsdcp |
---|
33 | INTEGER i,k,ixt,ivapcur,iliqcur,isolcur |
---|
34 | |
---|
35 | !--------Stochastic Boundary Layer Triggering: ALE_BL-------- |
---|
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 ! water |
---|
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 | END IF |
---|
63 | !>jyg |
---|
64 | END IF |
---|
65 | IF (iflag_ice_thermo == 0) THEN |
---|
66 | !pas necessaire a priori |
---|
67 | |
---|
68 | zdelta = MAX(0., SIGN(1., RTT - t_seri(i, k))) |
---|
69 | zdelta = 0. |
---|
70 | zb = MAX(0.0, qx(i, k, iliqcur)) |
---|
71 | IF (ixt == 1) THEN |
---|
72 | za = - MAX(0.0, qx(i, k, iliqcur)) & |
---|
73 | * (zlvdcp * (1. - zdelta) + zlsdcp * zdelta) |
---|
74 | d_t_eva(i, k) = za |
---|
75 | END IF |
---|
76 | d_qx_eva(i, k, ivapcur) = zb |
---|
77 | d_qx_eva(i, k, iliqcur) = -qx(i, k, iliqcur) |
---|
78 | d_qx_eva(i, k, isolcur) = 0. |
---|
79 | |
---|
80 | ELSE |
---|
81 | |
---|
82 | !CR: on r\'e-\'evapore eau liquide et glace |
---|
83 | |
---|
84 | ! zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k))) |
---|
85 | ! zb = MAX(0.0,ql_seri(i,k)) |
---|
86 | ! za = - MAX(0.0,ql_seri(i,k)) & |
---|
87 | ! * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta) |
---|
88 | IF (ixt == 1) THEN |
---|
89 | za = - MAX(0.0, qx(i, k, iliqcur)) * zlvdcp & |
---|
90 | - MAX(0.0, qx(i, k, iliqcur)) * zlsdcp |
---|
91 | d_t_eva(i, k) = za |
---|
92 | |
---|
93 | END IF |
---|
94 | !zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k)) |
---|
95 | !d_q_eva(i,k) = zb |
---|
96 | !d_ql_eva(i,k) = -ql_seri(i,k) |
---|
97 | !d_qs_eva(i,k) = -qs_seri(i,k) |
---|
98 | |
---|
99 | zb = MAX(0.0,qx(i,k,iliqcur)+qx(i,k,isolcur)) |
---|
100 | d_qx_eva(i,k,ivapcur) = zb |
---|
101 | d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur) |
---|
102 | d_qx_eva(i,k,isolcur) = -qx(i,k,isolcur) |
---|
103 | END IF |
---|
104 | |
---|
105 | |
---|
106 | END DO |
---|
107 | END DO |
---|
108 | |
---|
109 | END DO ! DO ixt = 1, 1+niso*(nzone +1) |
---|
110 | |
---|
111 | |
---|
112 | |
---|
113 | END SUBROUTINE reevap |
---|