source: LMDZ6/branches/Amaury_dev/libf/phylmdiso/reevap.F90 @ 5423

Last change on this file since 5423 was 5218, checked in by abarral, 3 months ago

Rename lmdz_xer.f90 to slatec_xer.f90
Rename lmdz_libmath_pch.f90 to slatec_libmath_pch.f90
Merge r5138, r5149 from trunk which had been missed in previous merges

File size: 3.7 KB
RevLine 
[5106]1  SUBROUTINE reevap(klon,klev,iflag_ice_thermo,t_seri,qx, &
[5087]2             d_t_eva,d_qx_eva)
[3927]3
4    ! flag to include modifications to ensure energy conservation (if flag >0)
[5101]5    USE add_phys_tend_mod, ONLY: fl_cor_ebil
[3927]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
[5088]13    USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille
[3927]14#endif
15#endif
[5088]16#endif
[5143]17
[5144]18    USE lmdz_yoethf
[5153]19
[5144]20    USE lmdz_yomcst
[5143]21
[5134]22    IMPLICIT NONE
[5153]23 INCLUDE "FCTTRE.h"
[3927]24    !>======================================================================
25
26    INTEGER klon,klev,iflag_ice_thermo
[5117]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
[5218]30    REAL, DIMENSION(klon,klev,nqtot), INTENT(OUT) ::    d_qx_eva
[3927]31
32    REAL za,zb,zdelta,zlvdcp,zlsdcp
[5088]33    INTEGER i,k,ixt,ivapcur,iliqcur,isolcur
[3927]34
35    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
[5099]36
[5218]37DO ixt = 1, 1+ntiso
[3927]38    ! Re-evaporer l'eau liquide nuageuse
[5099]39
[5088]40    iliqcur= iqWIsoPha(ixt,iliq)
41    ivapcur= iqWIsoPha(ixt,ivap)
42    isolcur= iqWIsoPha(ixt,isol)
[5160]43!PRINT *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
[3927]44    DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
[5218]45      DO i = 1, klon
[4982]46
[5218]47        IF (ixt == 1) THEN ! water
[5117]48         IF (fl_cor_ebil > 0) THEN
[4982]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)))
[5218]53         ELSE
[4982]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))
[5218]59         END IF
[5082]60         IF (iflag_ice_thermo == 0) THEN
[3927]61             zlsdcp=zlvdcp
[5218]62         END IF
[3927]63          !>jyg
[5218]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
[3927]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)
[5218]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
[3927]92
[5218]93          END IF
[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)
[5218]103        END IF
[3927]104
[4982]105
[5218]106      END DO
107    END DO
[3927]108
[5218]109    END DO ! DO ixt = 1, 1+niso*(nzone +1)
[4982]110
[5088]111
[3927]112
113END SUBROUTINE reevap
Note: See TracBrowser for help on using the repository browser.