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

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

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

revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 254 by guez, Mon Feb 5 10:39:38 2018 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 lwvn_m, only: lwvn
14    ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN      USE suphec_m
15    ! CONTRIBUTIONS BY -  THE NEARBY LAYERS      USE raddim
16    ! -  THE DISTANT LAYERS      USE raddimlw
17    ! -  THE BOUNDARY TERMS  
18    ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.      ! -----------------------------------------------------------------------
19        ! PURPOSE.
20    ! REFERENCE.      ! --------
21    ! ----------      ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
22        ! FLUXES OR RADIANCES
23    ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND  
24    ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS      ! METHOD.
25        ! -------
26    ! AUTHOR.  
27    ! -------      ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
28    ! JEAN-JACQUES MORCRETTE  *ECMWF*      ! CONTRIBUTIONS BY -  THE NEARBY LAYERS
29        ! -  THE DISTANT LAYERS
30    ! MODIFICATIONS.      ! -  THE BOUNDARY TERMS
31    ! --------------      ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
32    ! ORIGINAL : 89-07-14  
33    ! -----------------------------------------------------------------------      ! REFERENCE.
34        ! ----------
35    ! * ARGUMENTS:  
36    INTEGER kuaer, ktraer, klim      ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
37        ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
38    DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS  
39    DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS      ! AUTHOR.
40    DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS      ! -------
41    DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION      ! JEAN-JACQUES MORCRETTE  *ECMWF*
42    DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION  
43    DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION      ! MODIFICATIONS.
44    DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT      ! --------------
45    DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY      ! ORIGINAL : 89-07-14
46    DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)      ! -----------------------------------------------------------------------
47    DOUBLE PRECISION ptave(kdlon, kflev) ! TEMPERATURE  
48    DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS      ! * ARGUMENTS:
49    DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS      INTEGER kuaer, ktraer, klim
50    DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS  
51    DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pabcu(kdlon, nua, 3*kflev+1) ! EFFECTIVE ABSORBER AMOUNTS
52    DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pb(kdlon, ninter, kflev+1) ! SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
53    DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS      DOUBLE PRECISION pbint(kdlon, kflev+1) ! HALF-LEVEL PLANCK FUNCTIONS
54        DOUBLE PRECISION pbsur(kdlon, ninter) ! SURFACE SPECTRAL PLANCK FUNCTION
55    DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX      DOUBLE PRECISION pbsuin(kdlon) ! SURFACE PLANCK FUNCTION
56    DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM      DOUBLE PRECISION pbtop(kdlon, ninter) ! T.O.A. SPECTRAL PLANCK FUNCTION
57    DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES      DOUBLE PRECISION pdbsl(kdlon, ninter, kflev*2) ! SUB-LAYER PLANCK FUNCTION GRADIENT
58    ! -----------------------------------------------------------------------      DOUBLE PRECISION pemis(kdlon) ! SURFACE EMISSIVITY
59    ! LOCAL VARIABLES:      DOUBLE PRECISION ppmb(kdlon, kflev+1) ! HALF-LEVEL PRESSURE (MB)
60    DOUBLE PRECISION zadjd(kdlon, kflev+1)      DOUBLE PRECISION pga(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
61    DOUBLE PRECISION zadju(kdlon, kflev+1)      DOUBLE PRECISION pgb(kdlon, 8, 2, kflev) ! PADE APPROXIMANTS
62    DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)      DOUBLE PRECISION pgasur(kdlon, 8, 2) ! PADE APPROXIMANTS
63    DOUBLE PRECISION zdisd(kdlon, kflev+1)      DOUBLE PRECISION pgbsur(kdlon, 8, 2) ! PADE APPROXIMANTS
64    DOUBLE PRECISION zdisu(kdlon, kflev+1)      DOUBLE PRECISION pgatop(kdlon, 8, 2) ! PADE APPROXIMANTS
65        DOUBLE PRECISION pgbtop(kdlon, 8, 2) ! PADE APPROXIMANTS
66    INTEGER jk, jl  
67    ! -----------------------------------------------------------------------      DOUBLE PRECISION pcntrb(kdlon, kflev+1, kflev+1) ! CLEAR-SKY ENERGY EXCHANGE MATRIX
68        DOUBLE PRECISION pcts(kdlon, kflev) ! COOLING-TO-SPACE TERM
69    DO jk = 1, kflev + 1      DOUBLE PRECISION pfluc(kdlon, 2, kflev+1) ! CLEAR-SKY RADIATIVE FLUXES
70      DO jl = 1, kdlon      ! -----------------------------------------------------------------------
71        zadjd(jl, jk) = 0.      ! LOCAL VARIABLES:
72        zadju(jl, jk) = 0.      DOUBLE PRECISION zadjd(kdlon, kflev+1)
73        zdisd(jl, jk) = 0.      DOUBLE PRECISION zadju(kdlon, kflev+1)
74        zdisu(jl, jk) = 0.      DOUBLE PRECISION zdbdt(kdlon, ninter, kflev)
75        DOUBLE PRECISION zdisd(kdlon, kflev+1)
76        DOUBLE PRECISION zdisu(kdlon, kflev+1)
77    
78        INTEGER jk, jl
79        ! -----------------------------------------------------------------------
80    
81        DO jk = 1, kflev + 1
82           DO jl = 1, kdlon
83              zadjd(jl, jk) = 0.
84              zadju(jl, jk) = 0.
85              zdisd(jl, jk) = 0.
86              zdisu(jl, jk) = 0.
87           END DO
88      END DO      END DO
   END DO  
89    
90    DO jk = 1, kflev      DO jk = 1, kflev
91      DO jl = 1, kdlon         DO jl = 1, kdlon
92        pcts(jl, jk) = 0.            pcts(jl, jk) = 0.
93           END DO
94      END DO      END DO
   END DO  
95    
96    ! * CONTRIBUTION FROM ADJACENT LAYERS      ! * CONTRIBUTION FROM ADJACENT LAYERS
97    
98        CALL lwvn(kuaer, pabcu, pdbsl, pga, pgb, zadjd, zadju, pcntrb, 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.82  
changed lines
  Added in v.254
  ViewVC Help
Powered by ViewVC 1.1.21