GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/suaersn.F90 Lines: 48 61 78.7 %
Date: 2023-06-30 12:56:34 Branches: 81 98 82.7 %

Line Branch Exec Source
1
1
SUBROUTINE SUAERSN (KTSW, KSW)
2
3
!**** *SUAERS*   - INITIALIZE COMMON YOEAER
4
5
!     PURPOSE.
6
!     --------
7
!           INITIALIZE YOEAER, THE COMMON THAT CONTAINS THE
8
!           RADIATIVE CHARACTERISTICS OF THE AEROSOLS
9
10
!**   INTERFACE.
11
!     ----------
12
!              -----        -----
13
14
!        EXPLICIT ARGUMENTS :
15
!        --------------------
16
!        NONE
17
18
!        IMPLICIT ARGUMENTS :
19
!        --------------------
20
!        COMMON YOEAER
21
22
!     METHOD.
23
!     -------
24
!        SEE DOCUMENTATION
25
26
!     EXTERNALS.
27
!     ----------
28
29
!     REFERENCE.
30
!     ----------
31
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IFS MODEL"
32
33
!     AUTHOR.
34
!     -------
35
!        JEAN-JACQUES MORCRETTE *ECMWF*
36
37
!     MODIFICATIONS.
38
!     --------------
39
!        ORIGINAL : 88-02-15
40
!        96-01-27  JJ Morcrette  Various spectral resolutions
41
!        99-05-25  JJMorcrette   Revised aerosol optical properties
42
!        00-10-25  JJMorcrette   6 spectral intervals
43
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
44
45
!     ------------------------------------------------------------------
46
47
USE PARKIND1  ,ONLY : JPIM     ,JPRB
48
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
49
50
USE YOESW    , ONLY : RTAUA     ,RPIZA    ,RCGA
51
52
!      ----------------------------------------------------------------
53
54
IMPLICIT NONE
55
56
INTEGER(KIND=JPIM),INTENT(IN)    :: KTSW
57
INTEGER(KIND=JPIM),INTENT(IN)    :: KSW
58
REAL(KIND=JPRB) :: ZTAUA2(2,6)  ,ZPIZA2(2,6)  ,ZCGA2(2,6)
59
REAL(KIND=JPRB) :: ZTAUA4(4,6)  ,ZPIZA4(4,6)  ,ZCGA4(4,6)
60
REAL(KIND=JPRB) :: ZTAUA6(6,6)  ,ZPIZA6(6,6)  ,ZCGA6(6,6)
61
62
INTEGER(KIND=JPIM) :: JAER, JNU
63
REAL(KIND=JPRB) :: ZHOOK_HANDLE
64
65
!      ----------------------------------------------------------------
66
67
!*       1.    SHORTWAVE COEFFICIENTS
68
!              ----------------------
69
!=======================================================================
70
!-- The (old) five aerosol types were respectively:
71
72
!  1/ continental average (+desert)       2/ maritime
73
!  3/ urban                               4/ volcanic active
74
!  5/ stratospheric background
75
76
!-- old values were not spectrally defined:
77
! ZTAU2  = .730719, .912819, .725059, .745405, .682188
78
! ZPIZA2 = .872212, .982545, .623143, .944887, .997975
79
! ZCGA2  = .647596, .739002, .580845, .662657, .624246
80
!=======================================================================
81
82
!-- The six aerosol types are respectively:
83
84
!  1/ continental average                 2/ maritime
85
!  3/ desert                              4/ urban
86
!  5/ volcanic active                     6/ stratospheric background
87
88
! The quantities given are:
89
! TAU : ratio of average optical thickness in interval to that at 0.55
90
!       micron
91
! PIZA: average single scattering albedo
92
! CGA : average asymmetry factor
93
94
! computed from Hess and Koepke (con, mar, des, urb)
95
!          from Bonnel et al.   (vol, str)
96
97
!        1.1   TWO SPECTRAL INTERVALS (0.25-0.69-4.00microns)
98
99
1
IF (LHOOK) CALL DR_HOOK('SUAERSN',0,ZHOOK_HANDLE)
100
ZTAUA2(1, :)= (/&
101
7
 & 1.69446_JPRB , 1.11855_JPRB , 1.09212_JPRB , 1.72145_JPRB , 1.03858_JPRB , 1.12044_JPRB /)
102
ZTAUA2(2, :)= (/&
103
7
 & 0.40174_JPRB , 0.89383_JPRB , 0.89546_JPRB , 0.40741_JPRB , 0.51143_JPRB , 0.32646_JPRB /)
104
105
ZPIZA2(1, :)= (/&
106
7
 & .9148907_JPRB, .9956173_JPRB, .7504584_JPRB, .8131335_JPRB, .9401905_JPRB, .9999999_JPRB/)
