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

Diff of /trunk/Sources/phylmd/diagphy.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/phylmd/diagphy.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC trunk/Sources/phylmd/diagphy.f revision 203 by guez, Wed Jun 8 15:10:12 2016 UTC
# Line 4  module diagphy_m Line 4  module diagphy_m
4    
5  contains  contains
6    
7    SUBROUTINE diagphy(airephy, tit, iprt, tops, topl, sols, soll, sens, evap, &    SUBROUTINE diagphy(airephy, tit, ip_ebil, tops, topl, sols, soll, sens, &
8         rain_fall, snow_fall, ts, d_etp_tot, d_qt_tot, d_ec_tot, fs_bound, &         evap, rain_fall, snow_fall, ts, d_etp_tot, d_qt_tot, d_ec_tot)
        fq_bound)  
9    
10      ! From LMDZ4/libf/phylmd/diagphy.F, version 1.1.1.1 2004/05/19 12:53:08      ! 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      ! Purpose: compute the thermal flux and the water mass flux at
13      ! the atmospheric boundaries. Print them and print the atmospheric      ! the atmospheric boundaries. Print them and print the atmospheric
# Line 19  contains Line 18  contains
18      USE dimphy, ONLY: klon      USE dimphy, ONLY: klon
19      USE suphec_m, ONLY: rcpd, rcpv, rcs, rcw, rlstt, rlvtt      USE suphec_m, ONLY: rcpd, rcpv, rcs, rcw, rlstt, rlvtt
20    
21      ! Arguments:      real, intent(in):: airephy(:) ! (klon) grid area
22        CHARACTER(len=15), intent(in):: tit ! comment to be added in PRINT
23      ! Input variables      INTEGER, intent(in):: ip_ebil ! PRINT level (<=0 : no PRINT)
24      real airephy(klon)      real, intent(in):: tops(klon) ! SW rad. at TOA (W/m2), positive up
25      ! airephy-------input-R- grid area      real, intent(in):: topl(klon) ! LW rad. at TOA (W/m2), positive down
26      CHARACTER(len=15) tit  
27      ! tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)      real, intent(in):: sols(klon)
28      INTEGER iprt      ! net SW flux above surface (W/m2), positive up (i.e. -1 * flux
29      ! iprt--------input-I- PRINT level (<=0 : no PRINT)      ! absorbed by the surface)
     real tops(klon), sols(klon)  
     ! 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)  
30    
31      real, intent(in):: soll(klon)      real, intent(in):: soll(klon)
32      ! net longwave flux above surface (W/m2), positive up (i. e. flux emited      ! net longwave flux above surface (W/m2), positive up (i. e. flux
33      ! - flux absorbed by the surface)      ! 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):: topl(klon) !LW rad. at TOA (W/m2), positive down      real, intent(in):: evap(klon)
39      real sens(klon)      ! evaporation + sublimation water vapour mass flux (kg/m2/s),
40      ! sens(klon)--input-R- Sensible Flux at surface (W/m2), positive down      ! positive up
     real evap(klon)  
     ! evap(klon)--input-R- Evaporation + sublimation water vapour mass flux  
     ! (kg/m2/s), positive up  
41    
42      real, intent(in):: rain_fall(klon)      real, intent(in):: rain_fall(klon)
43      ! liquid water mass flux (kg/m2/s), positive down      ! liquid water mass flux (kg/m2/s), positive down
44    
45      real snow_fall(klon)      real, intent(in):: snow_fall(klon)
46      ! snow_fall(klon)      ! solid water mass flux (kg/m2/s), positive down
47      ! --input-R- Solid water mass flux (kg/m2/s), positive down  
48      REAL ts(klon)      REAL, intent(in):: ts(klon) ! surface temperature (K)
     ! ts(klon)----input-R- Surface temperature (K)  
     REAL d_etp_tot, d_qt_tot, d_ec_tot  
     ! 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)  
   
     ! Output variables  
     REAL fs_bound  
     ! fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)  
     real fq_bound  
     ! fq_bound---output-R- Water mass flux at the atmosphere  
     ! boundaries (kg/m2/s)  
49    
50      ! Local variables:      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      real stops, stopl, ssols, ssoll
63      real ssens, sfront, slat      real ssens, sfront, slat
64      real airetot, zcpvap, zcwat, zcice      real airetot, zcpvap, zcwat, zcice
65      REAL rain_fall_tot, snow_fall_tot, evap_tot      REAL rain_fall_tot, snow_fall_tot, evap_tot
   
