libf/phylmd/diagphy.f90

module diagphy_m

  implicit none

contains

  SUBROUTINE diagphy(airephy, tit, iprt, tops, topl, sols, soll, sens, evap, &
       rain_fall, snow_fall, ts, d_etp_tot, d_qt_tot, d_ec_tot, fs_bound, &
       fq_bound)

    ! From LMDZ4/libf/phylmd/diagphy.F, version 1.1.1.1 2004/05/19 12:53:08

    ! Purpose: compute the thermal flux and the water mass flux at
    ! the atmospheric boundaries. Print them and print the atmospheric
    ! enthalpy change and the atmospheric mass change.

    ! J.-L. Dufresne, July 2002

    USE dimphy, ONLY: klon
    USE suphec_m, ONLY: rcpd, rcpv, rcs, rcw, rlstt, rlvtt

    ! Arguments: 
    ! airephy-------input-R- grid area
    ! tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)
    ! iprt--------input-I- PRINT level (<=0 : no PRINT)
    ! tops(klon)--input-R- SW rad. at TOA (W/m2), positive up.
    ! sols(klon)--input-R- Net SW flux above surface (W/m2), positive up 
    ! (i.e. -1 * flux absorbed by the surface)
    ! soll(klon)--input-R- Net LW flux above surface (W/m2), positive up 
    ! (i.e. flux emited - flux absorbed by the surface)
    ! ts(klon)----input-R- Surface temperature (K)
    ! d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy 
    ! change (W/m2)
    ! d_qt_tot----input-R- Mass flux equivalent to atmospheric water mass 
    ! change (kg/m2/s)
    ! d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy
    ! change (W/m2)

    ! fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)
    ! fq_bound---output-R- Water mass flux at the atmosphere boundaries (kg/m2/s)
    ! Input variables
    real airephy(klon)
    CHARACTER*15 tit
    INTEGER iprt
    real tops(klon), sols(klon), soll(klon)
    real, intent(in):: topl(klon) !LW rad. at TOA (W/m2), positive down
    real sens(klon)
    ! sens(klon)--input-R- Sensible Flux at surface (W/m2), positive down
    real evap(klon)
    ! evap(klon)--input-R- Evaporation + sublimation water vapour mass flux
    ! (kg/m2/s), positive up

    real, intent(in):: rain_fall(klon)
    ! liquid water mass flux (kg/m2/s), positive down

    real snow_fall(klon)
    ! snow_fall(klon)
    ! --input-R- Solid water mass flux (kg/m2/s), positive down
    REAL ts(klon)
    REAL d_etp_tot, d_qt_tot, d_ec_tot
    ! Output variables
    REAL fs_bound, fq_bound

    ! Local variables
    real stops, stopl, ssols, ssoll
    real ssens, sfront, slat
    real airetot, zcpvap, zcwat, zcice
    REAL rain_fall_tot, snow_fall_tot, evap_tot

    integer i
    integer:: pas = 0

    !------------------------------------------------------------------

    pas=pas+1
    stops=0.
    stopl=0.
    ssols=0.
    ssoll=0.
    ssens=0.
    sfront = 0.
    evap_tot = 0.
    rain_fall_tot = 0.
    snow_fall_tot = 0.
    airetot=0.

    ! Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de
    ! la glace, on travaille par difference a la chaleur specifique de
    ! l' air sec. En effet, comme on travaille a niveau de pression
    ! donne, toute variation de la masse d'un constituant est
    ! totalement compense par une variation de masse d'air.

    zcpvap=RCPV-RCPD
    zcwat=RCW-RCPD
    zcice=RCS-RCPD

    do i=1, klon
       stops=stops+tops(i)*airephy(i)
       stopl=stopl+topl(i)*airephy(i)
       ssols=ssols+sols(i)*airephy(i)
       ssoll=ssoll+soll(i)*airephy(i)
       ssens=ssens+sens(i)*airephy(i)
       sfront = sfront &
            + (evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice) * ts(i) &
            * airephy(i)
       evap_tot = evap_tot + evap(i)*airephy(i)
       rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
       snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
       airetot=airetot+airephy(i)
    enddo
    stops=stops/airetot
    stopl=stopl/airetot
    ssols=ssols/airetot
    ssoll=ssoll/airetot
    ssens=ssens/airetot
    sfront = sfront/airetot
    evap_tot = evap_tot /airetot
    rain_fall_tot = rain_fall_tot/airetot
    snow_fall_tot = snow_fall_tot/airetot

    slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
    ! Heat flux at atm. boundaries
    fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront + slat
    ! Water flux at atm. boundaries
    fq_bound = evap_tot - rain_fall_tot -snow_fall_tot

    IF (iprt >= 1) print 6666, tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot

    IF (iprt >= 1) print 6668, tit, pas, d_etp_tot+d_ec_tot-fs_bound, &
         d_qt_tot-fq_bound

    IF (iprt >= 2) print 6667, tit, pas, stops, stopl, ssols, ssoll, ssens, &
         slat, evap_tot, rain_fall_tot+snow_fall_tot

6666 format('Phys. Flux Budget ', a15, 1i6, 2f8.2, 2(1pE13.5))
6667 format('Phys. Boundary Flux ', a15, 1i6, 6f8.2, 2(1pE13.5))
6668 format('Phys. Total Budget ', a15, 1i6, f8.2, 2(1pE13.5))

  end SUBROUTINE diagphy

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