107
ZPIZA2(2, :)= (/&
108
7
 & .8814597_JPRB, .9920407_JPRB, .9239428_JPRB, .7546879_JPRB, .9515548_JPRB, .9938563_JPRB/)
109
110
ZCGA2(1, :)= (/&
111
7
 & 0.729019_JPRB, 0.803129_JPRB, 0.784592_JPRB, 0.712208_JPRB, .7008249_JPRB, .7270548_JPRB/)
112
ZCGA2(2, :)= (/&
113
7
 & 0.663224_JPRB, 0.793746_JPRB, 0.696315_JPRB, 0.652612_JPRB, .6608509_JPRB, .6318786_JPRB/)
114
115
!        1.2   FOUR SPECTRAL INTERVALS (0.25-0.69-1.19-2.38-4.00microns)
116
117
ZTAUA4(1, :)= (/&
118
7
 & 1.69446_JPRB , 1.11855_JPRB , 1.09212_JPRB , 1.72145_JPRB , 1.03858_JPRB , 1.12044_JPRB /)
119
ZTAUA4(2, :)= (/&
120
7
 & 0.52838_JPRB , 0.93285_JPRB , 0.93449_JPRB , 0.53078_JPRB , 0.67148_JPRB , 0.46608_JPRB /)
121
ZTAUA4(3, :)= (/&
122
7
 & 0.20543_JPRB , 0.84642_JPRB , 0.84958_JPRB , 0.21673_JPRB , 0.28270_JPRB , 0.10915_JPRB /)
123
ZTAUA4(4, :)= (/&
124
7
 & 0.10849_JPRB , 0.66699_JPRB , 0.65255_JPRB , 0.11600_JPRB , 0.06529_JPRB , 0.04468_JPRB /)
125
126
ZPIZA4(1, :)= (/&
127
7
 & .9148907_JPRB, .9956173_JPRB, .7504584_JPRB, .8131335_JPRB, .9401905_JPRB, .9999999_JPRB/)
128
ZPIZA4(2, :)= (/&
129
7
 & .8970131_JPRB, .9984940_JPRB, .9245594_JPRB, .7768385_JPRB, .9532763_JPRB, .9999999_JPRB/)
130
ZPIZA4(3, :)= (/&
131
7
 & .8287144_JPRB, .9949396_JPRB, .9279543_JPRB, .6765051_JPRB, .9467578_JPRB, .9955938_JPRB/)
132
ZPIZA4(4, :)= (/&
133
7
 & .5230504_JPRB, .7868518_JPRB, .8531531_JPRB, .4048149_JPRB, .8748231_JPRB, .2355667_JPRB/)
134
135
ZCGA4(1, :)= (/&
136
7
 & 0.729019_JPRB, 0.803129_JPRB, 0.784592_JPRB, 0.712208_JPRB, .7008249_JPRB, .7270548_JPRB/)
137
ZCGA4(2, :)= (/&
138
7
 & 0.668431_JPRB, 0.788530_JPRB, 0.698682_JPRB, 0.657422_JPRB, .6735182_JPRB, .6519706_JPRB/)
139
ZCGA4(3, :)= (/&
140
7
 & 0.636342_JPRB, 0.802467_JPRB, 0.691305_JPRB, 0.627497_JPRB, .6105750_JPRB, .4760794_JPRB/)
141
ZCGA4(4, :)= (/&
142
7
 & 0.700610_JPRB, 0.818871_JPRB, 0.702399_JPRB, 0.689886_JPRB, .4629866_JPRB, .1907639_JPRB/)
143
144
!        1.3   SIX SPECTRAL INTERVALS (0.185-0.25-0.44-0.69-1.19-2.38-4.00microns)
145
146
ZTAUA6(1, :)= (/&
147
7
 & 1.69446_JPRB , 1.11855_JPRB , 1.09212_JPRB , 1.72145_JPRB , 1.03858_JPRB , 1.12044_JPRB /)
148
ZTAUA6(2, :)= (/&
149
7
 & 1.69446_JPRB , 1.11855_JPRB , 1.09212_JPRB , 1.72145_JPRB , 1.03858_JPRB , 1.12044_JPRB /)
150
ZTAUA6(3, :)= (/&
151
7
 & 1.69446_JPRB , 1.11855_JPRB , 1.09212_JPRB , 1.72145_JPRB , 1.03858_JPRB , 1.12044_JPRB /)
152
ZTAUA6(4, :)= (/&
153
7
 & 0.52838_JPRB , 0.93285_JPRB , 0.93449_JPRB , 0.53078_JPRB , 0.67148_JPRB , 0.46608_JPRB /)
154
ZTAUA6(5, :)= (/&
155
7
 & 0.20543_JPRB , 0.84642_JPRB , 0.84958_JPRB , 0.21673_JPRB , 0.28270_JPRB , 0.10915_JPRB /)
