source: LMDZ6/trunk/libf/phylmd/lmdz_thermcell_qsat.f90 @ 5512

Last change on this file since 5512 was 5512, checked in by yann meurdesoif, 42 hours ago

Implement GPU automatic port for :

  • Thermics
  • acama_gwd_rando
  • flott_gwd_rando

YM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 3.1 KB
Line 
1MODULE lmdz_thermcell_qsat
2
3  REAL, PARAMETER :: DDT0=.01
4
5CONTAINS
6
7subroutine thermcell_qsat(klon, nlev, active,pplev,ztemp,zqta,zqsat)
8USE yoethf_mod_h
9  USE yomcst_mod_h
10
11
12implicit none
13
14
15  INCLUDE "FCTTRE.h"
16
17
18!====================================================================
19! DECLARATIONS
20!====================================================================
21
22! Arguments
23INTEGER, INTENT(IN) :: klon
24INTEGER, INTENT(IN) :: nlev  ! number of vertical to apply qsat
25REAL zpspsk(klon, nlev),pplev(klon, nlev)
26REAL ztemp(klon, nlev),zqta(klon,nlev),zqsat(klon,nlev)
27LOGICAL active(klon, nlev)
28
29! Variables locales
30INTEGER ig,iter
31REAL Tbef(klon,nlev),DT(klon,nlev)
32REAL tdelta,qsatbef,zcor,qlbef,zdelta,zcvm5,dqsat,num,denom,dqsat_dT
33logical Zsat
34REAL RLvCp
35
36LOGICAL afaire(klon, nlev),tout_converge
37INTEGER :: l
38!====================================================================
39! INITIALISATIONS
40!====================================================================
41
42RLvCp = RLVTT/RCPD
43tout_converge=.false.
44afaire(:,:)=.false.
45DT(:,:)=0.
46
47
48!====================================================================
49! Routine a vectoriser en copiant active dans converge et en mettant
50! la boucle sur les iterations a l'exterieur est en mettant
51! converge= false des que la convergence est atteinte.
52!====================================================================
53do l=1,nlev
54  do ig=1,klon
55     if (active(ig,l)) then
56               Tbef(ig,l)=ztemp(ig,l)
57               zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
58               qsatbef= R2ES * FOEEW(Tbef(ig,l),zdelta)/pplev(ig,l)
59               qsatbef=MIN(0.5,qsatbef)
60               zcor=1./(1.-retv*qsatbef)
61               qsatbef=qsatbef*zcor
62               qlbef=max(0.,zqta(ig,l)-qsatbef)
63               DT(ig) = 0.5*RLvCp*qlbef
64               zqsat(ig,l)=qsatbef
65     endif
66  enddo
67enddo
68! Traitement du cas ou il y a condensation mais faible
69! On ne condense pas mais on dit que le qsat est le qta
70do l=1,nlev
71  do ig=1,klon
72     if (active(ig,l)) then
73       if (0.<abs(DT(ig,l)).and.abs(DT(ig,l))<=DDT0) then
74           zqsat(ig,l)=zqta(ig,l)
75        endif
76     endif
77  enddo
78enddo
79
80do iter=1,10
81    do l=1,nlev
82      afaire(:,l)=abs(DT(:,l)).gt.DDT0
83      do ig=1,klon
84               if (afaire(ig,l)) then
85                 Tbef(ig,l)=Tbef(ig,l)+DT(ig,l)
86                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
87                 qsatbef= R2ES * FOEEW(Tbef(ig,l),zdelta)/pplev(ig,l)
88                 qsatbef=MIN(0.5,qsatbef)
89                 zcor=1./(1.-retv*qsatbef)
90                 qsatbef=qsatbef*zcor
91                 qlbef=zqta(ig,l)-qsatbef
92                 zdelta=MAX(0.,SIGN(1.,RTT-Tbef(ig,l)))
93                 zcvm5=R5LES*(1.-zdelta) + R5IES*zdelta
94                 zcor=1./(1.-retv*qsatbef)
95                 dqsat_dT=FOEDE(Tbef(ig,l),zdelta,zcvm5,qsatbef,zcor)
96                 num=-Tbef(ig,l)+ztemp(ig,l)+RLvCp*qlbef
97                 denom=1.+RLvCp*dqsat_dT
98                 zqsat(ig,l) = qsatbef
99                 DT(ig,l)=num/denom
100               endif
101      enddo
102    enddo
103enddo
104
105return
106end subroutine thermcell_qsat
107END MODULE lmdz_thermcell_qsat
Note: See TracBrowser for help on using the repository browser.