source: LMDZ6/branches/Test_modipsl/libf/phylmd/thermcell_alim.F90 @ 4582

Last change on this file since 4582 was 4089, checked in by fhourdin, 3 years ago

Reecriture des thermiques

File size: 3.9 KB
Line 
1!
2! $Id: thermcell_plume.F90 2311 2015-06-25 07:45:24Z emillour $
3!
4      SUBROUTINE thermcell_alim(flag,ngrid,klev,ztv,d_temp,zlev,alim_star,lalim)
5IMPLICIT NONE
6
7!--------------------------------------------------------------------------
8! FH : 2015/11/06
9! thermcell_alim: calcule la distribution verticale de l'alimentation
10! laterale a la base des panaches thermiques
11!--------------------------------------------------------------------------
12
13      INTEGER, INTENT(IN) :: ngrid,klev
14      REAL, INTENT(IN) :: ztv(ngrid,klev)
15      REAL, INTENT(IN) :: d_temp(ngrid)
16      REAL, INTENT(IN) :: zlev(ngrid,klev+1)
17      REAL, INTENT(OUT) :: alim_star(ngrid,klev)
18      INTEGER, INTENT(OUT) :: lalim(ngrid)
19      INTEGER, INTENT(IN) :: flag
20
21      REAL :: alim_star_tot(ngrid),zi(ngrid),zh(ngrid)
22      REAL :: zlay(ngrid,klev)
23      REAL ztv_parcel
24
25      INTEGER ig,l
26
27      REAL h,z,falim
28      falim(h,z)=0.2*((z-h)**5+h**5)
29
30
31!===================================================================
32
33   lalim(:)=1
34   alim_star_tot(:)=0.
35
36!-------------------------------------------------------------------------
37! Definition de l'alimentation
38!-------------------------------------------------------------------------
39   IF (flag==0) THEN ! CMIP5 version
40      do l=1,klev-1
41         do ig=1,ngrid
42            if (ztv(ig,l)> ztv(ig,l+1) .and. ztv(ig,1)>=ztv(ig,l) ) then
43               alim_star(ig,l)=MAX((ztv(ig,l)-ztv(ig,l+1)),0.)  &
44     &                       *sqrt(zlev(ig,l+1))
45               lalim(ig)=l+1
46               alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,l)
47            endif
48         enddo
49      enddo
50      do l=1,klev
51         do ig=1,ngrid
52            if (alim_star_tot(ig) > 1.e-10 ) then
53               alim_star(ig,l)=alim_star(ig,l)/alim_star_tot(ig)
54            endif
55         enddo
56      enddo
57      alim_star_tot(:)=1.
58
59!-------------------------------------------------------------------------
60! Nouvelle definition avec possibilite d'introduire un DT en surface
61! On suppose que la forme du profile d'alimentation scale avec la hauteur
62! d'inversion calculée avec une particule partant de la premieere couche
63
64! Fonction  f(z) = z ( h - z ) , avec h = zi/3
65! On utilise l'integralle
66! Int_0^z f(z') dz' = z^2 ( h/2 - z/3 ) = falim(h,z)
67! Pour calculer l'alimentation des couches
68!-------------------------------------------------------------------------
69   ELSE
70! Computing inversion height zi and zh=zi/3.
71      zi(:)=0.
72! Il faut recalculer zlay qui n'est pas dispo dans thermcell_plume
73! A changer eventuellement.
74      do l=1,klev
75         zlay(:,l)=0.5*(zlev(:,l)+zlev(:,l+1))
76      enddo
77
78      do l=klev-1,1,-1
79         do ig=1,ngrid
80            ztv_parcel=ztv(ig,1)+d_temp(ig)
81            if (ztv_parcel<ztv(ig,l+1)) lalim(ig)=l
82         enddo
83      enddo
84
85      do ig=1,ngrid
86         l=lalim(ig)
87         IF (l==1) THEN
88            zi(ig)=0.
89         ELSE
90            ztv_parcel=ztv(ig,1)+d_temp(ig)
91            zi(ig)=zlay(ig,l)+(zlay(ig,l+1)-zlay(ig,l))/(ztv(ig,l+1)-ztv(ig,l))*(ztv_parcel-ztv(ig,l))
92         ENDIF
93      enddo
94
95      zh(:)=zi(:)/2.
96      alim_star_tot(:)=0.
97      alim_star(:,:)=0.
98      lalim(:)=0
99      do l=1,klev-1
100         do ig=1,ngrid
101            IF (zh(ig)==0.) THEN
102               alim_star(ig,l)=0.
103               lalim(ig)=1
104            ELSE IF (zlev(ig,l+1)<=zh(ig)) THEN
105               alim_star(ig,l)=(falim(zh(ig),zlev(ig,l+1))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
106               lalim(ig)=l
107            ELSE IF (zlev(ig,l)<=zh(ig)) THEN
108               alim_star(ig,l)=(falim(zh(ig),zh(ig))-falim(zh(ig),zlev(ig,l)))/falim(zh(ig),zh(ig))
109               lalim(ig)=l
110            ELSE
111               alim_star(ig,l)=0.
112            ENDIF
113         ENDDO
114         alim_star_tot(:)=alim_star_tot(:)+alim_star(:,l)
115      ENDDO
116      IF (ngrid==1) print*,'NEW ALIM CALCUL DE ZI ',alim_star_tot,lalim,zi,zh
117      alim_star_tot(:)=1.
118
119   ENDIF
120
121
122RETURN
123END
Note: See TracBrowser for help on using the repository browser.