Sources/phylmd/diagphy.f

module diagphy_m

  implicit none

contains

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

    ! 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

    real, intent(in):: airephy(:) ! (klon) grid area
    CHARACTER(len=15), intent(in):: tit ! comment to be added in PRINT
    INTEGER, intent(in):: ip_ebil ! PRINT level (<=0 : no PRINT)
    real, intent(in):: tops(klon) ! SW rad. at TOA (W/m2), positive up
    real, intent(in):: topl(klon) ! LW rad. at TOA (W/m2), positive down

    real, intent(in):: sols(klon)
    ! net SW flux above surface (W/m2), positive up (i.e. -1 * flux
    ! absorbed by the surface)

    real, intent(in):: soll(klon)
    ! net longwave flux above surface (W/m2), positive up (i. e. flux
    ! emited - flux absorbed by the surface)

    real, intent(in):: sens(klon)
    ! sensible Flux at surface (W/m2), positive down

    real, intent(in):: evap(klon)
    ! 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, intent(in):: snow_fall(klon)
    ! solid water mass flux (kg/m2/s), positive down

    REAL, intent(in):: ts(klon) ! surface temperature (K)

    REAL, intent(in):: d_etp_tot
    ! heat flux equivalent to atmospheric enthalpy change (W/m2)

    REAL, intent(in):: d_qt_tot
    ! Mass flux equivalent to atmospheric water mass change (kg/m2/s)

    REAL, intent(in):: d_ec_tot
    ! flux equivalent to atmospheric cinetic energy change (W/m2)

    ! Local:
    REAL fs_bound ! thermal flux at the atmosphere boundaries (W/m2)
    real fq_bound ! water mass flux at the atmosphere boundaries (kg/m2/s)
    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

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

    IF (ip_ebil >= 1) then
       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 chaleurs spécifiques de la vapeur d'eau, de l'eau et de
       ! la glace, on travaille par différence à la chaleur spécifique de
       ! l'air sec. En effet, comme on travaille à niveau de pression
       ! donné, toute variation de la masse d'un constituant est
       ! totalement compensée 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
       fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront + slat
       fq_bound = evap_tot - rain_fall_tot -snow_fall_tot

       print 6666, tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot
       print 6668, tit, pas, d_etp_tot+d_ec_tot-fs_bound, d_qt_tot - fq_bound

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

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