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

Diff of /trunk/phylmd/diagphy.f

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

trunk/libf/phylmd/diagphy.f revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC trunk/libf/phylmd/diagphy.f90 revision 62 by guez, Thu Jul 26 14:37:37 2012 UTC
# Line 1  Line 1 
1  !  module diagphy_m
 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/diagphy.F,v 1.1.1.1 2004/05/19 12:53:08 lmdzadmin Exp $  
 !  
       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)  
 C======================================================================  
 C  
 C Purpose:  
 C    Compute the thermal flux and the watter mass flux at the atmosphere  
 c    boundaries. Print them and also the atmospheric enthalpy change and  
 C    the  atmospheric mass change.  
 C  
 C Arguments:  
 C airephy-------input-R-  grid area  
 C tit---------input-A15- Comment to be added in PRINT (CHARACTER*15)  
 C iprt--------input-I-  PRINT level ( <=0 : no PRINT)  
 C tops(klon)--input-R-  SW rad. at TOA (W/m2), positive up.  
 C topl(klon)--input-R-  LW rad. at TOA (W/m2), positive down  
 C sols(klon)--input-R-  Net SW flux above surface (W/m2), positive up  
 C                   (i.e. -1 * flux absorbed by the surface)  
 C soll(klon)--input-R-  Net LW flux above surface (W/m2), positive up  
 C                   (i.e. flux emited - flux absorbed by the surface)  
 C sens(klon)--input-R-  Sensible Flux at surface  (W/m2), positive down  
 C evap(klon)--input-R-  Evaporation + sublimation watter vapour mass flux  
 C                   (kg/m2/s), positive up  
 C rain_fall(klon)  
 C           --input-R- Liquid  watter mass flux (kg/m2/s), positive down  
 C snow_fall(klon)  
 C           --input-R- Solid  watter mass flux (kg/m2/s), positive down  
 C ts(klon)----input-R- Surface temperature (K)  
 C d_etp_tot---input-R- Heat flux equivalent to atmospheric enthalpy  
 C                    change (W/m2)  
 C d_qt_tot----input-R- Mass flux equivalent to atmospheric watter mass  
 C                    change (kg/m2/s)  
 C d_ec_tot----input-R- Flux equivalent to atmospheric cinetic energy  
 C                    change (W/m2)  
 C  
 C fs_bound---output-R- Thermal flux at the atmosphere boundaries (W/m2)  
 C fq_bound---output-R- Watter mass flux at the atmosphere boundaries (kg/m2/s)  
 C  
 C J.L. Dufresne, July 2002  
 C======================================================================  
 C  
       use dimens_m  
       use dimphy  
       use SUPHEC_M  
       use yoethf_m  
       implicit none  
   
 C  
 C     Input variables  
       real airephy(klon)  
       CHARACTER*15 tit  
       INTEGER iprt  
       real tops(klon),topl(klon),sols(klon),soll(klon)  
       real sens(klon),evap(klon),rain_fall(klon),snow_fall(klon)  
       REAL ts(klon)  
       REAL d_etp_tot, d_qt_tot, d_ec_tot  
 c     Output variables  
       REAL fs_bound, fq_bound  
 C  
 C     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  
 C  
       integer i  
 C  
       integer pas  
       save pas  
       data pas/0/  
 C  
       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.  
 C  
 C     Pour les chaleur specifiques de la vapeur d'eau, de l'eau et de  
 C     la glace, on travaille par difference a la chaleur specifique de l'  
 c     air sec. En effet, comme on travaille a niveau de pression donne,  
 C     toute variation de la masse d'un constituant est totalement  
 c     compense par une variation de masse d'air.  
 C  
       zcpvap=RCPV-RCPD  
       zcwat=RCW-RCPD  
       zcice=RCS-RCPD  
 C  
       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  
 C  
       slat = RLVTT * rain_fall_tot + RLSTT * snow_fall_tot  
 C     Heat flux at atm. boundaries  
       fs_bound = stops-stopl - (ssols+ssoll)+ssens+sfront  
      $    + slat  
 C     Watter flux at atm. boundaries  
       fq_bound = evap_tot - rain_fall_tot -snow_fall_tot  
 C  
       IF (iprt.ge.1) write(6,6666)  
      $    tit, pas, fs_bound, d_etp_tot, fq_bound, d_qt_tot  
 C  
       IF (iprt.ge.1) write(6,6668)  
      $    tit, pas, d_etp_tot+d_ec_tot-fs_bound, d_qt_tot-fq_bound  
 C  
       IF (iprt.ge.2) write(6,6667)  
      $    tit, pas, stops,stopl,ssols,ssoll,ssens,slat,evap_tot  
      $    ,rain_fall_tot+snow_fall_tot  
   
       return  
   
  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))  
2    
3        end    implicit none
4    
5    contains
6    
7      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    
11        ! 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

Legend:
Removed from v.47  
changed lines
  Added in v.62

  ViewVC Help
Powered by ViewVC 1.1.21