/[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

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