/[lmdze]/trunk/libf/phylmd/diagetpq.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/diagetpq.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 51 - (hide annotations)
Tue Sep 20 09:14:34 2011 UTC (12 years, 7 months ago) by guez
File size: 8504 byte(s)
Split "getincom.f90" into "getincom.f90" and "getincom2.f90". Split
"nuage.f" into "nuage.f90", "diagcld1.f90" and "diagcld2.f90". Created
module "chem" from included file "chem.h". Moved "YOEGWD.f90" to
directory "Orography".

In "physiq", for evaporation of water, "zlsdcp" was equal to
"zlvdc". Removed useless variables.

1 guez 51 module diagetpq_m
2 guez 47
3 guez 51 IMPLICIT NONE
4 guez 47
5 guez 51 contains
6    
7     SUBROUTINE diagetpq(airephy, tit, iprt, idiag, idiag2, dtime, t, q, ql, qs, &
8     u, v, paprs, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
9    
10     ! From LMDZ4/libf/phylmd/diagphy.F, version 1.1.1.1 2004/05/19 12:53:08
11    
12     ! Purpose:
13    
14     ! Calcule la différence d'enthalpie et de masse d'eau entre deux
15     ! appels et calcule le flux de chaleur et le flux d'eau
16     ! nécessaires à ces changements. Ces valeurs sont moyennées sur la
17     ! surface de tout le globe et sont exprimées en W/m2 et
18     ! kg/s/m2. Outil pour diagnostiquer la conservation de l'énergie
19     ! et de la masse dans la physique. Suppose que les niveaux de
20     ! pression entre les couches ne varient pas entre deux appels.
21    
22     ! Plusieurs de ces diagnostics peuvent être faits en parallèle :
23     ! les bilans sont sauvegardés dans des tableaux indices. On
24     ! parlera "d'indice de diagnostic".
25    
26     ! Jean-Louis Dufresne, July 2002
27    
28     use dimens_m
29     use dimphy
30     use SUPHEC_M
31     use yoethf_m
32    
33     ! Arguments:
34     ! airephy-------input-R- grid area
35     ! tit-----imput-A15- Comment added in PRINT (CHARACTER*15)
36     ! iprt----input-I- PRINT level ( <=1 : no PRINT)
37     ! idiag---input-I- indice dans lequel sera range les nouveaux
38     ! bilans d' entalpie et de masse
39     ! idiag2--input-I-les nouveaux bilans d'entalpie et de masse
40     ! sont compare au bilan de d'enthalpie de masse de
41     ! l'indice numero idiag2
42     ! Cas particulier : si idiag2=0, pas de comparaison, on
43     ! sort directement les bilans d'enthalpie et de masse
44     ! dtime----input-R- time step (s)
45     ! t--------input-R- temperature (K)
46     ! q--------input-R- vapeur d'eau (kg/kg)
47     ! ql-------input-R- liquid water (kg/kg)
48     ! qs-------input-R- solid water (kg/kg)
49     ! u--------input-R- vitesse u
50     ! v--------input-R- vitesse v
51     ! paprs----input-R- pression a intercouche (Pa)
52    
53     ! the following total value are computed by UNIT of earth surface
54    
55     ! d_h_vcol--output-R- Heat flux (W/m2) define as the Enthalpy
56     ! change (J/m2) during one time step (dtime) for the whole
57     ! atmosphere (air, water vapour, liquid and solid)
58     ! d_qt------output-R- total water mass flux (kg/m2/s) defined as the
59     ! total water (kg/m2) change during one time step (dtime),
60     ! d_qw------output-R- same, for the water vapour only (kg/m2/s)
61     ! d_ql------output-R- same, for the liquid water only (kg/m2/s)
62     ! d_qs------output-R- same, for the solid water only (kg/m2/s)
63     ! d_ec------output-R- Kinetic Energy Budget (W/m2) for vertical air column
64    
65     ! other (COMMON...)
66     ! RCPD, RCPV, ....
67    
68     ! Input variables
69     real airephy(klon)
70     CHARACTER(len=15) tit
71     INTEGER iprt, idiag, idiag2
72     REAL, intent(in):: dtime
73     REAL, intent(in):: t(klon, klev)
74     REAL, intent(in):: q(klon, klev), ql(klon, klev), qs(klon, klev)
75     REAL u(klon, klev), v(klon, klev)
76     REAL, intent(in):: paprs(klon, klev+1)
77     ! Output variables
78     REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
79    
80     ! Local variables
81    
82     REAL h_vcol_tot, h_dair_tot, h_qw_tot, h_ql_tot, h_qs_tot, qw_tot, ql_tot
83     real qs_tot , ec_tot
84     ! h_vcol_tot-- total enthalpy of vertical air column
85     ! (air with water vapour, liquid and solid) (J/m2)
86     ! h_dair_tot-- total enthalpy of dry air (J/m2)
87     ! h_qw_tot---- total enthalpy of water vapour (J/m2)
88     ! h_ql_tot---- total enthalpy of liquid water (J/m2)
89     ! h_qs_tot---- total enthalpy of solid water (J/m2)
90     ! qw_tot------ total mass of water vapour (kg/m2)
91     ! ql_tot------ total mass of liquid water (kg/m2)
92     ! qs_tot------ total mass of solid water (kg/m2)
93     ! ec_tot------ total kinetic energy (kg/m2)
94    
95     REAL zairm(klon, klev) ! layer air mass (kg/m2)
96     REAL zqw_col(klon)
97     REAL zql_col(klon)
98     REAL zqs_col(klon)
99     REAL zec_col(klon)
100     REAL zh_dair_col(klon)
101     REAL zh_qw_col(klon), zh_ql_col(klon), zh_qs_col(klon)
102    
103     REAL d_h_dair, d_h_qw, d_h_ql, d_h_qs
104    
105     REAL airetot, zcpvap, zcwat, zcice
106    
107     INTEGER i, k
108    
109     INTEGER, PARAMETER:: ndiag = 10 ! max number of diagnostic in parallel
110     integer:: pas(ndiag) = 0
111    
112     REAL, save:: h_vcol_pre(ndiag), h_dair_pre(ndiag), h_qw_pre(ndiag)
113     REAL, save:: h_ql_pre(ndiag), h_qs_pre(ndiag), qw_pre(ndiag), ql_pre(ndiag)
114     REAL, save:: qs_pre(ndiag), ec_pre(ndiag)
115    
116     !-------------------------------------------------------------
117    
118     DO k = 1, klev
119     DO i = 1, klon
120     ! layer air mass
121     zairm(i, k) = (paprs(i, k)-paprs(i, k+1))/RG
122     ENDDO
123     END DO
124    
125     ! Reset variables
126     DO i = 1, klon
127     zqw_col(i)=0.
128     zql_col(i)=0.
129     zqs_col(i)=0.
130     zec_col(i) = 0.
131     zh_dair_col(i) = 0.
132     zh_qw_col(i) = 0.
133     zh_ql_col(i) = 0.
134     zh_qs_col(i) = 0.
135     ENDDO
136    
137     zcpvap=RCPV
138     zcwat=RCW
139     zcice=RCS
140    
141     ! Compute vertical sum for each atmospheric column
142     DO k = 1, klev
143     DO i = 1, klon
144     ! Water mass
145     zqw_col(i) = zqw_col(i) + q(i, k)*zairm(i, k)
146     zql_col(i) = zql_col(i) + ql(i, k)*zairm(i, k)
147     zqs_col(i) = zqs_col(i) + qs(i, k)*zairm(i, k)
148     ! Kinetic Energy
149     zec_col(i) = zec_col(i) +0.5*(u(i, k)**2+v(i, k)**2)*zairm(i, k)
150     ! Air enthalpy
151     zh_dair_col(i) = zh_dair_col(i) &
152     + RCPD*(1.-q(i, k)-ql(i, k)-qs(i, k))*zairm(i, k)*t(i, k)
153     zh_qw_col(i) = zh_qw_col(i) + zcpvap*q(i, k)*zairm(i, k)*t(i, k)
154     zh_ql_col(i) = zh_ql_col(i) &
155     + zcwat*ql(i, k)*zairm(i, k)*t(i, k) &
156     - RLVTT*ql(i, k)*zairm(i, k)
157     zh_qs_col(i) = zh_qs_col(i) &
158     + zcice*qs(i, k)*zairm(i, k)*t(i, k) &
159     - RLSTT*qs(i, k)*zairm(i, k)
160     END DO
161     ENDDO
162    
163     ! Mean over the planet surface
164     qw_tot = 0.
165     ql_tot = 0.
166     qs_tot = 0.
167     ec_tot = 0.
168     h_vcol_tot = 0.
169     h_dair_tot = 0.
170     h_qw_tot = 0.
171     h_ql_tot = 0.
172     h_qs_tot = 0.
173     airetot=0.
174    
175     do i=1, klon
176     qw_tot = qw_tot + zqw_col(i)*airephy(i)
177     ql_tot = ql_tot + zql_col(i)*airephy(i)
178     qs_tot = qs_tot + zqs_col(i)*airephy(i)
179     ec_tot = ec_tot + zec_col(i)*airephy(i)
180     h_dair_tot = h_dair_tot + zh_dair_col(i)*airephy(i)
181     h_qw_tot = h_qw_tot + zh_qw_col(i)*airephy(i)
182     h_ql_tot = h_ql_tot + zh_ql_col(i)*airephy(i)
183     h_qs_tot = h_qs_tot + zh_qs_col(i)*airephy(i)
184     airetot=airetot+airephy(i)
185     END DO
186    
187     qw_tot = qw_tot/airetot
188     ql_tot = ql_tot/airetot
189     qs_tot = qs_tot/airetot
190     ec_tot = ec_tot/airetot
191     h_dair_tot = h_dair_tot/airetot
192     h_qw_tot = h_qw_tot/airetot
193     h_ql_tot = h_ql_tot/airetot
194     h_qs_tot = h_qs_tot/airetot
195    
196     h_vcol_tot = h_dair_tot+h_qw_tot+h_ql_tot+h_qs_tot
197    
198     ! Compute the change of the atmospheric state compared to the one
199     ! stored in "idiag2", and convert it in flux. This computation is
200     ! performed if idiag2 /= 0 and if it is not the first call for
201     ! "idiag".
202    
203     IF ((idiag2 > 0) .and. (pas(idiag2) /= 0)) THEN
204     d_h_vcol = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
205     d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime
206     d_h_qw = (h_qw_tot - h_qw_pre(idiag2) )/dtime
207     d_h_ql = (h_ql_tot - h_ql_pre(idiag2) )/dtime
208     d_h_qs = (h_qs_tot - h_qs_pre(idiag2) )/dtime
209     d_qw = (qw_tot - qw_pre(idiag2) )/dtime
210     d_ql = (ql_tot - ql_pre(idiag2) )/dtime
211     d_qs = (qs_tot - qs_pre(idiag2) )/dtime
212     d_ec = (ec_tot - ec_pre(idiag2) )/dtime
213     d_qt = d_qw + d_ql + d_qs
214     ELSE
215     d_h_vcol = 0.
216     d_h_dair = 0.
217     d_h_qw = 0.
218     d_h_ql = 0.
219     d_h_qs = 0.
220     d_qw = 0.
221     d_ql = 0.
222     d_qs = 0.
223     d_ec = 0.
224     d_qt = 0.
225     ENDIF
226    
227     IF (iprt >= 2) THEN
228     WRITE(6, 9000) tit, pas(idiag), d_qt, d_qw, d_ql, d_qs
229     9000 format('Phys. Water Mass Budget (kg/m2/s)', A15, 1i6, 10(1pE14.6))
230     WRITE(6, 9001) tit, pas(idiag), d_h_vcol
231     9001 format('Phys. Enthalpy Budget (W/m2) ', A15, 1i6, 10(F8.2))
232     WRITE(6, 9002) tit, pas(idiag), d_ec
233     9002 format('Phys. Kinetic Energy Budget (W/m2) ', A15, 1i6, 10(F8.2))
234     END IF
235    
236     ! Store the new atmospheric state in "idiag"
237     pas(idiag)=pas(idiag)+1
238     h_vcol_pre(idiag) = h_vcol_tot
239     h_dair_pre(idiag) = h_dair_tot
240     h_qw_pre(idiag) = h_qw_tot
241     h_ql_pre(idiag) = h_ql_tot
242     h_qs_pre(idiag) = h_qs_tot
243     qw_pre(idiag) = qw_tot
244     ql_pre(idiag) = ql_tot
245     qs_pre(idiag) = qs_tot
246     ec_pre (idiag) = ec_tot
247    
248     END SUBROUTINE diagetpq
249    
250     end module diagetpq_m

  ViewVC Help
Powered by ViewVC 1.1.21