156
ZTAUA6(6, :)= (/&
157
7
 & 0.10849_JPRB , 0.66699_JPRB , 0.65255_JPRB , 0.11600_JPRB , 0.06529_JPRB , 0.04468_JPRB /)
158
159
ZPIZA6(1, :)= (/&
160
7
 & .9148907_JPRB, .9956173_JPRB, .7504584_JPRB, .8131335_JPRB, .9401905_JPRB, .9999999_JPRB/)
161
ZPIZA6(2, :)= (/&
162
7
 & .9148907_JPRB, .9956173_JPRB, .7504584_JPRB, .8131335_JPRB, .9401905_JPRB, .9999999_JPRB/)
163
ZPIZA6(3, :)= (/&
164
7
 & .9148907_JPRB, .9956173_JPRB, .7504584_JPRB, .8131335_JPRB, .9401905_JPRB, .9999999_JPRB/)
165
ZPIZA6(4, :)= (/&
166
7
 & .8970131_JPRB, .9984940_JPRB, .9245594_JPRB, .7768385_JPRB, .9532763_JPRB, .9999999_JPRB/)
167
ZPIZA6(5, :)= (/&
168
7
 & .8287144_JPRB, .9949396_JPRB, .9279543_JPRB, .6765051_JPRB, .9467578_JPRB, .9955938_JPRB/)
169
ZPIZA6(6, :)= (/&
170
7
 & .5230504_JPRB, .7868518_JPRB, .8531531_JPRB, .4048149_JPRB, .8748231_JPRB, .2355667_JPRB/)
171
172
ZCGA6(1, :)= (/&
173
7
 & 0.729019_JPRB, 0.803129_JPRB, 0.784592_JPRB, 0.712208_JPRB, .7008249_JPRB, .7270548_JPRB/)
174
ZCGA6(2, :)= (/&
175
7
 & 0.729019_JPRB, 0.803129_JPRB, 0.784592_JPRB, 0.712208_JPRB, .7008249_JPRB, .7270548_JPRB/)
176
ZCGA6(3, :)= (/&
177
7
 & 0.729019_JPRB, 0.803129_JPRB, 0.784592_JPRB, 0.712208_JPRB, .7008249_JPRB, .7270548_JPRB/)
178
ZCGA6(4, :)= (/&
179
7
 & 0.668431_JPRB, 0.788530_JPRB, 0.698682_JPRB, 0.657422_JPRB, .6735182_JPRB, .6519706_JPRB/)
180
ZCGA6(5, :)= (/&
181
7
 & 0.636342_JPRB, 0.802467_JPRB, 0.691305_JPRB, 0.627497_JPRB, .6105750_JPRB, .4760794_JPRB/)
182
ZCGA6(6, :)= (/&
183
7
 & 0.700610_JPRB, 0.818871_JPRB, 0.702399_JPRB, 0.689886_JPRB, .4629866_JPRB, .1907639_JPRB/)
184
185
!      ----------------------------------------------------------------
186
187
1
IF (KSW == 2) THEN
188
  DO JNU=1,KSW
189
    DO JAER=1,6
190
      RTAUA(JNU,JAER)=ZTAUA2(JNU,JAER)
191
      RPIZA(JNU,JAER)=ZPIZA2(JNU,JAER)
192
      RCGA(JNU,JAER) =ZCGA2 (JNU,JAER)
193
    ENDDO
194
  ENDDO
195
1
ELSEIF (KSW == 4) THEN
196
  DO JNU=1,KSW
197
    DO JAER=1,6
198
      RTAUA(JNU,JAER)=ZTAUA4(JNU,JAER)
199
      RPIZA(JNU,JAER)=ZPIZA4(JNU,JAER)
200
      RCGA(JNU,JAER) =ZCGA4 (JNU,JAER)
201
    ENDDO
202
  ENDDO
203
1
ELSEIF (KSW == 6) THEN
204
7
  DO JNU=1,KSW
205
43
    DO JAER=1,6
206
36
      RTAUA(JNU,JAER)=ZTAUA6(JNU,JAER)
207
36
      RPIZA(JNU,JAER)=ZPIZA6(JNU,JAER)
208
42
      RCGA(JNU,JAER) =ZCGA6 (JNU,JAER)
209
    ENDDO
210
  ENDDO
211
ELSEIF (KSW == 14 .AND. KTSW == 14) THEN
212
  PRINT *,'SUAERSN: 14-SPECTRAL INTERVALS --> RRTM_SW'
213
ELSE
214
  STOP 'SUAERSN: WRONG NUMBER OF SPECTRAL INTERVALS'
215
ENDIF
216
217
!      ----------------------------------------------------------------
218
219
1
IF (LHOOK) CALL DR_HOOK('SUAERSN',1,ZHOOK_HANDLE)
220
1
END SUBROUTINE SUAERSN