source: LMDZ6/branches/Amaury_dev/libf/phylmd/reevap.F90 @ 5160

Last change on this file since 5160 was 5160, checked in by abarral, 7 weeks ago

Put .h into modules

File size: 2.6 KB
RevLine 
[5143]1SUBROUTINE reevap(klon, klev, iflag_ice_thermo, t_seri, q_seri, ql_seri, qs_seri, &
2        d_t_eva, d_q_eva, d_ql_eva, d_qs_eva)
[2705]3
[5143]4  ! flag to include modifications to ensure energy conservation (if flag >0)
5  USE add_phys_tend_mod, ONLY: fl_cor_ebil
[5144]6  USE lmdz_yoethf
[5153]7
[5144]8  USE lmdz_yomcst
[2705]9
[5143]10  IMPLICIT NONE
[5153]11 INCLUDE "FCTTRE.h"
[5143]12  !>======================================================================
[2705]13
[5143]14  INTEGER klon, klev, iflag_ice_thermo
15  REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri, q_seri, ql_seri, qs_seri
16  REAL, DIMENSION(klon, klev), INTENT(OUT) :: d_t_eva, d_q_eva, d_ql_eva, d_qs_eva
[2705]17
[5143]18  REAL za, zb, zdelta, zlvdcp, zlsdcp
19  INTEGER i, k
[5099]20
[5143]21  !--------Stochastic Boundary Layer Triggering: ALE_BL--------
22  !---Propri\'et\'es du thermiques au LCL
23  !IM 100106 BEG : pouvoir sortir les ctes de la physique
[5099]24
[5143]25  ! Re-evaporer l'eau liquide nuageuse
[2705]26
[5160]27  !PRINT *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
[5143]28  DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
29    DO i = 1, klon
30      IF (fl_cor_ebil > 0) THEN
31        zlvdcp = RLVTT / RCPD / (1.0 + RVTMP2 * (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)))
32        zlsdcp = RLSTT / RCPD / (1.0 + RVTMP2 * (q_seri(i, k) + ql_seri(i, k) + qs_seri(i, k)))
33      else
34        zlvdcp = RLVTT / RCPD / (1.0 + RVTMP2 * q_seri(i, k))
35        !jyg<
36        !  Attention : Arnaud a propose des formules completement differentes
37        !                  A verifier !!!
38        zlsdcp = RLSTT / RCPD / (1.0 + RVTMP2 * q_seri(i, k))
39      end if
40      IF (iflag_ice_thermo == 0) THEN
41        zlsdcp = zlvdcp
42      ENDIF
43      !>jyg
[2705]44
[5143]45      IF (iflag_ice_thermo==0) THEN
46        !pas necessaire a priori
[2705]47
[5143]48        zdelta = MAX(0., SIGN(1., RTT - t_seri(i, k)))
49        zdelta = 0.
50        zb = MAX(0.0, ql_seri(i, k))
51        za = - MAX(0.0, ql_seri(i, k)) &
52                * (zlvdcp * (1. - zdelta) + zlsdcp * zdelta)
53        d_t_eva(i, k) = za
54        d_q_eva(i, k) = zb
55        d_ql_eva(i, k) = -ql_seri(i, k)
56        d_qs_eva(i, k) = 0.
[2705]57
[5143]58      ELSE
[2705]59
[5143]60        !CR: on r\'e-\'evapore eau liquide et glace
[2705]61
[5143]62        !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
63        !        zb = MAX(0.0,ql_seri(i,k))
64        !        za = - MAX(0.0,ql_seri(i,k)) &
65        !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
66        zb = MAX(0.0, ql_seri(i, k) + qs_seri(i, k))
67        za = - MAX(0.0, ql_seri(i, k)) * zlvdcp &
68                - MAX(0.0, qs_seri(i, k)) * zlsdcp
69        d_t_eva(i, k) = za
70        d_q_eva(i, k) = zb
71        d_ql_eva(i, k) = -ql_seri(i, k)
72        d_qs_eva(i, k) = -qs_seri(i, k)
73      ENDIF
74
[2705]75    ENDDO
[5143]76  ENDDO
[2705]77
78END SUBROUTINE reevap
Note: See TracBrowser for help on using the repository browser.