source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/thermcell_env.F90 @ 5003

Last change on this file since 5003 was 1330, checked in by idelkadi, 15 years ago

Optimisation des thermiques

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.4 KB
RevLine 
[878]1      SUBROUTINE thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
[1330]2     &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,pqsat,lev_out)
[878]3
4!--------------------------------------------------------------
5!thermcell_env: calcule les caracteristiques de l environnement
6!necessaires au calcul des proprietes dans le thermique
7!--------------------------------------------------------------
8
9      IMPLICIT NONE
10
11#include "YOMCST.h"
12#include "YOETHF.h"
13#include "FCTTRE.h"     
[938]14#include "iniprint.h"
[878]15
16      INTEGER ngrid,nlay
17      REAL po(ngrid,nlay)
18      REAL pt(ngrid,nlay)
19      REAL pu(ngrid,nlay)
20      REAL pv(ngrid,nlay)
21      REAL pplay(ngrid,nlay)
22      REAL pplev(ngrid,nlay+1)
23      integer lev_out                           ! niveau pour les print
24
25      REAL zo(ngrid,nlay)
26      REAL zl(ngrid,nlay)
27      REAL zh(ngrid,nlay)
28      REAL ztv(ngrid,nlay)
29      REAL zthl(ngrid,nlay)
30      REAL zpspsk(ngrid,nlay)
31      REAL zu(ngrid,nlay)
32      REAL zv(ngrid,nlay)
[1330]33      REAL pqsat(ngrid,nlay)
[878]34
[1330]35      INTEGER ig,ll
[878]36
[1330]37      real dqsat_dT
38      real RLvCp
[878]39
[1330]40logical mask(ngrid,nlay)
[970]41
[1330]42
43!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
44! Initialisations :
45!------------------
46
47print*,'THERMCELL ENV OPTIMISE '
48mask(:,:)=.true.
49RLvCp = RLVTT/RCPD
50
[878]51!
52! calcul des caracteristiques de l environnement
53       DO  ll=1,nlay
54         DO ig=1,ngrid
55            zo(ig,ll)=po(ig,ll)
56            zl(ig,ll)=0.
57            zh(ig,ll)=pt(ig,ll)
58         EndDO
59       EndDO
60!
61!
[1330]62! Condensation :
63!---------------
64! Calcul de l'humidite a saturation et de la condensation
65
66call thermcell_qsat(ngrid*nlay,mask,pplev,pt,po,pqsat)
67DO ll=1,nlay
68   DO ig=1,ngrid
69      zl(ig,ll) = max(0.,po(ig,ll)-pqsat(ig,ll))
70      zh(ig,ll) = pt(ig,ll)+RLvCp*zl(ig,ll)         !   T = Tl + Lv/Cp ql
71      zo(ig,ll) = po(ig,ll)-zl(ig,ll)
72   ENDDO
73ENDDO
[878]74!
75!
76!-----------------------------------------------------------------------
77
[938]78      if (prt_level.ge.1) print*,'0 OK convect8'
[878]79
[1330]80      DO ll=1,nlay
81         DO ig=1,ngrid
82             zpspsk(ig,ll)=(pplay(ig,ll)/100000.)**RKAPPA
83             zu(ig,ll)=pu(ig,ll)
84             zv(ig,ll)=pv(ig,ll)
[878]85!attention zh est maintenant le profil de T et plus le profil de theta !
[1330]86! Quelle horreur ! A eviter.
[878]87!
88!   T-> Theta
[1330]89            ztv(ig,ll)=zh(ig,ll)/zpspsk(ig,ll)
[878]90!Theta_v
[1330]91            ztv(ig,ll)=ztv(ig,ll)*(1.+RETV*(zo(ig,ll))-zl(ig,ll))
[878]92!Thetal
[1330]93            zthl(ig,ll)=pt(ig,ll)/zpspsk(ig,ll)
[878]94!           
[1330]95         ENDDO
96      ENDDO
[878]97 
98      RETURN
99      END
Note: See TracBrowser for help on using the repository browser.