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	module diagphy_m
2
3	implicit none
4
5	contains
6
7	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
10	! From LMDZ4/libf/phylmd/diagphy.F, version 1.1.1.1, 2004/05/19 12:53:08
11
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	real, intent(in):: airephy(:) ! (klon) grid area
22	CHARACTER(len=15), intent(in):: tit ! comment to be added in PRINT
23	INTEGER, intent(in):: ip_ebil ! PRINT level (<=0 : no PRINT)
24	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
27	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	real, intent(in):: soll(klon)
32	! net longwave flux above surface (W/m2), positive up (i. e. flux
33	! emited - flux absorbed by the surface)
34
35	real, intent(in):: sens(klon)
36	! sensible Flux at surface (W/m2), positive down
37
38	real, intent(in):: evap(klon)
39	! evaporation + sublimation water vapour mass flux (kg/m2/s),
40	! positive up
41
42	real, intent(in):: rain_fall(klon)
43	! liquid water mass flux (kg/m2/s), positive down
44
45	real, intent(in):: snow_fall(klon)
46	! solid water mass flux (kg/m2/s), positive down
47
48	REAL, intent(in):: ts(klon) ! surface temperature (K)
49
50	REAL, intent(in):: d_etp_tot
51	! heat flux equivalent to atmospheric enthalpy change (W/m2)
52
53	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	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	IF (ip_ebil >= 1) then
72	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
84	! 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
90	zcpvap=RCPV-RCPD
91	zcwat=RCW-RCPD
92	zcice=RCS-RCPD
93
94	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
117	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
121	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
124	IF (ip_ebil >= 2) print 6667, tit, pas, stops, stopl, ssols, ssoll, &
125	ssens, slat, evap_tot, rain_fall_tot + snow_fall_tot
126	end IF
127
128	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
132	end SUBROUTINE diagphy
133
134	end module diagphy_m