66      integer i      integer i
67      integer:: pas = 0      integer:: pas = 0
68    
69      !------------------------------------------------------------------      !------------------------------------------------------------------
70    
71      pas=pas+1      IF (ip_ebil >= 1) then
72      stops=0.         pas=pas+1
73      stopl=0.         stops=0.
74      ssols=0.         stopl=0.
75      ssoll=0.         ssols=0.
76      ssens=0.         ssoll=0.
77      sfront = 0.         ssens=0.
78      evap_tot = 0.         sfront = 0.
79      rain_fall_tot = 0.         evap_tot = 0.
80      snow_fall_tot = 0.         rain_fall_tot = 0.
81      airetot=0.         snow_fall_tot = 0.
82           airetot=0.
83      ! Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de  
84      ! la glace, on travaille par difference a la chaleur specifique de         ! Pour les chaleurs spécifiques de la vapeur d'eau, de l'eau et de
85      ! l' air sec. En effet, comme on travaille a niveau de pression         ! la glace, on travaille par différence à la chaleur spécifique de
86      ! donne, toute variation de la masse d'un constituant est         ! l'air sec. En effet, comme on travaille à niveau de pression
87      ! totalement compense par une variation de masse d'air.         ! donné, toute variation de la masse d'un constituant est
88           ! totalement compensée par une variation de masse d'air.
89      zcpvap=RCPV-RCPD  
90      zcwat=RCW-RCPD         zcpvap=RCPV-RCPD
91      zcice=RCS-RCPD         zcwat=RCW-RCPD
92           zcice=RCS-RCPD
93      do i=1, klon  
94         stops=stops+tops(i)*airephy(i)         do i=1, klon
95         stopl=stopl+topl(i)*airephy(i)            stops=stops+tops(i)*airephy(i)
96         ssols=ssols+sols(i)*airephy(i)            stopl=stopl+topl(i)*airephy(i)
97         ssoll=ssoll+soll(i)*airephy(i)            ssols=ssols+sols(i)*airephy(i)
98         ssens=ssens+sens(i)*airephy(i)            ssoll=ssoll+soll(i)*airephy(i)
99         sfront = sfront &            ssens=ssens+sens(i)*airephy(i)
100              + (evap(i)*zcpvap-rain_fall(i)*zcwat-snow_fall(i)*zcice) * ts(i) &            sfront = sfront + (evap(i) * zcpvap - rain_fall(i) * zcwat &
101              * airephy(i)                 - snow_fall(i) * zcice) * ts(i) * airephy(i)
102         evap_tot = evap_tot + evap(i)*airephy(i)            evap_tot = evap_tot + evap(i)*airephy(i)
103         rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)            rain_fall_tot = rain_fall_tot + rain_fall(i)*airephy(i)
104         snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)            snow_fall_tot = snow_fall_tot + snow_fall(i)*airephy(i)
105         airetot=airetot+airephy(i)            airetot=airetot+airephy(i)
106      enddo         enddo
107      stops=stops/airetot         stops=stops/airetot
108      stopl=stopl/airetot         stopl=stopl/airetot
109      ssols=ssols/airetot         ssols=ssols/airetot
110      ssoll=ssoll/airetot         ssoll=ssoll/airetot
111      ssens=ssens/airetot         ssens=ssens/airetot
112      sfront = sfront/airetot         sfront = sfront/airetot
113      evap_tot = evap_tot /airetot         evap_tot = evap_tot /airetot
114      rain_fall_tot = rain_fall_tot/airetot         rain_fall_tot = rain_fall_tot/airetot
115      snow_fall_tot = snow_fall_tot/airetot         snow_fall_tot = snow_fall_tot/airetot
116    
117      slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot         slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot
118      ! Heat flux at atm. boundaries         fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront + slat
119      fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront + slat         fq_bound = evap_tot - rain_fall_tot -snow_fall_tot
120      ! Water flux at atm. boundaries  
121      fq_bound = evap_tot - rain_fall_tot -snow_fall_tot         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      IF (iprt >= 1) print 6666, tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot  
124           IF (ip_ebil >= 2) print 6667, tit, pas, stops, stopl, ssols, ssoll, &
125      IF (iprt >= 1) print 6668, tit, pas, d_etp_tot+d_ec_tot-fs_bound, &              ssens, slat, evap_tot, rain_fall_tot + snow_fall_tot
126           d_qt_tot-fq_bound      end IF
127    
128      IF (iprt >= 2) print 6667, tit, pas, stops, stopl, ssols, ssoll, ssens, &  6666 format('Physics flux budget ', a15, 1i6, 2f8.2, 2(1pE13.5))
129           slat, evap_tot, rain_fall_tot+snow_fall_tot  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))
 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))  
131    
132    end SUBROUTINE diagphy    end SUBROUTINE diagphy
133    
Legend:
Removed from v.82  
changed lines
  Added in v.203
  ViewVC Help
Powered by ViewVC 1.1.21