FV3 Bundle
CloudCoeff_Define.f90
Go to the documentation of this file.
1 !
2 ! CloudCoeff_Define
3 !
4 ! Module defining the CloudCoeff data structure and containing routines to
5 ! manipulate it.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Yong Han, NOAA/NESDIS; Yong.Han@noaa.gov
10 ! Quanhua Liu, QSS Group, Inc; Quanhua.Liu@noaa.gov
11 ! Paul van Delst, CIMSS/SSEC; paul.vandelst@ssec.wisc.edu
12 !
13 
15 
16  ! ------------------
17  ! Environment set up
18  ! ------------------
19  ! Module use
20  USE type_kinds, ONLY: long, double
22  USE compare_float_numbers, ONLY: OPERATOR(.equalto.)
23  ! Disable implicit typing
24  IMPLICIT NONE
25 
26 
27  ! ------------
28  ! Visibilities
29  ! ------------
30  ! Everything private by default
31  PRIVATE
32  ! Datatypes
33  PUBLIC :: cloudcoeff_type
34  ! Operators
35  PUBLIC :: OPERATOR(==)
36  ! Procedures
37  PUBLIC :: cloudcoeff_associated
38  PUBLIC :: cloudcoeff_destroy
39  PUBLIC :: cloudcoeff_create
40  PUBLIC :: cloudcoeff_inspect
41  PUBLIC :: cloudcoeff_validrelease
42  PUBLIC :: cloudcoeff_info
43  PUBLIC :: cloudcoeff_defineversion
44 
45 
46  ! ---------------------
47  ! Procedure overloading
48  ! ---------------------
49  INTERFACE OPERATOR(==)
50  MODULE PROCEDURE cloudcoeff_equal
51  END INTERFACE OPERATOR(==)
52 
53 
54  ! -----------------
55  ! Module parameters
56  ! -----------------
57  ! Version Id for the module
58  CHARACTER(*), PARAMETER :: module_version_id = &
59  '$Id: CloudCoeff_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
60  ! CloudCoeff init values
61  REAL(Double), PARAMETER :: zero = 0.0_double
62  ! Keyword set value
63  INTEGER, PARAMETER :: set = 1
64  ! Current valid release and version numbers
65  INTEGER, PARAMETER :: cloudcoeff_release = 3 ! This determines structure and file formats.
66  INTEGER, PARAMETER :: cloudcoeff_version = 1 ! This is just the data version for the release.
67  ! Meggage string length
68  INTEGER, PARAMETER :: ml = 256
69 
70  ! Number of stream angle definitions in the data set
71  INTEGER, PARAMETER :: def_n_stream_sets = 5
72  INTEGER, PARAMETER :: def_n_streams(def_n_stream_sets) = [2, 4, 6, 8, 16]
73  ! ...This defines the offset in the "n_Legendre_Terms"
74  ! ...dimension of the phase coefficient arrays for the
75  ! ...various stream angle sets.
76  INTEGER, PARAMETER :: def_legendre_offset(def_n_stream_sets) = [0, 0, 5, 12, 21]
77 
78 
79  ! --------------------------------
80  ! CloudCoeff data type definition,
81  ! MW: Microwave
82  ! IR: Infrared
83  ! Reff: Effective radius
84  ! ke: Extinction coefficient
85  ! w: Single scatter albedo
86  ! g: Asymmetry parameter
87  ! L: Liquid phase
88  ! S: Solid phase
89  ! --------------------------------
90  !:tdoc+:
92  ! Release and version information
93  INTEGER(Long) :: release = cloudcoeff_release
94  INTEGER(Long) :: version = cloudcoeff_version
95  ! Allocation indicator
96  LOGICAL :: is_allocated = .false.
97  ! Dataset parameter definitions (eventually stored in the datafile)
98  INTEGER :: n_stream_sets = def_n_stream_sets
99  INTEGER :: n_streams(def_n_stream_sets) = def_n_streams
100  INTEGER :: legendre_offset(def_n_stream_sets) = def_legendre_offset
101  ! Array dimensions
102  INTEGER(Long) :: n_mw_frequencies = 0 ! I1 dimension
103  INTEGER(Long) :: n_mw_radii = 0 ! I2 dimension
104  INTEGER(Long) :: n_ir_frequencies = 0 ! I3 dimension
105  INTEGER(Long) :: n_ir_radii = 0 ! I4 dimension
106  INTEGER(Long) :: n_temperatures = 0 ! I5 dimension
107  INTEGER(Long) :: n_densities = 0 ! I6 dimension
108  INTEGER(Long) :: max_legendre_terms = 0 ! I7 dimension
109  INTEGER(Long) :: n_legendre_terms = 0
110  INTEGER(Long) :: max_phase_elements = 0 ! I8 dimension
111  INTEGER(Long) :: n_phase_elements = 0
112  ! LUT dimension vectors
113  REAL(Double), ALLOCATABLE :: frequency_mw(:) ! I1
114  REAL(Double), ALLOCATABLE :: frequency_ir(:) ! I3
115  REAL(Double), ALLOCATABLE :: reff_mw(:) ! I2
116  REAL(Double), ALLOCATABLE :: reff_ir(:) ! I4
117  REAL(Double), ALLOCATABLE :: temperature(:) ! I5
118  REAL(Double), ALLOCATABLE :: density(:) ! I6
119  ! Microwave data for liquid phase clouds
120  REAL(Double), ALLOCATABLE :: ke_l_mw(:,:,:) ! I1 x I2 x I5
121  REAL(Double), ALLOCATABLE :: w_l_mw(:,:,:) ! I1 x I2 x I5
122  REAL(Double), ALLOCATABLE :: g_l_mw(:,:,:) ! I1 x I2 x I5
123  REAL(Double), ALLOCATABLE :: pcoeff_l_mw(:,:,:,:,:) ! I1 x I2 x I5 x I7 x I8
124  ! Microwave data for solid phase clouds
125  REAL(Double), ALLOCATABLE :: ke_s_mw(:,:,:) ! I1 x I2 x I6
126  REAL(Double), ALLOCATABLE :: w_s_mw(:,:,:) ! I1 x I2 x I6
127  REAL(Double), ALLOCATABLE :: g_s_mw(:,:,:) ! I1 x I2 x I6
128  REAL(Double), ALLOCATABLE :: pcoeff_s_mw(:,:,:,:,:) ! I1 x I2 x I6 x I7 x I8
129  ! Infrared data. Note that the 0'th element in the I6 dimension
130  ! of these data correspond to the liquid phase component. The
131  ! remaining elements in this dimension are for the solid phase
132  ! component
133  REAL(Double), ALLOCATABLE :: ke_ir(:,:,:) ! I3 x I4 x 0:I6
134  REAL(Double), ALLOCATABLE :: w_ir(:,:,:) ! I3 x I4 x 0:I6
135  REAL(Double), ALLOCATABLE :: g_ir(:,:,:) ! I3 x I4 x 0:I6
136  REAL(Double), ALLOCATABLE :: pcoeff_ir(:,:,:,:) ! I3 x I4 x 0:I6 x I7
137  END TYPE cloudcoeff_type
138  !:tdoc-:
139 
140 
141 CONTAINS
142 
143 
144 !################################################################################
145 !################################################################################
146 !## ##
147 !## ## PUBLIC MODULE ROUTINES ## ##
148 !## ##
149 !################################################################################
150 !################################################################################
151 
152 !--------------------------------------------------------------------------------
153 !:sdoc+:
154 !
155 ! NAME:
156 ! CloudCoeff_Associated
157 !
158 ! PURPOSE:
159 ! Elemental function to test the status of the allocatable components
160 ! of a CloudCoeff object.
161 !
162 ! CALLING SEQUENCE:
163 ! Status = CloudCoeff_Associated( CloudCoeff )
164 !
165 ! OBJECTS:
166 ! CloudCoeff: CloudCoeff object which is to have its member's
167 ! status tested.
168 ! UNITS: N/A
169 ! TYPE: TYPE(CloudCoeff_type)
170 ! DIMENSION: Scalar or any rank
171 ! ATTRIBUTES: INTENT(IN)
172 !
173 ! FUNCTION RESULT:
174 ! Status: The return value is a logical value indicating the
175 ! status of the CloudCoeff members.
176 ! .TRUE. - if ANY of the CloudCoeff allocatable or
177 ! pointer members are in use.
178 ! .FALSE. - if ALL of the CloudCoeff allocatable or
179 ! pointer members are not in use.
180 ! UNITS: N/A
181 ! TYPE: LOGICAL
182 ! DIMENSION: Same as input CloudCoeff argument
183 !
184 !:sdoc-:
185 !--------------------------------------------------------------------------------
186 
187  ELEMENTAL FUNCTION cloudcoeff_associated( CloudCoeff ) RESULT( Status )
188  TYPE(cloudcoeff_type), INTENT(IN) :: cloudcoeff
189  LOGICAL :: status
190  status = cloudcoeff%Is_Allocated
191  END FUNCTION cloudcoeff_associated
192 
193 
194 !--------------------------------------------------------------------------------
195 !:sdoc+:
196 !
197 ! NAME:
198 ! CloudCoeff_Destroy
199 !
200 ! PURPOSE:
201 ! Elemental subroutine to re-initialize CloudCoeff objects.
202 !
203 ! CALLING SEQUENCE:
204 ! CALL CloudCoeff_Destroy( CloudCoeff )
205 !
206 ! OBJECTS:
207 ! CloudCoeff: Re-initialized CloudCoeff object.
208 ! UNITS: N/A
209 ! TYPE: TYPE(CloudCoeff_type)
210 ! DIMENSION: Scalar OR any rank
211 ! ATTRIBUTES: INTENT(OUT)
212 !
213 !:sdoc-:
214 !--------------------------------------------------------------------------------
215 
216  ELEMENTAL SUBROUTINE cloudcoeff_destroy( CloudCoeff )
217  TYPE(cloudcoeff_type), INTENT(OUT) :: cloudcoeff
218  cloudcoeff%Is_Allocated = .false.
219  cloudcoeff%n_MW_Frequencies = 0
220  cloudcoeff%n_MW_Radii = 0
221  cloudcoeff%n_IR_Frequencies = 0
222  cloudcoeff%n_IR_Radii = 0
223  cloudcoeff%n_Temperatures = 0
224  cloudcoeff%n_Densities = 0
225  cloudcoeff%Max_Legendre_Terms = 0
226  cloudcoeff%n_Legendre_Terms = 0
227  cloudcoeff%Max_Phase_Elements = 0
228  cloudcoeff%n_Phase_Elements = 0
229  END SUBROUTINE cloudcoeff_destroy
230 
231 
232 !--------------------------------------------------------------------------------
233 !
234 ! NAME:
235 ! CloudCoeff_Create
236 !
237 ! PURPOSE:
238 ! Elemental subroutine to create an instance of a CloudCoeff object.
239 !
240 ! CALLING SEQUENCE:
241 ! CALL CloudCoeff_Create( CloudCoeff , &
242 ! n_MW_Frequencies, &
243 ! n_MW_Radii , &
244 ! n_IR_Frequencies, &
245 ! n_IR_Radii , &
246 ! n_Temperatures , &
247 ! n_Densities , &
248 ! n_Legendre_Terms, &
249 ! n_Phase_Elements )
250 !
251 ! OBJECTS:
252 ! CloudCoeff: CloudCoeff object.
253 ! UNITS: N/A
254 ! TYPE: TYPE(CloudCoeff_type)
255 ! DIMENSION: Scalar or any rank
256 ! ATTRIBUTES: INTENT(OUT)
257 !
258 ! INPUTS:
259 ! n_MW_Frequencies: The number of microwave frequencies in
260 ! the look-up table (LUT)
261 ! The "I1" dimension. Must be > 0.
262 ! UNITS: N/A
263 ! TYPE: INTEGER
264 ! DIMENSION: Scalar
265 ! ATTRIBUTES: INTENT(IN)
266 !
267 ! n_MW_Radii: The number of discrete effective radii
268 ! for MW scatterers in the LUT.
269 ! The "I2" dimension. Must be > 0.
270 ! UNITS: N/A
271 ! TYPE: INTEGER
272 ! DIMENSION: Scalar
273 ! ATTRIBUTES: INTENT(IN)
274 !
275 ! n_IR_Frequencies: The number of infrared frequencies in
276 ! the LUT
277 ! The "I3" dimension. Must be > 0.
278 ! UNITS: N/A
279 ! TYPE: INTEGER
280 ! DIMENSION: Scalar
281 ! ATTRIBUTES: INTENT(IN)
282 !
283 ! n_IR_Radii: The number of discrete effective radii
284 ! for IR scatterers in the LUT.
285 ! The "I4" dimension. Must be > 0.
286 ! UNITS: N/A
287 ! TYPE: INTEGER
288 ! DIMENSION: Scalar
289 ! ATTRIBUTES: INTENT(IN)
290 !
291 ! n_Temperatures: The number of discrete layer temperatures
292 ! in the LUT.
293 ! The "I5" dimension. Must be > 0.
294 ! UNITS: N/A
295 ! TYPE: INTEGER
296 ! DIMENSION: Scalar
297 ! ATTRIBUTES: INTENT(IN)
298 !
299 ! n_Densities: The number of fixed densities for snow, graupel,
300 ! and hail/ice in the LUT.
301 ! The "I6" dimension. Must be > 0.
302 ! UNITS: N/A
303 ! TYPE: INTEGER
304 ! DIMENSION: Scalar
305 ! ATTRIBUTES: INTENT(IN)
306 !
307 ! n_Legendre_Terms: The maximum number of Legendre polynomial
308 ! terms in the LUT.
309 ! The "I7" dimension. Can be = 0.
310 ! UNITS: N/A
311 ! TYPE: INTEGER
312 ! DIMENSION: Scalar
313 ! ATTRIBUTES: INTENT(IN)
314 !
315 ! n_Phase_Elements: The maximum number of phase elements in the LUT.
316 ! The "I8" dimension. Must be > 0.
317 ! UNITS: N/A
318 ! TYPE: INTEGER
319 ! DIMENSION: Scalar
320 ! ATTRIBUTES: INTENT(IN)
321 !
322 !:sdoc-:
323 !--------------------------------------------------------------------------------
324 
325  ELEMENTAL SUBROUTINE cloudcoeff_create( &
326  CloudCoeff , &
327  n_MW_Frequencies, &
328  n_MW_Radii , &
329  n_IR_Frequencies, &
330  n_IR_Radii , &
331  n_Temperatures , &
332  n_Densities , &
333  n_Legendre_Terms, &
334  n_Phase_Elements )
335  ! Arguments
336  TYPE(cloudcoeff_type) , INTENT(OUT) :: cloudcoeff
337  INTEGER, INTENT(IN) :: n_mw_frequencies
338  INTEGER, INTENT(IN) :: n_mw_radii
339  INTEGER, INTENT(IN) :: n_ir_frequencies
340  INTEGER, INTENT(IN) :: n_ir_radii
341  INTEGER, INTENT(IN) :: n_temperatures
342  INTEGER, INTENT(IN) :: n_densities
343  INTEGER, INTENT(IN) :: n_legendre_terms
344  INTEGER, INTENT(IN) :: n_phase_elements
345  ! Local parameters
346  CHARACTER(*), PARAMETER :: routine_name = 'CloudCoeff_Create'
347  ! Local variables
348  INTEGER :: alloc_stat(4)
349 
350  ! Check input
351  IF ( n_mw_frequencies < 1 .OR. &
352  n_mw_radii < 1 .OR. &
353  n_ir_frequencies < 1 .OR. &
354  n_ir_radii < 1 .OR. &
355  n_temperatures < 1 .OR. &
356  n_densities < 1 .OR. &
357  n_legendre_terms < 0 .OR. &
358  n_phase_elements < 1 ) RETURN
359 
360 
361  ! Perform the allocation. The allocations were
362  ! split across several calls for clarity only.
363  ! ...Allocate the dimension vectors
364  ALLOCATE( cloudcoeff%Frequency_MW(n_mw_frequencies), &
365  cloudcoeff%Frequency_IR(n_ir_frequencies), &
366  cloudcoeff%Reff_MW(n_mw_radii), &
367  cloudcoeff%Reff_IR(n_ir_radii), &
368  cloudcoeff%Temperature(n_temperatures), &
369  cloudcoeff%Density(n_densities), &
370  stat = alloc_stat(1) )
371  ! ...Allocate the microwave liquid phase arrays
372  ALLOCATE( cloudcoeff%ke_L_MW(n_mw_frequencies, n_mw_radii, n_temperatures), &
373  cloudcoeff%w_L_MW(n_mw_frequencies , n_mw_radii, n_temperatures), &
374  cloudcoeff%g_L_MW(n_mw_frequencies , n_mw_radii, n_temperatures), &
375  cloudcoeff%pcoeff_L_MW(n_mw_frequencies , &
376  n_mw_radii , &
377  n_temperatures , &
378  0:n_legendre_terms, &
379  n_phase_elements ), &
380  stat = alloc_stat(2) )
381  ! ...Allocate the microwave solid phase arrays
382  ALLOCATE( cloudcoeff%ke_S_MW(n_mw_frequencies, n_mw_radii, n_densities), &
383  cloudcoeff%w_S_MW(n_mw_frequencies , n_mw_radii, n_densities), &
384  cloudcoeff%g_S_MW(n_mw_frequencies , n_mw_radii, n_densities), &
385  cloudcoeff%pcoeff_S_MW(n_mw_frequencies , &
386  n_mw_radii , &
387  n_densities , &
388  0:n_legendre_terms, &
389  n_phase_elements ), &
390  stat = alloc_stat(3) )
391  ! ...Allocate the infrared arrays
392  ALLOCATE( cloudcoeff%ke_IR(n_ir_frequencies, n_ir_radii, 0:n_densities), &
393  cloudcoeff%w_IR(n_ir_frequencies , n_ir_radii, 0:n_densities), &
394  cloudcoeff%g_IR(n_ir_frequencies , n_ir_radii, 0:n_densities), &
395  cloudcoeff%pcoeff_IR(n_ir_frequencies , &
396  n_ir_radii , &
397  0:n_densities , &
398  0:n_legendre_terms ), &
399  stat = alloc_stat(4) )
400  IF ( any(alloc_stat /= 0) ) RETURN
401 
402 
403  ! Initialise
404  ! ...Dimensions
405  cloudcoeff%n_MW_Frequencies = n_mw_frequencies
406  cloudcoeff%n_MW_Radii = n_mw_radii
407  cloudcoeff%n_IR_Frequencies = n_ir_frequencies
408  cloudcoeff%n_IR_Radii = n_ir_radii
409  cloudcoeff%n_Temperatures = n_temperatures
410  cloudcoeff%n_Densities = n_densities
411  cloudcoeff%Max_Legendre_Terms = n_legendre_terms
412  cloudcoeff%n_Legendre_Terms = n_legendre_terms
413  cloudcoeff%Max_Phase_Elements = n_phase_elements
414  cloudcoeff%n_Phase_Elements = n_phase_elements
415  ! ...Arrays
416  cloudcoeff%Frequency_MW = zero
417  cloudcoeff%Frequency_IR = zero
418  cloudcoeff%Reff_MW = zero
419  cloudcoeff%Reff_IR = zero
420  cloudcoeff%Temperature = zero
421  cloudcoeff%Density = zero
422 
423  cloudcoeff%ke_L_MW = zero
424  cloudcoeff%w_L_MW = zero
425  cloudcoeff%g_L_MW = zero
426  cloudcoeff%pcoeff_L_MW = zero
427 
428  cloudcoeff%ke_S_MW = zero
429  cloudcoeff%w_S_MW = zero
430  cloudcoeff%g_S_MW = zero
431  cloudcoeff%pcoeff_S_MW = zero
432 
433  cloudcoeff%ke_IR = zero
434  cloudcoeff%w_IR = zero
435  cloudcoeff%g_IR = zero
436  cloudcoeff%pcoeff_IR = zero
437 
438 
439  ! Set allocationindicator
440  cloudcoeff%Is_Allocated = .true.
441 
442  END SUBROUTINE cloudcoeff_create
443 
444 
445 !--------------------------------------------------------------------------------
446 !:sdoc+:
447 !
448 ! NAME:
449 ! CloudCoeff_Inspect
450 !
451 ! PURPOSE:
452 ! Subroutine to print the contents of a CloudCoeff object to stdout.
453 !
454 ! CALLING SEQUENCE:
455 ! CALL CloudCoeff_Inspect( CloudCoeff )
456 !
457 ! INPUTS:
458 ! CloudCoeff: CloudCoeff object to display.
459 ! UNITS: N/A
460 ! TYPE: TYPE(CloudCoeff_type)
461 ! DIMENSION: Scalar
462 ! ATTRIBUTES: INTENT(IN)
463 !
464 !:sdoc-:
465 !--------------------------------------------------------------------------------
466 
467  SUBROUTINE cloudcoeff_inspect( CloudCoeff, Pause )
468  ! Arguments
469  TYPE(cloudcoeff_type), INTENT(IN) :: cloudcoeff
470  LOGICAL, OPTIONAL, INTENT(IN) :: pause
471  ! Variables
472  INTEGER :: i, j, k, l, m
473  INTEGER :: kidx
474  LOGICAL :: wait
475 
476  wait = .false.
477  IF ( PRESENT(pause) ) wait = pause
478 
479  WRITE(*,'(1x,"CloudCoeff OBJECT")')
480  ! Dimensions
481  WRITE(*,'(3x,"n_MW_Frequencies :",1x,i0)') cloudcoeff%n_MW_Frequencies
482  WRITE(*,'(3x,"n_MW_Radii :",1x,i0)') cloudcoeff%n_MW_Radii
483  WRITE(*,'(3x,"n_IR_Frequencies :",1x,i0)') cloudcoeff%n_IR_Frequencies
484  WRITE(*,'(3x,"n_IR_Radii :",1x,i0)') cloudcoeff%n_IR_Radii
485  WRITE(*,'(3x,"n_Temperatures :",1x,i0)') cloudcoeff%n_Temperatures
486  WRITE(*,'(3x,"n_Densities :",1x,i0)') cloudcoeff%n_Densities
487  WRITE(*,'(3x,"n_Legendre_Terms :",1x,i0)') cloudcoeff%n_Legendre_Terms
488  WRITE(*,'(3x,"n_Phase_Elements :",1x,i0)') cloudcoeff%n_Phase_Elements
489  IF ( .NOT. cloudcoeff_associated(cloudcoeff) ) RETURN
490  ! Dimensional vectors
491  WRITE(*,'(/3x,"Dimensional vectors...")')
492  WRITE(*,'(5x,"CloudCoeff Frequency_MW:")')
493  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Frequency_MW
494  WRITE(*,'(5x,"CloudCoeff Frequency_IR:")')
495  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Frequency_IR
496  WRITE(*,'(5x,"CloudCoeff Reff_MW :")')
497  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Reff_MW
498  WRITE(*,'(5x,"CloudCoeff Reff_IR :")')
499  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Reff_IR
500  WRITE(*,'(5x,"CloudCoeff Temperature :")')
501  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Temperature
502  WRITE(*,'(5x,"CloudCoeff Density :")')
503  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%Density
504 
505  ! Microwave data
506  WRITE(*,'(/3x,"Microwave data...")')
507 
508  ! ...Liquid phase data
509  IF ( wait ) THEN
510  WRITE(*,'(/5x,"Press <ENTER> to view the microwave liquid phase mass extinction coefficients")')
511  READ(*,*)
512  END IF
513  DO j = 1, cloudcoeff%n_Temperatures
514  WRITE(*,'(5x,"Microwave liquid phase mass extinction coefficients:")')
515  WRITE(*,'(7x,"Temperature : ",es13.6)') cloudcoeff%Temperature(j)
516  DO i = 1, cloudcoeff%n_MW_Radii
517  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
518  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%ke_L_MW(:,i,j)
519  END DO
520  END DO
521 
522  IF ( wait ) THEN
523  WRITE(*,'(/5x,"Press <ENTER> to view the microwave liquid phase single scatter albedo")')
524  READ(*,*)
525  END IF
526  DO j = 1, cloudcoeff%n_Temperatures
527  WRITE(*,'(5x,"Microwave liquid phase single scatter albedo:")')
528  WRITE(*,'(7x,"Temperature : ",es13.6)') cloudcoeff%Temperature(j)
529  DO i = 1, cloudcoeff%n_MW_Radii
530  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
531  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%w_L_MW(:,i,j)
532  END DO
533  END DO
534 
535  IF ( wait ) THEN
536  WRITE(*,'(/5x,"Press <ENTER> to view the microwave liquid phase asymmetry parameter")')
537  READ(*,*)
538  END IF
539  DO j = 1, cloudcoeff%n_Temperatures
540  WRITE(*,'(5x,"Microwave liquid phase asymmetry parameter:")')
541  WRITE(*,'(7x,"Temperature : ",es13.6)') cloudcoeff%Temperature(j)
542  DO i = 1, cloudcoeff%n_MW_Radii
543  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
544  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%g_L_MW(:,i,j)
545  END DO
546  END DO
547 
548  DO m = 1, cloudcoeff%n_Stream_Sets
549  IF ( wait ) THEN
550  WRITE(*,'(/5x,"Press <ENTER> to view the ",i0,"-stream microwave liquid ",&
551  &"phase phase coefficients")') cloudcoeff%n_Streams(m)
552  READ(*,*)
553  END IF
554  WRITE(*,'(5x,i0,"-stream microwave liquid phase phase coefficients:")') cloudcoeff%n_Streams(m)
555  DO l = 1, cloudcoeff%n_Phase_Elements
556  WRITE(*,'(7x,"Phase element: ",i0)') l
557  DO k = 1, cloudcoeff%n_Streams(m)
558  WRITE(*,'(7x,"Legendre term: ",i0)') k
559  kidx = k + cloudcoeff%Legendre_Offset(m)
560  DO j = 1, cloudcoeff%n_Temperatures
561  WRITE(*,'(7x,"Temperature : ",es13.6)') cloudcoeff%Temperature(j)
562  DO i = 1, cloudcoeff%n_MW_Radii
563  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
564  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%pcoeff_L_MW(:,i,j,kidx,l)
565  END DO
566  END DO
567  END DO
568  END DO
569  END DO
570 
571  ! ...Solid phase data
572  IF ( wait ) THEN
573  WRITE(*,'(/5x,"Press <ENTER> to view the microwave solid phase mass extinction coefficients")')
574  READ(*,*)
575  END IF
576  DO j = 1, cloudcoeff%n_Densities
577  WRITE(*,'(5x,"Microwave solid phase mass extinction coefficients:")')
578  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
579  DO i = 1, cloudcoeff%n_MW_Radii
580  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
581  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%ke_S_MW(:,i,j)
582  END DO
583  END DO
584 
585  IF ( wait ) THEN
586  WRITE(*,'(/5x,"Press <ENTER> to view the microwave solid phase single scatter albedo")')
587  READ(*,*)
588  END IF
589  DO j = 1, cloudcoeff%n_Densities
590  WRITE(*,'(5x,"Microwave solid phase single scatter albedo:")')
591  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
592  DO i = 1, cloudcoeff%n_MW_Radii
593  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
594  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%w_S_MW(:,i,j)
595  END DO
596  END DO
597 
598  IF ( wait ) THEN
599  WRITE(*,'(/5x,"Press <ENTER> to view the microwave solid phase asymmetry parameter")')
600  READ(*,*)
601  END IF
602  DO j = 1, cloudcoeff%n_Densities
603  WRITE(*,'(5x,"Microwave solid phase asymmetry parameter:")')
604  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
605  DO i = 1, cloudcoeff%n_MW_Radii
606  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
607  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%g_S_MW(:,i,j)
608  END DO
609  END DO
610 
611  DO m = 1, cloudcoeff%n_Stream_Sets
612  IF ( wait ) THEN
613  WRITE(*,'(/5x,"Press <ENTER> to view the ",i0,"-stream microwave solid ",&
614  &"phase phase coefficients")') cloudcoeff%n_Streams(m)
615  READ(*,*)
616  END IF
617  WRITE(*,'(5x,i0,"-stream microwave solid phase phase coefficients:")') cloudcoeff%n_Streams(m)
618  DO l = 1, cloudcoeff%n_Phase_Elements
619  WRITE(*,'(7x,"Phase element: ",i0)') l
620  DO k = 1, cloudcoeff%n_Streams(m)
621  WRITE(*,'(7x,"Legendre term: ",i0)') k
622  kidx = k + cloudcoeff%Legendre_Offset(m)
623  DO j = 1, cloudcoeff%n_Densities
624  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
625  DO i = 1, cloudcoeff%n_MW_Radii
626  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_MW(i)
627  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%pcoeff_S_MW(:,i,j,kidx,l)
628  END DO
629  END DO
630  END DO
631  END DO
632  END DO
633 
634 
635  ! Infrared data
636  WRITE(*,'(/3x,"Infrared data...")')
637 
638  ! ...Liquid phase data
639  IF ( wait ) THEN
640  WRITE(*,'(/5x,"Press <ENTER> to view the infrared liquid phase mass extinction coefficients")')
641  READ(*,*)
642  END IF
643  WRITE(*,'(5x,"Infrared liquid phase mass extinction coefficients:")')
644  DO i = 1, cloudcoeff%n_IR_Radii
645  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
646  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%ke_IR(:,i,0)
647  END DO
648 
649  IF ( wait ) THEN
650  WRITE(*,'(/5x,"Press <ENTER> to view the infrared liquid phase single scatter albedo")')
651  READ(*,*)
652  END IF
653  WRITE(*,'(5x,"Infrared liquid phase single scatter albedo:")')
654  DO i = 1, cloudcoeff%n_IR_Radii
655  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
656  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%w_IR(:,i,0)
657  END DO
658 
659  IF ( wait ) THEN
660  WRITE(*,'(/5x,"Press <ENTER> to view the infrared liquid phase asymmetry parameter")')
661  READ(*,*)
662  END IF
663  WRITE(*,'(5x,"Infrared liquid phase asymmetry parameter:")')
664  DO i = 1, cloudcoeff%n_IR_Radii
665  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
666  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%g_IR(:,i,0)
667  END DO
668 
669  DO m = 1, cloudcoeff%n_Stream_Sets
670  IF ( wait ) THEN
671  WRITE(*,'(/5x,"Press <ENTER> to view the ",i0,"-stream infrared liquid ",&
672  &"phase phase coefficients")') cloudcoeff%n_Streams(m)
673  READ(*,*)
674  END IF
675  WRITE(*,'(5x,i0,"-stream infrared liquid phase phase coefficients:")') cloudcoeff%n_Streams(m)
676  DO k = 1, cloudcoeff%n_Streams(m)
677  WRITE(*,'(7x,"Legendre term: ",i0)') k
678  kidx = k + cloudcoeff%Legendre_Offset(m)
679  DO i = 1, cloudcoeff%n_IR_Radii
680  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
681  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%pcoeff_IR(:,i,0,kidx)
682  END DO
683  END DO
684  END DO
685 
686  ! ...Solid phase data
687  IF ( wait ) THEN
688  WRITE(*,'(/5x,"Press <ENTER> to view the infrared solid phase mass extinction coefficients")')
689  READ(*,*)
690  END IF
691  DO j = 1, cloudcoeff%n_Densities
692  WRITE(*,'(5x,"Infrared solid phase mass extinction coefficients:")')
693  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
694  DO i = 1, cloudcoeff%n_IR_Radii
695  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
696  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%ke_IR(:,i,j)
697  END DO
698  END DO
699 
700  IF ( wait ) THEN
701  WRITE(*,'(/5x,"Press <ENTER> to view the infrared solid phase single scatter albedo")')
702  READ(*,*)
703  END IF
704  DO j = 1, cloudcoeff%n_Densities
705  WRITE(*,'(5x,"Infrared solid phase single scatter albedo:")')
706  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
707  DO i = 1, cloudcoeff%n_IR_Radii
708  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
709  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%w_IR(:,i,j)
710  END DO
711  END DO
712 
713  IF ( wait ) THEN
714  WRITE(*,'(/5x,"Press <ENTER> to view the infrared solid phase asymmetry parameter")')
715  READ(*,*)
716  END IF
717  DO j = 1, cloudcoeff%n_Densities
718  WRITE(*,'(5x,"Infrared solid phase asymmetry parameter:")')
719  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
720  DO i = 1, cloudcoeff%n_IR_Radii
721  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
722  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%g_IR(:,i,j)
723  END DO
724  END DO
725 
726  DO m = 1, cloudcoeff%n_Stream_Sets
727  IF ( wait ) THEN
728  WRITE(*,'(/5x,"Press <ENTER> to view the ",i0,"-stream infrared solid ",&
729  &"phase phase coefficients")') cloudcoeff%n_Streams(m)
730  READ(*,*)
731  END IF
732  WRITE(*,'(5x,i0,"-stream infrared solid phase phase coefficients:")') cloudcoeff%n_Streams(m)
733  DO k = 1, cloudcoeff%n_Streams(m)
734  WRITE(*,'(7x,"Legendre term: ",i0)') k
735  kidx = k + cloudcoeff%Legendre_Offset(m)
736  DO j = 1, cloudcoeff%n_Densities
737  WRITE(*,'(7x,"Density : ",es13.6)') cloudcoeff%Density(j)
738  DO i = 1, cloudcoeff%n_IR_Radii
739  WRITE(*,'(7x,"Effective radius: ",es13.6)') cloudcoeff%Reff_IR(i)
740  WRITE(*,'(5(1x,es13.6,:))') cloudcoeff%pcoeff_IR(:,i,j,kidx)
741  END DO
742  END DO
743  END DO
744  END DO
745 
746  END SUBROUTINE cloudcoeff_inspect
747 
748 
749 !----------------------------------------------------------------------------------
750 !:sdoc+:
751 !
752 ! NAME:
753 ! CloudCoeff_ValidRelease
754 !
755 ! PURPOSE:
756 ! Function to check the CloudCoeff Release value.
757 !
758 ! CALLING SEQUENCE:
759 ! IsValid = CloudCoeff_ValidRelease( CloudCoeff )
760 !
761 ! INPUTS:
762 ! CloudCoeff: CloudCoeff object for which the Release component
763 ! is to be checked.
764 ! UNITS: N/A
765 ! TYPE: TYPE(CloudCoeff_type)
766 ! DIMENSION: Scalar
767 ! ATTRIBUTES: INTENT(IN)
768 !
769 ! FUNCTION RESULT:
770 ! IsValid: Logical value defining the release validity.
771 ! UNITS: N/A
772 ! TYPE: LOGICAL
773 ! DIMENSION: Scalar
774 !
775 !----------------------------------------------------------------------------------
776 
777  FUNCTION cloudcoeff_validrelease( CloudCoeff ) RESULT( IsValid )
778  ! Arguments
779  TYPE(cloudcoeff_type), INTENT(IN) :: cloudcoeff
780  ! Function result
781  LOGICAL :: isvalid
782  ! Local parameters
783  CHARACTER(*), PARAMETER :: routine_name = 'CloudCoeff_ValidRelease'
784  ! Local variables
785  CHARACTER(ML) :: msg
786 
787  ! Set up
788  isvalid = .true.
789 
790 
791  ! Check release is not too old
792  IF ( cloudcoeff%Release < cloudcoeff_release ) THEN
793  isvalid = .false.
794  WRITE( msg,'("A CloudCoeff data update is needed. ", &
795  &"CloudCoeff release is ",i0, &
796  &". Valid release is ",i0,"." )' ) &
797  cloudcoeff%Release, cloudcoeff_release
798  CALL display_message( routine_name, msg, information )
799  RETURN
800  END IF
801 
802 
803  ! Check release is not too new
804  IF ( cloudcoeff%Release > cloudcoeff_release ) THEN
805  isvalid = .false.
806  WRITE( msg,'("A CloudCoeff software update is needed. ", &
807  &"CloudCoeff release is ",i0, &
808  &". Valid release is ",i0,"." )' ) &
809  cloudcoeff%Release, cloudcoeff_release
810  CALL display_message( routine_name, msg, information )
811  RETURN
812  END IF
813 
814  END FUNCTION cloudcoeff_validrelease
815 
816 
817 !--------------------------------------------------------------------------------
818 !:sdoc+:
819 !
820 ! NAME:
821 ! CloudCoeff_Info
822 !
823 ! PURPOSE:
824 ! Subroutine to return a string containing version and dimension
825 ! information about a CloudCoeff object.
826 !
827 ! CALLING SEQUENCE:
828 ! CALL CloudCoeff_Info( CloudCoeff, Info )
829 !
830 ! INPUTS:
831 ! CloudCoeff: CloudCoeff object about which info is required.
832 ! UNITS: N/A
833 ! TYPE: TYPE(CloudCoeff_type)
834 ! DIMENSION: Scalar
835 ! ATTRIBUTES: INTENT(IN)
836 !
837 ! OUTPUTS:
838 ! Info: String containing version and dimension information
839 ! about the passed CloudCoeff object.
840 ! UNITS: N/A
841 ! TYPE: CHARACTER(*)
842 ! DIMENSION: Scalar
843 ! ATTRIBUTES: INTENT(OUT)
844 !
845 !:sdoc-:
846 !--------------------------------------------------------------------------------
847 
848  SUBROUTINE cloudcoeff_info( CloudCoeff, Info )
849  ! Arguments
850  TYPE(cloudcoeff_type), INTENT(IN) :: cloudcoeff
851  CHARACTER(*), INTENT(OUT) :: info
852  ! Parameters
853  INTEGER, PARAMETER :: carriage_return = 13
854  INTEGER, PARAMETER :: linefeed = 10
855  ! Local variables
856  CHARACTER(2000) :: long_string
857 
858  ! Write the required data to the local string
859  WRITE( long_string, &
860  '( a,1x,"CloudCoeff RELEASE.VERSION: ", i2, ".", i2.2, 2x, &
861  &"N_FREQUENCIES(MW)=",i4,2x,&
862  &"N_FREQUENCIES(IR)=",i4,2x,&
863  &"N_RADII(MW)=",i2,2x,&
864  &"N_RADII(IR)=",i2,2x,&
865  &"N_TEMPERATURES=",i2,2x,&
866  &"N_DENSITIES=",i2,2x,&
867  &"N_LEGENDRE_TERMS=",i2,2x,&
868  &"N_PHASE_ELEMENTS=",i2 )' ) &
869  achar(carriage_return)//achar(linefeed), &
870  cloudcoeff%Release, cloudcoeff%Version, &
871  cloudcoeff%n_MW_Frequencies, &
872  cloudcoeff%n_IR_Frequencies, &
873  cloudcoeff%n_MW_Radii , &
874  cloudcoeff%n_IR_Radii , &
875  cloudcoeff%n_Temperatures , &
876  cloudcoeff%n_Densities , &
877  cloudcoeff%n_Legendre_Terms, &
878  cloudcoeff%n_Phase_Elements
879 
880  ! Trim the output based on the
881  ! dummy argument string length
882  info = long_string(1:min(len(info), len_trim(long_string)))
883 
884  END SUBROUTINE cloudcoeff_info
885 
886 
887 !--------------------------------------------------------------------------------
888 !:sdoc+:
889 !
890 ! NAME:
891 ! CloudCoeff_DefineVersion
892 !
893 ! PURPOSE:
894 ! Subroutine to return the module version information.
895 !
896 ! CALLING SEQUENCE:
897 ! CALL CloudCoeff_DefineVersion( Id )
898 !
899 ! OUTPUTS:
900 ! Id: Character string containing the version Id information
901 ! for the module.
902 ! UNITS: N/A
903 ! TYPE: CHARACTER(*)
904 ! DIMENSION: Scalar
905 ! ATTRIBUTES: INTENT(OUT)
906 !
907 !:sdoc-:
908 !--------------------------------------------------------------------------------
909 
910  SUBROUTINE cloudcoeff_defineversion( Id )
911  CHARACTER(*), INTENT(OUT) :: id
912  id = module_version_id
913  END SUBROUTINE cloudcoeff_defineversion
914 
915 
916 
917 
918 !##################################################################################
919 !##################################################################################
920 !## ##
921 !## ## PRIVATE MODULE ROUTINES ## ##
922 !## ##
923 !##################################################################################
924 !##################################################################################
925 
926 !------------------------------------------------------------------------------
927 !
928 ! NAME:
929 ! CloudCoeff_Equal
930 !
931 ! PURPOSE:
932 ! Elemental function to test the equality of two CloudCoeff objects.
933 ! Used in OPERATOR(==) interface block.
934 !
935 ! CALLING SEQUENCE:
936 ! is_equal = CloudCoeff_Equal( x, y )
937 !
938 ! or
939 !
940 ! IF ( x == y ) THEN
941 ! ...
942 ! END IF
943 !
944 ! OBJECTS:
945 ! x, y: Two CloudCoeff objects to be compared.
946 ! UNITS: N/A
947 ! TYPE: TYPE(CloudCoeff_type)
948 ! DIMENSION: Scalar or any rank
949 ! ATTRIBUTES: INTENT(IN)
950 !
951 ! FUNCTION RESULT:
952 ! is_equal: Logical value indicating whether the inputs are equal.
953 ! UNITS: N/A
954 ! TYPE: LOGICAL
955 ! DIMENSION: Same as inputs.
956 !
957 !------------------------------------------------------------------------------
958 
959  ELEMENTAL FUNCTION cloudcoeff_equal( x, y ) RESULT( is_equal )
960  TYPE(cloudcoeff_type), INTENT(IN) :: x, y
961  LOGICAL :: is_equal
962 
963  ! Set up
964  is_equal = .false.
965 
966  ! Check the object association status
967  IF ( (.NOT. cloudcoeff_associated(x)) .OR. &
968  (.NOT. cloudcoeff_associated(y)) ) RETURN
969 
970  ! Check contents
971  ! ...Dimensions
972  IF ( (x%n_MW_Frequencies /= y%n_MW_Frequencies) .OR. &
973  (x%n_IR_Frequencies /= y%n_IR_Frequencies) .OR. &
974  (x%n_MW_Radii /= y%n_MW_Radii ) .OR. &
975  (x%n_IR_Radii /= y%n_IR_Radii ) .OR. &
976  (x%n_Temperatures /= y%n_Temperatures ) .OR. &
977  (x%n_Densities /= y%n_Densities ) .OR. &
978  (x%n_Legendre_Terms /= y%n_Legendre_Terms) .OR. &
979  (x%n_Phase_Elements /= y%n_Phase_Elements) ) RETURN
980  ! ...Data
981  IF ( all(x%Frequency_MW .equalto. y%Frequency_MW ) .AND. &
982  all(x%Frequency_IR .equalto. y%Frequency_IR ) .AND. &
983  all(x%Reff_MW .equalto. y%Reff_MW ) .AND. &
984  all(x%Reff_IR .equalto. y%Reff_IR ) .AND. &
985  all(x%Temperature .equalto. y%Temperature ) .AND. &
986  all(x%Density .equalto. y%Density ) .AND. &
987  all(x%ke_L_MW .equalto. y%ke_L_MW ) .AND. &
988  all(x%w_L_MW .equalto. y%w_L_MW ) .AND. &
989  all(x%g_L_MW .equalto. y%g_L_MW ) .AND. &
990  all(x%pcoeff_L_MW .equalto. y%pcoeff_L_MW ) .AND. &
991  all(x%ke_S_MW .equalto. y%ke_S_MW ) .AND. &
992  all(x%w_S_MW .equalto. y%w_S_MW ) .AND. &
993  all(x%g_S_MW .equalto. y%g_S_MW ) .AND. &
994  all(x%pcoeff_S_MW .equalto. y%pcoeff_S_MW ) .AND. &
995  all(x%ke_IR .equalto. y%ke_IR ) .AND. &
996  all(x%w_IR .equalto. y%w_IR ) .AND. &
997  all(x%g_IR .equalto. y%g_IR ) .AND. &
998  all(x%pcoeff_IR .equalto. y%pcoeff_IR ) ) &
999  is_equal = .true.
1000 
1001  END FUNCTION cloudcoeff_equal
1002 
1003 END MODULE cloudcoeff_define
integer, parameter, public failure
integer, parameter, public long
Definition: Type_Kinds.f90:76
character(*), parameter module_version_id
elemental subroutine, public cloudcoeff_destroy(CloudCoeff)
integer, parameter set
elemental subroutine, public cloudcoeff_create(CloudCoeff, n_MW_Frequencies, n_MW_Radii, n_IR_Frequencies, n_IR_Radii, n_Temperatures, n_Densities, n_Legendre_Terms, n_Phase_Elements)
integer, parameter, public double
Definition: Type_Kinds.f90:106
integer, parameter cloudcoeff_release
subroutine, public cloudcoeff_inspect(CloudCoeff, Pause)
integer, dimension(def_n_stream_sets), parameter def_legendre_offset
real(double), parameter zero
integer, parameter cloudcoeff_version
subroutine, public cloudcoeff_defineversion(Id)
elemental logical function cloudcoeff_equal(x, y)
integer, parameter def_n_stream_sets
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
subroutine, public cloudcoeff_info(CloudCoeff, Info)
integer, parameter ml
elemental logical function, public cloudcoeff_associated(CloudCoeff)
#define min(a, b)
Definition: mosaic_util.h:32
logical function, public cloudcoeff_validrelease(CloudCoeff)
integer, parameter, public success
integer, parameter, public information
integer, dimension(def_n_stream_sets), parameter def_n_streams