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

Last change on this file since 5040 was 4982, checked in by crisi, 6 months ago

suppress isotope_params.def + update physiq_mod + proof of concept of 3rd dimension with reevap routine

File size: 3.3 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
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]37do 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]93RETURN
94
95END SUBROUTINE reevap
Note: See TracBrowser for help on using the repository browser.