/[lmdze]/trunk/phylmd/diagphy.f
ViewVC logotype

Annotation of /trunk/phylmd/diagphy.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 47 - (hide annotations)
Fri Jul 1 15:00:48 2011 UTC (12 years, 11 months ago) by guez
Original Path: trunk/libf/phylmd/diagphy.f
File size: 5101 byte(s)
Split "thermcell.f" and "cv3_routines.f".
Removed copies of files that are now in "L_util".
Moved "mva9" and "diagetpq" to their own files.
Unified variable names across procedures.

1 guez 3 !
2     ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/diagphy.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $
3     !
4     SUBROUTINE diagphy(airephy,tit,iprt
5     $ , tops, topl, sols, soll, sens
6     $ , evap, rain_fall, snow_fall, ts
7     $ , d_etp_tot, d_qt_tot, d_ec_tot
8     $ , fs_bound, fq_bound)
9     C======================================================================
10     C
11     C Purpose:
12     C Compute the thermal flux and the watter mass flux at the atmosphere
13     c boundaries. Print them and also the atmospheric enthalpy change and
14     C the atmospheric mass change.
15     C
16     C Arguments:
17     C airephy-------input-R- grid area
18     C tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
19     C iprt--------input-I- PRINT level ( <=0 : no PRINT)
20     C tops(klon)--input-R- SW rad. at TOA (W/m2), positive up.
21     C topl(klon)--input-R- LW rad. at TOA (W/m2), positive down
22     C sols(klon)--input-R- Net SW flux above surface (W/m2), positive up
23     C (i.e. -1 * flux absorbed by the surface)
24     C soll(klon)--input-R- Net LW flux above surface (W/m2), positive up
25     C (i.e. flux emited - flux absorbed by the surface)
26     C sens(klon)--input-R- Sensible Flux at surface (W/m2), positive down
27     C evap(klon)--input-R- Evaporation + sublimation watter vapour mass flux
28     C (kg/m2/s), positive up
29     C rain_fall(klon)
30     C --input-R- Liquid watter mass flux (kg/m2/s), positive down
31     C snow_fall(klon)
32     C --input-R- Solid watter mass flux (kg/m2/s), positive down
33     C ts(klon)----input-R- Surface temperature (K)
34     C d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy
35     C change (W/m2)
36     C d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass
37     C change (kg/m2/s)
38     C d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
39     C change (W/m2)
40     C
41     C fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
42     C fq_bound---output-R- Watter mass flux at the atmosphere boundaries (kg/m2/s)
43     C
44     C J.L. Dufresne, July 2002
45     C======================================================================
46     C
47     use dimens_m
48     use dimphy
49 guez 38 use SUPHEC_M
50     use yoethf_m
51 guez 3 implicit none
52    
53     C
54     C Input variables
55     real airephy(klon)
56     CHARACTER*15 tit
57     INTEGER iprt
58     real tops(klon),topl(klon),sols(klon),soll(klon)
59     real sens(klon),evap(klon),rain_fall(klon),snow_fall(klon)
60     REAL ts(klon)
61     REAL d_etp_tot, d_qt_tot, d_ec_tot
62     c Output variables
63     REAL fs_bound, fq_bound
64     C
65     C Local variables
66     real stops,stopl,ssols,ssoll
67     real ssens,sfront,slat
68     real airetot, zcpvap, zcwat, zcice
69     REAL rain_fall_tot, snow_fall_tot, evap_tot
70     C
71     integer i
72     C
73     integer pas
74     save pas
75     data pas/0/
76     C
77     pas=pas+1
78     stops=0.
79     stopl=0.
80     ssols=0.
81     ssoll=0.
82     ssens=0.
83     sfront = 0.
84     evap_tot = 0.
85     rain_fall_tot = 0.
86     snow_fall_tot = 0.
87     airetot=0.
88     C
89     C Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
90     C la glace, on travaille par difference a la chaleur specifique de l'
91     c air sec. En effet, comme on travaille a niveau de pression donne,
92     C toute variation de la masse d'un constituant est totalement
93     c compense par une variation de masse d'air.
94     C
95     zcpvap=RCPV-RCPD
96     zcwat=RCW-RCPD
97     zcice=RCS-RCPD
98     C
99     do i=1,klon
100     stops=stops+tops(i)*airephy(i)
101     stopl=stopl+topl(i)*airephy(i)
102     ssols=ssols+sols(i)*airephy(i)
103     ssoll=ssoll+soll(i)*airephy(i)
104     ssens=ssens+sens(i)*airephy(i)
105     sfront = sfront
106     $ + ( evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice
107     $ ) *ts(i) *airephy(i)
108     evap_tot = evap_tot + evap(i)*airephy(i)
109     rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
110     snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
111     airetot=airetot+airephy(i)
112     enddo
113     stops=stops/airetot
114     stopl=stopl/airetot
115     ssols=ssols/airetot
116     ssoll=ssoll/airetot
117     ssens=ssens/airetot
118     sfront = sfront/airetot
119     evap_tot = evap_tot /airetot
120     rain_fall_tot = rain_fall_tot/airetot
121     snow_fall_tot = snow_fall_tot/airetot
122     C
123     slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
124     C Heat flux at atm. boundaries
125     fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront
126     $ + slat
127     C Watter flux at atm. boundaries
128     fq_bound = evap_tot - rain_fall_tot -snow_fall_tot
129     C
130     IF (iprt.ge.1) write(6,6666)
131     $ tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot
132     C
133     IF (iprt.ge.1) write(6,6668)
134     $ tit, pas, d_etp_tot+d_ec_tot-fs_bound, d_qt_tot-fq_bound
135     C
136     IF (iprt.ge.2) write(6,6667)
137     $ tit, pas, stops,stopl,ssols,ssoll,ssens,slat,evap_tot
138     $ ,rain_fall_tot+snow_fall_tot
139    
140     return
141    
142     6666 format('Phys. Flux Budget ',a15,1i6,2f8.2,2(1pE13.5))
143     6667 format('Phys. Boundary Flux ',a15,1i6,6f8.2,2(1pE13.5))
144     6668 format('Phys. Total Budget ',a15,1i6,f8.2,2(1pE13.5))
145    
146     end

  ViewVC Help
Powered by ViewVC 1.1.21