source: trunk/LMDZ.GENERIC/libf/phystd/thermcell_closure.F90 @ 2127

Last change on this file since 2127 was 2127, checked in by aboissinot, 6 years ago

Fix in convadj.F
New version of the thermal plume model (new entrainment and detrainment formulae, alimentation is removed)
File size: 3.1 KB
Line 
1!
2!
3!
4SUBROUTINE thermcell_closure(ngrid,nlay,ptimestep,rho,zlev,                   &
5                             lmax,alim_star,zmax,wmax,f)
6     
7!===============================================================================
8!  Purpose: fermeture, determination de f
9!
10! Modification 7 septembre 2009
11! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis
12! coherent avec l'integrale au numerateur.
13! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec
14! l'idee etant que le choix se fasse a l'appel de thermcell_closure
15! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if
16!===============================================================================
17     
18      USE thermcell_mod
19     
20      IMPLICIT NONE
21     
22     
23!===============================================================================
24! Declaration
25!===============================================================================
26     
27!     Inputs:
28!     -------
29     
30      INTEGER ngrid, nlay
31      INTEGER lmax(ngrid)
32     
33      REAL ptimestep
34      REAL rho(ngrid,nlay)
35      REAL zlev(ngrid,nlay)
36      REAL alim_star(ngrid,nlay)
37      REAL zmax(ngrid)
38      REAL wmax(ngrid)
39     
40!     Outputs:
41!     --------
42     
43      REAL f(ngrid)
44     
45!     Local:
46!     ------
47     
48      INTEGER ig, l
49      INTEGER llmax
50     
51      REAL alim_star_tot(ngrid)
52      REAL alim_star2(ngrid)
53      REAL zdenom(ngrid)
54     
55!===============================================================================
56! Initialization
57!===============================================================================
58     
59      alim_star2(:) = 0.
60      alim_star_tot(:) = 0.
61     
62      f(:) = 0.
63     
64      llmax = 1
65     
66!===============================================================================
67! Closure
68!===============================================================================
69     
70!-------------------------------------------------------------------------------
71! Indice vertical max atteint par les thermiques sur le domaine
72!-------------------------------------------------------------------------------
73     
74      DO ig=1,ngrid
75         IF (lmax(ig).GT.llmax) THEN
76            llmax = lmax(ig)
77         ENDIF
78      ENDDO
79     
80!-------------------------------------------------------------------------------
81! Calcul des integrales sur la verticale de alim_star et de alim_star^2/(rho dz)
82!-------------------------------------------------------------------------------
83     
84      DO l=1,llmax-1
85         DO ig=1,ngrid
86            IF (l < lmax(ig)) THEN
87               alim_star2(ig) = alim_star2(ig) + alim_star(ig,l)**2           &
88               &              / (rho(ig,l) * (zlev(ig,l+1) - zlev(ig,l)))
89               alim_star_tot(ig) = alim_star_tot(ig) + alim_star(ig,l)
90            ENDIF
91         ENDDO
92      ENDDO
93     
94      DO ig=1,ngrid
95         IF (alim_star2(ig).GT.0.) THEN
96            f(ig) = wmax(ig) * alim_star_tot(ig)                              &
97            &     / (max(1.,zmax(ig)) * r_aspect_thermals * alim_star2(ig))
98         ELSE
99            f(ig) = 0.
100         ENDIF
101      ENDDO
102     
103     
104RETURN
105END
Note: See TracBrowser for help on using the repository browser.