source: LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_qsat.f90 @ 5450

Last change on this file since 5450 was 5390, checked in by yann meurdesoif, 3 weeks ago
  • Remove UTF8 character that inihibit fortran parsing with GPU morphosis
  • Add missing END SUBROUTINE instead of simple END, that inhibit correct parsing with regulat expression parser (quick and dirty parsing)

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