GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/lwv.F90 Lines: 0 23 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 12 0.0 %

Line Branch Exec Source
1
SUBROUTINE LWV &
2
 & ( KIDIA, KFDIA, KLON , KLEV , KUAER , KTRAER,&
3
 & PABCU, PB   , PBINT, PBSUR, PBTOP , PDBSL,&
4
 & PEMIS, PEMIW,&
5
 & PGA  , PGB  , PGASUR,PGBSUR,PGATOP, PGBTOP,&
6
 & PCNTRB,PFLUC &
7
 & )
8
9
!**** *LWV*   - LONGWAVE RADIATION, VERTICAL INTEGRATION
10
11
!     PURPOSE.
12
!     --------
13
!           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
14
!           FLUXES OR RADIANCES
15
16
!**   INTERFACE.
17
!     ----------
18
19
!        EXPLICIT ARGUMENTS :
20
!        --------------------
21
!     ==== INPUTS ===
22
! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
23
! PB     : (KLON,NSIL,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
24
! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
25
! PBSUR  : (KLON,NSIL)       ; SURFACE SPECTRAL PLANCK FUNCTION
26
! PBTOP  : (KLON,NSIL)       ; T.O.A. SPECTRAL PLANCK FUNCTION
27
! PDBSL  : (KLON,KLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
28
! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
29
! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
30
! PGA, PGB                   ; PADE APPROXIMANTS
31
! PGASUR, PGBSUR             ; SURFACE PADE APPROXIMANTS
32
! PGATOP, PGBTOP             ; T.O.A. PADE APPROXIMANTS
33
!     ==== OUTPUTS ===
34
! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
35
! PFLUC(KLON,2,KLEV)           ; RADIATIVE FLUXES CLEAR-SKY
36
37
!        IMPLICIT ARGUMENTS :   NONE
38
!        --------------------
39
40
!     METHOD.
41
!     -------
42
43
!          1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
44
!     CONTRIBUTIONS BY -  THE NEARBY LAYERS
45
!                      -  THE DISTANT LAYERS
46
!                      -  THE BOUNDARY TERMS
47
!          2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
48
49
!     EXTERNALS.
50
!     ----------
51
52
!          *LWVN*, *LWVD*, *LWVB*
53
54
!     REFERENCE.
55
!     ----------
56
57
!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
58
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
59
60
!     AUTHOR.
61
!     -------
62
!        JEAN-JACQUES MORCRETTE  *ECMWF*
63
64
!     MODIFICATIONS.
65
!     --------------
66
!        ORIGINAL : 89-07-14
67
!        JJ Morcrette 96-06-07 Surface LW window emissivity
68
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
69
!-----------------------------------------------------------------------
70
71
USE PARKIND1  ,ONLY : JPIM     ,JPRB
72
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
73
74
USE YOELW    , ONLY : NSIL     ,NIPD     ,NUA
75
76
IMPLICIT NONE
77
78
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON
79
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
80
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA
81
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA
82
INTEGER(KIND=JPIM),INTENT(IN)    :: KUAER
83
INTEGER(KIND=JPIM),INTENT(IN)    :: KTRAER
84
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(KLON,NUA,3*KLEV+1)
85
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB(KLON,NSIL,KLEV+1)
86
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBINT(KLON,KLEV+1)
87
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBSUR(KLON,NSIL)
88
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBTOP(KLON,NSIL)
89
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBSL(KLON,NSIL,KLEV*2)
90
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
91
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(KLON)
92
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(KLON,NIPD,2,KLEV)
93
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(KLON,NIPD,2,KLEV)
94
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGASUR(KLON,NIPD,2)
95
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBSUR(KLON,NIPD,2)
96
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGATOP(KLON,NIPD,2)
97
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBTOP(KLON,NIPD,2)
98
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(KLON,KLEV+1,KLEV+1)
99
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(KLON,2,KLEV+1)
100
!-----------------------------------------------------------------------
101
102
!*       0.1   ARGUMENTS
103
!              ---------
104
105
!-----------------------------------------------------------------------
106
107
!              ------------
108
109
REAL(KIND=JPRB) :: ZADJD(KLON,KLEV+1)  , ZADJU(KLON,KLEV+1)&
110
 & ,  ZDBDT(KLON,NSIL,KLEV)&
111
 & ,  ZDISD(KLON,KLEV+1)  , ZDISU(KLON,KLEV+1)&
112
 & ,  ZDWFSU(KLON,NSIL)
113
114
INTEGER(KIND=JPIM) :: JA, JK, JL
115
REAL(KIND=JPRB) :: ZHOOK_HANDLE
116
117
#include "lwvb.intfb.h"
118
#include "lwvd.intfb.h"
119
#include "lwvn.intfb.h"
120
121
!-----------------------------------------------------------------------
122
123
!*         1.    INITIALIZATION
124
!                --------------
125
126
!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
127
!                  ------------------------------
128
129
IF (LHOOK) CALL DR_HOOK('LWV',0,ZHOOK_HANDLE)
130
DO JK=1,KLEV+1
131
  DO JL=KIDIA,KFDIA
132
    ZADJD(JL,JK)=0.0_JPRB
133
    ZADJU(JL,JK)=0.0_JPRB
134
    ZDISD(JL,JK)=0.0_JPRB
135
    ZDISU(JL,JK)=0.0_JPRB
136
  ENDDO
137
ENDDO
138
DO JA=1,NSIL
139
  DO JL=KIDIA,KFDIA
140
    ZDWFSU(JL,JA)=0.0_JPRB
141
  ENDDO
142
ENDDO
143
144
!     ------------------------------------------------------------------
145
146
!*         2.      VERTICAL INTEGRATION
147
!                  --------------------
148
149
!     ------------------------------------------------------------------
150
151
!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
152
!                  ---------------------------------
153
154
CALL LWVN &
155
 & ( KIDIA, KFDIA, KLON  , KLEV , KUAER,&
156
 & PABCU, PDBSL, PGA   , PGB,&
157
 & ZADJD, ZADJU, PCNTRB, ZDBDT, ZDWFSU  &
158
 & )
159
160
!     ------------------------------------------------------------------
161
162
!*         2.2     CONTRIBUTION FROM DISTANT LAYERS
163
!                  ---------------------------------
164
165
CALL LWVD &
166
 & ( KIDIA , KFDIA, KLON , KLEV  , KTRAER,&
167
 & PABCU , ZDBDT, PGA  , PGB,&
168
 & PCNTRB, ZDISD, ZDISU, ZDWFSU &
169
 & )
170
171
!     ------------------------------------------------------------------
172
173
!*         2.3     EXCHANGE WITH THE BOUNDARIES
174
!                  ----------------------------
175
176
CALL LWVB &
177
 & ( KIDIA , KFDIA , KLON  , KLEV  , KUAER,&
178
 & PABCU , ZADJD , ZADJU,&
179
 & PB    , PBINT , PBSUR , PBTOP,&
180
 & ZDISD , ZDISU , PEMIS , PEMIW,&
181
 & PGASUR, PGBSUR, PGATOP, PGBTOP,&
182
 & ZDWFSU,PFLUC  &
183
 & )
184
185
!-----------------------------------------------------------------------
186
187
IF (LHOOK) CALL DR_HOOK('LWV',1,ZHOOK_HANDLE)
188
END SUBROUTINE LWV