/[lmdze]/trunk/Sources/phylmd/Radlwsw/lwv.f
ViewVC logotype

Diff of /trunk/Sources/phylmd/Radlwsw/lwv.f

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

revision 154 by guez, Wed Apr 29 15:47:56 2015 UTC revision 155 by guez, Wed Jul 8 17:03:45 2015 UTC
# Line 1  Line 1 
1  SUBROUTINE lwv(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, pbtop, &  module lwv_m
2      pdbsl, pemis, ppmb, ptave, pga, pgb, pgasur, pgbsur, pgatop, pgbtop, &  
     pcntrb, pcts, pfluc)  
   USE dimens_m  
   USE dimphy  
   USE suphec_m  
   USE raddim  
   USE raddimlw  
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! -----------------------------------------------------------------------  contains
6    ! PURPOSE.  
7    ! --------    SUBROUTINE lwv(kuaer, ktraer, klim, pabcu, pb, pbint, pbsuin, pbsur, pbtop, &
8    ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE         pdbsl, pemis, ppmb, pga, pgb, pgasur, pgbsur, pgatop, pgbtop, &
9    ! FLUXES OR RADIANCES         pcntrb, pcts, pfluc)
10        USE dimens_m
11    ! METHOD.      USE dimphy
12    ! -------      use lwvd_m, only: lwvd
13        USE suphec_m
14    ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN      USE raddim
15    ! CONTRIBUTIONS BY -  THE NEARBY LAYERS      USE raddimlw
16    ! -  THE DISTANT LAYERS  
17    ! -  THE BOUNDARY TERMS      ! -----------------------------------------------------------------------
18    ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.      ! PURPOSE.
19        ! --------
20    ! REFERENCE.      ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
21    ! ----------      ! FLUXES OR RADIANCES
22    
23    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND      ! METHOD.
24    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS      ! -------
25    
26    ! AUTHOR.      ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
27    ! -------      ! CONTRIBUTIONS BY -  THE NEARBY LAYERS
28    ! JEAN-JACQUES MORCRETTE  *ECMWF*      ! -  THE DISTANT LAYERS
29        ! -  THE BOUNDARY TERMS
30    ! MODIFICATIONS.      ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
31    ! --------------  
32    ! ORIGINAL : 89-07-14      ! REFERENCE.
33    ! -----------------------------------------------------------------------      ! ----------
34    
35    ! * ARGUMENTS:      ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
36    INTEGER kuaer, ktraer, klim      ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
37    
38    DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS      ! AUTHOR.
39    DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS      ! -------
40    DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS      ! JEAN-JACQUES MORCRETTE  *ECMWF*
41    DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION  
42    DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION      ! MODIFICATIONS.
43    DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION      ! --------------
44    DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT      ! ORIGINAL : 89-07-14
45    DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY      ! -----------------------------------------------------------------------
46    DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)  
47    DOUBLE PRECISION ptave(kdlon, kflev) ! TEMPERATURE      ! * ARGUMENTS:
48    DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS      INTEGER kuaer, ktraer, klim
49    DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS  
50    DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
51    DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
52    DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
53    DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
54        DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
55    DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX      DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
56    DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM      DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
57    DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES      DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
58    ! -----------------------------------------------------------------------      DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
59    ! LOCAL VARIABLES:      DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
60    DOUBLE PRECISION zadjd(kdlon, kflev+1)      DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
61    DOUBLE PRECISION zadju(kdlon, kflev+1)      DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
62    DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)      DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
63    DOUBLE PRECISION zdisd(kdlon, kflev+1)      DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
64    DOUBLE PRECISION zdisu(kdlon, kflev+1)      DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS
65    
66    INTEGER jk, jl      DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
67    ! -----------------------------------------------------------------------      DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
68        DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
69    DO jk = 1, kflev + 1      ! -----------------------------------------------------------------------
70      DO jl = 1, kdlon      ! LOCAL VARIABLES:
71        zadjd(jl, jk) = 0.      DOUBLE PRECISION zadjd(kdlon, kflev+1)
72        zadju(jl, jk) = 0.      DOUBLE PRECISION zadju(kdlon, kflev+1)
73        zdisd(jl, jk) = 0.      DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)
74        zdisu(jl, jk) = 0.      DOUBLE PRECISION zdisd(kdlon, kflev+1)
75        DOUBLE PRECISION zdisu(kdlon, kflev+1)
76    
77        INTEGER jk, jl
78        ! -----------------------------------------------------------------------
79    
80        DO jk = 1, kflev + 1
81           DO jl = 1, kdlon
82              zadjd(jl, jk) = 0.
83              zadju(jl, jk) = 0.
84              zdisd(jl, jk) = 0.
85              zdisu(jl, jk) = 0.
86           END DO
87      END DO      END DO
   END DO  
88    
89    DO jk = 1, kflev      DO jk = 1, kflev
90      DO jl = 1, kdlon         DO jl = 1, kdlon
91        pcts(jl, jk) = 0.            pcts(jl, jk) = 0.
92           END DO
93      END DO      END DO
   END DO  
94    
95    ! * CONTRIBUTION FROM ADJACENT LAYERS      ! * CONTRIBUTION FROM ADJACENT LAYERS
96    
97        CALL lwvn(kuaer, ktraer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, &
98             zdbdt)
99        ! * CONTRIBUTION FROM DISTANT LAYERS
100    
101    CALL lwvn(kuaer, ktraer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, &      CALL lwvd(ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)
     zdbdt)  
   ! * CONTRIBUTION FROM DISTANT LAYERS  
102    
103    CALL lwvd(kuaer, ktraer, pabcu, zdbdt, pga, pgb, pcntrb, zdisd, zdisu)      ! * EXCHANGE WITH THE BOUNDARIES
104    
105    ! * EXCHANGE WITH THE BOUNDARIES      CALL lwvb(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, pbsuin, &
106             pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &
107             pgatop, pgbtop, pcts, pfluc)
108    
   CALL lwvb(kuaer, ktraer, klim, pabcu, zadjd, zadju, pb, pbint, pbsuin, &  
     pbsur, pbtop, zdisd, zdisu, pemis, ppmb, pga, pgb, pgasur, pgbsur, &  
     pgatop, pgbtop, pcts, pfluc)  
109    
110        RETURN
111      END SUBROUTINE lwv
112    
113    RETURN  end module lwv_m
 END SUBROUTINE lwv  
Legend:
Removed from v.154  
changed lines
  Added in v.155
  ViewVC Help
Powered by ViewVC 1.1.21