source: LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_env.F90 @ 5128

Last change on this file since 5128 was 5117, checked in by abarral, 5 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.7 KB
Line 
1MODULE lmdz_thermcell_env
2CONTAINS
3
4   SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
5             pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lcong,lintercong,lev_out)
6
7!--------------------------------------------------------------
8!thermcell_env: calcule les caracteristiques de l environnement
9!necessaires au calcul des proprietes dans le thermique
10!--------------------------------------------------------------
11
12
13   USE lmdz_thermcell_ini, ONLY: prt_level,RLvCp,RKAPPA,RETV
14   USE lmdz_thermcell_qsat, ONLY: thermcell_qsat
15   IMPLICIT NONE
16
17! arguments
18
19   INTEGER,INTENT(IN) :: ngrid,nlay,lev_out
20   REAL,INTENT(IN), DIMENSION(ngrid,nlay) :: po,pt,pu,pv,pplay
21   REAL,INTENT(IN), DIMENSION(ngrid,nlay+1) :: pplev
22   REAL,INTENT(OUT), DIMENSION(ngrid,nlay) :: zo,zl,zh,ztv,zthl
23   REAL,INTENT(OUT), DIMENSION(ngrid,nlay) :: zpspsk,zu,zv,pqsat
24   REAL, INTENT(OUT), DIMENSION(ngrid) :: lintercong
25   INTEGER, INTENT(OUT), DIMENSION(ngrid) :: lcong
26! Local
27
28   INTEGER ig,ll
29   REAL dqsat_dT
30   LOGICAL mask(ngrid,nlay)
31
32
33!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
34! Initialisations :
35!------------------
36
37   mask(:,:)=.TRUE.
38
39! calcul des caracteristiques de l environnement
40   DO  ll=1,nlay
41     DO ig=1,ngrid
42        zo(ig,ll)=po(ig,ll)
43        zl(ig,ll)=0.
44        zh(ig,ll)=pt(ig,ll)
45     enddo
46   enddo
47
48! Condensation :
49!---------------
50! Calcul de l'humidite a saturation et de la condensation
51
52   CALL thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
53   do ll=1,nlay
54      do ig=1,ngrid
55         zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
56         zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
57         zo(ig,ll) = po(ig,ll)-zl(ig,ll)
58      enddo
59   enddo
60
61!-----------------------------------------------------------------------
62   IF (prt_level>=1) PRINT*,'0 OK convect8'
63
64   do ll=1,nlay
65      do ig=1,ngrid
66          zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
67          zu(ig,ll)=pu(ig,ll)
68          zv(ig,ll)=pv(ig,ll)
69!attention zh est maintenant le profil de T et plus le profil de theta !
70! Quelle horreur ! A eviter.
71!   T-> Theta
72            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
73!Theta_v
74            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
75!Thetal
76            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
77
78      enddo
79   enddo
80!CR: Calcul du niveau de congelation
81   do ig=1,ngrid
82      lcong(ig)=1
83      lintercong(ig)=0.
84   enddo
85   do ig=1,ngrid
86      do ll=1,nlay-1
87         IF ((zh(ig,ll)>273.15).AND.(zh(ig,ll+1)<=273.15)) THEN
88            lcong(ig)=ll+1
89            lintercong(ig)=(ll*(zh(ig,ll+1)-zh(ig,ll))  &
90                 -zh(ig,ll)+273.15)/(zh(ig,ll+1)-zh(ig,ll))
91         endif
92      enddo
93   enddo
94 
95 RETURN
96   END
97END MODULE lmdz_thermcell_env
Note: See TracBrowser for help on using the repository browser.