FV3 Bundle
CRTM_VIS_Water_SfcOptics.f90
Go to the documentation of this file.
1 !
2 ! CRTM_VIS_Water_SfcOptics
3 !
4 ! Module to compute the surface optical properties for WATER surfaces at
5 ! visible frequencies required for determining the WATER surface
6 ! contribution to the radiative transfer.
7 !
8 !
9 ! CREATION HISTORY:
10 ! Written by: Paul van Delst, 17-Dec-2008
11 ! paul.vandelst@noaa.gov
12 !
13 
15 
16  ! -----------------
17  ! Environment setup
18  ! -----------------
19  ! Module use
20  USE type_kinds , ONLY: fp
23  USE crtm_parameters , ONLY: zero, one, max_n_angles
24  USE crtm_spccoeff , ONLY: sc
28  USE crtm_secategory , ONLY: sevar_type => ivar_type, &
30  USE crtm_viswatercoeff , ONLY: viswaterc
31  ! Disable implicit typing
32  IMPLICIT NONE
33 
34 
35  ! ------------
36  ! Visibilities
37  ! ------------
38  ! Everything private by default
39  PRIVATE
40  ! Data types
41  PUBLIC :: ivar_type
42  ! Science routines
46 
47 
48  ! -----------------
49  ! Module parameters
50  ! -----------------
51  CHARACTER(*), PARAMETER :: module_version_id = &
52  '$Id: CRTM_VIS_Water_SfcOptics.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
53  ! Message string length
54  INTEGER, PARAMETER :: ml = 256
55 
56 
57  ! --------------------------------------
58  ! Structure definition to hold forward
59  ! variables across FWD, TL, and AD calls
60  ! --------------------------------------
61  TYPE :: ivar_type
62  PRIVATE
63  TYPE(sevar_type) :: sevar
64  END TYPE ivar_type
65 
66 
67 CONTAINS
68 
69 
70 !----------------------------------------------------------------------------------
71 !:sdoc+:
72 !
73 ! NAME:
74 ! Compute_VIS_Water_SfcOptics
75 !
76 ! PURPOSE:
77 ! Function to compute the surface emissivity and reflectivity at UV/visible
78 ! frequencies over a water surface.
79 !
80 ! CALLING SEQUENCE:
81 ! Error_Status = Compute_VIS_Water_SfcOptics(
82 ! Surface , &
83 ! SensorIndex , &
84 ! Channel_Index, &
85 ! SfcOptics , &
86 ! iVar )
87 !
88 ! INPUTS:
89 ! Surface: CRTM_Surface structure containing the surface state
90 ! data.
91 ! UNITS: N/A
92 ! TYPE: CRTM_Surface_type
93 ! DIMENSION: Scalar
94 ! ATTRIBUTES: INTENT(IN)
95 !
96 ! SensorIndex: Channel index id. This is a unique index associated
97 ! with a (supported) sensor channel used to access the
98 ! shared coefficient data.
99 ! UNITS: N/A
100 ! TYPE: INTEGER
101 ! DIMENSION: Scalar
102 ! ATTRIBUTES: INTENT(IN)
103 !
104 ! Channel_Index: Channel index id. This is a unique index associated
105 ! with a (supported) sensor channel used to access the
106 ! shared coefficient data.
107 ! UNITS: N/A
108 ! TYPE: INTEGER
109 ! DIMENSION: Scalar
110 ! ATTRIBUTES: INTENT(IN)
111 !
112 ! OUTPUTS:
113 ! SfcOptics: CRTM_SfcOptics structure containing the surface
114 ! optical properties required for the radiative
115 ! transfer calculation. On input the Angle component
116 ! is assumed to contain data.
117 ! UNITS: N/A
118 ! TYPE: CRTM_SfcOptics_type
119 ! DIMENSION: Scalar
120 ! ATTRIBUTES: INTENT(IN OUT)
121 !
122 ! iVar: Structure containing internal variables required for
123 ! subsequent tangent-linear or adjoint model calls.
124 ! The contents of this structure are NOT accessible
125 ! outside of the module containing this procedure.
126 ! UNITS: N/A
127 ! TYPE: iVar_type
128 ! DIMENSION: Scalar
129 ! ATTRIBUTES: INTENT(OUT)
130 !
131 ! FUNCTION RESULT:
132 ! Error_Status: The return value is an integer defining the error status.
133 ! The error codes are defined in the Message_Handler module.
134 ! If == SUCCESS the computation was sucessful
135 ! == FAILURE an unrecoverable error occurred
136 ! UNITS: N/A
137 ! TYPE: INTEGER
138 ! DIMENSION: Scalar
139 !
140 ! COMMENTS:
141 ! Note the INTENT on the output SfcOptics argument is IN OUT rather
142 ! than just OUT as it is assumed to contain some data upon input.
143 !
144 !:sdoc-:
145 !----------------------------------------------------------------------------------
146 
147  FUNCTION compute_vis_water_sfcoptics( &
148  Surface , & ! Input
149  SensorIndex , & ! Input
150  ChannelIndex, & ! Input
151  SfcOptics , & ! Output
152  iVar ) & ! Internal variable output
153  result( err_stat )
154  ! Arguments
155  TYPE(crtm_surface_type), INTENT(IN) :: surface
156  INTEGER, INTENT(IN) :: sensorindex
157  INTEGER, INTENT(IN) :: channelindex
158  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics
159  TYPE(ivar_type), INTENT(IN OUT) :: ivar
160  ! Function result
161  INTEGER :: err_stat
162  ! Local parameters
163  CHARACTER(*), PARAMETER :: routine_name = 'Compute_VIS_Water_SfcOptics'
164  ! Local variables
165  CHARACTER(ML) :: msg
166  INTEGER :: j
167  REAL(fp) :: frequency, emissivity
168 
169  ! Set up
170  err_stat = success
171  frequency = sc(sensorindex)%Wavenumber(channelindex)
172 
173 
174  ! Compute Lambertian surface emissivity
175  err_stat = secategory_emissivity( &
176  viswaterc , & ! Input
177  frequency , & ! Input
178  surface%Water_Type, & ! Input
179  emissivity , & ! Output
180  ivar%sevar ) ! Internal variable output
181  IF ( err_stat /= success ) THEN
182  msg = 'Error occurred in SEcategory_Emissivity()'
183  CALL display_message( routine_name, msg, err_stat ); RETURN
184  END IF
185 
186 
187  ! Solar direct component
188  sfcoptics%Direct_Reflectivity(:,1) = one - emissivity
189 
190 
191  ! Fill the return emissivity and reflectivity arrays
192  sfcoptics%Emissivity(1:sfcoptics%n_Angles,1) = emissivity
193  DO j = 1, sfcoptics%n_Angles
194  sfcoptics%Reflectivity(1:sfcoptics%n_Angles,1,j,1) = (one - sfcoptics%Emissivity(j,1))*sfcoptics%Weight(j)
195  END DO
196 
197  END FUNCTION compute_vis_water_sfcoptics
198 
199 
200 !----------------------------------------------------------------------------------
201 !:sdoc+:
202 !
203 ! NAME:
204 ! Compute_VIS_Water_SfcOptics_TL
205 !
206 ! PURPOSE:
207 ! Function to compute the tangent-linear surface emissivity and
208 ! reflectivity at UV/visible frequencies over a water surface.
209 !
210 ! This function is a wrapper for third party code.
211 !
212 ! NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO TL
213 ! COMPONENTS IN THE VIS WATER SFCOPTICS COMPUTATIONS.
214 !
215 ! CALLING SEQUENCE:
216 ! Error_Status = Compute_VIS_Water_SfcOptics_TL( SfcOptics_TL )
217 !
218 ! OUTPUTS:
219 ! SfcOptics_TL: CRTM_SfcOptics structure containing the tangent-linear
220 ! surface optical properties required for the tangent-
221 ! linear radiative transfer calculation.
222 ! UNITS: N/A
223 ! TYPE: CRTM_SfcOptics_type
224 ! DIMENSION: Scalar
225 ! ATTRIBUTES: INTENT(IN OUT)
226 !
227 ! FUNCTION RESULT:
228 ! Error_Status: The return value is an integer defining the error status.
229 ! The error codes are defined in the Message_Handler module.
230 ! If == SUCCESS the computation was sucessful
231 ! == FAILURE an unrecoverable error occurred
232 ! UNITS: N/A
233 ! TYPE: INTEGER
234 ! DIMENSION: Scalar
235 !
236 ! COMMENTS:
237 ! Note the INTENT on the output SfcOptics_TL argument is IN OUT rather
238 ! than just OUT as it may be defined upon input.
239 !
240 !:sdoc-:
241 !----------------------------------------------------------------------------------
242 
244  SfcOptics_TL ) & ! Output
245  result( err_stat )
246  ! Arguments
247  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics_tl
248  ! Function result
249  INTEGER :: err_stat
250  ! Local parameters
251  CHARACTER(*), PARAMETER :: routine_name = 'Compute_VIS_Water_SfcOptics_TL'
252  ! Local variables
253 
254 
255  ! Set up
256  err_stat = success
257 
258 
259  ! Compute the tangent-linear surface optical parameters
260  ! ***No TL models yet, so default TL output is zero***
261  sfcoptics_tl%Reflectivity = zero
262  sfcoptics_tl%Direct_Reflectivity = zero
263  sfcoptics_tl%Emissivity = zero
264 
265  END FUNCTION compute_vis_water_sfcoptics_tl
266 
267 
268 !----------------------------------------------------------------------------------
269 !:sdoc+:
270 !
271 ! NAME:
272 ! Compute_VIS_Water_SfcOptics_AD
273 !
274 ! PURPOSE:
275 ! Function to compute the adjoint surface emissivity and
276 ! reflectivity at UW/visible frequencies over a water surface.
277 !
278 ! This function is a wrapper for third party code.
279 !
280 ! NB: CURRENTLY THIS IS A STUB FUNCTION AS THERE ARE NO AD
281 ! COMPONENTS IN THE VIS WATER SFCOPTICS COMPUTATIONS.
282 !
283 ! CALLING SEQUENCE:
284 ! Error_Status = Compute_VIS_Water_SfcOptics_AD( SfcOptics_AD )
285 !
286 ! INPUTS:
287 ! SfcOptics_AD: Structure containing the adjoint surface optical
288 ! properties required for the adjoint radiative
289 ! transfer calculation.
290 ! *** COMPONENTS MODIFIED UPON OUTPUT ***
291 ! UNITS: N/A
292 ! TYPE: CRTM_SfcOptics_type
293 ! DIMENSION: Scalar
294 ! ATTRIBUTES: INTENT(IN OUT)
295 !
296 ! FUNCTION RESULT:
297 ! Error_Status: The return value is an integer defining the error status.
298 ! The error codes are defined in the Message_Handler module.
299 ! If == SUCCESS the computation was sucessful
300 ! == FAILURE an unrecoverable error occurred
301 ! UNITS: N/A
302 ! TYPE: INTEGER
303 ! DIMENSION: Scalar
304 !
305 ! COMMENTS:
306 ! Note the INTENT on the input adjoint arguments are IN OUT regardless
307 ! of their specification as "input" or "output". This is because these
308 ! arguments may contain information on input, or need to be zeroed on
309 ! output (or both).
310 !
311 !:sdoc-:
312 !----------------------------------------------------------------------------------
313 
315  SfcOptics_AD ) & ! Input
316  result( err_stat )
317  ! Arguments
318  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics_ad
319  ! Function result
320  INTEGER :: err_stat
321  ! Local parameters
322  CHARACTER(*), PARAMETER :: routine_name = 'Compute_VIS_Water_SfcOptics_AD'
323  ! Local variables
324 
325 
326  ! Set up
327  err_stat = success
328 
329 
330  ! Compute the adjoint surface optical parameters
331  ! ***No AD models yet, so there is no impact on AD result***
332  sfcoptics_ad%Reflectivity = zero
333  sfcoptics_ad%Direct_Reflectivity = zero
334  sfcoptics_ad%Emissivity = zero
335 
336  END FUNCTION compute_vis_water_sfcoptics_ad
337 
338 END MODULE crtm_vis_water_sfcoptics
real(fp), parameter, public zero
integer function, public compute_vis_water_sfcoptics_tl(SfcOptics_TL)
integer, parameter, public fp
Definition: Type_Kinds.f90:124
integer, parameter, public max_n_angles
character(*), parameter module_version_id
elemental real(fp) function, public inverse_cm_to_micron(Wavenumber)
integer function, public compute_vis_water_sfcoptics(Surface, SensorIndex, ChannelIndex, SfcOptics, iVar)
real(fp), parameter, public one
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
integer function, public compute_vis_water_sfcoptics_ad(SfcOptics_AD)
integer function, public secategory_emissivity(SEcategory, Frequency, Surface_Type, Emissivity, iVar)
type(spccoeff_type), dimension(:), allocatable, save, public sc
type(secategory_type), save, public viswaterc
integer, parameter, public success