source: LMDZ6/branches/contrails/libf/phylmd/lmdz_thermcell_env.f90 @ 5440

Last change on this file since 5440 was 5390, checked in by yann meurdesoif, 4 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.8 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!
40! calcul des caracteristiques de l environnement
41   DO  ll=1,nlay
42     DO ig=1,ngrid
43        zo(ig,ll)=po(ig,ll)
44        zl(ig,ll)=0.
45        zh(ig,ll)=pt(ig,ll)
46     enddo
47   enddo
48
49! Condensation :
50!---------------
51! Calcul de l'humidite a saturation et de la condensation
52
53   call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
54   do ll=1,nlay
55      do ig=1,ngrid
56         zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
57         zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
58         zo(ig,ll) = po(ig,ll)-zl(ig,ll)
59      enddo
60   enddo
61
62!-----------------------------------------------------------------------
63   if (prt_level.ge.1) print*,'0 OK convect8'
64
65   do ll=1,nlay
66      do ig=1,ngrid
67          zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
68          zu(ig,ll)=pu(ig,ll)
69          zv(ig,ll)=pv(ig,ll)
70!attention zh est maintenant le profil de T et plus le profil de theta !
71! Quelle horreur ! A eviter.
72!   T-> Theta
73            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
74!Theta_v
75            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
76!Thetal
77            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
78!           
79      enddo
80   enddo
81!CR: Calcul du niveau de congelation
82   do ig=1,ngrid
83      lcong(ig)=1
84      lintercong(ig)=0.
85   enddo
86   do ig=1,ngrid
87      do ll=1,nlay-1
88         if ((zh(ig,ll).gt.273.15).and.(zh(ig,ll+1).le.273.15)) then
89            lcong(ig)=ll+1
90            lintercong(ig)=(ll*(zh(ig,ll+1)-zh(ig,ll))  &
91     &               -zh(ig,ll)+273.15)/(zh(ig,ll+1)-zh(ig,ll))
92         endif
93      enddo
94   enddo
95 
96 RETURN
97   END SUBROUTINE thermcell_env
98END MODULE lmdz_thermcell_env
Note: See TracBrowser for help on using the repository browser.