FV3 Bundle
CRTM_VISsnowCoeff.f90
Go to the documentation of this file.
1 !
2 ! CRTM_VISsnowCoeff
3 !
4 ! Module containing the shared CRTM visible snow surface emissivity
5 ! data and their load/destruction routines.
6 !
7 ! PUBLIC DATA:
8 ! VISsnowC: Data structure containing the visible snow surface
9 ! emissivity data.
10 !
11 ! SIDE EFFECTS:
12 ! Routines in this module modify the contents of the public
13 ! data structure VISsnowC.
14 !
15 ! RESTRICTIONS:
16 ! Routines in this module should only be called during the
17 ! CRTM initialisation.
18 !
19 ! CREATION HISTORY:
20 ! Written by: Paul van Delst, 20-Jan-2012
21 ! paul.vandelst@noaa.gov
22 !
23 
25 
26  ! -----------------
27  ! Environment setup
28  ! -----------------
29  ! Module use
35  ! Disable all implicit typing
36  IMPLICIT NONE
37 
38 
39  ! ------------
40  ! Visibilities
41  ! ------------
42  ! Everything private by default
43  PRIVATE
44  ! The shared data
45  PUBLIC :: vissnowc
46  ! Procedures
47  PUBLIC :: crtm_vissnowcoeff_load
50 
51 
52  ! -----------------
53  ! Module parameters
54  ! -----------------
55  CHARACTER(*), PARAMETER :: module_version_id = &
56  '$Id: CRTM_VISsnowCoeff.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
57  ! Message string length
58  INTEGER, PARAMETER :: ml = 512
59 
60 
61  ! ------------------------------------------------
62  ! The shared visible snow surface emissivity data
63  ! ------------------------------------------------
64  TYPE(secategory_type), SAVE :: vissnowc
65 
66 
67 CONTAINS
68 
69 
70 !------------------------------------------------------------------------------
71 !:sdoc+:
72 !
73 ! NAME:
74 ! CRTM_VISsnowCoeff_Load
75 !
76 ! PURPOSE:
77 ! Function to load the visible snow surface emissivity data into
78 ! the public data structure VISsnowC
79 !
80 ! CALLING SEQUENCE:
81 ! Error_Status = CRTM_VISsnowCoeff_Load( &
82 ! Filename, &
83 ! File_Path = File_Path , &
84 ! Quiet = Quiet , &
85 ! Process_ID = Process_ID , &
86 ! Output_Process_ID = Output_Process_ID )
87 !
88 ! INPUT ARGUMENTS:
89 ! Filename: Name of the VISsnowCoeff file.
90 ! UNITS: N/A
91 ! TYPE: CHARACTER(*)
92 ! DIMENSION: Scalar
93 ! ATTRIBUTES: INTENT(IN)
94 !
95 !
96 ! OPTIONAL INPUT ARGUMENTS:
97 ! File_Path: Character string specifying a file path for the
98 ! input data file. If not specified, the current
99 ! directory is the default.
100 ! UNITS: N/A
101 ! TYPE: CHARACTER(*)
102 ! DIMENSION: Scalar
103 ! ATTRIBUTES: INTENT(IN), OPTIONAL
104 !
105 ! Quiet: Set this logical argument to suppress INFORMATION
106 ! messages being printed to stdout
107 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
108 ! == .TRUE., INFORMATION messages are SUPPRESSED.
109 ! If not specified, default is .FALSE.
110 ! UNITS: N/A
111 ! TYPE: LOGICAL
112 ! DIMENSION: Scalar
113 ! ATTRIBUTES: INTENT(IN), OPTIONAL
114 !
115 ! Process_ID: Set this argument to the MPI process ID that this
116 ! function call is running under. This value is used
117 ! solely for controlling INFORMATIOn message output.
118 ! If MPI is not being used, ignore this argument.
119 ! This argument is ignored if the Quiet argument is set.
120 ! UNITS: N/A
121 ! TYPE: INTEGER
122 ! DIMENSION: Scalar
123 ! ATTRIBUTES: INTENT(IN), OPTIONAL
124 !
125 ! Output_Process_ID: Set this argument to the MPI process ID in which
126 ! all INFORMATION messages are to be output. If
127 ! the passed Process_ID value agrees with this value
128 ! the INFORMATION messages are output.
129 ! This argument is ignored if the Quiet argument
130 ! is set.
131 ! UNITS: N/A
132 ! TYPE: INTEGER
133 ! DIMENSION: Scalar
134 ! ATTRIBUTES: INTENT(IN), OPTIONAL
135 !
136 ! FUNCTION RESULT:
137 ! Error_Status: The return value is an integer defining the error
138 ! status. The error codes are defined in the
139 ! Message_Handler module.
140 ! If == SUCCESS the data load was successful
141 ! == FAILURE an unrecoverable error occurred.
142 ! UNITS: N/A
143 ! TYPE: INTEGER
144 ! DIMENSION: Scalar
145 !
146 ! SIDE EFFECTS:
147 ! This function modifies the contents of the public data
148 ! structure VISsnowC.
149 !
150 !:sdoc-:
151 !------------------------------------------------------------------------------
152 
153  FUNCTION crtm_vissnowcoeff_load( &
154  Filename , & ! Input
155  File_Path , & ! Optional input
156  Quiet , & ! Optional input
157  Process_ID , & ! Optional input
158  Output_Process_ID) & ! Optional input
159  result( err_stat )
160  ! Arguments
161  CHARACTER(*), INTENT(IN) :: filename
162  CHARACTER(*), OPTIONAL, INTENT(IN) :: file_path
163  LOGICAL , OPTIONAL, INTENT(IN) :: quiet
164  INTEGER , OPTIONAL, INTENT(IN) :: process_id
165  INTEGER , OPTIONAL, INTENT(IN) :: output_process_id
166  ! Function result
167  INTEGER :: err_stat
168  ! Local parameters
169  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_VISsnowCoeff_Load'
170  ! Local variables
171  CHARACTER(ML) :: msg, pid_msg
172  CHARACTER(ML) :: vissnowcoeff_file
173  LOGICAL :: noisy
174 
175  ! Setup
176  err_stat = success
177  ! ...Assign the filename to local variable
178  vissnowcoeff_file = adjustl(filename)
179  ! ...Add the file path
180  IF ( PRESENT(file_path) ) vissnowcoeff_file = trim(adjustl(file_path))//trim(vissnowcoeff_file)
181  ! ...Check Quiet argument
182  noisy = .true.
183  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
184  ! ...Check the MPI Process Ids
185  IF ( noisy .AND. PRESENT(process_id) .AND. PRESENT(output_process_id) ) THEN
186  IF ( process_id /= output_process_id ) noisy = .false.
187  END IF
188  ! ...Create a process ID message tag for error messages
189  IF ( PRESENT(process_id) ) THEN
190  WRITE( pid_msg,'("; Process ID: ",i0)' ) process_id
191  ELSE
192  pid_msg = ''
193  END IF
194 
195 
196  ! Read the VIS snow SEcategory file
197  err_stat = secategory_readfile( &
198  vissnowc, &
199  vissnowcoeff_file, &
200  quiet = .NOT. noisy )
201  IF ( err_stat /= success ) THEN
202  msg = 'Error reading VISsnowCoeff SEcategory file '//trim(vissnowcoeff_file)//trim(pid_msg)
203  CALL load_cleanup(); RETURN
204  END IF
205 
206 
207  CONTAINS
208 
209  SUBROUTINE load_cleanup()
211  err_stat = failure
212  CALL display_message( routine_name, msg, err_stat )
213  END SUBROUTINE load_cleanup
214 
215  END FUNCTION crtm_vissnowcoeff_load
216 
217 
218 !------------------------------------------------------------------------------
219 !:sdoc+:
220 !
221 ! NAME:
222 ! CRTM_VISsnowCoeff_Destroy
223 !
224 ! PURPOSE:
225 ! Function to deallocate the public data structure VISsnowC containing
226 ! the CRTM visible snow surface emissivity data.
227 !
228 ! CALLING SEQUENCE:
229 ! Error_Status = CRTM_VISsnowCoeff_Destroy( Process_ID = Process_ID )
230 !
231 ! OPTIONAL INPUTS:
232 ! Process_ID: Set this argument to the MPI process ID that this
233 ! function call is running under. This value is used
234 ! solely for controlling message output. If MPI is not
235 ! being used, ignore this argument.
236 ! UNITS: N/A
237 ! TYPE: INTEGER
238 ! DIMENSION: Scalar
239 ! ATTRIBUTES: INTENT(IN), OPTIONAL
240 !
241 ! FUNCTION RESULT:
242 ! Error_Status: The return value is an integer defining the error
243 ! status. The error codes are defined in the
244 ! Message_Handler module.
245 ! If == SUCCESS the deallocation of the public data
246 ! structure was successful
247 ! == FAILURE an unrecoverable error occurred.
248 ! UNITS: N/A
249 ! TYPE: INTEGER
250 ! DIMENSION: Scalar
251 !
252 ! SIDE EFFECTS:
253 ! This function modifies the contents of the public data
254 ! structure VISsnowC.
255 !
256 !:sdoc-:
257 !------------------------------------------------------------------------------
258 
259  FUNCTION crtm_vissnowcoeff_destroy( Process_ID ) RESULT( err_stat )
260  ! Arguments
261  INTEGER, OPTIONAL, INTENT(IN) :: process_id
262  ! Function result
263  INTEGER :: err_stat
264  ! Local parameters
265  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_VISsnowCoeff_Destroy'
266  ! Local variables
267  CHARACTER(ML) :: msg, pid_msg
268 
269  ! Setup
270  err_stat = success
271  ! ...Create a process ID message tag for error messages
272  IF ( PRESENT(process_id) ) THEN
273  WRITE( pid_msg,'("; Process ID: ",i0)' ) process_id
274  ELSE
275  pid_msg = ''
276  END IF
277 
278  ! Destroy the structure
280  IF ( secategory_associated( vissnowc ) ) THEN
281  err_stat = failure
282  msg = 'Error deallocating VISsnowCoeff shared data structure'//trim(pid_msg)
283  CALL display_message( routine_name, msg, err_stat ); RETURN
284  END IF
285 
286  END FUNCTION crtm_vissnowcoeff_destroy
287 
288 
289 !------------------------------------------------------------------------------
290 !:sdoc+:
291 !
292 ! NAME:
293 ! CRTM_VISsnowCoeff_IsLoaded
294 !
295 ! PURPOSE:
296 ! Function to test if visible snow surface emissivity data has
297 ! been loaded into the public data structure VISsnowC.
298 !
299 ! CALLING SEQUENCE:
300 ! status = CRTM_VISsnowCoeff_IsLoaded()
301 !
302 !:sdoc-:
303 !------------------------------------------------------------------------------
304 
305  FUNCTION crtm_vissnowcoeff_isloaded() RESULT( IsLoaded )
306  LOGICAL :: isloaded
307  isloaded = secategory_associated( vissnowc )
308  END FUNCTION crtm_vissnowcoeff_isloaded
309 
310 END MODULE crtm_vissnowcoeff
integer, parameter, public failure
subroutine load_cleanup()
type(secategory_type), save, public vissnowc
integer function, public secategory_readfile(SEcategory, Filename, No_Close, Quiet, Title, History, Comment, Debug)
integer, parameter ml
elemental logical function, public secategory_associated(self)
logical function, public crtm_vissnowcoeff_isloaded()
integer function, public crtm_vissnowcoeff_destroy(Process_ID)
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
elemental subroutine, public secategory_destroy(self)
character(*), parameter module_version_id
integer function, public crtm_vissnowcoeff_load(Filename, File_Path, Quiet, Process_ID, Output_Process_ID)
integer, parameter, public success