source: LMDZ6/trunk/libf/phylmdiso/reevap.F90 @ 5435

Last change on this file since 5435 was 5285, checked in by abarral, 8 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

File size: 3.9 KB
RevLine 
[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
[5285]17    USE yomcst_mod_h
[5284]18    USE yoethf_mod_h
[5274]19IMPLICIT none
[3927]20    !>======================================================================
21
22    INTEGER klon,klev,iflag_ice_thermo
[4982]23    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri
24    REAL, DIMENSION(klon,klev,nqtot), INTENT(in) ::     qx
25    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva
[5149]26    REAL, DIMENSION(klon,klev,nqtot), INTENT(out) ::    d_qx_eva
[3927]27
28    REAL za,zb,zdelta,zlvdcp,zlsdcp
[5274]29    INTEGER i,k,ixt,ivapcur,iliqcur,isolcur
[3927]30
31
32    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
[5274]33    !---Propri\'et\'es du thermiques au LCL
34
[3927]35    include "FCTTRE.h"
36    !IM 100106 BEG : pouvoir sortir les ctes de la physique
37    !
[5149]38    DO ixt = 1, 1+ntiso
[3927]39    ! Re-evaporer l'eau liquide nuageuse
40    !
[4982]41    iliqcur= iqWIsoPha(ixt,iliq)   
42    ivapcur= iqWIsoPha(ixt,ivap)   
43    isolcur= iqWIsoPha(ixt,isol)   
[3927]44!print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
45    DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
[5149]46      DO i = 1, klon
[4982]47
[5149]48        IF (ixt == 1) THEN ! water
49          IF (fl_cor_ebil > 0) THEN
50            !zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
51            !zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
52            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
53            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(qx(i,k,ivapcur)+qx(i,k,iliqcur)+qx(i,k,isolcur)))
54          ELSE
55            zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
56            !jyg<
57            !  Attention : Arnaud a propose des formules completement differentes
58            !                  A verifier !!!
59            zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*qx(i,k,ivapcur))
[4982]60         ENDIF
[5149]61          IF (iflag_ice_thermo == 0) THEN
62            zlsdcp=zlvdcp
63          ENDIF
[3927]64          !>jyg
[5149]65        ENDIF
66        IF (iflag_ice_thermo == 0) THEN   
67           !pas necessaire a priori
68
69            zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
70            zdelta = 0.
71            zb = MAX(0.0,qx(i,k,iliqcur))
72            IF (ixt == 1) THEN
73              za = - MAX(0.0,qx(i,k,iliqcur)) &
74                   * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
75              d_t_eva(i,k) = za
76            ENDIF
77            d_qx_eva(i,k,ivapcur)  = zb
78            d_qx_eva(i,k,iliqcur) = -qx(i,k,iliqcur)
79            d_qx_eva(i,k,isolcur) = 0.
80
81        ELSE
82             
[3927]83             !CR: on r\'e-\'evapore eau liquide et glace
84
85             !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
86             !        zb = MAX(0.0,ql_seri(i,k))
87             !        za = - MAX(0.0,ql_seri(i,k)) &
88             !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
[5149]89            IF (ixt == 1) THEN
90              za = - MAX(0.0,qx(i,k,iliqcur))*zlvdcp &
91                   - MAX(0.0,qx(i,k,iliqcur))*zlsdcp
92              d_t_eva(i,k) = za
93            ENDIF
[4982]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)
[3927]98
[4982]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)
[5149]103        ENDIF
[3927]104
[4982]105
[5149]106      ENDDO
[3927]107    ENDDO
108
[5149]109    ENDDO ! DO ixt = 1, 1+niso*(nzone +1)
[4982]110
[3927]111RETURN
112
113END SUBROUTINE reevap
Note: See TracBrowser for help on using the repository browser.