source: LMDZ6/trunk/libf/phylmd/reevap.f90 @ 5810

Last change on this file since 5810 was 5810, checked in by rkazeroni, 2 months ago

For GPU porting of reevap routine:

  • Put routine into module (speeds up source-to-source transformation)
  • Add "horizontal" comment to specify possible names of horizontal variables
File size: 2.8 KB
Line 
1!$gpum horizontal klon
2MODULE reevap_mod
3  PRIVATE
4
5  PUBLIC reevap
6
7  CONTAINS
8
9SUBROUTINE reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
10   &         d_t_eva,d_q_eva,d_ql_eva,d_qs_eva)
11
12    ! flag to include modifications to ensure energy conservation (if flag >0)
13    USE add_phys_tend_mod, only : fl_cor_ebil
14   
15    USE yomcst_mod_h
16    USE yoethf_mod_h
17IMPLICIT none
18    !>======================================================================
19
20    INTEGER klon,klev,iflag_ice_thermo
21    REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri,q_seri,ql_seri,qs_seri
22    REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva
23
24    REAL za,zb,zdelta,zlvdcp,zlsdcp
25    INTEGER i,k
26
27    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
28    !---Propri\'et\'es du thermiques au LCL
29
30    include "FCTTRE.h"
31    !IM 100106 BEG : pouvoir sortir les ctes de la physique
32    !
33    ! Re-evaporer l'eau liquide nuageuse
34    !
35!print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2
36    DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
37       DO i = 1, klon
38        if (fl_cor_ebil .GT. 0) then
39          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
40          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k)))
41        else
42          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
43          !jyg<
44          !  Attention : Arnaud a propose des formules completement differentes
45          !                  A verifier !!!
46          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
47        end if
48          IF (iflag_ice_thermo .EQ. 0) THEN
49             zlsdcp=zlvdcp
50          ENDIF
51          !>jyg
52
53          IF (iflag_ice_thermo.eq.0) THEN   
54             !pas necessaire a priori
55
56             zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
57  zdelta = 0.
58             zb = MAX(0.0,ql_seri(i,k))
59             za = - MAX(0.0,ql_seri(i,k)) &
60                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
61             d_t_eva(i,k) = za
62             d_q_eva(i,k) = zb
63             d_ql_eva(i,k) = -ql_seri(i,k)
64             d_qs_eva(i,k) = 0.
65
66          ELSE
67
68             !CR: on r\'e-\'evapore eau liquide et glace
69
70             !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
71             !        zb = MAX(0.0,ql_seri(i,k))
72             !        za = - MAX(0.0,ql_seri(i,k)) &
73             !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
74             zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
75             za = - MAX(0.0,ql_seri(i,k))*zlvdcp &
76                  - MAX(0.0,qs_seri(i,k))*zlsdcp
77             d_t_eva(i,k) = za
78             d_q_eva(i,k) = zb
79             d_ql_eva(i,k) = -ql_seri(i,k)
80             d_qs_eva(i,k) = -qs_seri(i,k)
81          ENDIF
82
83       ENDDO
84    ENDDO
85
86RETURN
87
88END SUBROUTINE reevap
89
90END MODULE reevap_mod
Note: See TracBrowser for help on using the repository browser.