/[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/libf/phylmd/diagphy.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 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      ! airephy-------input-R- grid area      CHARACTER(len=15), intent(in):: tit ! comment to be added in PRINT
23      ! tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)      INTEGER, intent(in):: ip_ebil ! PRINT level (<=0 : no PRINT)
24      ! iprt--------input-I- PRINT level (<=0 : no PRINT)      real, intent(in):: tops(klon) ! SW rad. at TOA (W/m2), positive up
25      ! tops(klon)--input-R- SW rad. at TOA (W/m2), positive up.      real, intent(in):: topl(klon) ! LW rad. at TOA (W/m2), positive down
26      ! sols(klon)--input-R- Net SW flux above surface (W/m2), positive up  
27      ! (i.e. -1 * flux absorbed by the surface)      real, intent(in):: sols(klon)
28      ! soll(klon)--input-R- Net LW flux above surface (W/m2), positive up      ! net SW flux above surface (W/m2), positive up (i.e. -1 * flux
29      ! (i.e. flux emited - flux absorbed by the surface)      ! absorbed by the surface)
30      ! ts(klon)----input-R- Surface temperature (K)  
31      ! d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy      real, intent(in):: soll(klon)
32      ! change (W/m2)      ! net longwave flux above surface (W/m2), positive up (i. e. flux
33      ! d_qt_tot----input-R- Mass flux equivalent to atmospheric water mass      ! emited - flux absorbed by the surface)
34      ! change (kg/m2/s)  
35      ! d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy      real, intent(in):: sens(klon)
36      ! change (W/m2)      ! sensible Flux at surface (W/m2), positive down
37    
38      ! fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)      real, intent(in):: evap(klon)
39      ! fq_bound---output-R- Water mass flux at the atmosphere boundaries (kg/m2/s)      ! evaporation + sublimation water vapour mass flux (kg/m2/s),
40      ! Input variables      ! positive up
     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  
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
     ! --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  
47    
48      ! Local variables      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      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.62  
changed lines
  Added in v.203
  ViewVC Help
Powered by ViewVC 1.1.21