Line data Source code
1 : !------------------------------------------------------------------------------
2 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3 : ! and NASA/GFSC, SIVO, Code 610.3 !
4 : !------------------------------------------------------------------------------
5 : !BOP
6 : !
7 : ! !MODULE: HCO_ncdf_mod.F90
8 : !
9 : ! !DESCRIPTION: Module HCO\_NCDF\_MOD contains routines to read data from
10 : ! netCDF files.
11 : !\\
12 : !\\
13 : ! !INTERFACE:
14 : !
15 : MODULE HCO_NCDF_MOD
16 : !
17 : ! !USES:
18 : !
19 : ! Modules for netCDF read
20 : USE HCO_m_netcdf_io_open
21 : USE HCO_m_netcdf_io_get_dimlen
22 : USE HCO_m_netcdf_io_read
23 : USE HCO_m_netcdf_io_readattr
24 : USE HCO_m_netcdf_io_close
25 : USE HCO_m_netcdf_io_create
26 : USE HCO_m_netcdf_io_define
27 : USE HCO_m_netcdf_io_write
28 : USE HCO_m_netcdf_io_checks
29 : USE HCO_PRECISION_MOD, ONLY : SP => f4, DP => f8
30 :
31 : IMPLICIT NONE
32 : PRIVATE
33 : # include "netcdf.inc"
34 : !
35 : ! !PUBLIC MEMBER FUNCTIONS:
36 : !
37 : PUBLIC :: NC_OPEN
38 : PUBLIC :: NC_APPEND
39 : PUBLIC :: NC_CREATE
40 : PUBLIC :: NC_SET_DEFMODE
41 : PUBLIC :: NC_VAR_DEF
42 : PUBLIC :: NC_VAR_CHUNK
43 : PUBLIC :: NC_VAR_WRITE
44 : PUBLIC :: NC_CLOSE
45 : PUBLIC :: NC_READ_TIME
46 : PUBLIC :: NC_READ_TIME_YYYYMMDDhhmm
47 : PUBLIC :: NC_READ_VAR
48 : PUBLIC :: NC_READ_ARR
49 : PUBLIC :: NC_GET_REFDATETIME
50 : PUBLIC :: NC_GET_GRID_EDGES
51 : PUBLIC :: NC_GET_SIGMA_LEVELS
52 : PUBLIC :: NC_WRITE
53 : PUBLIC :: NC_ISMODELLEVEL
54 : PUBLIC :: NC_ISSIGMALEVEL
55 : PUBLIC :: GET_TAU0
56 : !
57 : ! !PRIVATE MEMBER FUNCTIONS:
58 : !
59 : PRIVATE :: GET_TIDX
60 : PRIVATE :: TIMEUNIT_CHECK
61 : PRIVATE :: NC_WRITE_3D
62 : PRIVATE :: NC_WRITE_4D
63 : PRIVATE :: NC_VAR_WRITE_INT_1D
64 : PRIVATE :: NC_VAR_WRITE_INT_2D
65 : PRIVATE :: NC_VAR_WRITE_INT_3D
66 : PRIVATE :: NC_VAR_WRITE_INT_4D
67 : PRIVATE :: NC_VAR_WRITE_R4_1D
68 : PRIVATE :: NC_VAR_WRITE_R4_2D
69 : PRIVATE :: NC_VAR_WRITE_R4_3D
70 : PRIVATE :: NC_VAR_WRITE_R4_4D
71 : PRIVATE :: NC_VAR_WRITE_R8_0D
72 : PRIVATE :: NC_VAR_WRITE_R8_1D
73 : PRIVATE :: NC_VAR_WRITE_R8_2D
74 : PRIVATE :: NC_VAR_WRITE_R8_3D
75 : PRIVATE :: NC_VAR_WRITE_R8_4D
76 : PRIVATE :: NC_READ_VAR_SP
77 : PRIVATE :: NC_READ_VAR_DP
78 : PRIVATE :: NC_GET_GRID_EDGES_SP
79 : PRIVATE :: NC_GET_GRID_EDGES_DP
80 : PRIVATE :: NC_GET_GRID_EDGES_C
81 : PRIVATE :: NC_GET_SIGMA_LEVELS_SP
82 : PRIVATE :: NC_GET_SIGMA_LEVELS_DP
83 : PRIVATE :: NC_GET_SIGMA_LEVELS_C
84 : PRIVATE :: NC_GET_SIG_FROM_HYBRID
85 : PRIVATE :: NC_READ_VAR_CORE
86 : !
87 : ! !REVISION HISTORY:
88 : ! 27 Jul 2012 - C. Keller - Initial version
89 : ! See https://github.com/geoschem/ncdfutil for complete history
90 : !EOP
91 : !------------------------------------------------------------------------------
92 : !BOC
93 : !
94 : ! !MODULE INTERFACES:
95 : !
96 : INTERFACE NC_WRITE
97 : MODULE PROCEDURE NC_WRITE_3D
98 : MODULE PROCEDURE NC_WRITE_4D
99 : END INTERFACE NC_WRITE
100 :
101 : INTERFACE NC_READ_VAR
102 : MODULE PROCEDURE NC_READ_VAR_SP
103 : MODULE PROCEDURE NC_READ_VAR_DP
104 : END INTERFACE NC_READ_VAR
105 :
106 : INTERFACE NC_GET_GRID_EDGES
107 : MODULE PROCEDURE NC_GET_GRID_EDGES_SP
108 : MODULE PROCEDURE NC_GET_GRID_EDGES_DP
109 : END INTERFACE NC_GET_GRID_EDGES
110 :
111 : INTERFACE NC_GET_SIGMA_LEVELS
112 : MODULE PROCEDURE NC_GET_SIGMA_LEVELS_SP
113 : MODULE PROCEDURE NC_GET_SIGMA_LEVELS_DP
114 : END INTERFACE NC_GET_SIGMA_LEVELS
115 :
116 : INTERFACE NC_VAR_WRITE
117 : MODULE PROCEDURE NC_VAR_WRITE_INT_0D
118 : MODULE PROCEDURE NC_VAR_WRITE_INT_1D
119 : MODULE PROCEDURE NC_VAR_WRITE_INT_2D
120 : MODULE PROCEDURE NC_VAR_WRITE_INT_3D
121 : MODULE PROCEDURE NC_VAR_WRITE_INT_4D
122 : MODULE PROCEDURE NC_VAR_WRITE_R4_0D
123 : MODULE PROCEDURE NC_VAR_WRITE_R4_1D
124 : MODULE PROCEDURE NC_VAR_WRITE_R4_2D
125 : MODULE PROCEDURE NC_VAR_WRITE_R4_3D
126 : MODULE PROCEDURE NC_VAR_WRITE_R4_4D
127 : MODULE PROCEDURE NC_VAR_WRITE_R8_0D
128 : MODULE PROCEDURE NC_VAR_WRITE_R8_1D
129 : MODULE PROCEDURE NC_VAR_WRITE_R8_2D
130 : MODULE PROCEDURE NC_VAR_WRITE_R8_3D
131 : MODULE PROCEDURE NC_VAR_WRITE_R8_4D
132 : END INTERFACE NC_VAR_WRITE
133 :
134 : CONTAINS
135 : !EOC
136 : !------------------------------------------------------------------------------
137 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
138 : ! and NASA/GSFC, SIVO, Code 610.3 !
139 : !------------------------------------------------------------------------------
140 : !BOP
141 : !
142 : ! !IROUTINE: Nc_Open
143 : !
144 : ! !DESCRIPTION: Simple wrapper routine to open the given netCDF file.
145 : !\\
146 : !\\
147 : ! !INTERFACE:
148 : !
149 0 : SUBROUTINE NC_OPEN( FileName, fID )
150 : !
151 : ! !INPUT PARAMETERS:
152 : !
153 : CHARACTER(LEN=*), INTENT(IN) :: FileName
154 : !
155 : ! !OUTPUT PARAMETERS:
156 : !
157 : INTEGER, INTENT(OUT) :: fID
158 : !
159 : ! !REVISION HISTORY:
160 : ! 04 Nov 2012 - C. Keller - Initial version
161 : ! See https://github.com/geoschem/ncdfutil for complete history
162 : !EOP
163 : !------------------------------------------------------------------------------
164 : !BOC
165 : !=================================================================
166 : ! NC_OPEN begins here
167 : !=================================================================
168 :
169 : ! Open netCDF file
170 0 : CALL Ncop_Rd( fId, TRIM( FileName ) )
171 :
172 0 : END SUBROUTINE NC_OPEN
173 : !EOC
174 : !------------------------------------------------------------------------------
175 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
176 : ! and NASA/GSFC, SIVO, Code 610.3 !
177 : !------------------------------------------------------------------------------
178 : !BOP
179 : !
180 : ! !IROUTINE: Nc_Append
181 : !
182 : ! !DESCRIPTION: Simple wrapper routine to open the given netCDF file.
183 : ! for appending extra values along a record dimension.
184 : !\\
185 : !\\
186 : ! !INTERFACE:
187 : !
188 0 : SUBROUTINE NC_APPEND( FileName, fID, nTime )
189 : !
190 : ! !INPUT PARAMETERS:
191 : !
192 : CHARACTER(LEN=*), INTENT(IN) :: FileName
193 : !
194 : ! !OUTPUT PARAMETERS:
195 : !
196 : INTEGER, INTENT(OUT) :: fID
197 : INTEGER, OPTIONAL :: nTime
198 : !
199 : ! !REVISION HISTORY:
200 : ! 04 Nov 2012 - C. Keller - Initial version
201 : ! See https://github.com/geoschem/ncdfutil for complete history
202 : !EOP
203 : !------------------------------------------------------------------------------
204 : !BOC
205 : !
206 : ! !LOCAL VARIABLES:
207 : !
208 : INTEGER :: RC, vId
209 :
210 : !=================================================================
211 : ! NC_APPEND begins here
212 : !=================================================================
213 :
214 : ! Open netCDF file
215 0 : CALL Ncop_Wr( fId, TRIM(FileName) )
216 :
217 : ! Also return the number of time slices so that we can
218 : ! append to an existing file w/o clobbering any data
219 0 : IF ( PRESENT( nTime ) ) THEN
220 0 : nTime = -1
221 0 : RC = Nf_Inq_DimId( fId, 'time', vId )
222 0 : IF ( RC == NF_NOERR ) THEN
223 0 : RC = Nf_Inq_DimLen( fId, vId, nTime )
224 : ENDIF
225 : ENDIF
226 :
227 0 : END SUBROUTINE NC_APPEND
228 : !EOC
229 : !------------------------------------------------------------------------------
230 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
231 : ! and NASA/GSFC, SIVO, Code 610.3 !
232 : !------------------------------------------------------------------------------
233 : !BOP
234 : !
235 : ! !IROUTINE: Nc_Close
236 : !
237 : ! !DESCRIPTION: Simple wrapper routine to close the given lun.
238 : !\\
239 : !\\
240 : ! !INTERFACE:
241 : !
242 0 : SUBROUTINE NC_CLOSE( fID )
243 : !
244 : ! !INPUT PARAMETERS:
245 : !
246 : INTEGER, INTENT(IN ) :: fID
247 : !
248 : ! !REVISION HISTORY:
249 : ! 04 Nov 2012 - C. Keller - Initial version
250 : ! See https://github.com/geoschem/ncdfutil for complete history
251 : !EOP
252 : !------------------------------------------------------------------------------
253 : !BOC
254 :
255 : !=================================================================
256 : ! NC_CLOSE begins here
257 : !=================================================================
258 :
259 0 : CALL NcCl( fID )
260 :
261 0 : END SUBROUTINE NC_CLOSE
262 : !EOC
263 : !------------------------------------------------------------------------------
264 : ! GEOS-Chem Global Chemical Transport Model !
265 : !------------------------------------------------------------------------------
266 : !BOP
267 : !
268 : ! !IROUTINE: Nc_Set_DefMode
269 : !
270 : ! !DESCRIPTION: Toggles netCDF define mode on or off.
271 : !\\
272 : !\\
273 : ! !INTERFACE:
274 : !
275 0 : SUBROUTINE Nc_Set_DefMode( fId, On, Off )
276 : !
277 : ! !INPUT PARAMETERS:
278 : !
279 : INTEGER, INTENT(IN) :: fId ! netCDF file ID
280 : LOGICAL, OPTIONAL :: On ! On=T will turn on netCDF define mode
281 : LOGICAL, OPTIONAL :: Off ! Off=T will turn off netCDF define mdoe
282 : !
283 : ! !REMARKS:
284 : ! This is a convenience wrapper for routines NcBegin_Def and NcEnd_Def in
285 : ! NcdfUtil module m_netcdf_define_mod.F90.
286 : !
287 : ! !REVISION HISTORY:
288 : ! 06 Jan 2015 - R. Yantosca - Initial version
289 : ! See https://github.com/geoschem/ncdfutil for complete history
290 : !EOP
291 : !------------------------------------------------------------------------------
292 : !BOC
293 :
294 : ! If the ON switch is passed then ...
295 0 : IF ( PRESENT( On ) ) THEN
296 0 : IF ( On ) THEN
297 0 : CALL NcBegin_Def( fId ) ! Turn define mode on
298 0 : RETURN
299 : ELSE
300 0 : CALL NcEnd_Def( fId ) ! Turn define mode off
301 0 : RETURN
302 : ENDIF
303 : ENDIF
304 :
305 : ! If the OFF switch is passed then ,,,
306 0 : IF ( PRESENT( Off ) ) THEN
307 0 : IF ( Off ) THEN
308 0 : CALL NcEnd_Def( fId ) ! Turn define mode off
309 0 : RETURN
310 : ELSE
311 0 : CALL NcBegin_Def( fId ) ! Turn define mode on
312 0 : RETURN
313 : ENDIF
314 : ENDIF
315 :
316 :
317 : END SUBROUTINE Nc_Set_DefMode
318 : !EOC
319 : !------------------------------------------------------------------------------
320 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
321 : ! and NASA/GSFC, SIVO, Code 610.3 !
322 : !------------------------------------------------------------------------------
323 : !BOP
324 : !
325 : ! !IROUTINE: Nc_Read_Time
326 : !
327 : ! !DESCRIPTION: Subroutine NC\_READ\_TIME reads the time variable of the
328 : ! given fID and returns the time slices and unit.
329 : !\\
330 : !\\
331 : ! !INTERFACE:
332 : !
333 0 : SUBROUTINE NC_READ_TIME( fID, nTime, timeUnit, &
334 : timeVec, timeCalendar, RC )
335 : !
336 : ! !INPUT PARAMETERS:
337 : !
338 : INTEGER, INTENT(IN ) :: fID
339 : !
340 : ! !OUTPUT PARAMETERS:
341 : !
342 : INTEGER, INTENT( OUT) :: nTime
343 : CHARACTER(LEN=*), INTENT( OUT) :: timeUnit
344 : REAL*8, POINTER, OPTIONAL :: timeVec(:)
345 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: timeCalendar
346 : !
347 : ! !INPUT/OUTPUT PARAMETERS:
348 : !
349 : INTEGER, INTENT(INOUT) :: RC
350 : !
351 : ! !REVISION HISTORY:
352 : ! 04 Nov 2012 - C. Keller - Initial version
353 : ! See https://github.com/geoschem/ncdfutil for complete history
354 : !EOP
355 : !------------------------------------------------------------------------------
356 : !BOC
357 : !
358 : ! !LOCAL VARIABLES:
359 : !
360 : ! Scalars
361 : LOGICAL :: hasTime
362 : CHARACTER(LEN=255) :: v_name ! netCDF variable name
363 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
364 : CHARACTER(LEN=255) :: a_val ! netCDF attribute value
365 : INTEGER :: st1d(1), ct1d(1) ! For 1D arrays
366 :
367 : ! Arrays
368 0 : REAL*8 , ALLOCATABLE :: tmpTime(:)
369 :
370 : !=================================================================
371 : ! NC_READ_TIME begins here
372 : !=================================================================
373 :
374 : ! Init
375 0 : RC = 0
376 0 : nTime = 0
377 0 : hasTime = .FALSE.
378 :
379 : ! Variable name
380 0 : v_name = "time"
381 :
382 : ! Check if dimension "time" exist
383 0 : hasTime = Ncdoes_Dim_Exist ( fID, TRIM(v_name) )
384 :
385 : ! If time dim not found, also check for dimension "date"
386 0 : IF ( .NOT. hasTime ) THEN
387 0 : v_name = "date"
388 0 : hasTime = Ncdoes_Dim_Exist ( fID, TRIM(v_name) )
389 : ENDIF
390 :
391 : ! Return here if no time variable defined
392 0 : IF ( .NOT. hasTime ) RETURN
393 :
394 : ! Get dimension length
395 0 : CALL Ncget_Dimlen ( fID, TRIM(v_name), nTime )
396 :
397 : ! Read time/date units attribute
398 0 : a_name = "units"
399 : CALL NcGet_Var_Attributes( fID, TRIM(v_name), &
400 0 : TRIM(a_name), timeUnit )
401 :
402 : ! Read time vector from file.
403 0 : IF ( PRESENT(timeVec) ) THEN
404 0 : IF ( ASSOCIATED(timeVec) ) DEALLOCATE ( timeVec)
405 0 : ALLOCATE ( tmpTime(nTime) )
406 0 : ALLOCATE ( timeVec(nTime) )
407 0 : st1d = (/ 1 /)
408 0 : ct1d = (/ nTime /)
409 0 : CALL NcRd( tmpTime, fID, TRIM(v_name), st1d, ct1d )
410 0 : timevec(:) = tmpTime
411 0 : DEALLOCATE(tmpTime)
412 : ENDIF
413 :
414 : ! Read calendar attribute
415 0 : IF ( PRESENT( timeCalendar ) ) THEN
416 :
417 : ! We now get the status variable RC. This will allow program
418 : ! flow to continue if the "time:calendar" attribute is not found.
419 0 : CALL NcGet_Var_Attributes( fId, v_name, 'calendar', timeCalendar, RC )
420 :
421 : ! If "time:calendar" is found, then throw an error for
422 : ! climatological calendars without leap years.
423 0 : IF ( RC == 0 ) THEN
424 0 : SELECT CASE( TRIM( v_name ) )
425 : CASE( '360_day', '365_day', '366_day', 'all_leap', &
426 : 'allleap', 'no_leap', 'noleap' )
427 0 : WRITE( 6, '(/,a)' ) REPEAT( '=', 79 )
428 : WRITE( 6, '(a )' ) 'HEMCO does not support calendar type ' // &
429 0 : TRIM( v_name )
430 0 : WRITE( 6, '(/,a)' ) 'HEMCO supports the following calendars:'
431 0 : WRITE( 6, '(a)' ) ' - standard (i.e. mixed gregorian/julian)'
432 0 : WRITE( 6, '(a)' ) ' - gregorian'
433 0 : WRITE( 6, '(a,/)' ) REPEAT( '=', 79 )
434 0 : RC = -1
435 : CASE DEFAULT
436 : ! Do nothing
437 : END SELECT
438 : ENDIF
439 :
440 : ! Reset RC so that we won't halt execution elsewhere
441 0 : RC = 0
442 : ENDIF
443 :
444 0 : END SUBROUTINE NC_READ_TIME
445 : !EOC
446 : !------------------------------------------------------------------------------
447 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
448 : ! and NASA/GSFC, SIVO, Code 610.3 !
449 : !------------------------------------------------------------------------------
450 : !BOP
451 : !
452 : ! !IROUTINE: Nc_Read_Var_Sp
453 : !
454 : ! !DESCRIPTION: Subroutine NC\_READ\_VAR\_SP reads the given variable from the
455 : ! given fID and returns the corresponding variable values and units.
456 : !\\
457 : !\\
458 : ! !INTERFACE:
459 : !
460 0 : SUBROUTINE NC_READ_VAR_SP( fID, Var, nVar, varUnit, varVec, RC )
461 : !
462 : ! !INPUT PARAMETERS:
463 : !
464 : INTEGER, INTENT(IN ) :: fID
465 : CHARACTER(LEN=*), INTENT(IN ) :: var
466 : !
467 : ! !OUTPUT PARAMETERS:
468 : !
469 : INTEGER, INTENT( OUT) :: nVar
470 : CHARACTER(LEN=*), INTENT( OUT) :: varUnit
471 : REAL*4, POINTER :: varVec(:)
472 : !
473 : ! !INPUT/OUTPUT PARAMETERS:
474 : !
475 : INTEGER, INTENT(INOUT) :: RC
476 : !
477 : ! !REVISION HISTORY:
478 : ! 04 Nov 2012 - C. Keller - Initial version
479 : ! See https://github.com/geoschem/ncdfutil for complete history
480 : !EOP
481 : !------------------------------------------------------------------------------
482 : !BOC
483 :
484 0 : CALL NC_READ_VAR_CORE( fID, Var, nVar, varUnit, varVecSp=varVec, RC=RC )
485 :
486 0 : END SUBROUTINE NC_READ_VAR_SP
487 : !EOC
488 : !------------------------------------------------------------------------------
489 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
490 : ! and NASA/GSFC, SIVO, Code 610.3 !
491 : !------------------------------------------------------------------------------
492 : !BOP
493 : !
494 : ! !IROUTINE: Nc_Read_Var_Dp
495 : !
496 : ! !DESCRIPTION: Subroutine NC\_READ\_VAR\_DP reads the given variable from the
497 : ! given fID and returns the corresponding variable values and units.
498 : !\\
499 : !\\
500 : ! !INTERFACE:
501 : !
502 0 : SUBROUTINE NC_READ_VAR_DP( fID, Var, nVar, varUnit, varVec, RC )
503 : !
504 : ! !INPUT PARAMETERS:
505 : !
506 : INTEGER, INTENT(IN ) :: fID
507 : CHARACTER(LEN=*), INTENT(IN ) :: var
508 : !
509 : ! !OUTPUT PARAMETERS:
510 : !
511 : INTEGER, INTENT( OUT) :: nVar
512 : CHARACTER(LEN=*), INTENT( OUT) :: varUnit
513 : REAL*8, POINTER :: varVec(:)
514 : !
515 : ! !INPUT/OUTPUT PARAMETERS:
516 : !
517 : INTEGER, INTENT(INOUT) :: RC
518 : !
519 : ! !REVISION HISTORY:
520 : ! 04 Nov 2012 - C. Keller - Initial version
521 : ! See https://github.com/geoschem/ncdfutil for complete history
522 : !EOP
523 : !------------------------------------------------------------------------------
524 : !BOC
525 :
526 0 : CALL NC_READ_VAR_CORE( fID, Var, nVar, varUnit, varVecDp=varVec, RC=RC )
527 :
528 0 : END SUBROUTINE NC_READ_VAR_DP
529 : !EOC
530 : !------------------------------------------------------------------------------
531 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
532 : ! and NASA/GSFC, SIVO, Code 610.3 !
533 : !------------------------------------------------------------------------------
534 : !BOP
535 : !
536 : ! !IROUTINE: Nc_Read_Var_Core
537 : !
538 : ! !DESCRIPTION: Subroutine NC\_READ\_VAR\_CORE reads the given variable from the
539 : ! given fID and returns the corresponding variable values and units.
540 : !\\
541 : !\\
542 : ! !INTERFACE:
543 : !
544 0 : SUBROUTINE NC_READ_VAR_CORE( fID, Var, nVar, varUnit, varVecDp, varVecSp, RC )
545 : !
546 : ! !INPUT PARAMETERS:
547 : !
548 : INTEGER, INTENT(IN ) :: fID
549 : CHARACTER(LEN=*), INTENT(IN ) :: var
550 : !
551 : ! !OUTPUT PARAMETERS:
552 : !
553 : INTEGER, INTENT( OUT) :: nVar
554 : CHARACTER(LEN=*), INTENT( OUT) :: varUnit
555 : REAL*4, POINTER, OPTIONAL :: varVecSp(:)
556 : REAL*8, POINTER, OPTIONAL :: varVecDp(:)
557 : !
558 : ! !INPUT/OUTPUT PARAMETERS:
559 : !
560 : INTEGER, INTENT(INOUT) :: RC
561 : !
562 : ! !REVISION HISTORY:
563 : ! 04 Nov 2012 - C. Keller - Initial version
564 : ! See https://github.com/geoschem/ncdfutil for complete history
565 : !EOP
566 : !------------------------------------------------------------------------------
567 : !BOC
568 : !
569 : ! !LOCAL VARIABLES:
570 : !
571 : LOGICAL :: hasVar
572 : CHARACTER(LEN=255) :: v_name ! netCDF variable name
573 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
574 : CHARACTER(LEN=255) :: a_val ! netCDF attribute value
575 : INTEGER :: a_type ! netCDF attribute type
576 : INTEGER :: st1d(1), ct1d(1) ! For 1D arrays
577 : INTEGER :: I
578 :
579 : !=================================================================
580 : ! NC_READ_VAR_CORE begins here
581 : !=================================================================
582 :
583 : ! Init
584 0 : RC = 0
585 0 : nVar = 0
586 0 : hasVar = .FALSE.
587 :
588 : ! Variable name
589 0 : v_name = var
590 :
591 : ! Check if variable exists
592 0 : hasVar = Ncdoes_Dim_Exist ( fID, TRIM(v_name) )
593 :
594 : ! Return here if variable not defined
595 0 : IF ( .NOT. hasVar ) RETURN
596 :
597 : ! Get dimension length
598 0 : CALL Ncget_Dimlen ( fID, TRIM(v_name), nVar )
599 :
600 : ! Read vector from file.
601 0 : IF ( PRESENT(VarVecSp) ) THEN
602 0 : IF ( ASSOCIATED( VarVecSp ) ) DEALLOCATE(VarVecSp)
603 0 : ALLOCATE ( VarVecSp(nVar) )
604 0 : st1d = (/ 1 /)
605 0 : ct1d = (/ nVar /)
606 0 : CALL NcRd( VarVecSp, fID, TRIM(v_name), st1d, ct1d )
607 : ENDIF
608 0 : IF ( PRESENT(VarVecDp) ) THEN
609 0 : IF ( ASSOCIATED( VarVecDp ) ) DEALLOCATE(VarVecDp)
610 0 : ALLOCATE ( VarVecDp(nVar) )
611 0 : st1d = (/ 1 /)
612 0 : ct1d = (/ nVar /)
613 0 : CALL NcRd( VarVecDp, fID, TRIM(v_name), st1d, ct1d )
614 : ENDIF
615 :
616 : ! Read units attribute. If unit attribute does not exist, return
617 : ! empty string (dimensionless vertical coordinates do not require
618 : ! a units attribute).
619 0 : a_name = "units"
620 0 : hasVar = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type )
621 0 : IF ( .NOT. hasVar ) THEN
622 0 : varUnit = ''
623 : ELSE
624 : CALL NcGet_Var_Attributes( fID, TRIM(v_name), &
625 0 : TRIM(a_name), varUnit )
626 :
627 : ! Check if the last character of VarUnit is the ASCII null character
628 : ! ("\0", ASCII value = 0), which is used to denote the end of a string.
629 : ! The ASCII null character may be introduced if the netCDF file was
630 : ! written using a language other than Fortran. The compiler might
631 : ! interpret the null character as part of the string instead of as
632 : ! an empty space. If the null space is there, then replace it with
633 : ! a Fortran empty string value (''). (bmy, 7/17/18)
634 0 : I = LEN_TRIM( VarUnit )
635 0 : IF ( ICHAR( VarUnit(I:I) ) == 0 ) THEN
636 0 : VarUnit(I:I) = ''
637 : ENDIF
638 : ENDIF
639 :
640 0 : END SUBROUTINE NC_READ_VAR_CORE
641 : !EOC
642 : !------------------------------------------------------------------------------
643 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
644 : ! and NASA/GSFC, SIVO, Code 610.3 !
645 : !------------------------------------------------------------------------------
646 : !BOP
647 : !
648 : ! !IROUTINE: Nc_Read_Arr
649 : !
650 : ! !DESCRIPTION: Routine NC\_READ\_ARR reads variable ncVar into a 4-D array
651 : ! (lon,lat,lev,time). Domain boundaries can be provided by input arguments
652 : ! lon1,lon2, lat1,lat2, lev1,lev2, and time1,time2. The level and time bounds
653 : ! are optional and can be set to zero (lev1=0 and/or time1=0) for data with
654 : ! undefined level/time coordinates.
655 : !\\
656 : !\\
657 : ! The default behavior for time slices is to read all slices (time1:time2),
658 : ! and pass all of them to the output array. It is also possible to assign
659 : ! specific weights (wgt1 and wgt2) to the two time slices time1 and time2,
660 : ! respectively. In this case, only those two slices will be read and merged
661 : ! using the given weights. The output array will then contain only one time
662 : ! dimension. Negative weights are currently not supported and will be ignored,
663 : ! e.g. providing negative weights has the same effect as providing no weights
664 : ! at all.
665 : !\\
666 : !\\
667 : ! If the passed variable contains attribute names `offset` and/or
668 : ! `scale\_factor`, those operations will be applied to the data array
669 : ! before returning it.
670 : !\\
671 : !\\
672 : ! Missing values in the netCDF file are replaced with value 'MissVal'
673 : ! (default = 0). Currently, the routine identifies attributes 'missing\_value'
674 : ! and '\_FillValue' as missing values.
675 : !\\
676 : !\\
677 : ! !INTERFACE:
678 : !
679 0 : SUBROUTINE NC_READ_ARR( fID, ncVar, lon1, lon2, lat1, &
680 : lat2, lev1, lev2, time1, time2, &
681 : ncArr, VarUnit, MissVal, wgt1, wgt2, &
682 : ArbIdx, RC )
683 : !
684 : ! !USES:
685 : !
686 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
687 : !
688 : ! !INPUT PARAMETERS:
689 : !
690 : INTEGER, INTENT(IN) :: fID
691 : CHARACTER(LEN=*), INTENT(IN) :: ncVar ! variable to read
692 : INTEGER, INTENT(IN) :: lon1, lon2
693 : INTEGER, INTENT(IN) :: lat1, lat2
694 : INTEGER, INTENT(IN) :: lev1, lev2
695 : INTEGER, INTENT(IN) :: time1, time2
696 : REAL*4, INTENT(IN ), OPTIONAL :: MissVal
697 : REAL*4, INTENT(IN ), OPTIONAL :: wgt1
698 : REAL*4, INTENT(IN ), OPTIONAL :: wgt2
699 : INTEGER, INTENT(IN ), OPTIONAL :: ArbIdx ! Index of arbitrary additional dimension (-1 if none)
700 : !
701 : ! !OUTPUT PARAMETERS:
702 : !
703 : ! Array to write data
704 : REAL*4, POINTER :: ncArr(:,:,:,:)
705 :
706 : ! Optional output
707 : CHARACTER(LEN=*), INTENT(OUT), OPTIONAL :: VarUnit
708 : !
709 : ! !INPUT/OUTPUT PARAMETERS:
710 : !
711 : ! Error handling
712 : INTEGER, INTENT(INOUT) :: RC
713 : !
714 : ! !REVISION HISTORY:
715 : ! 27 Jul 2012 - C. Keller - Initial version
716 : ! See https://github.com/geoschem/ncdfutil for complete history
717 : !EOP
718 : !------------------------------------------------------------------------------
719 : !BOC
720 : !
721 : ! !LOCAL VARIABLES:
722 : !
723 : !=================================================================
724 : ! Variable declarations
725 : !=================================================================
726 :
727 : ! Data arrays
728 : CHARACTER(LEN=255) :: v_name ! netCDF variable name
729 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
730 : CHARACTER(LEN=255) :: a_val ! netCDF attribute value
731 : INTEGER :: a_type ! netCDF attribute type
732 : REAL*8 :: corr ! netCDF attribute value
733 :
734 : ! Arrays for netCDF start and count values
735 : INTEGER :: I, nRead, l1, l2
736 : INTEGER :: ndims
737 : INTEGER :: nlon, nlat, nlev, ntime, arbdim
738 : INTEGER :: nclev, nctime
739 : INTEGER :: s1, s2, s3, s4, s5
740 : INTEGER :: n1, n2, n3, n4, n5
741 : INTEGER :: nt, st, tdim, sti, nti
742 : INTEGER :: st2d(2), ct2d(2) ! For 2D arrays
743 : INTEGER :: st3d(3), ct3d(3) ! For 3D arrays
744 : INTEGER :: st4d(4), ct4d(4) ! For 4D arrays
745 : INTEGER :: st5d(5), ct5d(5) ! For 5D arrays
746 :
747 : ! Temporary arrays
748 0 : REAL*4, ALLOCATABLE :: TMPARR_5D(:,:,:,:,:)
749 0 : REAL*4, ALLOCATABLE :: WGTARR_5D(:,:,:,:,:)
750 0 : REAL*4, ALLOCATABLE :: TMPARR_4D(:,:,:,:)
751 0 : REAL*4, ALLOCATABLE :: WGTARR_4D(:,:,:,:)
752 0 : REAL*4, ALLOCATABLE :: TMPARR_3D(:,:,:)
753 0 : REAL*4, ALLOCATABLE :: WGTARR_3D(:,:,:)
754 0 : REAL*4, ALLOCATABLE :: TMPARR_2D(:,:)
755 :
756 : ! Logicals
757 : LOGICAL :: FlipZ
758 : LOGICAL :: ReadAtt
759 :
760 : ! Missing value
761 : REAL*8 :: miss8
762 : REAL*4 :: miss4
763 : REAL*4 :: MissValue
764 :
765 : ! Weights
766 : LOGICAL :: ApplyWeights
767 : REAL*4 :: weight1, weight2
768 :
769 : ! For error handling
770 : CHARACTER(LEN=255) :: LOC, MSG
771 :
772 : !=================================================================
773 : ! NC_READ_ARR begins here
774 : !=================================================================
775 :
776 : !-----------------------------------------------------------------
777 : ! Initialize
778 : !-----------------------------------------------------------------
779 :
780 : ! For error handling
781 0 : LOC = 'NC_READ_ARR ("ncdf_mod.F")'
782 :
783 : ! Eventually deallocate output array
784 0 : IF ( ASSOCIATED ( ncArr ) ) DEALLOCATE ( ncArr )
785 :
786 : ! weights to be applied to time1 and time2 (if any):
787 0 : weight1 = -999.0
788 0 : weight2 = -999.0
789 0 : IF(PRESENT(wgt1)) weight1 = wgt1
790 0 : IF(PRESENT(wgt2)) weight2 = wgt2
791 :
792 : ! apply weights?
793 0 : IF ( time1 > 0 .AND. weight1 >= 0.0 ) THEN
794 : ApplyWeights = .TRUE.
795 : ELSE
796 0 : ApplyWeights = .FALSE.
797 : ENDIF
798 :
799 : ! # of horizontal dimensions to read
800 0 : nLon = lon2 - lon1 + 1
801 0 : nLat = lat2 - lat1 + 1
802 :
803 : ! # of vertical levels
804 0 : FlipZ = .FALSE. ! Flip z-axis?
805 0 : l1 = lev1 ! Lower level to be read
806 0 : l2 = lev2 ! Upper level to be read
807 0 : IF ( lev1 > 0 ) THEN
808 :
809 : ! Check if we need to flip the vertical axis
810 0 : IF ( lev1 > lev2 ) THEN
811 0 : FlipZ = .TRUE.
812 0 : l1 = lev2
813 0 : l2 = lev1
814 : ENDIF
815 :
816 : ! Number of levels to be read
817 0 : nLev = l2 - l1 + 1
818 :
819 : ! no vertical levels:
820 : ELSE
821 : nLev = 0
822 : ENDIF
823 :
824 : ! # of time slices
825 : ! read all time slices time1:time2:
826 0 : IF ( time1 > 0 .AND. weight1 < 0.0 ) THEN
827 0 : ntime = time2 - time1 + 1
828 : ! Interpolate amongs 2 time slices:
829 0 : ELSEIF ( ApplyWeights ) THEN
830 : ntime = 1
831 : ! no time dimension:
832 : ELSE
833 0 : ntime = 0
834 : ENDIF
835 :
836 : ! # of arbitrary other dimensions
837 0 : arbdim = -1
838 0 : IF ( PRESENT(ArbIdx) ) THEN
839 0 : IF ( ArbIdx > 0 ) THEN
840 0 : arbdim = ArbIdx
841 : ENDIF
842 : ENDIF
843 :
844 : ! Set dimensions of output array
845 : ! --> must have at least dimension 1
846 0 : nclev = max(nlev ,1)
847 0 : nctime = max(ntime,1)
848 :
849 : ! set total number of dimensions to be read. This is at least 2 and
850 : ! at most 5.
851 0 : ndims = 2
852 0 : if ( nlev > 0 ) ndims = ndims + 1
853 0 : if ( ntime > 0 ) ndims = ndims + 1
854 0 : if ( arbdim > 0 ) ndims = ndims + 1
855 :
856 : !----------------------------------------
857 : ! Read array
858 : !----------------------------------------
859 :
860 : ! Variable name
861 0 : v_name = TRIM(ncVar)
862 :
863 : ! Allocate the output array
864 0 : ALLOCATE ( ncArr( nLon, nLat, ncLev, ncTime ) )
865 0 : ncArr = 0.0
866 :
867 : ! Define number of required reads and time dimension on temporary array
868 0 : nRead = 1
869 0 : IF ( ntime > 0 ) THEN
870 0 : IF ( ApplyWeights ) THEN
871 : nRead = 2
872 : nt = 2
873 : ELSE
874 0 : nRead = 1
875 0 : nt = ntime
876 : ENDIF
877 : ENDIF
878 :
879 : !----------------------------------------
880 : ! Read 5D array:
881 0 : IF ( ndims == 5 ) THEN
882 :
883 : ! Allocate array. If time weights are applied, the two
884 : ! time slices are read into TMPARR_5D and then temporarily
885 : ! stored in WGTARR_5D. Same applies to 4D and 3D below.
886 : ! (ckeller, 01/09/17)
887 0 : IF ( ApplyWeights ) THEN
888 0 : ALLOCATE ( TMPARR_5D( nlon, nlat, nlev, 1, 1 ) )
889 0 : TMPARR_5D = 0.0
890 0 : ALLOCATE ( WGTARR_5D( nlon, nlat, nlev, nt, 1 ) )
891 0 : WGTARR_5D = 0.0
892 : ELSE
893 0 : ALLOCATE ( TMPARR_5D( nlon, nlat, nlev, nt, 1 ) )
894 0 : TMPARR_5D = 0.0
895 : ENDIF
896 :
897 : ! Set default start/end indeces
898 0 : s1 = lon1
899 0 : n1 = nlon
900 0 : s2 = lat1
901 0 : n2 = nlat
902 0 : s3 = l1
903 0 : n3 = nlev
904 : s5 = arbdim
905 : n5 = 1
906 :
907 : ! Read arrays from file
908 0 : DO I = 1, nRead
909 :
910 : ! time index
911 0 : IF ( .NOT. ApplyWeights ) THEN
912 : s4 = time1
913 : n4 = ntime
914 : ELSE
915 0 : IF ( I == 1 ) THEN
916 : s4 = time1
917 : ELSE
918 0 : s4 = time2
919 : ENDIF
920 : n4 = 1
921 : ENDIF
922 :
923 0 : st5d = (/ s1, s2, s3, s4, s5 /)
924 0 : ct5d = (/ n1, n2, n3, n4, n5 /)
925 0 : CALL NcRd( TMPARR_5D, fId, TRIM(v_name), st5d, ct5d )
926 :
927 : ! Eventually pass time weighted arrays to temporary array
928 0 : IF ( ApplyWeights ) THEN
929 0 : WGTARR_5D(:,:,:,I,:) = TMPARR_5D(:,:,:,1,:)
930 : ENDIF
931 :
932 : ENDDO
933 :
934 : ! Pass to output array. Eventually apply time weights.
935 0 : IF ( ApplyWeights ) THEN
936 0 : ncArr(:,:,:,1) = WGTARR_5D(:,:,:,1,1) * weight1 &
937 0 : + WGTARR_5D(:,:,:,2,1) * weight2
938 : ELSE
939 0 : ncArr(:,:,:,:) = TMPARR_5D(:,:,:,:,1)
940 : ENDIF
941 :
942 : ! Cleanup
943 0 : DEALLOCATE(TMPARR_5D)
944 0 : IF(ALLOCATED(WGTARR_5D)) DEALLOCATE(WGTARR_5D)
945 : ENDIF
946 :
947 : !----------------------------------------
948 : ! Read 4D array:
949 : ! This can be:
950 : ! - lon,lat,lev,time
951 : ! - lon,lat,lev,arb
952 : ! - lon,lat,time,arb
953 0 : IF ( ndims == 4 ) THEN
954 :
955 : ! Allocate temporary array
956 0 : s1 = lon1
957 0 : n1 = nlon
958 0 : s2 = lat1
959 0 : n2 = nlat
960 0 : tdim = -1
961 :
962 : ! 3rd and 4th dim
963 :
964 : ! lev is defined
965 0 : IF ( nlev > 0 ) THEN
966 0 : s3 = l1
967 0 : n3 = nlev
968 : ! plus time...
969 0 : IF ( ntime > 0 ) THEN
970 : n4 = nt
971 : tdim = 4
972 : ! ... or plus arbitrary dim
973 : ELSE
974 0 : s4 = arbdim
975 0 : n4 = 1
976 : ENDIF
977 :
978 : ! lev not defined: time + arbitrary dim
979 : ELSE
980 : n3 = nt
981 : tdim = 3
982 : s4 = arbdim
983 : n4 = 1
984 : ENDIF
985 :
986 0 : IF ( ApplyWeights ) THEN
987 0 : ALLOCATE ( WGTARR_4D(n1,n2,n3,n4) )
988 0 : WGTARR_4D = 0.0
989 0 : IF ( tdim == 3 ) THEN
990 0 : ALLOCATE ( TMPARR_4D(n1,n2,1,n4) )
991 0 : TMPARR_4D = 0.0
992 0 : ELSEIF ( tdim == 4 ) THEN
993 0 : ALLOCATE ( TMPARR_4D(n1,n2,n3,1) )
994 0 : TMPARR_4D = 0.0
995 : ENDIF
996 :
997 : ELSE
998 0 : ALLOCATE ( TMPARR_4D(n1,n2,n3,n4) )
999 0 : TMPARR_4D = 0.0
1000 : ENDIF
1001 :
1002 : ! Read arrays from file
1003 0 : DO I = 1, nRead
1004 :
1005 : ! time index
1006 0 : IF ( .NOT. ApplyWeights ) THEN
1007 : sti = time1
1008 : nti = ntime
1009 : ELSE
1010 0 : IF ( I == 1 ) THEN
1011 : sti = time1
1012 : ELSE
1013 0 : sti = time2
1014 : ENDIF
1015 : nti = 1
1016 : ENDIF
1017 :
1018 : ! need to adjust time index: this is either 3rd or 4th dimension:
1019 0 : IF ( tdim == 3 ) THEN
1020 : s3 = sti
1021 : n3 = nti
1022 0 : ELSEIF ( tdim == 4 ) THEN
1023 0 : s4 = sti
1024 0 : n4 = nti
1025 : ENDIF
1026 :
1027 0 : st4d = (/ s1, s2, s3, s4 /)
1028 0 : ct4d = (/ n1, n2, n3, n4 /)
1029 :
1030 : ! Read data from disk
1031 0 : CALL NcRd( TMPARR_4D, fId, TRIM(v_name), st4d, ct4d )
1032 :
1033 : ! Eventually pass time weighted arrays to temporary array
1034 0 : IF ( ApplyWeights ) THEN
1035 0 : IF ( tdim == 3 ) THEN
1036 0 : WGTARR_4D(:,:,I,:) = TMPARR_4D(:,:,1,:)
1037 0 : ELSEIF ( tdim == 4 ) THEN
1038 0 : WGTARR_4D(:,:,:,I) = TMPARR_4D(:,:,:,1)
1039 : ENDIF
1040 : ENDIF
1041 : ENDDO
1042 :
1043 : ! Pass to output array. Eventually apply time weights.
1044 0 : IF ( ApplyWeights ) THEN
1045 0 : IF ( tdim == 3 ) THEN
1046 0 : ncArr(:,:,:,1) = WGTARR_4D(:,:,1,:) * weight1 &
1047 0 : + WGTARR_4D(:,:,2,:) * weight2
1048 0 : ELSEIF ( tdim == 4 ) THEN
1049 0 : ncArr(:,:,:,1) = WGTARR_4D(:,:,:,1) * weight1 &
1050 0 : + WGTARR_4D(:,:,:,2) * weight2
1051 : ENDIF
1052 : ELSE
1053 0 : ncArr(:,:,:,:) = TMPARR_4D(:,:,:,:)
1054 : ENDIF
1055 :
1056 : ! Cleanup
1057 0 : DEALLOCATE(TMPARR_4D)
1058 0 : IF(ALLOCATED(WGTARR_4D)) DEALLOCATE(WGTARR_4D)
1059 : ENDIF
1060 :
1061 : !----------------------------------------
1062 : ! Read 3D array:
1063 : ! This can be:
1064 : ! - lon,lat,lev
1065 : ! - lon,lat,time
1066 : ! - lon,lat,arb
1067 0 : IF ( ndims == 3 ) THEN
1068 :
1069 : ! Allocate temporary array
1070 0 : s1 = lon1
1071 0 : n1 = nlon
1072 0 : s2 = lat1
1073 0 : n2 = nlat
1074 0 : tdim = -1
1075 :
1076 : ! 3rd dim:
1077 : ! - lev is defined:
1078 0 : IF ( nlev > 0 ) THEN
1079 : s3 = l1
1080 : n3 = nlev
1081 : ! - time is defined:
1082 0 : ELSEIF ( ntime > 0 ) THEN
1083 : n3 = nt
1084 : tdim = 3
1085 : ! - arbitrary dimension is defined:
1086 0 : ELSEIF ( arbdim > 0 ) THEN
1087 0 : s3 = arbdim
1088 0 : n3 = 1
1089 : ENDIF
1090 :
1091 0 : IF ( ApplyWeights ) THEN
1092 0 : ALLOCATE ( TMPARR_3D(n1,n2,1) )
1093 0 : TMPARR_3D = 0.0
1094 0 : ALLOCATE ( WGTARR_3D(n1,n2,n3) )
1095 0 : WGTARR_3D = 0.0
1096 : ELSE
1097 0 : ALLOCATE ( TMPARR_3D(n1,n2,n3) )
1098 0 : TMPARR_3D = 0.0
1099 : ENDIF
1100 :
1101 : ! Read arrays from file
1102 0 : DO I = 1, nRead
1103 :
1104 : ! time index
1105 0 : IF ( tdim == 3 ) THEN
1106 0 : IF ( .NOT. ApplyWeights ) THEN
1107 : s3 = time1
1108 : n3 = ntime
1109 : ELSE
1110 0 : IF ( I == 1 ) THEN
1111 : s3 = time1
1112 : ELSE
1113 0 : s3 = time2
1114 : ENDIF
1115 : n3 = 1
1116 : ENDIF
1117 : ENDIF
1118 :
1119 0 : st3d = (/ s1, s2, s3 /)
1120 0 : ct3d = (/ n1, n2, n3 /)
1121 0 : CALL NcRd( TMPARR_3D, fId, TRIM(v_name), st3d, ct3d )
1122 :
1123 : ! Eventually pass time weighted arrays to temporary array
1124 0 : IF ( ApplyWeights ) THEN
1125 0 : WGTARR_3D(:,:,I) = TMPARR_3D(:,:,1)
1126 : ENDIF
1127 :
1128 : ENDDO
1129 :
1130 : ! Pass to output array. Eventually apply time weights.
1131 0 : IF ( ApplyWeights ) THEN
1132 0 : ncArr(:,:,1,1) = WGTARR_3D(:,:,1) * weight1 &
1133 0 : + WGTARR_3D(:,:,2) * weight2
1134 : ELSE
1135 0 : IF ( tdim == 3 ) THEN
1136 0 : ncArr(:,:,1,:) = TMPARR_3D(:,:,:)
1137 : ELSE
1138 0 : ncArr(:,:,:,1) = TMPARR_3D(:,:,:)
1139 : ENDIF
1140 : ENDIF
1141 :
1142 : ! Cleanup
1143 0 : IF(ALLOCATED(TMPARR_3D)) DEALLOCATE(TMPARR_3D)
1144 0 : IF(ALLOCATED(WGTARR_3D)) DEALLOCATE(WGTARR_3D)
1145 : ENDIF
1146 :
1147 : !----------------------------------------
1148 : ! Read a 2D array (lon and lat only):
1149 0 : IF ( ndims == 2 ) THEN
1150 0 : ALLOCATE ( TMPARR_2D( nLon, nLat ) )
1151 0 : TMPARR_2D = 0.0
1152 0 : st2d = (/ lon1, lat1 /)
1153 0 : ct2d = (/ nlon, nlat /)
1154 0 : CALL NcRd( TMPARR_2D, fId, TRIM(v_name), st2d, ct2d )
1155 0 : ncArr(:,:,1,1) = TMPARR_2D(:,:)
1156 0 : DEALLOCATE(TMPARR_2D)
1157 : ENDIF
1158 :
1159 : ! ------------------------------------------
1160 : ! Eventually apply scale / offset factors
1161 : ! ------------------------------------------
1162 :
1163 : ! Check for scale factor
1164 0 : a_name = "scale_factor"
1165 0 : ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type )
1166 :
1167 0 : IF ( ReadAtt ) THEN
1168 0 : CALL NcGet_Var_Attributes(fId,TRIM(v_name),TRIM(a_name),corr)
1169 0 : ncArr(:,:,:,:) = ncArr(:,:,:,:) * corr
1170 : ENDIF
1171 :
1172 : ! Check for offset factor
1173 0 : a_name = "add_offset"
1174 0 : ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type )
1175 :
1176 0 : IF ( ReadAtt ) THEN
1177 0 : CALL NcGet_Var_Attributes(fId,TRIM(v_name),TRIM(a_name),corr)
1178 0 : ncArr(:,:,:,:) = ncArr(:,:,:,:) + corr
1179 : ENDIF
1180 :
1181 : ! ------------------------------------------
1182 : ! Check for filling values
1183 : ! NOTE: Test for REAL*4 and REAL*8
1184 : ! ------------------------------------------
1185 :
1186 : ! Define missing value
1187 0 : IF ( PRESENT(MissVal) ) THEN
1188 0 : MissValue = MissVal
1189 : ELSE
1190 : MissValue = 0.0
1191 : ENDIF
1192 :
1193 : ! 1: 'missing_value'
1194 0 : a_name = "missing_value"
1195 0 : ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type )
1196 0 : IF ( ReadAtt ) THEN
1197 0 : IF ( a_type == NF_REAL ) THEN
1198 0 : CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss4 )
1199 0 : WHERE ( ncArr == miss4 )
1200 : ncArr = MissValue
1201 : END WHERE
1202 0 : ELSE IF ( a_type == NF_DOUBLE ) THEN
1203 0 : CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss8 )
1204 0 : miss4 = REAL( miss8 )
1205 0 : WHERE ( ncArr == miss4 )
1206 : ncArr = MissValue
1207 : END WHERE
1208 : ENDIF
1209 : ENDIF
1210 :
1211 : ! 2: '_FillValue'
1212 0 : a_name = "_FillValue"
1213 0 : ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type )
1214 0 : IF ( ReadAtt ) THEN
1215 0 : IF ( a_type == NF_REAL ) THEN
1216 0 : CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss4 )
1217 0 : WHERE ( ncArr == miss4 )
1218 : ncArr = MissValue
1219 : END WHERE
1220 0 : ELSE IF ( a_type == NF_DOUBLE ) THEN
1221 0 : CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss8 )
1222 0 : miss4 = REAL( miss8 )
1223 0 : WHERE ( ncArr == miss4 )
1224 : ncArr = MissValue
1225 : END WHERE
1226 : ENDIF
1227 : ENDIF
1228 :
1229 : ! ------------------------------------------
1230 : ! Flip z-axis if needed
1231 : ! ------------------------------------------
1232 0 : IF ( FlipZ ) THEN
1233 0 : ncArr(:,:,:,:) = ncArr(:,:,ncLev:1:-1,:)
1234 : ENDIF
1235 :
1236 : ! ----------------------------
1237 : ! Read optional arguments
1238 : ! ----------------------------
1239 :
1240 : ! Read units
1241 0 : IF ( PRESENT(VarUnit) )THEN
1242 0 : a_name = "units"
1243 0 : CALL NcGet_Var_Attributes(fId,TRIM(v_name),TRIM(a_name),a_val)
1244 0 : VarUnit = TRIM(a_val)
1245 :
1246 : ! Check if the last character of VarUnit is the ASCII null character
1247 : ! ("\0", ASCII value = 0), which is used to denote the end of a string.
1248 : ! The ASCII null character may be introduced if the netCDF file was
1249 : ! written using a language other than Fortran. The compiler might
1250 : ! interpret the null character as part of the string instead of as
1251 : ! an empty space. If the null space is there, then replace it with
1252 : ! a Fortran empty string value (''). (bmy, 7/17/18)
1253 0 : I = LEN_TRIM( VarUnit )
1254 0 : IF ( ICHAR( VarUnit(I:I) ) == 0 ) THEN
1255 0 : VarUnit(I:I) = ''
1256 : ENDIF
1257 : ENDIF
1258 :
1259 : !=================================================================
1260 : ! Cleanup and quit
1261 : !=================================================================
1262 :
1263 : ! Return w/ success
1264 0 : RC = 0
1265 :
1266 0 : END SUBROUTINE NC_READ_ARR
1267 : !EOC
1268 : !------------------------------------------------------------------------------
1269 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
1270 : ! and NASA/GSFC, SIVO, Code 610.3 !
1271 : !------------------------------------------------------------------------------
1272 : !BOP
1273 : !
1274 : ! !IROUTINE: Nc_Read_Time_yyyymmddhhmm
1275 : !
1276 : ! !DESCRIPTION: Returns a vector containing the datetimes (YYYYMMDDhhmm) of
1277 : ! all time slices in the netCDF file.
1278 : !\\
1279 : ! !INTERFACE:
1280 : !
1281 0 : SUBROUTINE NC_READ_TIME_YYYYMMDDhhmm( fID, nTime, &
1282 : all_YYYYMMDDhhmm, timeUnit, &
1283 : refYear, RC )
1284 : !
1285 : ! !USES:
1286 : !
1287 : USE HCO_JULDAY_MOD, ONLY : JULDAY, CALDATE
1288 : !
1289 : ! !INPUT PARAMETERS:
1290 : !
1291 : INTEGER, INTENT(IN ) :: fID
1292 : !
1293 : ! !INPUT/OUTPUT PARAMETERS:
1294 : !
1295 : REAL*8, POINTER :: all_YYYYMMDDhhmm(:)
1296 : CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: timeUnit
1297 : INTEGER, INTENT( OUT), OPTIONAL :: refYear
1298 : !
1299 : ! !INPUT/OUTPUT PARAMETERS:
1300 : !
1301 : INTEGER, INTENT(INOUT) :: nTime
1302 : INTEGER, INTENT(INOUT) :: RC
1303 : !
1304 : ! !REVISION HISTORY:
1305 : ! 27 Jul 2012 - C. Keller - Initial version
1306 : ! See https://github.com/geoschem/ncdfutil for complete history
1307 : !EOP
1308 : !------------------------------------------------------------------------------
1309 : !BOC
1310 : !
1311 : ! !LOCAL VARIABLES:
1312 : !
1313 : ! Scalars
1314 : CHARACTER(LEN=255) :: ncUnit, cal
1315 : INTEGER :: refYr, refMt, refDy, refHr, refMn, refSc
1316 : INTEGER :: T, YYYYMMDD, hhmmss
1317 : REAL*8 :: realrefDy, refJulday, tJulday
1318 :
1319 : ! Pointers
1320 0 : REAL*8, POINTER :: tVec(:)
1321 :
1322 : !=================================================================
1323 : ! NC_READ_TIME_YYYYMMDDhhmm begins here
1324 : !=================================================================
1325 :
1326 : ! Init values
1327 0 : RC = 0
1328 0 : tVec => NULL()
1329 0 : IF ( PRESENT(TimeUnit) ) TimeUnit = ''
1330 0 : IF ( PRESENT(refYear ) ) refYear = 0
1331 :
1332 : ! Read time vector
1333 : CALL NC_READ_TIME ( fID, nTime, ncUnit, &
1334 0 : timeVec=tVec, timeCalendar=cal, RC=RC )
1335 0 : IF ( RC/=0 ) THEN
1336 0 : WRITE( 6, '(/,a)' ) REPEAT( '=', 79 )
1337 0 : WRITE( 6, '(a)' ) 'Error encountered in NC_READ_TIME (ncdf_mod.F90)'
1338 0 : WRITE( 6, '(a,/)' ) REPEAT( '=', 79 )
1339 0 : RETURN
1340 : ENDIF
1341 :
1342 : ! If nTime is zero, return here!
1343 0 : IF ( nTime == 0 ) RETURN
1344 :
1345 : ! Get reference date in julian days
1346 : CALL NC_GET_REFDATETIME ( ncUnit, refYr, refMt, &
1347 0 : refDy, refHr, refMn, refSc, RC )
1348 0 : IF ( RC /= 0 ) RETURN
1349 : realrefDy = refDy &
1350 : + ( MAX(0,refHr) / 24d0 ) &
1351 : + ( MAX(0,refMn) / 1440d0 ) &
1352 0 : + ( MAX(0,refSc) / 86400d0 )
1353 0 : refJulday = JULDAY ( refYr, refMt, realrefDy )
1354 :
1355 : ! NOTE: It seems that there is an issue with reference dates
1356 : ! between 1800 and 1901: the respective time stamps all seem to
1357 : ! be off by one day (this problem doesn't appear for netCDF files
1358 : ! with reference date zero, i.e. hours since 1-1-1)!
1359 : ! I'm not sure what causes this problem, but adding one day to
1360 : ! reference dates that lie between 1600 and 1900 seems to fix the
1361 : ! problem.
1362 : ! TODO: requires more testing!
1363 0 : IF ( refYr <= 1900 .AND. refYr >= 1600 ) THEN
1364 0 : refJulday = refJulday + 1.0
1365 : !PRINT *, 'Reference julian day increased by one day!!!'
1366 : ENDIF
1367 :
1368 : ! Get calendar dates
1369 0 : IF ( ASSOCIATED ( all_YYYYMMDDhhmm ) ) DEALLOCATE( all_YYYYMMDDhhmm )
1370 0 : ALLOCATE( all_YYYYMMDDhhmm(nTime) )
1371 0 : all_YYYYMMDDhhmm = 0.0d0
1372 :
1373 : ! Construct julian date for every available time slice. Make sure it is
1374 : ! in the proper 'units', e.g. in days, hours or minutes, depending on
1375 : ! the reference unit.
1376 0 : DO T = 1, nTime
1377 0 : tJulDay = tVec(T)
1378 0 : IF ( refHr >= 0 ) tJulday = tJulday / 24.d0
1379 0 : IF ( refMn >= 0 ) tJulday = tJulday / 60.d0
1380 0 : IF ( refSc >= 0 ) tJulday = tJulday / 60.d0
1381 0 : tJulday = tJulday + refJulday
1382 0 : CALL CALDATE ( tJulday, YYYYMMDD, hhmmss )
1383 0 : all_YYYYMMDDhhmm(T) = ( DBLE( YYYYMMDD ) * 1d4 ) + &
1384 0 : ( DBLE( hhmmss / 100 ) )
1385 : ENDDO
1386 :
1387 : ! Cleanup
1388 0 : IF ( ASSOCIATED( tVec ) ) DEALLOCATE( tVec )
1389 :
1390 : ! Return
1391 0 : IF ( PRESENT(timeUnit) ) timeUnit = ncUnit
1392 0 : IF ( PRESENT(refYear ) ) refYear = refYr
1393 0 : RC = 0
1394 :
1395 0 : END SUBROUTINE NC_READ_TIME_YYYYMMDDhhmm
1396 : !EOC
1397 : !------------------------------------------------------------------------------
1398 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
1399 : ! and NASA/GSFC, SIVO, Code 610.3 !
1400 : !------------------------------------------------------------------------------
1401 : !BOP
1402 : !
1403 : ! !IROUTINE: Nc_Get_RefDateTime
1404 : !
1405 : ! !DESCRIPTION: Returns the reference datetime (tYr / tMt / tDy / tHr /
1406 : ! tMn ) of the provided time unit. For now, supported formats are
1407 : ! "days since YYYY-MM-DD", "hours since YYYY-MM-DD HH:MM:SS", and
1408 : ! "minutes since YYYY-MM-DD HH:NN:SS". For times in days since refdate,
1409 : ! the returned reference hour rHr is set to -1. The same applies for the
1410 : ! reference minute for units in days / hours since XXX.
1411 : !\\
1412 : ! !INTERFACE:
1413 : !
1414 0 : SUBROUTINE NC_GET_REFDATETIME( tUnit, tYr, tMt, tDy, tHr, tMn, tSc, RC )
1415 : !
1416 : ! !USES:
1417 : !
1418 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
1419 : !
1420 : ! !INPUT PARAMETERS:
1421 : !
1422 : ! Required
1423 : CHARACTER(LEN=*), INTENT( IN) :: tUnit
1424 : !
1425 : ! !OUTPUT PARAMETERS:
1426 : !
1427 : INTEGER, INTENT(OUT) :: tYr
1428 : INTEGER, INTENT(OUT) :: tMt
1429 : INTEGER, INTENT(OUT) :: tDy
1430 : INTEGER, INTENT(OUT) :: tHr
1431 : INTEGER, INTENT(OUT) :: tMn
1432 : INTEGER, INTENT(OUT) :: tSc
1433 : !
1434 : ! !INPUT/OUTPUT PARAMETERS:
1435 : !
1436 : INTEGER, INTENT(INOUT) :: RC
1437 : !
1438 : ! !REMARKS:
1439 : !
1440 : ! !REVISION HISTORY:
1441 : ! 18 Jan 2012 - C. Keller - Initial version
1442 : ! See https://github.com/geoschem/ncdfutil for complete history
1443 : !EOP
1444 : !------------------------------------------------------------------------------
1445 : !BOC
1446 : !
1447 : ! !LOCAL VARIABLES:
1448 : !
1449 : CHARACTER(LEN=255) :: LOC, MSG
1450 : CHARACTER(LEN=255) :: MIRRUNIT
1451 : INTEGER :: TTYPE, STAT, L1, L2
1452 : INTEGER :: MINLEN, STRLEN, I
1453 :
1454 : !=================================================================
1455 : ! NC_GET_REFDATETIME starts here
1456 : !=================================================================
1457 :
1458 : ! Init
1459 0 : LOC = 'NC_GET_REFDATETIME (ncdf_mod.F)'
1460 :
1461 : ! ----------------------------------------------------------------------
1462 : ! Determine time unit type
1463 : ! ----------------------------------------------------------------------
1464 :
1465 : ! Mirror time unit and convert to lower case
1466 0 : MIRRUNIT = tUnit
1467 0 : CALL TRANLC( MIRRUNIT )
1468 :
1469 : ! Check for reference time unit '(days, hours, minutes) since ...'
1470 : ! Set beginning of reference date according to the unit and define
1471 : ! minimum string length required by unit.
1472 :
1473 : ! 'days since YYYY-M-D'
1474 0 : IF ( MIRRUNIT(1:10) == 'days since' ) THEN
1475 : TTYPE = 1
1476 : L1 = 12
1477 : MINLEN = 19
1478 :
1479 : ! 'hours since YYYY-M-D h:m:s'
1480 0 : ELSEIF ( MIRRUNIT(1:11) == 'hours since' ) THEN
1481 : TTYPE = 2
1482 : L1 = 13
1483 : MINLEN = 26
1484 :
1485 : ! 'minutes since YYYY-M-D h:m:s'
1486 0 : ELSEIF ( MIRRUNIT(1:13) == 'minutes since' ) THEN
1487 : TTYPE = 3
1488 : L1 = 15
1489 : MINLEN = 28
1490 :
1491 : ! 'seconds since YYYY-M-D h:m:s'
1492 0 : ELSEIF ( MIRRUNIT(1:13) == 'seconds since' ) THEN
1493 : TTYPE = 4
1494 : L1 = 15
1495 : MINLEN = 28
1496 :
1497 : ! Return w/ error otherwise
1498 : ELSE
1499 0 : PRINT *, 'Invalid time unit: ' // TRIM(tUnit)
1500 0 : RC = -999; RETURN
1501 : ENDIF
1502 :
1503 : ! Check if time string is long enough or not
1504 0 : STRLEN = LEN(tUnit)
1505 0 : IF ( STRLEN < MINLEN ) THEN
1506 0 : PRINT *, 'Time unit string too short: ' // TRIM(tUnit)
1507 0 : RC = -999; RETURN
1508 : ENDIF
1509 :
1510 : ! ----------------------------------------------------------------------
1511 : ! Determine reference time/date
1512 : ! Get the year, month, day and hour from the string
1513 : ! '... since YYYY-MM-DD hh:mm:ss
1514 :
1515 : ! Read reference year, i.e. from beginning of date string until
1516 : ! first separator sign (-).
1517 0 : DO I=L1,STRLEN
1518 0 : IF(tUnit(I:I) == '-') EXIT
1519 : ENDDO
1520 0 : L2 = I-1
1521 :
1522 0 : READ( tUnit(L1:L2),'(i4)', IOSTAT=STAT ) tYr
1523 0 : IF ( STAT /= 0 ) THEN
1524 0 : PRINT *, 'Invalid year in ' // TRIM(tUnit)
1525 0 : RC = -999; RETURN
1526 : ENDIF
1527 :
1528 : ! Advance in date string: now read reference month.
1529 0 : L1 = L2 + 2
1530 0 : DO I=L1,STRLEN
1531 0 : IF(tUnit(I:I) == '-') EXIT
1532 : ENDDO
1533 0 : L2 = I-1
1534 0 : READ( tUnit(L1:L2), '(i2)', IOSTAT=STAT ) tMt
1535 0 : IF ( STAT /= 0 ) THEN
1536 0 : PRINT *, 'Invalid month in ' // TRIM(tUnit)
1537 0 : RC = -999; RETURN
1538 : ENDIF
1539 :
1540 : ! Advance in date string: now read reference day.
1541 0 : L1 = L2 + 2
1542 0 : DO I=L1,STRLEN
1543 0 : IF(tUnit(I:I) == ' ') EXIT
1544 : ENDDO
1545 0 : L2 = I-1
1546 0 : READ( tUnit(L1:L2), '(i2)', IOSTAT=STAT ) tDy
1547 0 : IF ( STAT /= 0 ) THEN
1548 0 : PRINT *, 'Invalid day in ' // TRIM(tUnit)
1549 0 : RC = -999; RETURN
1550 : ENDIF
1551 :
1552 : ! Get reference hour only if 'hours/minutes/seconds since'.
1553 0 : IF ( TTYPE > 1 ) THEN
1554 :
1555 : ! Reference hour
1556 0 : L1 = L2 + 2
1557 0 : DO I=L1,STRLEN
1558 0 : IF(tUnit(I:I) == ':') EXIT
1559 : ENDDO
1560 0 : L2 = I-1
1561 0 : READ( tUnit(L1:L2), '(i2)', IOSTAT=STAT ) tHr
1562 0 : IF ( STAT /= 0 ) THEN
1563 0 : PRINT *, 'Invalid hour in ', TRIM(tUnit)
1564 0 : RC = -999; RETURN
1565 : ENDIF
1566 :
1567 : ELSE
1568 : ! Set reference hour to -1
1569 0 : tHr = -1
1570 : ENDIF
1571 :
1572 : ! Get reference minute only if 'minutes since...'
1573 0 : IF ( TTYPE>2 ) THEN
1574 :
1575 : ! Reference minute
1576 0 : L1 = L2 + 2
1577 0 : DO I=L1,STRLEN
1578 0 : IF(tUnit(I:I) == ':') EXIT
1579 : ENDDO
1580 0 : L2 = I-1
1581 0 : READ( tUnit(L1:L2), '(i2)', IOSTAT=STAT ) tMn
1582 0 : IF ( STAT /= 0 ) THEN
1583 0 : PRINT *, 'Invalid minute in ', TRIM(tUnit)
1584 0 : RC = -999; RETURN
1585 : ENDIF
1586 :
1587 : ELSE
1588 : ! Set reference minute to -1
1589 0 : tMn = -1
1590 : ENDIF
1591 :
1592 : ! Get reference minute only if 'seconds since...'
1593 0 : IF ( TTYPE>3 ) THEN
1594 :
1595 : ! Reference second
1596 0 : L1 = L2 + 2
1597 0 : DO I=L1,STRLEN
1598 0 : IF(tUnit(I:I) == ':') EXIT
1599 : ENDDO
1600 0 : L2 = I-1
1601 0 : READ( tUnit(L1:L2), '(i2)', IOSTAT=STAT ) tSc
1602 0 : IF ( STAT /= 0 ) THEN
1603 0 : PRINT *, 'Invalid second in ', TRIM(tUnit)
1604 0 : RC = -999; RETURN
1605 : ENDIF
1606 :
1607 : ELSE
1608 : ! Set reference second to -1
1609 0 : tSc = -1
1610 : ENDIF
1611 :
1612 : ! Return w/ success
1613 0 : RC = 0
1614 :
1615 0 : END SUBROUTINE NC_GET_REFDATETIME
1616 : !EOC
1617 : !------------------------------------------------------------------------------
1618 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
1619 : ! and NASA/GSFC, SIVO, Code 610.3 !
1620 : !------------------------------------------------------------------------------
1621 : !BOP
1622 : !
1623 : ! !IROUTINE: Get_Tidx
1624 : !
1625 : ! !DESCRIPTION: Routine GET\_TIDX returns the index with the specified time
1626 : ! for a given time vector.
1627 : !\\
1628 : !\\
1629 : ! !INTERFACE:
1630 : !
1631 : SUBROUTINE GET_TIDX( TDIM, TIMEVEC, TTYPE, TOFFSET, &
1632 : YEAR, MONTH, DAY, HOUR, &
1633 : TIDX, TDIMREAD, RC )
1634 : !
1635 : ! !INPUT PARAMETERS:
1636 : !
1637 : ! Required
1638 : INTEGER, INTENT( IN) :: TDIM
1639 : INTEGER, INTENT( IN) :: TTYPE
1640 : REAL*8, INTENT( IN) :: TOFFSET
1641 : !
1642 : ! !INPUT/OUTPUT PARAMETERS:
1643 : !
1644 : INTEGER, INTENT(INOUT) :: TIMEVEC(TDIM)
1645 : INTEGER, INTENT(INOUT) :: YEAR
1646 : INTEGER, INTENT(INOUT) :: MONTH
1647 : INTEGER, INTENT(INOUT) :: DAY
1648 : INTEGER, INTENT(INOUT) :: HOUR
1649 : INTEGER, INTENT(INOUT) :: RC
1650 : !
1651 : ! !OUTPUT PARAMETERS:
1652 : !
1653 : INTEGER, INTENT( OUT) :: TIDX
1654 : INTEGER, INTENT( OUT) :: TDIMREAD
1655 : !
1656 : ! !REMARKS:
1657 : !
1658 : ! !REVISION HISTORY:
1659 : ! 04 Nov 2012 - C. Keller - Initial version
1660 : ! See https://github.com/geoschem/ncdfutil for complete history
1661 : !EOP
1662 : !------------------------------------------------------------------------------
1663 : !BOC
1664 : !
1665 : ! !LOCAL VARIABLES:
1666 : !
1667 : INTEGER :: II, iiDiff, minDiff
1668 : REAL*8 :: TAU
1669 : CHARACTER(LEN=255) :: MSG, LOC
1670 :
1671 : !=================================================================
1672 : ! GET_TIDX starts here
1673 : !=================================================================
1674 :
1675 : ! Init
1676 : LOC = 'GET_TIDX (ncdf_mod.F)'
1677 : TIDX = 0
1678 : minDiff = -999
1679 :
1680 : !-----------------------------------------------------------------
1681 : ! If year is given, compare netcdf-tau against desired tau
1682 : !-----------------------------------------------------------------
1683 : IF ( YEAR > 0 ) THEN
1684 :
1685 : ! Restrict month, day and hour to valid values
1686 : MONTH = MIN ( MAX( 1, MONTH ), 12 )
1687 : DAY = MIN ( MAX( 1, DAY ), 31 )
1688 : HOUR = MIN ( MAX( 0, HOUR ), 23 )
1689 :
1690 : ! Read desired tau => hours relative to G-C reference time
1691 : TAU = GET_TAU0( MONTH, DAY, YEAR, HOUR )
1692 :
1693 : ! Convert to 'hours since ...' if unit is 'days since ...'
1694 : IF ( TTYPE == 2 ) THEN
1695 : TIMEVEC(:) = TIMEVEC(:) * 24
1696 : ENDIF
1697 :
1698 : ! Convert time stamps to hours since G-C reference time
1699 : TIMEVEC(:) = TIMEVEC(:) + INT(TOFFSET)
1700 :
1701 : ! Compare wanted tau to tau's of ncdf-file.
1702 : ! Loop over all time stamps and check which one is closest
1703 : ! to the specified one. Print a warning if time stamps don't
1704 : ! match!
1705 : DO II = 1, TDIM
1706 :
1707 : ! Difference between time stamps
1708 : iiDiff = ABS( TIMEVEC(II) - INT(TAU) )
1709 :
1710 : ! Check if this is closest time stamp so far, and save this
1711 : ! index and difference
1712 : IF ( iiDiff < minDiff .OR. II == 1 ) THEN
1713 : minDiff = iiDiff
1714 : TIDX = II
1715 : ENDIF
1716 :
1717 : ! Exit loop if difference is zero
1718 : IF ( minDiff == 0 ) EXIT
1719 :
1720 : ENDDO
1721 :
1722 : ! Warning if time stamps did not match
1723 : IF ( minDiff /= 0 ) THEN
1724 : PRINT *, 'In NCDF_MOD: Time stamp not found ' // &
1725 : 'take closest timestamp!'
1726 : ENDIF
1727 :
1728 : ! Set number of time stamps to be read to 1
1729 : TDIMREAD = 1
1730 :
1731 : !-----------------------------------------------------------------
1732 : ! If only month is given, assume netCDF file to contain monthly
1733 : ! data and pick the desired month.
1734 : !-----------------------------------------------------------------
1735 : ELSEIF ( MONTH > 0 ) THEN
1736 :
1737 : ! Check if it's indeed monthly data:
1738 : IF ( TDIM /= 12 ) THEN
1739 : PRINT *, 'Array is not monthly '
1740 : RC = -999; RETURN
1741 : ENDIF
1742 :
1743 : ! Set time index to specified month
1744 : TIDX = MONTH
1745 :
1746 : ! Set number of time stamps to be read to 1
1747 : TDIMREAD = 1
1748 :
1749 : !-----------------------------------------------------------------
1750 : ! If hour is given, assume netCDF file to contain hourly data
1751 : ! and pick the desired hour.
1752 : !-----------------------------------------------------------------
1753 : ELSEIF ( HOUR >= 0 ) THEN
1754 :
1755 : ! Check if it's indeed hourly data:
1756 : IF ( TDIM /= 24 ) THEN
1757 : PRINT *, 'Array is not hourly'
1758 : RC = -999; RETURN
1759 : ENDIF
1760 :
1761 : ! Set time index to specified hour (+1 since hour 0 is idx 1)
1762 : TIDX = HOUR + 1
1763 :
1764 : ! Set number of time stamps to be read to 1
1765 : TDIMREAD = 1
1766 :
1767 : !-----------------------------------------------------------------
1768 : ! Otherwise, read all time dimensions
1769 : !-----------------------------------------------------------------
1770 : ELSE
1771 : TIDX = 1
1772 : TDIMREAD = TDIM
1773 : ENDIF
1774 :
1775 : ! Return w/ success
1776 : RC = 0
1777 :
1778 : END SUBROUTINE GET_TIDX
1779 : !EOC
1780 : !------------------------------------------------------------------------------
1781 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
1782 : ! and NASA/GSFC, SIVO, Code 610.3 !
1783 : !------------------------------------------------------------------------------
1784 : !BOP
1785 : !
1786 : ! !IROUTINE: TimeUnit_Check
1787 : !
1788 : ! !DESCRIPTION: Makes a validity check of the passed unit string.
1789 : ! Supported formats are "days since YYYY-MM-DD" (TIMETYPE=1) and
1790 : ! "hours since YYYY-MM-DD HH:MM:SS" (TIMETYPE=2).
1791 : !\\
1792 : !\\
1793 : ! The output argument TOFFSET gives the offset of the ncdf reference
1794 : ! time relative to Geos-Chem reference time (in hours).
1795 : !\\
1796 : !\\
1797 : ! !INTERFACE:
1798 : !
1799 : SUBROUTINE TIMEUNIT_CHECK( TIMEUNIT, TIMETYPE, TOFFSET, FILENAME, RC )
1800 : !
1801 : ! !USES:
1802 : !
1803 : USE HCO_CHARPAK_MOD, ONLY : TRANLC
1804 : !
1805 : ! !INPUT PARAMETERS:
1806 : !
1807 : ! Required
1808 : CHARACTER(LEN=*), INTENT(IN ) :: TIMEUNIT
1809 : CHARACTER(LEN=*), INTENT(IN ) :: FILENAME
1810 : !
1811 : ! !OUTPUT PARAMETERS:
1812 : !
1813 : INTEGER, INTENT( OUT) :: TIMETYPE
1814 : REAL*8, INTENT( OUT) :: TOFFSET
1815 : !
1816 : ! !INPUT/OUTPUT PARAMETERS:
1817 : !
1818 : INTEGER, INTENT(INOUT) :: RC
1819 : !
1820 : ! !REMARKS:
1821 : !
1822 : ! !REVISION HISTORY:
1823 : ! 18 Jan 2012 - C. Keller - Initial version
1824 : ! See https://github.com/geoschem/ncdfutil for complete history
1825 : !EOP
1826 : !------------------------------------------------------------------------------
1827 : !BOC
1828 : !
1829 : ! !LOCAL VARIABLES:
1830 : !
1831 : CHARACTER(LEN=255) :: LOC, MSG
1832 : CHARACTER(LEN=255) :: MIRRUNIT
1833 : INTEGER :: STAT, L1, L2
1834 : INTEGER :: TTYPE
1835 : INTEGER :: YYYY, MM, DD, HH
1836 : INTEGER :: STRLEN
1837 :
1838 : !=================================================================
1839 : ! TIMEUNIT_CHECK starts here
1840 : !=================================================================
1841 :
1842 : ! Init
1843 : LOC = 'TIMEUNIT_CHECK (ncdf_mod.F)'
1844 :
1845 : ! Check length of time unit string. This must be at least 21
1846 : ! ("days since YYYY:MM:DD" is of length 21)
1847 : STRLEN = LEN(TIMEUNIT)
1848 : IF ( STRLEN < 21 ) THEN
1849 : PRINT *, 'Time unit string too short: ' // TRIM(FILENAME)
1850 : RC = -999; RETURN
1851 : ENDIF
1852 :
1853 : ! ----------------------------------------------------------------------
1854 : ! Determine time unit type
1855 : ! ----------------------------------------------------------------------
1856 :
1857 : ! Mirror time unit and convert to lower case
1858 : MIRRUNIT = TIMEUNIT
1859 : CALL TRANLC( MIRRUNIT )
1860 :
1861 : ! Check for 'hours since'. If true, set TTYPE to 1 and set the
1862 : ! begin of the effective date string to 12. Also check if the time
1863 : ! string is at least of length 25, which is required for this
1864 : ! unit.
1865 : IF ( MIRRUNIT(1:11) == 'hours since' ) THEN
1866 : TTYPE = 1
1867 : L1 = 13
1868 : IF ( STRLEN < 25 ) THEN
1869 : PRINT *, 'Time unit string too short: ' // TRIM(FILENAME)
1870 : RC = -999; RETURN
1871 : ENDIF
1872 :
1873 : ! Check for 'days since'. If true, set TTYPE to 2 and set the
1874 : ! begin of the effective date string to 11.
1875 : ELSEIF ( MIRRUNIT(1:10) == 'days since' ) THEN
1876 : TTYPE = 2
1877 : L1 = 12
1878 : ELSE
1879 : ! Return w/ error
1880 : PRINT *, 'Invalid time unit in', TRIM(FILENAME)
1881 : RC = -999; RETURN
1882 : ENDIF
1883 :
1884 : ! ----------------------------------------------------------------------
1885 : ! Determine reference time/date
1886 : ! Get the year, month, day and hour from the string
1887 : ! '... since YYYY-MM-DD hh:mm:ss
1888 : ! ----------------------------------------------------------------------
1889 :
1890 : ! Read reference year, i.e. first four integers
1891 : L2 = L1 + 3
1892 : READ( TIMEUNIT(L1:L2),'(i4)', IOSTAT=STAT ) YYYY
1893 : IF ( STAT /= 0 ) THEN
1894 : PRINT *, 'Invalid year in ', TRIM(TIMEUNIT), &
1895 : ' in file' , TRIM(FILENAME)
1896 : RC = -999; RETURN
1897 : ENDIF
1898 :
1899 : ! Read reference month. Typically, the month is represented by
1900 : ! two characters, i.e. 1 is 01, etc.
1901 : L1 = L2 + 2
1902 : L2 = L1 + 1
1903 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) MM
1904 : ! Also check for the case where the month is only one character:
1905 : IF ( STAT /= 0 ) THEN
1906 : L2 = L1
1907 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) MM
1908 : IF ( STAT /= 0 ) THEN
1909 : PRINT *, 'Invalid month in ', TRIM(TIMEUNIT), &
1910 : ' in file' , TRIM(FILENAME)
1911 : RC = -999; RETURN
1912 : ENDIF
1913 : ENDIF
1914 :
1915 : ! Reference day. Typically, the day is represented by two
1916 : ! characters, i.e. 1 is 01, etc.
1917 : L1 = L2 + 2
1918 : L2 = L1 + 1
1919 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) DD
1920 : ! Also check for the case where the day is only one character:
1921 : IF ( STAT /= 0 ) THEN
1922 : L2 = L1
1923 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) DD
1924 : IF ( STAT /= 0 ) THEN
1925 : PRINT *, 'Invalid day in ', TRIM(TIMEUNIT), &
1926 : ' in file' , TRIM(FILENAME)
1927 : RC = -999; RETURN
1928 : ENDIF
1929 : ENDIF
1930 :
1931 : ! Get reference hour only if 'hours since...'
1932 : IF ( TTYPE == 1 ) THEN
1933 :
1934 : ! Reference hour
1935 : L1 = L2 + 2
1936 : L2 = L1 + 1
1937 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) HH
1938 : IF ( STAT /= 0 ) THEN
1939 : L2 = L1
1940 : READ( TIMEUNIT(L1:L2), '(i2)', IOSTAT=STAT ) HH
1941 : IF ( STAT /= 0 ) THEN
1942 : PRINT *, 'Invalid hour in ', TRIM(TIMEUNIT), &
1943 : ' in file' , TRIM(FILENAME)
1944 : RC = -999; RETURN
1945 : ENDIF
1946 : ENDIF
1947 :
1948 : ELSE
1949 : ! Set reference hour to 0
1950 : HH = 0
1951 :
1952 : ENDIF
1953 :
1954 : ! Get reference tau relative to G-C reference time, i.e. the
1955 : ! offset of the netCDF reference time to the G-C reference time.
1956 : ! This is hours since G-C reftime.
1957 : TOFFSET = GET_TAU0( MM, DD, YYYY, HH )
1958 :
1959 : ! Remove one day if TOFFSET is negative, i.e. if the netCDF
1960 : ! reference time is older than G-C reference time. We have to do
1961 : ! this because GET_TAU0 does count the last day in this case!
1962 : IF ( TOFFSET < 0d0 ) THEN
1963 : TOFFSET = TOFFSET + 24d0
1964 : ENDIF
1965 :
1966 : ! Output argument
1967 : TIMETYPE = TTYPE
1968 :
1969 : ! Return w/ success
1970 : RC = 0
1971 :
1972 : END SUBROUTINE TIMEUNIT_CHECK
1973 : !EOC
1974 : !------------------------------------------------------------------------------
1975 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
1976 : ! and NASA/GSFC, SIVO, Code 610.3 !
1977 : !------------------------------------------------------------------------------
1978 : !BOP
1979 : !
1980 : ! !IROUTINE: Nc_Get_Grid_Edges_Sp
1981 : !
1982 : ! !DESCRIPTION: Routine to get the longitude or latitude edges. If the edge
1983 : ! cannot be read from the netCDF file, they are calculated from the provided
1984 : ! grid midpoints. Use the axis input argument to discern between longitude
1985 : ! (axis 1) and latitude (axis 2).
1986 : !\\
1987 : !\\
1988 : ! !INTERFACE:
1989 : !
1990 0 : SUBROUTINE NC_GET_GRID_EDGES_SP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC )
1991 : !
1992 : ! !USES:
1993 : !
1994 : IMPLICIT NONE
1995 : !
1996 : ! !INPUT PARAMETERS:
1997 : !
1998 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
1999 : INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat
2000 : INTEGER, INTENT(IN ) :: NMID ! # of midpoints
2001 : REAL*4, INTENT(IN ) :: MID(NMID) ! midpoints
2002 : !
2003 : ! !INPUT/OUTPUT PARAMETERS:
2004 : !
2005 : REAL*4, POINTER :: EDGE(:) ! edges
2006 : INTEGER, INTENT(INOUT) :: NEDGE ! # of edges
2007 : INTEGER, INTENT(INOUT) :: RC ! Return code
2008 : !
2009 : ! !REVISION HISTORY:
2010 : ! 16 Jul 2014 - C. Keller - Initial version
2011 : ! See https://github.com/geoschem/ncdfutil for complete history
2012 : !EOP
2013 : !------------------------------------------------------------------------------
2014 : !BOC
2015 :
2016 : !======================================================================
2017 : ! NC_GET_GRID_EDGES_SP begins here
2018 : !======================================================================
2019 :
2020 : CALL NC_GET_GRID_EDGES_C( fID, AXIS, NMID, NEDGE, RC, &
2021 0 : MID4=MID, EDGE4=EDGE )
2022 :
2023 0 : END SUBROUTINE NC_GET_GRID_EDGES_SP
2024 : !EOC
2025 : !------------------------------------------------------------------------------
2026 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2027 : ! and NASA/GSFC, SIVO, Code 610.3 !
2028 : !------------------------------------------------------------------------------
2029 : !BOP
2030 : !
2031 : ! !IROUTINE: Nc_Get_Grid_Edges_Dp
2032 : !
2033 : ! !DESCRIPTION: Routine to get the longitude or latitude edges. If the edge
2034 : ! cannot be read from the netCDF file, they are calculated from the provided
2035 : ! grid midpoints. Use the axis input argument to discern between longitude
2036 : ! (axis 1) and latitude (axis 2).
2037 : !\\
2038 : !\\
2039 : ! !INTERFACE:
2040 : !
2041 0 : SUBROUTINE NC_GET_GRID_EDGES_DP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC )
2042 : !
2043 : ! !USES:
2044 : !
2045 : IMPLICIT NONE
2046 : !
2047 : ! !INPUT PARAMETERS:
2048 : !
2049 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2050 : INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat
2051 : INTEGER, INTENT(IN ) :: NMID ! # of midpoints
2052 : REAL*8, INTENT(IN ) :: MID(NMID) ! midpoints
2053 : !
2054 : ! !INPUT/OUTPUT PARAMETERS:
2055 : !
2056 : REAL*8, POINTER :: EDGE(:) ! edges
2057 : INTEGER, INTENT(INOUT) :: NEDGE ! # of edges
2058 : INTEGER, INTENT(INOUT) :: RC ! Return code
2059 : !
2060 : ! !REVISION HISTORY:
2061 : ! 16 Jul 2014 - C. Keller - Initial version
2062 : ! See https://github.com/geoschem/ncdfutil for complete history
2063 : !EOP
2064 : !------------------------------------------------------------------------------
2065 : !BOC
2066 :
2067 : !======================================================================
2068 : ! NC_GET_GRID_EDGES_DP begins here
2069 : !======================================================================
2070 :
2071 : CALL NC_GET_GRID_EDGES_C( fID, AXIS, NMID, NEDGE, RC, &
2072 0 : MID8=MID, EDGE8=EDGE )
2073 :
2074 0 : END SUBROUTINE NC_GET_GRID_EDGES_DP
2075 : !EOC
2076 : !------------------------------------------------------------------------------
2077 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2078 : ! and NASA/GSFC, SIVO, Code 610.3 !
2079 : !------------------------------------------------------------------------------
2080 : !BOP
2081 : !
2082 : ! !IROUTINE: Nc_Get_Grid_Edges_C
2083 : !
2084 : ! !DESCRIPTION: Routine to get the longitude or latitude edges. If the edge
2085 : ! cannot be read from the netCDF file, they are calculated from the provided
2086 : ! grid midpoints. Use the axis input argument to discern between longitude
2087 : ! (axis 1) and latitude (axis 2).
2088 : !\\
2089 : !\\
2090 : ! !INTERFACE:
2091 : !
2092 0 : SUBROUTINE NC_GET_GRID_EDGES_C( fID, AXIS, NMID, NEDGE, RC, &
2093 0 : MID4, MID8, EDGE4, EDGE8 )
2094 : !
2095 : ! !INPUT PARAMETERS:
2096 : !
2097 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2098 : INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat
2099 : INTEGER, INTENT(IN ) :: NMID ! # of midpoints
2100 : REAL*4, OPTIONAL, INTENT(IN ) :: MID4(NMID) ! midpoints
2101 : REAL*8, OPTIONAL, INTENT(IN ) :: MID8(NMID) ! midpoints
2102 : !
2103 : ! !INPUT/OUTPUT PARAMETERS:
2104 : !
2105 : REAL*4, OPTIONAL, POINTER :: EDGE4(:) ! edges
2106 : REAL*8, OPTIONAL, POINTER :: EDGE8(:) ! edges
2107 : INTEGER, INTENT(INOUT) :: NEDGE ! # of edges
2108 : INTEGER, INTENT(INOUT) :: RC ! Return code
2109 : !
2110 : ! !REVISION HISTORY:
2111 : ! 16 Jul 2014 - C. Keller - Initial version
2112 : ! See https://github.com/geoschem/ncdfutil for complete history
2113 : !EOP
2114 : !------------------------------------------------------------------------------
2115 : !BOC
2116 : !
2117 : ! !LOCAL VARIABLES:
2118 : !
2119 : LOGICAL :: PoleMid
2120 : INTEGER :: I, AS
2121 : CHARACTER(LEN=255) :: ncVar, ThisUnit
2122 :
2123 : !======================================================================
2124 : ! NC_GET_GRID_EDGES_DP begins here
2125 : !======================================================================
2126 :
2127 : ! Error trap: edge and mid must be same kind
2128 0 : IF ( PRESENT(EDGE4) ) THEN
2129 0 : IF ( .NOT. PRESENT(MID4) ) THEN
2130 0 : PRINT *, 'If you provide EDGE4, you must also provide MID4'
2131 0 : RC = -999
2132 0 : RETURN
2133 : ENDIF
2134 0 : ELSEIF ( PRESENT(EDGE8) ) THEN
2135 0 : IF ( .NOT. PRESENT(MID8) ) THEN
2136 0 : PRINT *, 'If you provide EDGE8, you must also provide MID8'
2137 0 : RC = -999
2138 0 : RETURN
2139 : ENDIF
2140 : ELSE
2141 0 : PRINT *, 'EDGE4 or EDGE8 must be given'
2142 0 : RC = -999
2143 0 : RETURN
2144 : ENDIF
2145 :
2146 : ! Try to read edges from ncdf file
2147 0 : IF ( AXIS == 1 ) THEN
2148 0 : ncVar = 'lon_edge'
2149 0 : ELSEIF ( AXIS == 2 ) THEN
2150 0 : ncVar = 'lat_edge'
2151 : ENDIF
2152 :
2153 0 : IF ( PRESENT(EDGE4) ) THEN
2154 0 : CALL NC_READ_VAR( fID, TRIM(ncVar), nEdge, ThisUnit, Edge4, RC )
2155 : ELSE
2156 0 : CALL NC_READ_VAR( fID, TRIM(ncVar), nEdge, ThisUnit, Edge8, RC )
2157 : ENDIF
2158 0 : IF ( RC /= 0 ) RETURN
2159 :
2160 : ! Also try 'XXX_edges'
2161 0 : IF ( nEdge == 0 ) THEN
2162 0 : IF ( AXIS == 1 ) THEN
2163 0 : ncVar = 'lon_edges'
2164 0 : ELSEIF ( AXIS == 2 ) THEN
2165 0 : ncVar = 'lat_edges'
2166 : ENDIF
2167 0 : IF ( PRESENT(EDGE4) ) THEN
2168 0 : CALL NC_READ_VAR( fID, 'lon_edges', nEdge, ThisUnit, Edge4, RC )
2169 : ELSE
2170 0 : CALL NC_READ_VAR( fID, 'lon_edges', nEdge, ThisUnit, Edge8, RC )
2171 : ENDIF
2172 0 : IF ( RC /= 0 ) RETURN
2173 : ENDIF
2174 :
2175 : ! Sanity check if edges are read from files: dimension must be nlon + 1!
2176 0 : IF ( nEdge > 0 ) THEN
2177 0 : IF ( nEdge /= (nMid + 1) ) THEN
2178 0 : PRINT *, 'Edge has incorrect length!'
2179 0 : RC = -999; RETURN
2180 : ENDIF
2181 :
2182 : ! If not read from file, calculate from provided lon midpoints.
2183 : ELSE
2184 :
2185 0 : nEdge = nMid + 1
2186 0 : IF ( PRESENT(EDGE4) ) THEN
2187 0 : IF ( ASSOCIATED ( Edge4 ) ) DEALLOCATE( Edge4 )
2188 0 : ALLOCATE ( Edge4(nEdge), STAT=AS )
2189 0 : IF ( AS /= 0 ) THEN
2190 0 : PRINT *, 'Edge alloc. error in NC_GET_LON_EDGES (ncdf_mod.F90)'
2191 0 : RC = -999; RETURN
2192 : ENDIF
2193 0 : Edge4 = 0.0
2194 : ELSE
2195 0 : IF ( ASSOCIATED ( Edge8 ) ) DEALLOCATE( Edge8 )
2196 0 : ALLOCATE ( Edge8(nEdge), STAT=AS )
2197 : IF ( AS /= 0 ) THEN
2198 0 : PRINT *, 'Edge alloc. error in NC_GET_LON_EDGES (ncdf_mod.F90)'
2199 0 : RC = -999; RETURN
2200 : ENDIF
2201 0 : Edge8 = 0.0d0
2202 : ENDIF
2203 :
2204 : ! Get leftmost edge by extrapolating from first two midpoints.
2205 : ! Error trap: for latitude axis, first edge must not be below -90!
2206 0 : IF ( PRESENT(EDGE4) ) THEN
2207 0 : Edge4(1) = Mid4(1) - ( (Mid4(2) - Mid4(1) ) / 2.0 )
2208 0 : IF ( Edge4(1) < -90.0 .AND. AXIS == 2 ) Edge4(1) = -90.0
2209 : ELSE
2210 0 : Edge8(1) = Mid8(1) - ( (Mid8(2) - Mid8(1) ) / 2.0d0 )
2211 0 : IF ( Edge8(1) < -90.0d0 .AND. AXIS == 2 ) Edge8(1) = -90.0d0
2212 : ENDIF
2213 :
2214 : ! Calculate second edge. We need to catch the case where the first
2215 : ! latitude mid-point is -90 (this is the case for GEOS-5 generic
2216 : ! grids...). In that case, the second edge is put in the middle of
2217 : ! the first two mid points (e.g. between -90 and -89). In all other
2218 : ! case, we calculate it from the previously calculated left edge.
2219 : IF ( PRESENT(EDGE4) ) THEN
2220 0 : IF ( Mid4(1) == Edge4(1) ) THEN
2221 0 : Edge4(2) = Mid4(1) + ( Mid4(2) - Mid4(1) ) / 2.0
2222 0 : PoleMid = .TRUE.
2223 : ELSE
2224 0 : Edge4(2) = Mid4(1) + Mid4(1) - Edge4(1)
2225 0 : PoleMid = .FALSE.
2226 : ENDIF
2227 :
2228 : ! Sequentially calculate the right edge from the previously
2229 : ! calculated left edge.
2230 0 : DO I = 2, nMid
2231 0 : Edge4(I+1) = Mid4(I) + Mid4(I) - Edge4(I)
2232 : ENDDO
2233 :
2234 : ! Error check: max. lat edge must not exceed +90!
2235 0 : IF ( Edge4(nMId+1) > 90.01 .AND. AXIS == 2 ) THEN
2236 0 : IF ( PoleMid ) THEN
2237 0 : Edge4(nMid+1) = 90.0
2238 : ELSE
2239 0 : PRINT *, 'Uppermost latitude edge above 90 deg north!'
2240 0 : PRINT *, Edge4
2241 0 : RC = -999; RETURN
2242 : ENDIF
2243 : ENDIF
2244 :
2245 : ! Real8
2246 : ELSE
2247 0 : IF ( Mid8(1) == Edge8(1) ) THEN
2248 0 : Edge8(2) = Mid8(1) + ( Mid8(2) - Mid8(1) ) / 2.0d0
2249 0 : PoleMid = .TRUE.
2250 : ELSE
2251 0 : Edge8(2) = Mid8(1) + Mid8(1) - Edge8(1)
2252 0 : PoleMid = .FALSE.
2253 : ENDIF
2254 :
2255 : ! Sequentially calculate the right edge from the previously
2256 : ! calculated left edge.
2257 0 : DO I = 2, nMid
2258 0 : Edge8(I+1) = Mid8(I) + Mid8(I) - Edge8(I)
2259 : ENDDO
2260 :
2261 : ! Error check: max. lat edge must not exceed +90!
2262 0 : IF ( Edge8(nMId+1) > 90.01d0 .AND. AXIS == 2 ) THEN
2263 0 : IF ( PoleMid ) THEN
2264 0 : Edge8(nMid+1) = 90.0d0
2265 : ELSE
2266 0 : PRINT *, 'Uppermost latitude edge above 90 deg north!'
2267 0 : PRINT *, Edge8
2268 0 : RC = -999; RETURN
2269 : ENDIF
2270 : ENDIF
2271 : ENDIF
2272 : ENDIF
2273 :
2274 : ! Return w/ success
2275 0 : RC = 0
2276 :
2277 0 : END SUBROUTINE NC_GET_GRID_EDGES_C
2278 : !EOC
2279 : !------------------------------------------------------------------------------
2280 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2281 : ! and NASA/GSFC, SIVO, Code 610.3 !
2282 : !------------------------------------------------------------------------------
2283 : !BOP
2284 : !
2285 : ! !IROUTINE: Nc_Get_Sigma_Levels_Sp
2286 : !
2287 : ! !DESCRIPTION: Wrapper routine to get the sigma levels in single precision.
2288 : !\\
2289 : !\\
2290 : ! !INTERFACE:
2291 : !
2292 0 : SUBROUTINE NC_GET_SIGMA_LEVELS_SP( fID, ncFile, levName, lon1, lon2, lat1, &
2293 : lat2, lev1, lev2, time, SigLev, dir, RC )
2294 : !
2295 : ! !INPUT PARAMETERS:
2296 : !
2297 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2298 : CHARACTER(LEN=*), INTENT(IN ) :: ncFile ! ncFile
2299 : CHARACTER(LEN=*), INTENT(IN ) :: levName ! variable name
2300 : INTEGER, INTENT(IN ) :: lon1 ! lon lower bound
2301 : INTEGER, INTENT(IN ) :: lon2 ! lon upper bound
2302 : INTEGER, INTENT(IN ) :: lat1 ! lat lower bound
2303 : INTEGER, INTENT(IN ) :: lat2 ! lat upper bound
2304 : INTEGER, INTENT(IN ) :: lev1 ! lev lower bound
2305 : INTEGER, INTENT(IN ) :: lev2 ! lev upper bound
2306 : INTEGER, INTENT(IN ) :: time ! time index
2307 : !
2308 : ! !INPUT/OUTPUT PARAMETERS:
2309 : !
2310 : REAL*4, POINTER :: SigLev(:,:,:) ! sigma levels
2311 : INTEGER, INTENT(INOUT) :: dir ! axis direction (1=up;-1=down)
2312 : INTEGER, INTENT(INOUT) :: RC ! Return code
2313 : !
2314 : ! !REVISION HISTORY:
2315 : ! 03 Oct 2014 - C. Keller - Initial version
2316 : ! See https://github.com/geoschem/ncdfutil for complete history
2317 : !EOP
2318 : !------------------------------------------------------------------------------
2319 : !BOC
2320 :
2321 : CALL NC_GET_SIGMA_LEVELS_C( fID, ncFile, levName, lon1, lon2, lat1, &
2322 : lat2, lev1, lev2, time, dir, RC, &
2323 0 : SigLev4=SigLev )
2324 :
2325 0 : END SUBROUTINE NC_GET_SIGMA_LEVELS_SP
2326 : !EOC
2327 : !------------------------------------------------------------------------------
2328 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2329 : ! and NASA/GSFC, SIVO, Code 610.3 !
2330 : !------------------------------------------------------------------------------
2331 : !BOP
2332 : !
2333 : ! !IROUTINE: Nc_Get_Sigma_Levels_Dp
2334 : !
2335 : ! !DESCRIPTION: Wrapper routine to get the sigma levels in double precision.
2336 : !\\
2337 : !\\
2338 : ! !INTERFACE:
2339 : !
2340 0 : SUBROUTINE NC_GET_SIGMA_LEVELS_DP( fID, ncFile, levName, lon1, lon2, lat1, &
2341 : lat2, lev1, lev2, time, SigLev, dir, RC )
2342 : !
2343 : ! !INPUT PARAMETERS:
2344 : !
2345 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2346 : CHARACTER(LEN=*), INTENT(IN ) :: ncFile ! ncFile
2347 : CHARACTER(LEN=*), INTENT(IN ) :: levName ! variable name
2348 : INTEGER, INTENT(IN ) :: lon1 ! lon lower bound
2349 : INTEGER, INTENT(IN ) :: lon2 ! lon upper bound
2350 : INTEGER, INTENT(IN ) :: lat1 ! lat lower bound
2351 : INTEGER, INTENT(IN ) :: lat2 ! lat upper bound
2352 : INTEGER, INTENT(IN ) :: lev1 ! lev lower bound
2353 : INTEGER, INTENT(IN ) :: lev2 ! lev upper bound
2354 : INTEGER, INTENT(IN ) :: time ! time index
2355 : !
2356 : ! !INPUT/OUTPUT PARAMETERS:
2357 : !
2358 : REAL*8, POINTER :: SigLev(:,:,:) ! sigma levels
2359 : INTEGER, INTENT(INOUT) :: dir ! axis direction (1=up;-1=down)
2360 : INTEGER, INTENT(INOUT) :: RC ! Return code
2361 : !
2362 : ! !REVISION HISTORY:
2363 : ! 03 Oct 2014 - C. Keller - Initial version
2364 : ! See https://github.com/geoschem/ncdfutil for complete history
2365 : !EOP
2366 : !------------------------------------------------------------------------------
2367 : !BOC
2368 :
2369 : CALL NC_GET_SIGMA_LEVELS_C( fID, ncFile, levName, lon1, lon2, lat1, &
2370 : lat2, lev1, lev2, time, dir, RC, &
2371 0 : SigLev8=SigLev )
2372 :
2373 0 : END SUBROUTINE NC_GET_SIGMA_LEVELS_DP
2374 : !EOC
2375 : !------------------------------------------------------------------------------
2376 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2377 : ! and NASA/GSFC, SIVO, Code 610.3 !
2378 : !------------------------------------------------------------------------------
2379 : !BOP
2380 : !
2381 : ! !IROUTINE: Nc_Get_Sigma_Levels_C
2382 : !
2383 : ! !DESCRIPTION: Routine to get the sigma levels from the netCDF file
2384 : ! within the given grid bounds and for the given time index. This routine
2385 : ! attempts to construct the 3D sigma values from provided variable levName.
2386 : ! The vertical coordinate system is determined based upon the variable
2387 : ! attribute "standard\_name".
2388 : !\\
2389 : !\\
2390 : ! For now, only hybrid sigma coordinate systems are supported, and the
2391 : ! standard\_name attribute must follow CF conventions and be set to
2392 : ! "atmosphere\_hybrid\_sigma\_pressure\_coordinate".
2393 : !\\
2394 : !\\
2395 : ! !INTERFACE:
2396 : !
2397 0 : SUBROUTINE NC_GET_SIGMA_LEVELS_C( fID, ncFile, levName, lon1, lon2, lat1, &
2398 : lat2, lev1, lev2, time, dir, RC, &
2399 : SigLev4, SigLev8 )
2400 : !
2401 : ! !INPUT PARAMETERS:
2402 : !
2403 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2404 : CHARACTER(LEN=*), INTENT(IN ) :: ncFile ! ncFile
2405 : CHARACTER(LEN=*), INTENT(IN ) :: levName ! variable name
2406 : INTEGER, INTENT(IN ) :: lon1 ! lon lower bound
2407 : INTEGER, INTENT(IN ) :: lon2 ! lon upper bound
2408 : INTEGER, INTENT(IN ) :: lat1 ! lat lower bound
2409 : INTEGER, INTENT(IN ) :: lat2 ! lat upper bound
2410 : INTEGER, INTENT(IN ) :: lev1 ! lev lower bound
2411 : INTEGER, INTENT(IN ) :: lev2 ! lev upper bound
2412 : INTEGER, INTENT(IN ) :: time ! time index
2413 : !
2414 : ! !INPUT/OUTPUT PARAMETERS:
2415 : !
2416 : INTEGER, INTENT( OUT) :: dir ! axis direction (1=up;-1=down)
2417 : INTEGER, INTENT(INOUT) :: RC ! Return code
2418 : REAL*4, OPTIONAL, POINTER :: SigLev4(:,:,:) ! sigma levels w/in
2419 : REAL*8, OPTIONAL, POINTER :: SigLev8(:,:,:) ! specified boundaries
2420 : !
2421 : ! !REVISION HISTORY:
2422 : ! 03 Oct 2014 - C. Keller - Initial version
2423 : ! See https://github.com/geoschem/ncdfutil for complete history
2424 : !EOP
2425 : !------------------------------------------------------------------------------
2426 : !BOC
2427 : !
2428 : ! !LOCAL VARIABLES:
2429 : !
2430 : ! Scalars
2431 : LOGICAL :: found
2432 : INTEGER :: a_type ! netCDF attribute type
2433 :
2434 : ! Straings
2435 : CHARACTER(LEN=255) :: stdname
2436 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
2437 : CHARACTER(LEN=255) :: a_val ! netCDF attribute value
2438 :
2439 : !========================================================================
2440 : ! NC_GET_SIGMA_LEVELS begins here
2441 : !========================================================================
2442 :
2443 : ! Initialize
2444 0 : RC = 0
2445 :
2446 : !------------------------------------------------------------------------
2447 : ! Test that the level index variable exists
2448 : !------------------------------------------------------------------------
2449 0 : found = Ncdoes_Var_Exist( fID, TRIM(levName) )
2450 0 : IF ( .not. found ) THEN
2451 0 : WRITE(*,*) 'Cannot find level variable ', &
2452 0 : TRIM(levName), ' in ', TRIM(ncFile), '!'
2453 0 : RC = -999
2454 0 : RETURN
2455 : ENDIF
2456 :
2457 : !------------------------------------------------------------------------
2458 : ! Look for the "standard_name" or "long_name" attribute,
2459 : ! which will be used to identify the vertical coordinate
2460 : !------------------------------------------------------------------------
2461 :
2462 : ! First look for "standard_name"
2463 0 : a_name = "standard_name"
2464 0 : found = NcDoes_Attr_Exist( fId, TRIM(levName), TRIM(a_name), a_type )
2465 :
2466 : ! If not found, then look for "long_name"
2467 0 : IF ( .not. found ) THEN
2468 0 : a_name = "long_name"
2469 0 : found = NcDoes_Attr_Exist( fId, TRIM(levName), TRIM(a_name), a_type )
2470 :
2471 : ! If neither attribute is found, then exit with error
2472 0 : IF ( .not. found ) THEN
2473 0 : WRITE(*,*) 'Cannot find level attribute ', TRIM(a_name), &
2474 0 : ' in variable ', TRIM(levName), ' - File: ', TRIM(ncFile), '!'
2475 0 : RC = -999
2476 0 : RETURN
2477 : ENDIF
2478 : ENDIF
2479 :
2480 : ! Read the "standard_name" or "long_name" attribute (whichever is found)
2481 0 : CALL NcGet_Var_Attributes( fID, TRIM(levName), TRIM(a_name), a_val )
2482 :
2483 : !------------------------------------------------------------------------
2484 : ! Call functions to calculate sigma levels depending on the coordinate
2485 : ! system.
2486 : !------------------------------------------------------------------------
2487 0 : IF ( TRIM(a_val) == 'atmosphere_hybrid_sigma_pressure_coordinate' ) THEN
2488 :
2489 0 : IF ( PRESENT( SigLev4 ) ) THEN
2490 :
2491 : ! Return 4-byte real array
2492 : CALL NC_GET_SIG_FROM_HYBRID( fID, levName, lon1, lon2, &
2493 : lat1, lat2, lev1, lev2, &
2494 0 : time, dir, RC, SigLev4=SigLev4 )
2495 0 : ELSE IF ( PRESENT( SigLev8 ) ) THEN
2496 :
2497 : ! Return 8-byte real array
2498 : CALL NC_GET_SIG_FROM_HYBRID( fID, levName, lon1, lon2, &
2499 : lat1, lat2, lev1, lev2, &
2500 0 : time, dir, RC, SigLev8=SigLev8 )
2501 : ELSE
2502 :
2503 : ! Othrwise exit with error
2504 0 : WRITE(*,*) 'SigLev array is missing!'
2505 0 : RC = -999
2506 0 : RETURN
2507 : ENDIF
2508 0 : IF ( RC /= 0 ) RETURN
2509 :
2510 : ELSE
2511 :
2512 : ! NOTE: for now, only hybrid sigma coordinates are supported!
2513 : ! So exit with error if we get this far
2514 0 : WRITE(*,*) 'Invalid level standard name: ', TRIM(stdname), &
2515 0 : ' in ', TRIM(ncFile)
2516 0 : RC = -999
2517 0 : RETURN
2518 : ENDIF
2519 :
2520 : ! Return w/ success
2521 0 : RC = 0
2522 :
2523 : END SUBROUTINE NC_GET_SIGMA_LEVELS_C
2524 : !EOC
2525 : !------------------------------------------------------------------------------
2526 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2527 : ! and NASA/GSFC, SIVO, Code 610.3 !
2528 : !------------------------------------------------------------------------------
2529 : !BOP
2530 : !
2531 : ! !IROUTINE: Nc_Get_Sig_From_Hybrid
2532 : !
2533 : ! !DESCRIPTION: Calculates the sigma level field for a hybrid sigma coordinate
2534 : ! system:
2535 : !
2536 : ! sigma(i,j,l,t) = ( a(l) * p0 + b(l) * ps(i,j,t) ) / ps(i,j,t)
2537 : !
2538 : ! or (p0=1):
2539 : !
2540 : ! sigma(i,j,l,t) = ( ap(l) + b(l) * ps(i,j,t) ) / ps(i,j,t)
2541 : !
2542 : ! where sigma are the sigma levels, ap and bp are the hybrid sigma coordinates,
2543 : ! p0 is the constant reference pressure, and ps is the surface pressure. The
2544 : ! variable names of ap, p0, bp, and ps are taken from level attribute
2545 : ! `formula\_terms`.
2546 : !\\
2547 : !\\
2548 : ! The direction of the vertical coordinate system is determined from attribute
2549 : ! `positive` (up or down) or - if not found - from the b values, whereby it is
2550 : ! assumed that the higher b value is found at the surface. The return argument
2551 : ! dir is set to 1 for upward coordinates (level 1 is surface level) and -1 for
2552 : ! downward coordinates (level 1 is top of atmosphere).
2553 : !\\
2554 : !\\
2555 : ! !REMARKS:
2556 : ! Example of valid netCDF meta-data: The attributes `standard\_name` and
2557 : ! `formula\_terms` are required, as is the 3D surface pressure field.
2558 : !
2559 : ! double lev(lev) ;\\
2560 : ! lev:standard_name = "atmosphere_hybrid_sigma_pressure_coordinate" ;\\
2561 : ! lev:units = "level" ;\\
2562 : ! lev:positive = "down" ;\\
2563 : ! lev:formula_terms = "ap: hyam b: hybm ps: PS" ;\\
2564 : ! double hyam(nhym) ;\\
2565 : ! hyam:long_name = "hybrid A coefficient at layer midpoints" ;\\
2566 : ! hyam:units = "hPa" ;\\
2567 : ! double hybm(nhym) ;\\
2568 : ! hybm:long_name = "hybrid B coefficient at layer midpoints" ;\\
2569 : ! hybm:units = "1" ;\\
2570 : ! double time(time) ;\\
2571 : ! time:standard_name = "time" ;\\
2572 : ! time:units = "days since 2000-01-01 00:00:00" ;\\
2573 : ! time:calendar = "standard" ;\\
2574 : ! double PS(time, lat, lon) ;\\
2575 : ! PS:long_name = "surface pressure" ;\\
2576 : ! PS:units = "hPa" ;\\
2577 : !
2578 : ! !INTERFACE:
2579 : !
2580 0 : SUBROUTINE NC_GET_SIG_FROM_HYBRID ( fID, levName, lon1, lon2, lat1, &
2581 : lat2, lev1, lev2, time, dir, &
2582 : RC, sigLev4, sigLev8 )
2583 : !
2584 : ! !INPUT PARAMETERS:
2585 : !
2586 : INTEGER, INTENT(IN ) :: fID ! Ncdf File ID
2587 : CHARACTER(LEN=*), INTENT(IN ) :: levName ! variable name
2588 : INTEGER, INTENT(IN ) :: lon1 ! lon lower bound
2589 : INTEGER, INTENT(IN ) :: lon2 ! lon upper bound
2590 : INTEGER, INTENT(IN ) :: lat1 ! lat lower bound
2591 : INTEGER, INTENT(IN ) :: lat2 ! lat upper bound
2592 : INTEGER, INTENT(IN ) :: lev1 ! lev lower bound
2593 : INTEGER, INTENT(IN ) :: lev2 ! lev upper bound
2594 : INTEGER, INTENT(IN ) :: time ! time index
2595 : !
2596 : ! !INPUT/OUTPUT PARAMETERS:
2597 : !
2598 : REAL*4, OPTIONAL, POINTER :: SigLev4(:,:,:) ! sigma levels w/in
2599 : REAL*8, OPTIONAL, POINTER :: SigLev8(:,:,:) ! specified boundaries
2600 : INTEGER, INTENT( OUT) :: dir ! axis direction (1=up;-1=down)
2601 : INTEGER, INTENT(INOUT) :: RC ! Return code
2602 : !
2603 : ! !REVISION HISTORY:
2604 : ! 03 Oct 2014 - C. Keller - Initial version
2605 : ! See https://github.com/geoschem/ncdfutil for complete history
2606 : !EOP
2607 : !------------------------------------------------------------------------------
2608 : !BOC
2609 : !
2610 : ! !LOCAL VARIABLES:
2611 : !
2612 : INTEGER :: I, J, l1, l2, AS
2613 : INTEGER :: nlev, nlat, nlon
2614 : INTEGER :: nlevs
2615 : INTEGER :: st1d(1), ct1d(1)
2616 : LOGICAL :: ok
2617 0 : REAL*4, POINTER :: a(:)
2618 0 : REAL*4, POINTER :: b(:)
2619 0 : REAL*4, POINTER :: ps(:,:,:,:)
2620 : REAL*8 :: p0
2621 : CHARACTER(LEN=255) :: formula, ThisUnit
2622 : CHARACTER(LEN=255) :: aname, bname, psname, p0name
2623 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
2624 : INTEGER :: a_type ! netCDF attribute type
2625 :
2626 : !======================================================================
2627 : ! NC_GET_SIG_FROM_HYBRID begins here
2628 : !======================================================================
2629 :
2630 : ! Init
2631 0 : p0 = -999.d0
2632 0 : a => NULL()
2633 0 : b => NULL()
2634 0 : ps => NULL()
2635 :
2636 : ! Get desired grid dimensions.
2637 0 : nlon = lon2 - lon1 + 1
2638 0 : nlat = lat2 - lat1 + 1
2639 0 : nlev = lev2 - lev1 + 1
2640 :
2641 : ! Get dimension length
2642 0 : CALL Ncget_Dimlen ( fID, TRIM(LevName), nlevs )
2643 :
2644 : ! Sanity check
2645 0 : IF ( nlevs < nlev ) THEN
2646 0 : WRITE(*,*) TRIM(LevName), ' is only of length ', nlevs, ' - required is: ', nlev
2647 0 : RC = -999
2648 0 : RETURN
2649 : ENDIF
2650 :
2651 : !------------------------------------------------------------------------
2652 : ! Get formula and parse variable names (ap, bp, p0, ps)
2653 : !------------------------------------------------------------------------
2654 :
2655 : ! Get formula
2656 0 : a_name = "formula_terms"
2657 0 : IF ( .NOT. NcDoes_Attr_Exist ( fID, TRIM(levName), &
2658 : TRIM(a_name), a_type ) ) THEN
2659 0 : WRITE(*,*) 'Cannot find attribute ', TRIM(a_name), ' in variable ', &
2660 0 : TRIM(levName)
2661 0 : RC = -999
2662 0 : RETURN
2663 : ENDIF
2664 0 : CALL NcGet_Var_Attributes( fID, TRIM(levName), TRIM(a_name), formula )
2665 :
2666 : ! Get variable names
2667 : !-------------------
2668 0 : I = INDEX( formula, 'a:' )
2669 0 : IF ( I > 0 ) THEN
2670 0 : CALL GetVarFromFormula( formula, 'a:', aname, RC )
2671 0 : IF ( RC /= 0 ) RETURN
2672 0 : CALL GetVarFromFormula( formula, 'p0:', p0name, RC )
2673 0 : IF ( RC /= 0 ) RETURN
2674 : ELSE
2675 0 : CALL GetVarFromFormula( formula, 'ap:', aname, RC )
2676 0 : IF ( RC /= 0 ) RETURN
2677 0 : p0 = 1.0d0
2678 : ENDIF
2679 0 : IF ( RC /= 0 ) RETURN
2680 :
2681 0 : CALL GetVarFromFormula( formula, 'b:', bname, RC )
2682 0 : IF ( RC /= 0 ) RETURN
2683 :
2684 0 : CALL GetVarFromFormula( formula, 'ps:', psname, RC )
2685 0 : IF ( RC /= 0 ) RETURN
2686 :
2687 : !------------------------------------------------------------------------
2688 : ! Read variables from file.
2689 : !------------------------------------------------------------------------
2690 :
2691 0 : ALLOCATE ( a(nlevs), b(nlevs) )
2692 0 : st1d = (/ 1 /)
2693 0 : ct1d = (/ nlevs /)
2694 :
2695 : ! read a
2696 : !-------
2697 0 : IF ( .NOT. Ncdoes_Var_Exist( fID, TRIM(aname) ) ) THEN
2698 0 : WRITE(*,*) 'Cannot find variable ', TRIM(aname), '!'
2699 0 : RC = -999
2700 0 : RETURN
2701 : ENDIF
2702 0 : CALL NcRd( a, fID, TRIM(aname), st1d, ct1d )
2703 :
2704 : ! eventually read p0
2705 : !-------------------
2706 0 : IF ( p0 < 0.0d0 ) THEN
2707 0 : IF ( .NOT. Ncdoes_Var_Exist( fID, TRIM(p0name) ) ) THEN
2708 0 : WRITE(*,*) 'Cannot find variable ', TRIM(p0name), '!'
2709 0 : RC = -999
2710 0 : RETURN
2711 : ENDIF
2712 0 : CALL NcRd( p0, fID, TRIM(p0name) )
2713 : ENDIF
2714 :
2715 : ! read b
2716 : !-------
2717 0 : IF ( .NOT. Ncdoes_Var_Exist( fID, TRIM(bname) ) ) THEN
2718 0 : WRITE(*,*) 'Cannot find variable ', TRIM(bname), '!'
2719 0 : RC = -999
2720 0 : RETURN
2721 : ENDIF
2722 0 : CALL NcRd( b, fID, TRIM(bname), st1d, ct1d )
2723 :
2724 : ! Read ps
2725 : !--------
2726 : CALL NC_READ_ARR( fID, TRIM(psname), lon1, lon2, lat1, &
2727 0 : lat2, 0, 0, time, time, ps, VarUnit=thisUnit, RC=RC )
2728 0 : IF ( RC /= 0 ) RETURN
2729 :
2730 : !------------------------------------------------------------------------
2731 : ! Determine positive axis ('up' or 'down')
2732 : ! Try to read it from the netCDF meta data (attribute `positive`). If not
2733 : ! found, determine it from b values (b value at surface higher than at
2734 : ! top of atmosphere).
2735 : !------------------------------------------------------------------------
2736 0 : a_name = "positive"
2737 0 : IF ( NcDoes_Attr_Exist( fID, TRIM(levName), TRIM(a_name), a_type ) ) THEN
2738 0 : CALL NcGet_Var_Attributes( fID, TRIM(levName), TRIM(a_name), formula )
2739 0 : IF ( TRIM(formula) == 'up' ) THEN
2740 0 : dir = 1
2741 0 : ELSEIF ( TRIM(formula) == 'down' ) THEN
2742 0 : dir = -1
2743 : ELSE
2744 0 : WRITE(*,*) 'level attribute `positive` must be `up` ', &
2745 0 : 'or `down`, instead: ', TRIM(formula)
2746 0 : RC = -999
2747 0 : RETURN
2748 : ENDIF
2749 :
2750 : ! determine direction from b values.
2751 : ELSE
2752 :
2753 0 : IF ( b(1) > b(nlevs) ) THEN
2754 0 : dir = 1
2755 : ELSE
2756 0 : dir = -1
2757 : ENDIF
2758 : ENDIF
2759 :
2760 : !------------------------------------------------------------------------
2761 : ! Determine vertical indeces to be used. It is possible to calculate
2762 : ! the pressure only for a given number of layers (as specified by input
2763 : ! arguments lev1 and lev2). Assume those are always from bottom to top,
2764 : ! i.e. counting `upwards`.
2765 : !------------------------------------------------------------------------
2766 :
2767 0 : IF ( dir == -1 ) THEN
2768 0 : l1 = nlevs - lev2 + 1
2769 0 : l2 = nlevs - lev1 + 1
2770 : ELSE
2771 : l1 = lev1
2772 : l2 = lev2
2773 : ENDIF
2774 :
2775 : !------------------------------------------------------------------------
2776 : ! Calculate sigma values at grid edges
2777 : !------------------------------------------------------------------------
2778 :
2779 0 : IF ( PRESENT(SigLev4) ) THEN
2780 0 : IF ( ASSOCIATED(SigLev4) ) DEALLOCATE(SigLev4)
2781 0 : ALLOCATE(SigLev4(nlon,nlat,nlev),STAT=AS)
2782 0 : ELSEIF ( PRESENT(SigLev8) ) THEN
2783 0 : IF ( ASSOCIATED(SigLev8) ) DEALLOCATE(SigLev8)
2784 0 : ALLOCATE(SigLev8(nlon,nlat,nlev),STAT=AS)
2785 : ELSE
2786 0 : WRITE(*,*) 'SigLev must be provided!'
2787 0 : RC = -999
2788 0 : RETURN
2789 : ENDIF
2790 0 : IF ( AS /= 0 ) THEN
2791 0 : WRITE(*,*) 'Cannot allocate SigLev!'
2792 0 : RC = -999
2793 0 : RETURN
2794 : ENDIF
2795 :
2796 0 : DO J=1,nlat
2797 0 : DO I=1,nlon
2798 0 : IF ( PRESENT(SigLev4) ) THEN
2799 0 : SigLev4(i,j,:) = ( ( a(l1:l2) * p0 ) + ( b(l1:l2) * ps(i,j,1,1) ) ) &
2800 0 : / ps(i,j,1,1)
2801 : ELSE
2802 0 : SigLev8(i,j,:) = ( ( a(l1:l2) * p0 ) + ( b(l1:l2) * ps(i,j,1,1) ) ) &
2803 0 : / ps(i,j,1,1)
2804 : ENDIF
2805 : ENDDO
2806 : ENDDO
2807 :
2808 : ! Cleanup
2809 0 : IF ( ASSOCIATED(a ) ) DEALLOCATE(a )
2810 0 : IF ( ASSOCIATED(b ) ) DEALLOCATE(b )
2811 0 : IF ( ASSOCIATED(ps) ) DEALLOCATE(ps)
2812 :
2813 : ! Return w/ success
2814 0 : RC = 0
2815 :
2816 0 : END SUBROUTINE NC_GET_SIG_FROM_HYBRID
2817 : !EOC
2818 : !------------------------------------------------------------------------------
2819 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2820 : ! and NASA/GSFC, SIVO, Code 610.3 !
2821 : !------------------------------------------------------------------------------
2822 : !BOP
2823 : !
2824 : ! !IROUTINE: GetVarFromFormula
2825 : !
2826 : ! !DESCRIPTION: helper function to extract the variable name from a vertical
2827 : ! coordinate formula.
2828 : !\\
2829 : !\\
2830 : ! !INTERFACE:
2831 : !
2832 0 : SUBROUTINE GetVarFromFormula ( formula, inname, outname, RC )
2833 : !
2834 : ! !INPUT PARAMETERS:
2835 : !
2836 : CHARACTER(LEN=*), INTENT(IN ) :: formula
2837 : CHARACTER(LEN=*), INTENT(IN ) :: inname
2838 : !
2839 : ! !INPUT/OUTPUT PARAMETERS:
2840 : !
2841 : CHARACTER(LEN=*), INTENT( OUT) :: outname
2842 : INTEGER, INTENT(INOUT) :: RC ! Return code
2843 : !
2844 : ! !REVISION HISTORY:
2845 : ! 03 Oct 2014 - C. Keller - Initial version
2846 : ! See https://github.com/geoschem/ncdfutil for complete history
2847 : !EOP
2848 : !------------------------------------------------------------------------------
2849 : !BOC
2850 : !
2851 : ! !LOCAL VARIABLES:
2852 : !
2853 : INTEGER :: I, J, IDX, LN
2854 :
2855 : !======================================================================
2856 : ! GetVarFromFormula begins here
2857 : !======================================================================
2858 :
2859 : ! maximum length
2860 0 : LN = LEN(TRIM(formula))
2861 :
2862 : ! Get start index of string
2863 : !--------------------------
2864 0 : I = INDEX( TRIM(formula), TRIM(inname) )
2865 0 : IF ( I <= 0 ) THEN
2866 0 : WRITE(*,*) 'Cannot extract ', TRIM(inname), ' from ', TRIM(formula)
2867 0 : RC = -999
2868 0 : RETURN
2869 : ENDIF
2870 :
2871 : ! The variable name follows the formula string plus one space!
2872 0 : I = I + LEN(inname) + 1
2873 :
2874 0 : outname = ''
2875 : IDX = 1
2876 0 : DO J = I, LN
2877 0 : IF ( formula(J:J) == ' ' ) EXIT
2878 0 : outname(IDX:IDX) = formula(J:J)
2879 0 : IDX = IDX + 1
2880 : ENDDO
2881 :
2882 : ! Return w/ success
2883 0 : RC = 0
2884 :
2885 0 : END SUBROUTINE GetVarFromFormula
2886 : !EOC
2887 : !------------------------------------------------------------------------------
2888 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2889 : ! and NASA/GSFC, SIVO, Code 610.3 !
2890 : !------------------------------------------------------------------------------
2891 : !BOP
2892 : !
2893 : ! !IROUTINE: Nc_Write_3d
2894 : !
2895 : ! !DESCRIPTION: Routine to write time slices of 2D fields into netCDF.
2896 : !\\
2897 : !\\
2898 : ! !INTERFACE:
2899 : !
2900 0 : SUBROUTINE NC_WRITE_3D( ncFile, I, J, T, N, lon, lat, &
2901 0 : time, timeUnit, ncVars, ncUnits, &
2902 0 : ncLongs, ncShorts, ncArrays )
2903 : !
2904 : ! !INPUT PARAMETERS:
2905 : !
2906 : CHARACTER(LEN=*), INTENT(IN) :: ncFile ! file path+name
2907 : INTEGER, INTENT(IN) :: I ! # of lons
2908 : INTEGER, INTENT(IN) :: J ! # of lats
2909 : INTEGER, INTENT(IN) :: T ! # of time slices
2910 : INTEGER, INTENT(IN) :: N ! # of vars
2911 : REAL*4, INTENT(IN) :: lon(I) ! longitude
2912 : REAL*4, INTENT(IN) :: lat(J) ! latitude
2913 : REAL*4, INTENT(IN) :: time(T) ! time
2914 : CHARACTER(LEN=*), INTENT(IN) :: timeUnit ! time unit
2915 : CHARACTER(LEN=*), INTENT(IN) :: ncVars(N) ! nc variables
2916 : CHARACTER(LEN=*), INTENT(IN) :: ncUnits(N) ! var units
2917 : CHARACTER(LEN=*), INTENT(IN) :: ncLongs(N) ! var long names
2918 : CHARACTER(LEN=*), INTENT(IN) :: ncShorts(N) ! var short names
2919 : REAL*4, TARGET, INTENT(IN) :: ncArrays(I,J,T,N) ! var arrays
2920 : !
2921 : ! !REMARKS:
2922 : ! Created with the ncCodeRead script of the NcdfUtilities package,
2923 : ! with subsequent hand-editing.
2924 : !
2925 : ! !REVISION HISTORY:
2926 : ! 15 Jun 2012 - C. Keller - Initial version
2927 : ! See https://github.com/geoschem/ncdfutil for complete history
2928 : !EOP
2929 : !------------------------------------------------------------------------------
2930 : !BOC
2931 : !
2932 : ! !LOCAL VARIABLES:
2933 : !
2934 : ! Scalars
2935 : INTEGER :: fId, II
2936 : REAL*4, POINTER :: tmpArr(:,:,:) => NULL()
2937 :
2938 : !======================================================================
2939 : ! NC_WRITE_3D begins here
2940 : !======================================================================
2941 :
2942 : CALL NC_DEFINE(ncFile=ncFile, nLon=I, nLat=J, &
2943 : nTime=T, timeUnit=timeUnit, ncVars=ncVars, &
2944 : ncUnits=ncUnits,ncLongs=ncLongs,ncShorts=ncShorts,&
2945 0 : fId=fId )
2946 :
2947 0 : CALL NC_WRITE_DIMS( fID=fId, lon=lon, lat=lat, time=time )
2948 :
2949 0 : DO II = 1, N
2950 0 : tmpArr => ncArrays(:,:,:,II)
2951 0 : CALL NC_WRITE_DATA_3D ( fId, ncVars(II), tmpArr )
2952 0 : tmpArr => NULL()
2953 : ENDDO
2954 :
2955 0 : CALL NcCl( fId )
2956 :
2957 0 : END SUBROUTINE NC_WRITE_3D
2958 : !EOC
2959 : !------------------------------------------------------------------------------
2960 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
2961 : ! and NASA/GSFC, SIVO, Code 610.3 !
2962 : !------------------------------------------------------------------------------
2963 : !BOP
2964 : !
2965 : ! !IROUTINE: Nc_Write_4d
2966 : !
2967 : ! !DESCRIPTION: Routine to write time slices of 3D fields into netCDF.
2968 : !\\
2969 : !\\
2970 : ! !INTERFACE:
2971 : !
2972 0 : SUBROUTINE NC_WRITE_4D (ncFile, I, J, L, T, N, lon, lat, lev, &
2973 0 : time, timeUnit, ncVars, ncUnits, &
2974 0 : ncLongs, ncShorts, ncArrays )
2975 : !
2976 : ! !INPUT PARAMETERS:
2977 : !
2978 : CHARACTER(LEN=*), INTENT(IN) :: ncFile ! file path+name
2979 : INTEGER, INTENT(IN) :: I ! # of lons
2980 : INTEGER, INTENT(IN) :: J ! # of lats
2981 : INTEGER, INTENT(IN) :: L ! # of levs
2982 : INTEGER, INTENT(IN) :: T ! # of time slices
2983 : INTEGER, INTENT(IN) :: N ! # of vars
2984 : REAL*4, INTENT(IN) :: lon(:) ! longitude
2985 : REAL*4, INTENT(IN) :: lat(:) ! latitude
2986 : REAL*4, INTENT(IN) :: lev(:) ! levels
2987 : REAL*4, INTENT(IN) :: time(:) ! time
2988 : CHARACTER(LEN=*), INTENT(IN) :: timeUnit ! time unit
2989 : CHARACTER(LEN=*), INTENT(IN) :: ncVars(:) ! nc variables
2990 : CHARACTER(LEN=*), INTENT(IN) :: ncUnits(:) ! var units
2991 : CHARACTER(LEN=*), INTENT(IN) :: ncLongs(:) ! var long names
2992 : CHARACTER(LEN=*), INTENT(IN) :: ncShorts(:) ! var short names
2993 : REAL*4, TARGET, INTENT(IN) :: ncArrays(:,:,:,:,:) ! var arrays
2994 : !
2995 : ! !REMARKS:
2996 : ! Created with the ncCodeRead script of the NcdfUtilities package,
2997 : ! with subsequent hand-editing.
2998 : !
2999 : ! !REVISION HISTORY:
3000 : ! 15 Jun 2012 - C. Keller - Initial version
3001 : ! See https://github.com/geoschem/ncdfutil for complete history
3002 : !EOP
3003 : !------------------------------------------------------------------------------
3004 : !BOC
3005 : !
3006 : ! !LOCAL VARIABLES:
3007 : !
3008 : INTEGER :: II, fID
3009 : REAL*4, POINTER :: tmpArr(:,:,:,:) => NULL()
3010 :
3011 : !======================================================================
3012 : ! NC_WRITE begins here
3013 : !======================================================================
3014 :
3015 : CALL NC_DEFINE(ncFile=ncFile, nLon=I, nLat=J, nLev=L, &
3016 : nTime=T, timeUnit=timeUnit, ncVars=ncVars, &
3017 : ncUnits=ncUnits,ncLongs=ncLongs,ncShorts=ncShorts,&
3018 0 : fId=fId )
3019 :
3020 0 : CALL NC_WRITE_DIMS( fID=fId, lon=lon, lat=lat, time=time, lev=lev)
3021 :
3022 0 : DO II = 1, size(ncVars)
3023 0 : tmpArr => ncArrays(:,:,:,:,II)
3024 0 : CALL NC_WRITE_DATA_4D ( fId, ncVars(II), tmpArr )
3025 0 : tmpArr => NULL()
3026 : ENDDO
3027 :
3028 0 : CALL NcCl( fId )
3029 :
3030 0 : END SUBROUTINE NC_WRITE_4D
3031 : !EOC
3032 : !------------------------------------------------------------------------------
3033 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3034 : ! and NASA/GSFC, SIVO, Code 610.3 !
3035 : !------------------------------------------------------------------------------
3036 : !BOP
3037 : !
3038 : ! !IROUTINE: Nc_Define
3039 : !
3040 : ! !DESCRIPTION: Routine to define the variables and attributes of a netCDF
3041 : ! file.
3042 : !\\
3043 : !\\
3044 : ! !INTERFACE:
3045 : !
3046 0 : SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,&
3047 0 : timeUnit, ncVars, ncUnits, ncLongs, ncShorts, fId )
3048 : !
3049 : ! !INPUT PARAMETERS:
3050 : !
3051 : CHARACTER(LEN=*), INTENT(IN ) :: ncFile ! ncdf file path + name
3052 : INTEGER, INTENT(IN ) :: nLon ! # of lons
3053 : INTEGER, INTENT(IN ) :: nLat ! # of lats
3054 : INTEGER, OPTIONAL, INTENT(IN ) :: nLev ! # of levels
3055 : INTEGER, INTENT(IN ) :: nTime ! # of time stamps
3056 : CHARACTER(LEN=*), INTENT(IN ) :: timeUnit ! time unit
3057 : CHARACTER(LEN=*), INTENT(IN ) :: ncVars(:) ! ncdf variables
3058 : CHARACTER(LEN=*), INTENT(IN ) :: ncUnits(:) ! var units
3059 : CHARACTER(LEN=*), INTENT(IN ) :: ncLongs(:) ! var long names
3060 : CHARACTER(LEN=*), INTENT(IN ) :: ncShorts(:) ! var short names
3061 : !
3062 : ! !OUTPUT PARAMETERS:
3063 : !
3064 : INTEGER, INTENT( OUT) :: fId ! netCDF file ID
3065 : !
3066 : ! !REMARKS:
3067 : ! Assumes that you have:
3068 : ! (1) A netCDF library (either v3 or v4) installed on your system
3069 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3070 : ! .
3071 : ! Although this routine was generated automatically, some further
3072 : ! hand-editing may be required.
3073 : !
3074 : ! !REVISION HISTORY:
3075 : ! 15 Jun 2012 - C. Keller - Initial version
3076 : ! See https://github.com/geoschem/ncdfutil for complete history
3077 : !EOP
3078 : !------------------------------------------------------------------------------
3079 : !BOC
3080 : !
3081 : ! !LOCAL VARIABLES:
3082 : !
3083 : ! Declare netCDF variable ID and fill mode
3084 : INTEGER :: vId
3085 : INTEGER :: omode
3086 :
3087 : ! Variables for netCDF dimensions
3088 : INTEGER :: id_lon
3089 : INTEGER :: id_lat
3090 : INTEGER :: id_time
3091 : INTEGER :: id_lev
3092 :
3093 : ! Character strings
3094 : CHARACTER(LEN=255) :: v_name ! netCDF variable name
3095 : CHARACTER(LEN=255) :: a_name ! netCDF attribute name
3096 : CHARACTER(LEN=255) :: a_val ! netCDF attribute value
3097 : CHARACTER(LEN=3 ) :: idstr ! tracer ID string
3098 :
3099 : ! Arrays for netCDF dimension IDs
3100 : INTEGER :: var1d(1) ! For 1D arrays
3101 : INTEGER :: var3d(3) ! For 3D arrays
3102 : INTEGER :: var4d(4) ! For 4D arrays
3103 :
3104 : ! Other variables
3105 : INTEGER :: I
3106 :
3107 : !=================================================================
3108 : ! %%%%% NETCDF DEFINITION SECTION %%%%%
3109 : !=================================================================
3110 :
3111 : ! Initialize the variable ID counter
3112 0 : vId = 0
3113 :
3114 : ! Open filename
3115 0 : CALL NcCr_Wr( fId, TRIM(ncFile) )
3116 :
3117 : ! Turn filling off
3118 0 : CALL NcSetFill( fId, NF_NOFILL, omode )
3119 :
3120 : !--------------------------------
3121 : ! GLOBAL ATTRIBUTES
3122 : !--------------------------------
3123 :
3124 : ! Define the title global attribute
3125 0 : a_name = "Title"
3126 0 : a_val = "Field generated by ncdf_util.F"
3127 0 : CALL NcDef_Glob_Attributes( fId, TRIM(a_name), TRIM(a_val) )
3128 :
3129 : ! Define the history global attribute
3130 0 : a_name = "History"
3131 0 : a_val = "Initial version"
3132 0 : CALL NcDef_Glob_Attributes( fId, TRIM(a_name), TRIM(a_val) )
3133 :
3134 : ! Define the conventions global attribute
3135 0 : a_name = "Conventions"
3136 0 : a_val = "COARDS"
3137 0 : CALL NcDef_Glob_Attributes( fId, TRIM(a_name), TRIM(a_val) )
3138 :
3139 : ! Define the format global attribute
3140 0 : a_name = "Format"
3141 0 : a_val = "netCDF-3"
3142 0 : CALL NcDef_Glob_Attributes( fId, TRIM(a_name), TRIM(a_val) )
3143 :
3144 : !--------------------------------
3145 : ! DIMENSIONS
3146 : !--------------------------------
3147 :
3148 : ! Define lon dimension
3149 0 : v_name = "lon"
3150 0 : CALL NcDef_Dimension( fId, TRIM(v_name), nlon, id_lon )
3151 :
3152 : ! Define lat dimension
3153 0 : v_name = "lat"
3154 0 : CALL NcDef_Dimension( fId, TRIM(v_name), nlat, id_lat )
3155 :
3156 : ! Define lev dimension
3157 0 : IF ( PRESENT(nlev) ) THEN
3158 0 : v_name = "lev"
3159 0 : CALL NcDef_Dimension( fId, TRIM(v_name), nlev, id_lev )
3160 : ENDIF
3161 :
3162 : ! Define time dimension
3163 0 : v_name = "time"
3164 0 : CALL NcDef_Dimension( fId, TRIM(v_name), ntime, id_time, unlimited=.true. )
3165 :
3166 : !--------------------------------
3167 : ! VARIABLE: lon
3168 : !--------------------------------
3169 :
3170 : ! Define the "lon" variable
3171 0 : v_name = "lon"
3172 0 : var1d = (/ id_lon /)
3173 0 : CALL NcDef_Variable( fId, TRIM(v_name), NF_FLOAT, 1, var1d, vId )
3174 :
3175 : ! Define the "lon:long_name" attribute
3176 0 : a_name = "long_name"
3177 0 : a_val = "Longitude"
3178 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3179 :
3180 : ! Define the "lon:units" attribute
3181 0 : a_name = "units"
3182 0 : a_val = "degrees_east"
3183 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3184 :
3185 : !--------------------------------
3186 : ! VARIABLE: lat
3187 : !--------------------------------
3188 :
3189 : ! Define the "lat" variable
3190 0 : v_name = "lat"
3191 0 : var1d = (/ id_lat /)
3192 0 : CALL NcDef_Variable( fId, TRIM(v_name), NF_FLOAT, 1, var1d, vId )
3193 :
3194 : ! Define the "lat:long_name" attribute
3195 0 : a_name = "long_name"
3196 0 : a_val = "Latitude"
3197 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3198 :
3199 : ! Define the "lat:units" attribute
3200 0 : a_name = "units"
3201 0 : a_val = "degrees_north"
3202 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3203 :
3204 : !--------------------------------
3205 : ! VARIABLE: lev
3206 : !--------------------------------
3207 :
3208 0 : IF ( PRESENT(nlev) ) THEN
3209 :
3210 : ! Define the "levels" variable
3211 0 : v_name = "lev"
3212 0 : var1d = (/ id_lev /)
3213 0 : CALL NcDef_Variable( fId, TRIM(v_name), NF_INT, 1, var1d, vId )
3214 :
3215 : ! Define the "time:long_name" attribute
3216 0 : a_name = "long_name"
3217 0 : a_val = "Levels"
3218 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val))
3219 :
3220 : ! Define the "time:units" attribute
3221 0 : a_name = "units"
3222 0 : a_val = "unitless"
3223 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val))
3224 : ENDIF
3225 :
3226 : !--------------------------------
3227 : ! VARIABLE: time
3228 : !--------------------------------
3229 :
3230 : ! Define the "time" variable
3231 0 : v_name = "time"
3232 0 : var1d = (/ id_time /)
3233 0 : CALL NcDef_Variable( fId, TRIM(v_name), NF_INT, 1, var1d, vId )
3234 :
3235 : ! Define the "time:long_name" attribute
3236 0 : a_name = "long_name"
3237 0 : a_val = "Time"
3238 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3239 :
3240 : ! Define the "time:units" attribute
3241 0 : a_name = "units"
3242 0 : a_val = trim(timeUnit)
3243 0 : CALL NcDef_Var_Attributes( fId, vId, TRIM(a_name), TRIM(a_val) )
3244 :
3245 : !--------------------------------
3246 : ! Define variables
3247 : !--------------------------------
3248 :
3249 0 : DO I = 1, SIZE(ncVars)
3250 :
3251 0 : v_name = TRIM(ncVars(I))
3252 0 : IF ( PRESENT(nlev) ) THEN
3253 0 : var4d = (/ id_lon, id_lat, id_lev, id_time /)
3254 0 : CALL NcDef_Variable(fId,TRIM(v_name),NF_DOUBLE,4,var4d,vId)
3255 : ELSE
3256 0 : var3d = (/ id_lon, id_lat, id_time /)
3257 0 : CALL NcDef_Variable(fId,TRIM(v_name),NF_DOUBLE,3,var3d,vId)
3258 : ENDIF
3259 :
3260 : ! Define the long_name attribute
3261 0 : a_name = "long_name"
3262 0 : a_val = TRIM(ncLongs(I))
3263 0 : CALL NcDef_Var_Attributes(fId, vId, TRIM(a_name), TRIM(a_val) )
3264 :
3265 : ! Define the short_name attribute
3266 0 : a_name = "short_name"
3267 0 : a_val = TRIM(ncShorts(I))
3268 0 : CALL NcDef_Var_Attributes(fId, vId, TRIM(a_name), TRIM(a_val) )
3269 :
3270 : ! Define the units attribute
3271 0 : a_name = "units"
3272 0 : a_val = TRIM(ncUnits(I))
3273 0 : CALL NcDef_Var_Attributes(fId, vId, TRIM(a_name), TRIM(a_val) )
3274 : ENDDO
3275 :
3276 : !=================================================================
3277 : ! %%%%% END OF NETCDF DEFINITION SECTION %%%%%
3278 : !=================================================================
3279 0 : CALL NcEnd_Def( fId )
3280 :
3281 0 : END SUBROUTINE NC_DEFINE
3282 : !EOC
3283 : !------------------------------------------------------------------------------
3284 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3285 : ! and NASA/GSFC, SIVO, Code 610.3 !
3286 : !------------------------------------------------------------------------------
3287 : !BOP
3288 : !
3289 : ! !IROUTINE: Nc_Write_Dims
3290 : !
3291 : ! !DESCRIPTION: Routine to write dimension arrays to a netCDF file.
3292 : !\\
3293 : !\\
3294 : ! !INTERFACE:
3295 : !
3296 0 : SUBROUTINE NC_WRITE_DIMS( fID, lon, lat, time, lev )
3297 : !
3298 : ! !INPUT/OUTPUT PARAMETERS:
3299 : !
3300 : INTEGER, INTENT(INOUT) :: fId
3301 : !
3302 : ! !INPUT PARAMETERS:
3303 : !
3304 : REAL*4, INTENT(IN ) :: lon(:)
3305 : REAL*4, INTENT(IN ) :: lat(:)
3306 : REAL*4, INTENT(IN ) :: time(:)
3307 : REAL*4, OPTIONAL, INTENT(IN ) :: lev(:)
3308 : !
3309 : ! !REMARKS:
3310 : ! Assumes that you have:
3311 : ! (1) A netCDF library (either v3 or v4) installed on your system
3312 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3313 : ! .
3314 : ! Although this routine was generated automatically, some further
3315 : ! hand-editing may be required.
3316 : !
3317 : ! !REVISION HISTORY:
3318 : ! 30 Jan 2012 - R. Yantosca - Initial version
3319 : ! See https://github.com/geoschem/ncdfutil for complete history
3320 : !EOP
3321 : !------------------------------------------------------------------------------
3322 : !BOC
3323 : !
3324 : ! !LOCAL VARIABLES:
3325 : !
3326 : ! Character strings
3327 : CHARACTER(LEN=255) :: v_name ! netCDF variable name
3328 :
3329 : ! Arrays for netCDF start and count values
3330 : INTEGER :: st1d(1), ct1d(1) ! For 1D arrays
3331 : INTEGER :: v_size
3332 :
3333 : !=================================================================
3334 : ! Define lon/lat
3335 : !=================================================================
3336 :
3337 : ! Write lon to netCDF file
3338 0 : v_name = "lon"
3339 0 : v_size = size( lon, 1 )
3340 0 : st1d = (/ 1 /)
3341 0 : ct1d = (/ v_size /)
3342 0 : CALL NcWr( lon, fId, TRIM(v_name), st1d, ct1d )
3343 :
3344 : ! Write lat to netCDF file
3345 0 : v_name = "lat"
3346 0 : v_size = size( lat, 1 )
3347 0 : st1d = (/ 1 /)
3348 0 : ct1d = (/ v_size /)
3349 0 : CALL NcWr( lat, fId, TRIM(v_name), st1d, ct1d )
3350 :
3351 : ! Write lev to netCDF file
3352 0 : IF ( PRESENT(lev) ) THEN
3353 0 : v_name = "lev"
3354 0 : v_size = size( lev, 1 )
3355 0 : st1d = (/ 1 /)
3356 0 : ct1d = (/ v_size /)
3357 0 : CALL NcWr( lev, fId, TRIM(v_name), st1d, ct1d )
3358 : ENDIF
3359 :
3360 : ! Write passed time integer to netCDF file
3361 0 : v_name = "time"
3362 0 : v_size = size( time, 1 )
3363 0 : st1d = (/ 1 /)
3364 0 : ct1d = (/ v_size /)
3365 0 : CALL NcWr( time, fId, TRIM(v_name), st1d, ct1d )
3366 :
3367 0 : END SUBROUTINE NC_WRITE_DIMS
3368 : !EOC
3369 : !------------------------------------------------------------------------------
3370 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3371 : ! and NASA/GSFC, SIVO, Code 610.3 !
3372 : !------------------------------------------------------------------------------
3373 : !BOP
3374 : !
3375 : ! !IROUTINE: Nc_Nrite_Data_3d
3376 : !
3377 : ! !DESCRIPTION: Routine to write a 3-D array to a netCDF file.
3378 : !\\
3379 : !\\
3380 : ! !INTERFACE:
3381 : !
3382 0 : SUBROUTINE NC_WRITE_DATA_3D ( fID, ncVar, Array )
3383 : !
3384 : ! !INPUT/OUTPUT PARAMETERS:
3385 : !
3386 : INTEGER, INTENT(INOUT) :: fId
3387 : !
3388 : ! !INPUT PARAMETERS:
3389 : !
3390 : CHARACTER(LEN=*), INTENT(IN ) :: ncVar
3391 : REAL*4, POINTER :: Array(:,:,:)
3392 : !
3393 : ! !REMARKS:
3394 : ! Assumes that you have:
3395 : ! (1) A netCDF library (either v3 or v4) installed on your system
3396 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3397 : ! .
3398 : ! Although this routine was generated automatically, some further
3399 : ! hand-editing may be required.
3400 : !
3401 : ! !REVISION HISTORY:
3402 : ! 30 Jan 2012 - R. Yantosca - Initial version
3403 : ! See https://github.com/geoschem/ncdfutil for complete history
3404 : !EOP
3405 : !------------------------------------------------------------------------------
3406 : !BOC
3407 : !
3408 : ! !LOCAL VARIABLES:
3409 : !
3410 : ! Arrays for netCDF start and count values
3411 : INTEGER :: st3d(3), ct3d(3) ! For 3D arrays
3412 :
3413 : !=================================================================
3414 : ! Write data to netCDF file
3415 : !=================================================================
3416 :
3417 0 : st3d = (/ 1, 1, 1 /)
3418 0 : ct3d = (/ size(array,1), size(array,2), size(array,3) /)
3419 0 : CALL NcWr( ARRAY, fId, TRIM(ncVar), st3d, ct3d )
3420 :
3421 0 : END SUBROUTINE NC_WRITE_DATA_3D
3422 : !EOC
3423 : !------------------------------------------------------------------------------
3424 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3425 : ! and NASA/GSFC, SIVO, Code 610.3 !
3426 : !------------------------------------------------------------------------------
3427 : !BOP
3428 : !
3429 : ! !IROUTINE: Nc_Write_Data_4d
3430 : !
3431 : ! !DESCRIPTION: Routine to write a 4-D array to a netCDF file.
3432 : !\\
3433 : !\\
3434 : ! !INTERFACE:
3435 : !
3436 0 : SUBROUTINE NC_WRITE_DATA_4D ( fID, ncVar, Array )
3437 : !
3438 : ! !INPUT/OUTPUT PARAMETERS:
3439 : !
3440 : INTEGER, INTENT(INOUT) :: fId
3441 : !
3442 : ! !INPUT PARAMETERS:
3443 : !
3444 : CHARACTER(LEN=*), INTENT(IN ) :: ncVar
3445 : REAL*4, POINTER :: Array(:,:,:,:)
3446 : !
3447 : ! !REMARKS:
3448 : ! Assumes that you have:
3449 : ! (1) A netCDF library (either v3 or v4) installed on your system
3450 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3451 : ! .
3452 : ! Although this routine was generated automatically, some further
3453 : ! hand-editing may be required.
3454 : !
3455 : ! !REVISION HISTORY:
3456 : ! 30 Jan 2012 - R. Yantosca - Initial version
3457 : ! See https://github.com/geoschem/ncdfutil for complete history
3458 : !EOP
3459 : !------------------------------------------------------------------------------
3460 : !BOC
3461 : !
3462 : ! !LOCAL VARIABLES:
3463 : !
3464 : ! Arrays for netCDF start and count values
3465 : INTEGER :: st4d(4), ct4d(4) ! For 4D arrays
3466 :
3467 : !=================================================================
3468 : ! Write data to netCDF file
3469 : !=================================================================
3470 :
3471 0 : st4d = (/ 1, 1, 1, 1 /)
3472 : ct4d = (/ size(array,1), size(array,2), &
3473 0 : size(array,3), size(array,4) /)
3474 0 : CALL NcWr( ARRAY, fId, TRIM(ncVar), st4d, ct4d )
3475 :
3476 0 : END SUBROUTINE NC_WRITE_DATA_4D
3477 : !EOC
3478 : !------------------------------------------------------------------------------
3479 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3480 : ! and NASA/GSFC, SIVO, Code 610.3 !
3481 : !------------------------------------------------------------------------------
3482 : !BOP
3483 : !
3484 : ! !IROUTINE: Nc_Create
3485 : !
3486 : ! !DESCRIPTION: Creates a new netCDF file and defines several global
3487 : ! attributes.
3488 : !\\
3489 : !\\
3490 : ! !INTERFACE:
3491 : !
3492 0 : SUBROUTINE Nc_Create( NcFile, Title, nLon, &
3493 : nLat, nLev, nTime, &
3494 : fId, lonID, latId, &
3495 : levId, timeId, VarCt, &
3496 : Create_NC4, KeepDefMode, NcFormat, &
3497 : Conventions, History, ProdDateTime, &
3498 : Reference, Contact, nIlev, &
3499 : iLevId, StartTimeStamp, EndTimeStamp )
3500 : !
3501 : ! !INPUT PARAMETERS:
3502 : !
3503 : ! Required arguments
3504 : CHARACTER(LEN=*), INTENT(IN ) :: ncFile ! ncdf file path + name
3505 : CHARACTER(LEN=*), INTENT(IN ) :: title ! ncdf file title
3506 : INTEGER, INTENT(IN ) :: nLon ! # of lons
3507 : INTEGER, INTENT(IN ) :: nLat ! # of lats
3508 : INTEGER, INTENT(IN ) :: nLev ! # of level midpoints
3509 : INTEGER, INTENT(IN ) :: nTime ! # of times
3510 : INTEGER, OPTIONAL :: nILev ! # of level interfaces
3511 :
3512 : ! Optional arguments (mostly global attributes)
3513 : LOGICAL, OPTIONAL :: Create_Nc4 ! Save as netCDF-4
3514 : LOGICAL, OPTIONAL :: KeepDefMode ! If = T, then don't
3515 : ! exit define mode
3516 : CHARACTER(LEN=*), OPTIONAL :: NcFormat ! e.g. netCDF-4
3517 : CHARACTER(LEN=*), OPTIONAL :: Conventions ! e.g. COARDS, CF, etc.
3518 : CHARACTER(LEN=*), OPTIONAL :: History ! History glob attribute
3519 : CHARACTER(LEN=*), OPTIONAL :: ProdDateTime ! Time/date of production
3520 : CHARACTER(LEN=*), OPTIONAL :: Reference ! Reference string
3521 : CHARACTER(LEN=*), OPTIONAL :: Contact ! People to contact
3522 : CHARACTER(LEN=*), OPTIONAL :: StartTimeStamp ! Timestamps at start
3523 : CHARACTER(LEN=*), OPTIONAL :: EndTimeStamp ! and end of simulation
3524 : !
3525 : ! !OUTPUT PARAMETERS:
3526 : !
3527 : INTEGER, INTENT( OUT) :: fId ! file id
3528 : INTEGER, INTENT( OUT) :: lonId ! lon dimension id
3529 : INTEGER, INTENT( OUT) :: latId ! lat dimension id
3530 : INTEGER, INTENT( OUT) :: levId ! lev dimension id
3531 : INTEGER, INTENT( OUT) :: timeId ! time dimension id
3532 : INTEGER, INTENT( OUT) :: VarCt ! variable counter
3533 : INTEGER, OPTIONAL :: ilevId ! ilev dimension id
3534 : !
3535 : ! !REMARKS:
3536 : ! Assumes that you have:
3537 : ! (1) A netCDF library (either v3 or v4) installed on your system
3538 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3539 : ! .
3540 : ! Although this routine was generated automatically, some further
3541 : ! hand-editing may be required.
3542 : !
3543 : ! !REVISION HISTORY:
3544 : ! 15 Jun 2012 - C. Keller - Initial version
3545 : ! See https://github.com/geoschem/ncdfutil for complete history
3546 : !EOP
3547 : !------------------------------------------------------------------------------
3548 : !BOC
3549 : !
3550 : ! !LOCAL VARIABLES:
3551 : !
3552 : ! Scalars
3553 : INTEGER :: omode
3554 : LOGICAL :: Save_As_Nc4
3555 : LOGICAL :: QuitDefMode
3556 :
3557 : ! Strings
3558 : CHARACTER(LEN=255) :: ThisHistory
3559 : CHARACTER(LEN=255) :: ThisNcFormat
3560 : CHARACTER(LEN=255) :: ThisConv
3561 : CHARACTER(LEN=255) :: ThisPdt
3562 : CHARACTER(LEN=255) :: ThisReference
3563 : CHARACTER(LEN=255) :: ThisContact
3564 : CHARACTER(LEN=255) :: ThisStartTimeStamp
3565 : CHARACTER(LEN=255) :: ThisEndTimeStamp
3566 :
3567 : !=======================================================================
3568 : ! Initialize
3569 : !=======================================================================
3570 :
3571 : ! Create file as NetCDF4?
3572 0 : IF ( PRESENT( Create_Nc4 ) ) THEN
3573 0 : Save_As_Nc4 = Create_Nc4
3574 : ELSE
3575 0 : Save_As_Nc4 = .FALSE.
3576 : ENDIF
3577 :
3578 : ! Should we exit netCDF define mode before leaving this routine?
3579 0 : IF ( PRESENT( KeepDefMode ) ) THEN
3580 0 : QuitDefMode = ( .not. KeepDefMode )
3581 : ELSE
3582 : QuitDefMode = .TRUE.
3583 : ENDIF
3584 :
3585 : ! History global attribute
3586 0 : IF ( PRESENT( History ) ) THEN
3587 0 : ThisHistory = TRIM( History )
3588 : ELSE
3589 0 : ThisHistory = 'Created by routine NC_CREATE (in ncdf_mod.F90)'
3590 : ENDIF
3591 :
3592 : ! NetCDF format global attribute
3593 0 : IF ( PRESENT( NcFormat ) ) Then
3594 0 : ThisNcFormat = NcFormat
3595 : ELSE
3596 0 : IF ( Save_As_Nc4 ) THEN
3597 0 : ThisNcFormat = 'NetCDF-4'
3598 : ELSE
3599 0 : ThisNcFormat = 'NetCDF-3'
3600 : ENDIF
3601 : ENDIF
3602 :
3603 : ! Conventions global attribute (assume COARDS)
3604 0 : IF ( PRESENT( Conventions ) ) THEN
3605 0 : ThisConv = TRIM( Conventions )
3606 : ELSE
3607 0 : ThisConv = 'COARDS'
3608 : ENDIF
3609 :
3610 : ! Conventions global attribute (assume COARDS)
3611 0 : IF ( PRESENT( ProdDateTime ) ) THEN
3612 0 : ThisPdt= TRIM( ProdDateTime )
3613 : ENDIF
3614 :
3615 : ! Conventions global attribute (assume COARDS)
3616 0 : IF ( PRESENT( Reference ) ) THEN
3617 0 : ThisReference = TRIM( Reference )
3618 : ELSE
3619 0 : ThisReference = ''
3620 : ENDIF
3621 :
3622 : ! Contact
3623 0 : IF ( PRESENT( Contact ) ) THEN
3624 0 : ThisContact = TRIM( Contact )
3625 : ELSE
3626 0 : ThisContact = ''
3627 : ENDIF
3628 :
3629 : ! Starting date and time of the simulation
3630 0 : IF ( PRESENT( StartTimeStamp ) ) THEN
3631 0 : ThisStartTimeStamp = TRIM( StartTimeStamp )
3632 : ELSE
3633 0 : ThisStartTimeStamp = ''
3634 : ENDIF
3635 :
3636 : ! Ending date and time of the simulation
3637 0 : IF ( PRESENT( EndTimeStamp ) ) THEN
3638 0 : ThisEndTimeStamp = TRIM( EndTimeStamp )
3639 : ELSE
3640 0 : ThisEndTimeStamp = ''
3641 : ENDIF
3642 :
3643 : !=======================================================================
3644 : ! Open the file
3645 : !=======================================================================
3646 :
3647 : ! Open filename. Save file in netCDF-4 format if requested by user.
3648 0 : CALL NcCr_Wr( fId, TRIM( ncFile ), Save_As_Nc4 )
3649 :
3650 : ! Turn filling off
3651 0 : CALL NcSetFill( fId, NF_NOFILL, omode )
3652 :
3653 : !=======================================================================
3654 : ! Set global attributes
3655 : !=======================================================================
3656 :
3657 : ! These attributes are required for COARDS or CF conventions
3658 0 : CALL NcDef_Glob_Attributes( fId, 'title', TRIM( Title ) )
3659 0 : CALL NcDef_Glob_Attributes( fId, 'history', TRIM( ThisHistory ) )
3660 0 : CALL NcDef_Glob_Attributes( fId, 'format', TRIM( ThisNcFormat ) )
3661 0 : CALL NcDef_Glob_Attributes( fId, 'conventions', TRIM( ThisConv ) )
3662 :
3663 : ! These attributes are optional
3664 0 : IF ( PRESENT( ProdDateTime ) ) THEN
3665 0 : CALL NcDef_Glob_Attributes( fId, 'ProdDateTime', TRIM( ThisPdt ) )
3666 : ENDIF
3667 :
3668 0 : IF ( PRESENT( Reference ) ) THEN
3669 0 : CALL NcDef_Glob_Attributes( fId, 'reference', TRIM( ThisReference ) )
3670 : ENDIF
3671 :
3672 0 : IF ( PRESENT( Contact ) ) THEN
3673 0 : CALL NcDef_Glob_Attributes( fId, 'contact', TRIM( ThisContact ) )
3674 : ENDIF
3675 :
3676 0 : IF ( PRESENT( StartTimeStamp ) ) THEN
3677 : CALL NcDef_Glob_Attributes( fId, 'simulation_start_date_and_time', &
3678 0 : TRIM( ThisStartTimeStamp ) )
3679 : ENDIF
3680 :
3681 0 : IF ( PRESENT( EndTimeStamp ) ) THEN
3682 : CALL NcDef_Glob_Attributes( fId, 'simulation_end_date_and_time', &
3683 0 : TRIM( ThisEndTimeStamp ) )
3684 : ENDIF
3685 :
3686 : !=======================================================================
3687 : ! Set dimensions
3688 : !=======================================================================
3689 :
3690 : ! Time
3691 0 : CALL NcDef_Dimension( fId, 'time', nTime, TimeId, unlimited=.true. )
3692 :
3693 : ! Level midpoints
3694 0 : IF ( nLev > 0 ) THEN
3695 0 : CALL NcDef_Dimension( fId, 'lev', nLev, levId )
3696 : ELSE
3697 0 : levId = -1
3698 : ENDIF
3699 :
3700 : ! Optional ILev dimension: level interfaces
3701 0 : IF ( PRESENT( nIlev ) .and. PRESENT( iLevId ) ) THEN
3702 0 : IF ( nILev > 0 ) THEN
3703 0 : CALL NcDef_Dimension( fId, 'ilev', nIlev, iLevId )
3704 : ELSE
3705 0 : iLevId = -1
3706 : ENDIF
3707 : ENDIF
3708 :
3709 : ! Lat and lon
3710 0 : CALL NcDef_Dimension( fId, 'lat', nLat, latId )
3711 0 : CALL NcDef_Dimension( fId, 'lon', nLon, lonId )
3712 :
3713 : ! Close definition section
3714 0 : IF ( QuitDefMode ) THEN
3715 0 : CALL NcEnd_Def( fId )
3716 : ENDIF
3717 :
3718 : ! Initialize variable counter
3719 0 : VarCt = -1
3720 :
3721 0 : END SUBROUTINE Nc_Create
3722 : !EOC
3723 : !------------------------------------------------------------------------------
3724 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
3725 : ! and NASA/GSFC, SIVO, Code 610.3 !
3726 : !------------------------------------------------------------------------------
3727 : !BOP
3728 : !
3729 : ! !IROUTINE: Nc_Var_Def
3730 : !
3731 : ! !DESCRIPTION: Defines a new netCDF variable along with its attributes.
3732 : !\\
3733 : !\\
3734 : ! !INTERFACE:
3735 : !
3736 0 : SUBROUTINE NC_Var_Def( fId, lonId, latId, levId, &
3737 : TimeId, VarName, VarLongName, VarUnit, &
3738 : DataType, VarCt, DefMode, Compress, &
3739 : AddOffset, MissingValue, ScaleFactor, Calendar, &
3740 : Axis, StandardName, FormulaTerms, AvgMethod, &
3741 : Positive, iLevId, nUpdates )
3742 : !
3743 : ! !INPUT PARAMETERS:
3744 : !
3745 : ! Required inputs
3746 : INTEGER, INTENT(IN ) :: fId ! file ID
3747 : INTEGER, INTENT(IN ) :: lonId ! ID of lon (X) dim
3748 : INTEGER, INTENT(IN ) :: latId ! ID of lat (Y) dim
3749 : INTEGER, INTENT(IN ) :: levId ! ID of lev ctr (Z) dim
3750 : INTEGER, OPTIONAL :: iLevId ! ID of lev edge (I) dim
3751 : INTEGER, INTENT(IN ) :: TimeId ! ID of time (T) dim
3752 : CHARACTER(LEN=*), INTENT(IN ) :: VarName ! Variable name
3753 : CHARACTER(LEN=*), INTENT(IN ) :: VarLongName ! Long name description
3754 : CHARACTER(LEN=*), INTENT(IN ) :: VarUnit ! Units
3755 : INTEGER, INTENT(IN ) :: DataType ! 1=Int, 4=float, 8=double
3756 :
3757 : ! Optional inputs
3758 : LOGICAL, OPTIONAL :: DefMode ! Toggles define mode
3759 : LOGICAL, OPTIONAL :: Compress ! Toggles compression
3760 : REAL*4, OPTIONAL :: AddOffset ! Add offset attribute
3761 : REAL*4, OPTIONAL :: MissingValue ! Missing value attribute
3762 : REAL*4, OPTIONAL :: ScaleFactor ! Scale factor attribute
3763 : CHARACTER(LEN=*), OPTIONAL :: Calendar ! Calendar for time var
3764 : CHARACTER(LEN=*), OPTIONAL :: Axis ! Axis for index vars
3765 : CHARACTER(LEN=*), OPTIONAL :: StandardName ! Standard name attribute
3766 : CHARACTER(LEN=*), OPTIONAL :: FormulaTerms ! Formula for vert coords
3767 : CHARACTER(LEN=*), OPTIONAL :: AvgMethod ! Averaging method
3768 : CHARACTER(LEN=*), OPTIONAL :: Positive ! Positive dir (up or down)
3769 : REAL*4, OPTIONAL :: nUpdates ! # of updates (for time-
3770 : ! averaged fields only)
3771 : !
3772 : ! !INPUT/OUTPUT PARAMETERS:
3773 : !
3774 : INTEGER, INTENT(INOUT) :: VarCt ! variable counter
3775 : !
3776 : ! !REMARKS:
3777 : ! Assumes that you have:
3778 : ! (1) A netCDF library (either v3 or v4) installed on your system
3779 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
3780 : !
3781 : ! !REVISION HISTORY:
3782 : ! 15 Jun 2012 - C. Keller - Initial version
3783 : ! See https://github.com/geoschem/ncdfutil for complete history
3784 : !EOP
3785 : !------------------------------------------------------------------------------
3786 : !BOC
3787 : !
3788 : ! !LOCAL VARIABLES:
3789 : !
3790 : ! Arrays
3791 0 : INTEGER, ALLOCATABLE :: VarDims(:)
3792 :
3793 : ! Scalars
3794 : INTEGER :: nDim, Pos
3795 : INTEGER :: NF_TYPE, tmpIlevId
3796 : LOGICAL :: isDefMode
3797 :
3798 : ! Strings
3799 : CHARACTER(LEN=80) :: Att
3800 :
3801 : !=======================================================================
3802 : ! Initialize
3803 : !=======================================================================
3804 :
3805 : ! Assume file is not in define mode unless explicitly told otherwise
3806 0 : IF ( PRESENT( DefMode ) ) THEN
3807 0 : isDefMode = DefMode
3808 : ELSE
3809 : isDefMode = .FALSE.
3810 : ENDIF
3811 :
3812 : ! Test if iLevId (dimension for level interfaces) is present
3813 0 : IF ( PRESENT( iLevId ) ) THEN
3814 0 : tmpIlevId = iLevId
3815 : ELSE
3816 : tmpIlevId = -1
3817 : ENDIF
3818 :
3819 : !=======================================================================
3820 : ! DEFINE VARIABLE
3821 : !=======================================================================
3822 :
3823 : ! Reopen definition section, if necessary
3824 0 : IF ( .not. isDefMode ) CALL NcBegin_Def( fId )
3825 :
3826 0 : VarCt = VarCt + 1
3827 :
3828 : ! number of dimensions
3829 0 : nDim = 0
3830 0 : IF ( lonId >= 0 ) nDim = nDim + 1
3831 0 : IF ( latId >= 0 ) nDim = nDim + 1
3832 0 : IF ( levId >= 0 ) nDim = nDim + 1
3833 0 : IF ( tmpIlevId >= 0 ) nDim = nDim + 1
3834 0 : if ( timeId >= 0 ) nDim = nDim + 1
3835 :
3836 : ! write dimensions
3837 0 : ALLOCATE( VarDims(nDim) )
3838 0 : Pos = 1
3839 0 : IF ( lonId >= 0 ) THEN
3840 0 : VarDims(Pos) = lonId
3841 0 : Pos = Pos + 1
3842 : ENDIF
3843 0 : IF ( latId >= 0 ) THEN
3844 0 : VarDims(Pos) = latId
3845 0 : Pos = Pos + 1
3846 : ENDIF
3847 0 : IF ( levId >= 0 ) THEN
3848 0 : VarDims(Pos) = levId
3849 0 : Pos = Pos + 1
3850 : ENDIF
3851 0 : IF ( tmpIlevId >= 0 ) THEN
3852 0 : VarDims(Pos) = tmpIlevId
3853 0 : Pos = Pos + 1
3854 : ENDIF
3855 0 : IF ( timeId >= 0 ) THEN
3856 0 : VarDims(Pos) = timeId
3857 0 : Pos = Pos + 1
3858 : ENDIF
3859 :
3860 : ! Set data type
3861 0 : IF ( DataType == 1 ) THEN
3862 0 : NF_TYPE = NF_INT
3863 0 : ELSEIF ( DataType == 4 ) THEN
3864 0 : NF_TYPE = NF_FLOAT
3865 0 : ELSEIF ( DataType == 8 ) THEN
3866 0 : NF_TYPE = NF_DOUBLE
3867 : ELSE
3868 0 : NF_TYPE = NF_FLOAT
3869 : ENDIF
3870 :
3871 : !-----------------------------------------------------------------------
3872 : ! Define variable
3873 : !-----------------------------------------------------------------------
3874 : CALL NcDef_Variable( fId, TRIM(VarName), NF_TYPE, &
3875 0 : nDim, VarDims, VarCt, Compress )
3876 0 : DEALLOCATE( VarDims )
3877 :
3878 : !-----------------------------------------------------------------------
3879 : ! Define variable atttibutes (some are optional)
3880 : !-----------------------------------------------------------------------
3881 :
3882 : ! long_name (reuired)
3883 0 : Att = 'long_name'
3884 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarLongName) )
3885 :
3886 : ! units (requited)
3887 0 : Att = 'units'
3888 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarUnit) )
3889 :
3890 : ! add_offset (optional)
3891 0 : IF ( PRESENT( AddOffset ) ) THEN
3892 0 : Att = 'add_offset'
3893 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), AddOffset )
3894 : ENDIF
3895 :
3896 : ! scale_factor (optional)
3897 0 : IF ( PRESENT( ScaleFactor ) ) THEN
3898 0 : Att = 'scale_factor'
3899 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), ScaleFactor )
3900 : ENDIF
3901 :
3902 : ! missing_value (optional but recommended)
3903 0 : IF ( PRESENT( MissingValue ) ) THEN
3904 0 : Att = '_FillValue'
3905 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), MissingValue )
3906 : ENDIF
3907 :
3908 : ! calendar (only used for time) -- skip if null string
3909 0 : IF ( PRESENT( Calendar ) ) THEN
3910 0 : IF ( LEN_TRIM( Calendar ) > 0 ) THEN
3911 0 : Att = 'calendar'
3912 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(Calendar) )
3913 : ENDIF
3914 : ENDIF
3915 :
3916 : ! axis (only used for index variables) -- skip if null string
3917 0 : IF ( PRESENT( Axis ) ) THEN
3918 0 : IF ( LEN_TRIM( Axis ) > 0 ) THEN
3919 0 : Att = 'axis'
3920 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(Axis) )
3921 : ENDIF
3922 : ENDIF
3923 :
3924 : ! averaging_method (optional) -- skip if null string
3925 0 : IF ( PRESENT( AvgMethod ) ) THEN
3926 0 : IF ( LEN_TRIM( AvgMethod ) > 0 ) THEN
3927 0 : Att = 'averaging_method'
3928 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(AvgMethod) )
3929 : ENDIF
3930 : ENDIF
3931 :
3932 : ! averaging_method (optional) -- skip if null string
3933 0 : IF ( PRESENT( Positive ) ) THEN
3934 0 : IF ( LEN_TRIM( Positive ) > 0 ) THEN
3935 0 : Att = 'positive'
3936 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(Positive) )
3937 : ENDIF
3938 : ENDIF
3939 :
3940 : ! Standard name (optional) -- skip if null string
3941 0 : IF ( PRESENT( StandardName ) ) THEN
3942 0 : IF ( LEN_TRIM( StandardName ) > 0 ) THEN
3943 0 : Att = 'standard_name'
3944 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(StandardName))
3945 : ENDIF
3946 : ENDIF
3947 :
3948 : ! Formula terms (optional) -- skip if null string
3949 0 : IF ( PRESENT( FormulaTerms ) ) THEN
3950 0 : IF ( LEN_TRIM( FormulaTerms ) > 0 ) THEN
3951 0 : Att = 'formula_terms'
3952 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(FormulaTerms))
3953 : ENDIF
3954 : ENDIF
3955 :
3956 : ! Number of updates
3957 0 : IF ( PRESENT( nUpdates ) ) THEN
3958 0 : IF ( nUpdates > 0.0 ) THEN
3959 0 : Att = 'number_of_updates'
3960 0 : CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), nUpdates )
3961 : ENDIF
3962 : ENDIF
3963 :
3964 : ! Close definition section, if necessary
3965 0 : IF ( .not. isDefMode ) CALL NcEnd_Def( fId )
3966 :
3967 0 : END SUBROUTINE NC_Var_Def
3968 : !EOC
3969 : !------------------------------------------------------------------------------
3970 : ! GEOS-Chem Global Chemical Transport Model !
3971 : !------------------------------------------------------------------------------
3972 : !BOP
3973 : !
3974 : ! !IROUTINE: Nc_Var_Chunk
3975 : !
3976 : ! !DESCRIPTION: Turns on chunking for a netCDF variable.
3977 : !\\
3978 : !\\
3979 : ! !INTERFACE:
3980 : !
3981 0 : SUBROUTINE Nc_Var_Chunk( fId, vId, ChunkSizes, RC )
3982 : !
3983 : ! !INPUT PARAMETERS:
3984 : !
3985 : INTEGER, INTENT(IN) :: fId ! NetCDF file ID
3986 : INTEGER, INTENT(IN) :: vId ! NetCDF variable ID
3987 : INTEGER, INTENT(IN) :: ChunkSizes(:) ! NetCDF chunk sizes for each dim
3988 : !
3989 : ! !OUTPUT PARAMETERS:
3990 : !
3991 : INTEGER, INTENT(OUT) :: RC ! Success or failure?
3992 : !
3993 : ! !REMARKS:
3994 : ! RC will return an error (nonzero) status if chunking cannot be activated.
3995 : ! Most often, this is because support for netCDF-4 compression is disabled,
3996 : ! or if the netCDF file is not a netCDF-4 file. In this case, RC will have
3997 : ! an error code of -111.
3998 : !
3999 : ! !REVISION HISTORY:
4000 : ! 28 Aug 2017 - R. Yantosca - Initial version
4001 : ! See https://github.com/geoschem/ncdfutil for complete history
4002 : !EOP
4003 : !------------------------------------------------------------------------------
4004 : !BOC
4005 : !
4006 : ! !LOCAL VARIABLES:
4007 : !
4008 : #if defined( NC_HAS_COMPRESSION )
4009 :
4010 : ! Turn on chunking for this variable
4011 : ! But only if the netCDF library supports it
4012 : RC = NF_Def_Var_Chunking( fId, vId, NF_CHUNKED, ChunkSizes )
4013 :
4014 : #else
4015 :
4016 : ! Otherwise return success
4017 0 : RC = 0
4018 :
4019 : #endif
4020 :
4021 0 : END SUBROUTINE Nc_Var_Chunk
4022 : !EOC
4023 : !------------------------------------------------------------------------------
4024 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4025 : ! and NASA/GSFC, SIVO, Code 610.3 !
4026 : !------------------------------------------------------------------------------
4027 : !BOP
4028 : !
4029 : ! !IROUTINE: Nc_Var_Write_R8_0d
4030 : !
4031 : ! !DESCRIPTION: Writes data of a 0-D double precision variable.
4032 : !\\
4033 : !\\
4034 : ! !INTERFACE:
4035 : !
4036 0 : SUBROUTINE NC_VAR_WRITE_R8_0D( fId, VarName, Var )
4037 : !
4038 : ! !INPUT PARAMETERS:
4039 : !
4040 : INTEGER, INTENT(IN) :: fId ! file ID
4041 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4042 : REAL(kind=dp) :: Var ! Variable to be written
4043 : !
4044 : ! !REMARKS:
4045 : ! Assumes that you have:
4046 : ! (1) A netCDF library (either v3 or v4) installed on your system
4047 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4048 : ! .
4049 : ! Although this routine was generated automatically, some further
4050 : ! hand-editing may be required.
4051 : !
4052 : ! !REVISION HISTORY:
4053 : ! 25 Aug 2017 - R. Yantosca - Initial version
4054 : ! See https://github.com/geoschem/ncdfutil for complete history
4055 : !EOP
4056 : !------------------------------------------------------------------------------
4057 : !BOC
4058 : !
4059 : ! !LOCAL VARIABLES:
4060 : !
4061 : !--------------------------------
4062 : ! WRITE DATA
4063 : !--------------------------------
4064 :
4065 : ! Write to netCDF file
4066 0 : CALL NcWr( Var, fId, VarName )
4067 :
4068 0 : END SUBROUTINE NC_VAR_WRITE_R8_0d
4069 : !EOC
4070 : !------------------------------------------------------------------------------
4071 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4072 : ! and NASA/GSFC, SIVO, Code 610.3 !
4073 : !------------------------------------------------------------------------------
4074 : !BOP
4075 : !
4076 : ! !IROUTINE: Nc_Var_Write_R8_1d
4077 : !
4078 : ! !DESCRIPTION: Writes data of a 1-D double precision variable.
4079 : !\\
4080 : !\\
4081 : ! !INTERFACE:
4082 : !
4083 0 : SUBROUTINE NC_VAR_WRITE_R8_1D( fId, VarName, Arr1D )
4084 : !
4085 : ! !INPUT PARAMETERS:
4086 : !
4087 : INTEGER, INTENT(IN) :: fId ! file ID
4088 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4089 : REAL(kind=dp), POINTER :: Arr1D(:) ! array to be written
4090 : !
4091 : ! !REMARKS:
4092 : ! Assumes that you have:
4093 : ! (1) A netCDF library (either v3 or v4) installed on your system
4094 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4095 : ! .
4096 : ! Although this routine was generated automatically, some further
4097 : ! hand-editing may be required.
4098 : !
4099 : ! !REVISION HISTORY:
4100 : ! 15 Jun 2012 - C. Keller - Initial version
4101 : ! See https://github.com/geoschem/ncdfutil for complete history
4102 : !EOP
4103 : !------------------------------------------------------------------------------
4104 : !BOC
4105 : !
4106 : ! !LOCAL VARIABLES:
4107 : !
4108 : ! Arrays
4109 : INTEGER :: St1d(1), Ct1d(1)
4110 :
4111 : !--------------------------------
4112 : ! WRITE DATA
4113 : !--------------------------------
4114 :
4115 : ! Set start & count arrays
4116 0 : St1d(1) = 1
4117 0 : Ct1d(1) = SIZE( Arr1d, 1 )
4118 :
4119 : ! Write to netCDF file
4120 0 : CALL NcWr( Arr1d, fId, VarName, St1d, Ct1d )
4121 :
4122 0 : END SUBROUTINE NC_VAR_WRITE_R8_1D
4123 : !EOC
4124 : !------------------------------------------------------------------------------
4125 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4126 : ! and NASA/GSFC, SIVO, Code 610.3 !
4127 : !------------------------------------------------------------------------------
4128 : !BOP
4129 : !
4130 : ! !IROUTINE: Nc_Var_Write_R8_2d
4131 : !
4132 : ! !DESCRIPTION: Writes data of a 2-D double precision variable.
4133 : !\\
4134 : !\\
4135 : ! !INTERFACE:
4136 : !
4137 0 : SUBROUTINE NC_VAR_WRITE_R8_2D( fId, VarName, Arr2D )
4138 : !
4139 : ! !INPUT PARAMETERS:
4140 : !
4141 : INTEGER, INTENT(IN) :: fId ! file ID
4142 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4143 : REAL(kind=dp), POINTER :: Arr2D(:,:) ! array to be written
4144 : !
4145 : ! !REMARKS:
4146 : ! Assumes that you have:
4147 : ! (1) A netCDF library (either v3 or v4) installed on your system
4148 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4149 : ! .
4150 : ! Although this routine was generated automatically, some further
4151 : ! hand-editing may be required.
4152 : !
4153 : ! !REVISION HISTORY:
4154 : ! 15 Jun 2012 - C. Keller - Initial version
4155 : ! See https://github.com/geoschem/ncdfutil for complete history
4156 : !EOP
4157 : !------------------------------------------------------------------------------
4158 : !BOC
4159 : !
4160 : ! !LOCAL VARIABLES:
4161 : !
4162 : ! Arrays
4163 : INTEGER :: St2d(2), Ct2d(2)
4164 :
4165 : ! Scalars
4166 : INTEGER :: I, nDim
4167 :
4168 : !--------------------------------
4169 : ! WRITE DATA
4170 : !--------------------------------
4171 :
4172 : ! Set start & count arrays
4173 0 : nDim = 2
4174 0 : DO I =1, nDim
4175 0 : St2d(I) = 1
4176 0 : Ct2d(I) = SIZE( Arr2d, I )
4177 : ENDDO
4178 :
4179 : ! Write to netCDF file
4180 0 : CALL NcWr( Arr2d, fId, VarName, St2d, Ct2d )
4181 :
4182 0 : END SUBROUTINE NC_VAR_WRITE_R8_2D
4183 : !EOC
4184 : !------------------------------------------------------------------------------
4185 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4186 : ! and NASA/GSFC, SIVO, Code 610.3 !
4187 : !------------------------------------------------------------------------------
4188 : !BOP
4189 : !
4190 : ! !IROUTINE: Nc_Var_Write_R8_3D
4191 : !
4192 : ! !DESCRIPTION: Writes data of a 3-D double precision variable.
4193 : !\\
4194 : !\\
4195 : ! !INTERFACE:
4196 : !
4197 0 : SUBROUTINE NC_VAR_WRITE_R8_3D( fId, VarName, Arr3D )
4198 : !
4199 : ! !INPUT PARAMETERS:
4200 : !
4201 : INTEGER, INTENT(IN) :: fId ! file ID
4202 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4203 : REAL(kind=dp), POINTER :: Arr3D(:,:,:) ! array to be written
4204 : !
4205 : ! !REMARKS:
4206 : ! Assumes that you have:
4207 : ! (1) A netCDF library (either v3 or v4) installed on your system
4208 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4209 : ! .
4210 : ! Although this routine was generated automatically, some further
4211 : ! hand-editing may be required.
4212 : !
4213 : ! !REVISION HISTORY:
4214 : ! 15 Jun 2012 - C. Keller - Initial version
4215 : ! See https://github.com/geoschem/ncdfutil for complete history
4216 : !EOP
4217 : !------------------------------------------------------------------------------
4218 : !BOC
4219 : !
4220 : ! !LOCAL VARIABLES:
4221 : !
4222 : ! Arrays
4223 : INTEGER :: St3d(3), Ct3d(3)
4224 :
4225 : ! Scalars
4226 : INTEGER :: I, nDim
4227 :
4228 : !--------------------------------
4229 : ! WRITE DATA
4230 : !--------------------------------
4231 :
4232 : ! Set start & count arrays
4233 0 : nDim = 3
4234 0 : DO I = 1, nDim
4235 0 : St3d(I) = 1
4236 0 : Ct3d(I) = SIZE( Arr3d, I )
4237 : ENDDO
4238 :
4239 : ! Write data to netCDF file
4240 0 : CALL NcWr( Arr3d, fId, VarName, St3d, Ct3d )
4241 :
4242 0 : END SUBROUTINE NC_VAR_WRITE_R8_3D
4243 : !EOC
4244 : !------------------------------------------------------------------------------
4245 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4246 : ! and NASA/GSFC, SIVO, Code 610.3 !
4247 : !------------------------------------------------------------------------------
4248 : !BOP
4249 : !
4250 : ! !IROUTINE: Nc_Var_Write_r8_4d
4251 : !
4252 : ! !DESCRIPTION: Writes data of a 4-D double precision variable.
4253 : !\\
4254 : !\\
4255 : ! !INTERFACE:
4256 : !
4257 0 : SUBROUTINE NC_VAR_WRITE_R8_4D( fId, VarName, Arr4D )
4258 : !
4259 : ! !INPUT PARAMETERS:
4260 : !
4261 : INTEGER, INTENT(IN) :: fId ! file ID
4262 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4263 : REAL(kind=dp), POINTER :: Arr4D(:,:,:,:) ! array to be written
4264 : !
4265 : ! !REMARKS:
4266 : ! Assumes that you have:
4267 : ! (1) A netCDF library (either v3 or v4) installed on your system
4268 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4269 : ! .
4270 : ! Although this routine was generated automatically, some further
4271 : ! hand-editing may be required.
4272 : !
4273 : ! !REVISION HISTORY:
4274 : ! 15 Jun 2012 - C. Keller - Initial version
4275 : ! See https://github.com/geoschem/ncdfutil for complete history
4276 : !EOP
4277 : !------------------------------------------------------------------------------
4278 : !BOC
4279 : !
4280 : ! !LOCAL VARIABLES:
4281 : !
4282 : ! Arrays
4283 : INTEGER :: St4d(4), Ct4d(4)
4284 :
4285 : ! Scalars
4286 : INTEGER :: I, nDim
4287 :
4288 : !--------------------------------
4289 : ! WRITE DATA
4290 : !--------------------------------
4291 :
4292 : ! Set start & count arrays
4293 0 : nDim = 4
4294 0 : DO I = 1, nDim
4295 0 : St4d(I) = 1
4296 0 : Ct4d(I) = SIZE( Arr4d, I )
4297 : ENDDO
4298 :
4299 : ! Write to netCDF file
4300 0 : CALL NcWr( Arr4d, fId, VarName, St4d, Ct4d )
4301 :
4302 0 : END SUBROUTINE NC_VAR_WRITE_R8_4D
4303 : !EOC
4304 : !------------------------------------------------------------------------------
4305 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4306 : ! and NASA/GSFC, SIVO, Code 610.3 !
4307 : !------------------------------------------------------------------------------
4308 : !BOP
4309 : !
4310 : ! !IROUTINE: Nc_Var_Write_R4_0d
4311 : !
4312 : ! !DESCRIPTION: Writes data of a 0-D single-precision variable.
4313 : !\\
4314 : !\\
4315 : ! !INTERFACE:
4316 : !
4317 0 : SUBROUTINE NC_VAR_WRITE_R4_0d( fId, VarName, Var )
4318 : !
4319 : ! !INPUT PARAMETERS:
4320 : !
4321 : INTEGER, INTENT(IN) :: fId ! file ID
4322 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4323 : REAL(kind=sp) :: Var ! Variable to be written
4324 : !
4325 : ! !REMARKS:
4326 : ! Assumes that you have:
4327 : ! (1) A netCDF library (either v3 or v4) installed on your system
4328 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4329 : ! .
4330 : ! Although this routine was generated automatically, some further
4331 : ! hand-editing may be required.
4332 : !
4333 : ! !REVISION HISTORY:
4334 : ! 25 Aug 2017 - R. Yantosca - Initial version
4335 : ! See https://github.com/geoschem/ncdfutil for complete history
4336 : !EOP
4337 : !------------------------------------------------------------------------------
4338 : !BOC
4339 : !
4340 : ! !LOCAL VARIABLES:
4341 : !
4342 : !--------------------------------
4343 : ! WRITE DATA
4344 : !--------------------------------
4345 :
4346 : ! Write to netCDF file
4347 0 : CALL NcWr( Var, fId, VarName )
4348 :
4349 0 : END SUBROUTINE NC_VAR_WRITE_R4_0D
4350 : !EOC
4351 : !------------------------------------------------------------------------------
4352 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4353 : ! and NASA/GSFC, SIVO, Code 610.3 !
4354 : !------------------------------------------------------------------------------
4355 : !BOP
4356 : !
4357 : ! !IROUTINE: Nc_Var_Write_r4_1d
4358 : !
4359 : ! !DESCRIPTION: Writes data of a single precision variable.
4360 : !\\
4361 : !\\
4362 : ! !INTERFACE:
4363 : !
4364 0 : SUBROUTINE NC_VAR_WRITE_R4_1D( fId, VarName, Arr1D )
4365 : !
4366 : ! !INPUT PARAMETERS:
4367 : !
4368 : INTEGER, INTENT(IN) :: fId ! file ID
4369 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4370 : REAL(kind=sp), POINTER :: Arr1D(:) ! array to be written
4371 : !
4372 : ! !REMARKS:
4373 : ! Assumes that you have:
4374 : ! (1) A netCDF library (either v3 or v4) installed on your system
4375 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4376 : ! .
4377 : ! Although this routine was generated automatically, some further
4378 : ! hand-editing may be required.
4379 : !
4380 : ! !REVISION HISTORY:
4381 : ! 15 Jun 2012 - C. Keller - Initial version
4382 : ! See https://github.com/geoschem/ncdfutil for complete history
4383 : !EOP
4384 : !------------------------------------------------------------------------------
4385 : !BOC
4386 : !
4387 : ! !LOCAL VARIABLES:
4388 : !
4389 : ! Arrays
4390 : INTEGER :: St1d(1), Ct1d(1)
4391 :
4392 : !--------------------------------
4393 : ! WRITE DATA
4394 : !--------------------------------
4395 :
4396 : ! Set start & count arrays
4397 0 : St1d(1) = 1
4398 0 : Ct1d(1) = SIZE( Arr1d, 1 )
4399 :
4400 : ! Write to netCDF file
4401 0 : CALL NcWr( Arr1d, fId, VarName, St1d, Ct1d )
4402 :
4403 0 : END SUBROUTINE NC_VAR_WRITE_R4_1D
4404 : !EOC
4405 : !------------------------------------------------------------------------------
4406 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4407 : ! and NASA/GSFC, SIVO, Code 610.3 !
4408 : !------------------------------------------------------------------------------
4409 : !BOP
4410 : !
4411 : ! !IROUTINE: Nc_Var_Write_r4_2D
4412 : !
4413 : ! !DESCRIPTION: Writes data of a 2-D single precision variable.
4414 : !\\
4415 : !\\
4416 : ! !INTERFACE:
4417 : !
4418 0 : SUBROUTINE NC_VAR_WRITE_R4_2D( fId, VarName, Arr2D )
4419 : !
4420 : ! !INPUT PARAMETERS:
4421 : !
4422 : INTEGER, INTENT(IN) :: fId ! file ID
4423 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4424 : REAL(kind=sp), POINTER :: Arr2D(:,:) ! array to be written
4425 : !
4426 : ! !REMARKS:
4427 : ! Assumes that you have:
4428 : ! (1) A netCDF library (either v3 or v4) installed on your system
4429 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4430 : ! .
4431 : ! Although this routine was generated automatically, some further
4432 : ! hand-editing may be required.
4433 : !
4434 : ! !REVISION HISTORY:
4435 : ! 15 Jun 2012 - C. Keller - Initial version
4436 : ! See https://github.com/geoschem/ncdfutil for complete history
4437 : !EOP
4438 : !------------------------------------------------------------------------------
4439 : !BOC
4440 : !
4441 : ! !LOCAL VARIABLES:
4442 : !
4443 : ! Arrays
4444 : INTEGER :: St2d(2), Ct2d(2)
4445 :
4446 : ! Scalars
4447 : INTEGER :: I, nDim
4448 :
4449 : !--------------------------------
4450 : ! WRITE DATA
4451 : !--------------------------------
4452 :
4453 : ! Set start & count arrays
4454 0 : nDim = 2
4455 0 : DO I = 1, nDim
4456 0 : St2d(I) = 1
4457 0 : Ct2d(I) = SIZE( Arr2d, I )
4458 : ENDDO
4459 :
4460 : ! Write to netCDF file
4461 0 : CALL NcWr( Arr2d, fId, VarName, St2d, Ct2d )
4462 :
4463 0 : END SUBROUTINE NC_VAR_WRITE_R4_2D
4464 : !EOC
4465 : !------------------------------------------------------------------------------
4466 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4467 : ! and NASA/GSFC, SIVO, Code 610.3 !
4468 : !------------------------------------------------------------------------------
4469 : !BOP
4470 : !
4471 : ! !IROUTINE: Nc_Var_Write_r4_3d
4472 : !
4473 : ! !DESCRIPTION: Writes data of a 3-D single precision variable.
4474 : !\\
4475 : !\\
4476 : ! !INTERFACE:
4477 : !
4478 0 : SUBROUTINE NC_VAR_WRITE_R4_3D( fId, VarName, Arr3D )
4479 : !
4480 : ! !INPUT PARAMETERS:
4481 : !
4482 : INTEGER, INTENT(IN) :: fId ! file ID
4483 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4484 : REAL(kind=sp), POINTER :: Arr3D(:,:,:) ! array to be written
4485 : !
4486 : ! !REMARKS:
4487 : ! Assumes that you have:
4488 : ! (1) A netCDF library (either v3 or v4) installed on your system
4489 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4490 : ! .
4491 : ! Although this routine was generated automatically, some further
4492 : ! hand-editing may be required.
4493 : !
4494 : ! !REVISION HISTORY:
4495 : ! 15 Jun 2012 - C. Keller - Initial version
4496 : ! See https://github.com/geoschem/ncdfutil for complete history
4497 : !EOP
4498 : !------------------------------------------------------------------------------
4499 : !BOC
4500 : !
4501 : ! !LOCAL VARIABLES:
4502 : !
4503 : ! Arrays
4504 : INTEGER :: St3d(3), Ct3d(3)
4505 :
4506 : ! Scalars
4507 : INTEGER :: I, nDim
4508 :
4509 : !--------------------------------
4510 : ! WRITE DATA
4511 : !--------------------------------
4512 :
4513 : ! Set start & count arrays
4514 0 : nDim = 3
4515 0 : DO I = 1, nDim
4516 0 : St3d(I) = 1
4517 0 : Ct3d(I) = SIZE( Arr3d, I )
4518 : ENDDO
4519 :
4520 : ! Write to netCDF file
4521 0 : CALL NcWr( Arr3d, fId, VarName, St3d, Ct3d )
4522 :
4523 0 : END SUBROUTINE NC_VAR_WRITE_R4_3D
4524 : !EOC
4525 : !------------------------------------------------------------------------------
4526 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4527 : ! and NASA/GSFC, SIVO, Code 610.3 !
4528 : !------------------------------------------------------------------------------
4529 : !BOP
4530 : !
4531 : ! !IROUTINE: Nc_Var_Write_r4_4d
4532 : !
4533 : ! !DESCRIPTION: Writes data of a 4-D single precision variable.
4534 : !\\
4535 : !\\
4536 : ! !INTERFACE:
4537 : !
4538 0 : SUBROUTINE NC_VAR_WRITE_R4_4D( fId, VarName, Arr4D )
4539 : !
4540 : ! !INPUT PARAMETERS:
4541 : !
4542 : INTEGER, INTENT(IN) :: fId ! file ID
4543 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4544 : REAL(kind=sp), POINTER :: Arr4D(:,:,:,:) ! array to be written
4545 : !
4546 : ! !REMARKS:
4547 : ! Assumes that you have:
4548 : ! (1) A netCDF library (either v3 or v4) installed on your system
4549 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4550 : ! .
4551 : ! Although this routine was generated automatically, some further
4552 : ! hand-editing may be required.
4553 : !
4554 : ! !REVISION HISTORY:
4555 : ! 15 Jun 2012 - C. Keller - Initial version
4556 : ! See https://github.com/geoschem/ncdfutil for complete history
4557 : !EOP
4558 : !------------------------------------------------------------------------------
4559 : !BOC
4560 : !
4561 : ! !LOCAL VARIABLES:
4562 : !
4563 : ! Arrays
4564 : INTEGER :: St4d(4), Ct4d(4)
4565 :
4566 : ! Scalars
4567 : INTEGER :: I, nDim
4568 :
4569 : !--------------------------------
4570 : ! WRITE DATA
4571 : !--------------------------------
4572 :
4573 0 : nDim = 4
4574 0 : DO I = 1, nDim
4575 0 : St4d(I) = 1
4576 0 : Ct4d(I) = SIZE( Arr4d, I )
4577 : ENDDO
4578 :
4579 : ! Write to netCDF file
4580 0 : CALL NcWr( Arr4d, fId, VarName, St4d, Ct4d )
4581 :
4582 0 : END SUBROUTINE NC_VAR_WRITE_R4_4D
4583 : !EOC
4584 : !------------------------------------------------------------------------------
4585 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4586 : ! and NASA/GSFC, SIVO, Code 610.3 !
4587 : !------------------------------------------------------------------------------
4588 : !BOP
4589 : !
4590 : ! !IROUTINE: Nc_Var_Write_Int_0d
4591 : !
4592 : ! !DESCRIPTION: Writes data of a 0-D integer variable.
4593 : !\\
4594 : !\\
4595 : ! !INTERFACE:
4596 : !
4597 0 : SUBROUTINE NC_VAR_WRITE_INT_0d( fId, VarName, Var )
4598 : !
4599 : ! !INPUT PARAMETERS:
4600 : !
4601 : INTEGER, INTENT(IN) :: fId ! file ID
4602 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4603 : INTEGER :: Var ! Variable to be written
4604 : !
4605 : ! !REMARKS:
4606 : ! Assumes that you have:
4607 : ! (1) A netCDF library (either v3 or v4) installed on your system
4608 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4609 : ! .
4610 : ! Although this routine was generated automatically, some further
4611 : ! hand-editing may be required.
4612 : !
4613 : ! !REVISION HISTORY:
4614 : ! 25 Aug 2017 - R. Yantosca - Initial version
4615 : ! See https://github.com/geoschem/ncdfutil for complete history
4616 : !EOP
4617 : !------------------------------------------------------------------------------
4618 : !BOC
4619 : !
4620 : ! !LOCAL VARIABLES:
4621 : !
4622 : !--------------------------------
4623 : ! WRITE DATA
4624 : !--------------------------------
4625 :
4626 : ! Write to netCDF file
4627 0 : CALL NcWr( Var, fId, VarName )
4628 :
4629 0 : END SUBROUTINE NC_VAR_WRITE_INT_0D
4630 : !EOC
4631 : !------------------------------------------------------------------------------
4632 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4633 : ! and NASA/GSFC, SIVO, Code 610.3 !
4634 : !------------------------------------------------------------------------------
4635 : !BOP
4636 : !
4637 : ! !IROUTINE: Nc_Var_Write_int_1d
4638 : !
4639 : ! !DESCRIPTION: Writes data of an 1-D integer variable.
4640 : !\\
4641 : !\\
4642 : ! !INTERFACE:
4643 : !
4644 0 : SUBROUTINE NC_VAR_WRITE_INT_1D( fId, VarName, Arr1D )
4645 : !
4646 : ! !INPUT PARAMETERS:
4647 : !
4648 : INTEGER, INTENT(IN) :: fId ! file ID
4649 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4650 : INTEGER, POINTER :: Arr1D(:) ! array to be written
4651 : !
4652 : ! !REMARKS:
4653 : ! Assumes that you have:
4654 : ! (1) A netCDF library (either v3 or v4) installed on your system
4655 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4656 : ! .
4657 : ! Although this routine was generated automatically, some further
4658 : ! hand-editing may be required.
4659 : !
4660 : ! !REVISION HISTORY:
4661 : ! 15 Jun 2012 - C. Keller - Initial version
4662 : ! See https://github.com/geoschem/ncdfutil for complete history
4663 : !EOP
4664 : !------------------------------------------------------------------------------
4665 : !BOC
4666 : !
4667 : ! !LOCAL VARIABLES:
4668 : !
4669 : ! Arrays
4670 : INTEGER :: St1d(1), Ct1d(1)
4671 :
4672 : !--------------------------------
4673 : ! WRITE DATA
4674 : !--------------------------------
4675 :
4676 : ! Set start & count arrays
4677 0 : St1d(1) = 1
4678 0 : Ct1d(1) = SIZE( Arr1d, 1 )
4679 :
4680 : ! Write to netCDF file
4681 0 : CALL NcWr( Arr1d, fId, VarName, St1d, Ct1d )
4682 :
4683 0 : END SUBROUTINE NC_VAR_WRITE_INT_1D
4684 : !EOC
4685 : !------------------------------------------------------------------------------
4686 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4687 : ! and NASA/GSFC, SIVO, Code 610.3 !
4688 : !------------------------------------------------------------------------------
4689 : !BOP
4690 : !
4691 : ! !IROUTINE: Nc_Var_Write_int_2d
4692 : !
4693 : ! !DESCRIPTION: writes data of an 2-D integer variable.
4694 : !\\
4695 : !\\
4696 : ! !INTERFACE:
4697 : !
4698 0 : SUBROUTINE NC_VAR_WRITE_INT_2D( fId, VarName, Arr2D )
4699 : !
4700 : ! !INPUT PARAMETERS:
4701 : !
4702 : INTEGER, INTENT(IN) :: fId ! file ID
4703 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4704 : INTEGER, POINTER :: Arr2D(:,:) ! array to be written
4705 : !
4706 : ! !REMARKS:
4707 : ! Assumes that you have:
4708 : ! (1) A netCDF library (either v3 or v4) installed on your system
4709 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4710 : ! .
4711 : ! Although this routine was generated automatically, some further
4712 : ! hand-editing may be required.
4713 : !
4714 : ! !REVISION HISTORY:
4715 : ! 15 Jun 2012 - C. Keller - Initial version
4716 : ! See https://github.com/geoschem/ncdfutil for complete history
4717 : !EOP
4718 : !------------------------------------------------------------------------------
4719 : !BOC
4720 : !
4721 : ! !LOCAL VARIABLES:
4722 : !
4723 : ! Arrays
4724 : INTEGER :: St2d(2), Ct2d(2)
4725 :
4726 : ! Scalars
4727 : INTEGER :: I, nDim
4728 :
4729 : !--------------------------------
4730 : ! WRITE DATA
4731 : !--------------------------------
4732 :
4733 : ! Set start & count arrays
4734 0 : nDim = 2
4735 0 : DO I = 1, nDim
4736 0 : St2d(I) = 1
4737 0 : Ct2d(I) = SIZE( Arr2d, I )
4738 : ENDDO
4739 :
4740 : ! Write to netCDF file
4741 0 : CALL NcWr( Arr2d, fId, VarName, St2d, Ct2d )
4742 :
4743 0 : END SUBROUTINE NC_VAR_WRITE_INT_2D
4744 : !EOC
4745 : !------------------------------------------------------------------------------
4746 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4747 : ! and NASA/GSFC, SIVO, Code 610.3 !
4748 : !------------------------------------------------------------------------------
4749 : !BOP
4750 : !
4751 : ! !IROUTINE: Nc_Var_Write_int_3d
4752 : !
4753 : ! !DESCRIPTION: writes data of an 3-D integer variable.
4754 : !\\
4755 : !\\
4756 : ! !INTERFACE:
4757 : !
4758 0 : SUBROUTINE NC_VAR_WRITE_INT_3D( fId, VarName, Arr3D )
4759 : !
4760 : ! !INPUT PARAMETERS:
4761 : !
4762 : INTEGER, INTENT(IN) :: fId ! file ID
4763 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4764 : INTEGER, POINTER :: Arr3D(:,:,:) ! array to be written
4765 : !
4766 : ! !REMARKS:
4767 : ! Assumes that you have:
4768 : ! (1) A netCDF library (either v3 or v4) installed on your system
4769 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4770 : ! .
4771 : ! Although this routine was generated automatically, some further
4772 : ! hand-editing may be required.
4773 : !
4774 : ! !REVISION HISTORY:
4775 : ! 15 Jun 2012 - C. Keller - Initial version
4776 : ! See https://github.com/geoschem/ncdfutil for complete history
4777 : !EOP
4778 : !------------------------------------------------------------------------------
4779 : !BOC
4780 : !
4781 : ! !LOCAL VARIABLES:
4782 : !
4783 : ! Arrays
4784 : INTEGER :: St3d(3), Ct3d(3)
4785 :
4786 : ! Scalars
4787 : INTEGER :: I, nDim
4788 :
4789 : !--------------------------------
4790 : ! WRITE DATA
4791 : !--------------------------------
4792 :
4793 : ! Set start & count arrays
4794 0 : nDim = 3
4795 0 : DO I = 1, nDim
4796 0 : St3d(I) = 1
4797 0 : Ct3d(I) = SIZE( Arr3d, I )
4798 : ENDDO
4799 :
4800 : ! Write to netCDF file
4801 0 : CALL NcWr( Arr3d, fId, trim(VarName), St3d, Ct3d )
4802 :
4803 0 : END SUBROUTINE NC_VAR_WRITE_INT_3D
4804 : !EOC
4805 : !------------------------------------------------------------------------------
4806 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4807 : ! and NASA/GSFC, SIVO, Code 610.3 !
4808 : !------------------------------------------------------------------------------
4809 : !BOP
4810 : !
4811 : ! !IROUTINE: Nc_Var_Write_int_4d
4812 : !
4813 : ! !DESCRIPTION: writes data of an 4-Dinteger variable.
4814 : !\\
4815 : !\\
4816 : ! !INTERFACE:
4817 : !
4818 0 : SUBROUTINE NC_VAR_WRITE_INT_4D( fId, VarName, Arr4D )
4819 : !
4820 : ! !INPUT PARAMETERS:
4821 : !
4822 : INTEGER, INTENT(IN) :: fId ! file ID
4823 : CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name
4824 : INTEGER, POINTER :: Arr4D(:,:,:,:) ! array to be written
4825 : !
4826 : ! !REMARKS:
4827 : ! Assumes that you have:
4828 : ! (1) A netCDF library (either v3 or v4) installed on your system
4829 : ! (2) The NcdfUtilities package (from Bob Yantosca) source code
4830 : ! .
4831 : ! Although this routine was generated automatically, some further
4832 : ! hand-editing may be required.
4833 : !
4834 : ! !REVISION HISTORY:
4835 : ! 15 Jun 2012 - C. Keller - Initial version
4836 : ! See https://github.com/geoschem/ncdfutil for complete history
4837 : !EOP
4838 : !------------------------------------------------------------------------------
4839 : !BOC
4840 : !
4841 : ! !LOCAL VARIABLES:
4842 : !
4843 : ! Arrays
4844 : INTEGER :: St4d(4), Ct4d(4)
4845 :
4846 : ! Scalars
4847 : INTEGER :: I, nDim
4848 :
4849 : !--------------------------------
4850 : ! WRITE DATA
4851 : !--------------------------------
4852 :
4853 : ! Set start & count arrays
4854 0 : nDim = 4
4855 0 : DO I = 1, nDim
4856 0 : St4d(I) = 1
4857 0 : Ct4d(I) = SIZE( Arr4d, I )
4858 : ENDDO
4859 :
4860 : ! Write to netCDF file
4861 0 : CALL NcWr( Arr4d, fId, VarName, St4d, Ct4d )
4862 :
4863 0 : END SUBROUTINE NC_VAR_WRITE_INT_4D
4864 : !EOC
4865 : !------------------------------------------------------------------------------
4866 : ! GEOS-Chem Global Chemical Transport Model !
4867 : !------------------------------------------------------------------------------
4868 : !BOP
4869 : !
4870 : ! !IROUTINE: Get_Tau0
4871 : !
4872 : ! !DESCRIPTION: Function GET\_TAU0\_6A returns the corresponding TAU0 value
4873 : ! for the first day of a given MONTH of a given YEAR. This is necessary to
4874 : ! index monthly mean binary punch files, which are used as input to GEOS-Chem.
4875 : !\\
4876 : !\\
4877 : ! This function takes 3 mandatory arguments (MONTH, DAY, YEAR) and 3
4878 : ! optional arguments (HOUR, MIN, SEC). It is intended to replace the current
4879 : ! 2-argument version of GET\_TAU0. The advantage being that GET\_TAU0\_6A
4880 : ! can compute a TAU0 for any date and time in the GEOS-Chem epoch, rather
4881 : ! than just the first day of each month. Overload this w/ an interface so
4882 : ! that the user can also choose the version of GET\_TAU0 w/ 2 arguments
4883 : ! (MONTH, YEAR), which is the prior version.
4884 : !\\
4885 : !\\
4886 : ! !INTERFACE:
4887 : !
4888 0 : FUNCTION GET_TAU0( MONTH, DAY, YEAR, HOUR, MIN, SEC ) RESULT( THIS_TAU0 )
4889 : !
4890 : ! !USES:
4891 : !
4892 : USE HCO_JULDAY_MOD, ONLY : JULDAY
4893 : !
4894 : ! !INPUT PARAMETERS:
4895 : !
4896 : INTEGER, INTENT(IN) :: MONTH
4897 : INTEGER, INTENT(IN) :: DAY
4898 : INTEGER, INTENT(IN) :: YEAR
4899 : INTEGER, INTENT(IN), OPTIONAL :: HOUR
4900 : INTEGER, INTENT(IN), OPTIONAL :: MIN
4901 : INTEGER, INTENT(IN), OPTIONAL :: SEC
4902 : !
4903 : ! !RETURN VALUE:
4904 : !
4905 : REAL*8 :: THIS_TAU0 ! TAU0 timestamp
4906 : !
4907 : ! !REMARKS:
4908 : ! TAU0 is hours elapsed since 00:00 GMT on 01 Jan 1985.
4909 : !
4910 : ! !REVISION HISTORY:
4911 : ! See https://github.com/geoschem/ncdfutil for complete history
4912 : !EOP
4913 : !------------------------------------------------------------------------------
4914 : !BOC
4915 : !
4916 : ! !LOCAL VARIABLES:
4917 : !
4918 : INTEGER :: TMP_HOUR, TMP_MIN, TMP_SEC
4919 : REAL*8 :: DAYS
4920 :
4921 : !=======================================================================
4922 : ! GET_TAU0 begins here!
4923 : !=======================================================================
4924 :
4925 : ! Error checking
4926 0 : IF ( MONTH < 1 .or. MONTH > 12 ) THEN
4927 0 : WRITE( 6, 100 )
4928 : 100 FORMAT( 'Invalid MONTH selection! STOP in GET_TAU0 (ncdf_mod.F90)!' )
4929 0 : STOP
4930 : ENDIF
4931 :
4932 : ! Error checking
4933 0 : IF ( DAY < 1 .or. DAY > 31 ) THEN
4934 0 : WRITE( 6, 110 )
4935 : 110 FORMAT( 'Invalid DAY selection! STOP in GET_TAU0 (ncdf_mod.F90)!' )
4936 0 : STOP
4937 : ENDIF
4938 :
4939 : ! If HOUR isn't passed, default to 0
4940 0 : IF ( PRESENT( HOUR ) ) THEN
4941 0 : TMP_HOUR = HOUR
4942 : ELSE
4943 : TMP_HOUR = 0
4944 : ENDIF
4945 :
4946 : ! If MIN isn't passed, default to 0
4947 0 : IF ( PRESENT( MIN ) ) THEN
4948 0 : TMP_MIN = MIN
4949 : ELSE
4950 : TMP_MIN = 0
4951 : ENDIF
4952 :
4953 : ! If SEC isn't passed, default to 0
4954 0 : IF ( PRESENT( SEC ) ) THEN
4955 0 : TMP_SEC = SEC
4956 : ELSE
4957 : TMP_SEC = 0
4958 : ENDIF
4959 :
4960 : ! Number of days since midnight on 1/1/1985
4961 0 : THIS_TAU0 = JULDAY( YEAR, MONTH, DBLE( DAY ) ) - 2446066.5d0
4962 :
4963 : ! Multiply by 24 to get hours since 1/1/1985
4964 : ! Also add in the hours elapsed since midnight on this date
4965 : THIS_TAU0 = ( THIS_TAU0 * 24d0 ) + ( TMP_HOUR ) + &
4966 0 : ( TMP_MIN / 60d0 ) + ( TMP_SEC / 3600d0 )
4967 :
4968 0 : END FUNCTION GET_TAU0
4969 : !------------------------------------------------------------------------------
4970 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
4971 : ! and NASA/GFSC, SIVO, Code 610.3 !
4972 : !------------------------------------------------------------------------------
4973 : !BOP
4974 : !
4975 : ! !IROUTINE: Nc_IsModelLevel
4976 : !
4977 : ! !DESCRIPTION: Function NC\_IsModelLevel returns true if (and only if) the
4978 : ! long name of the level variable name of the given file ID contains the
4979 : ! character "GEOS-Chem level".
4980 : !\\
4981 : !\\
4982 : ! !INTERFACE:
4983 : !
4984 0 : FUNCTION NC_IsModelLevel( fID, lev_name ) RESULT ( IsModelLevel )
4985 : !
4986 : ! !USES:
4987 : !
4988 : # include "netcdf.inc"
4989 : !
4990 : ! !INPUT PARAMETERS:
4991 : !
4992 : INTEGER, INTENT(IN) :: fID ! file ID
4993 : CHARACTER(LEN=*), INTENT(IN) :: lev_name ! level variable name
4994 : !
4995 : ! !RETURN VALUE:
4996 : !
4997 : LOGICAL :: IsModelLevel
4998 : !
4999 : ! !REVISION HISTORY:
5000 : ! 12 Dec 2014 - C. Keller - Initial version
5001 : ! See https://github.com/geoschem/ncdfutil for complete history
5002 : !EOP
5003 : !------------------------------------------------------------------------------
5004 : !BOC
5005 : !
5006 : ! !LOCAL VARIABLES:
5007 : !
5008 : LOGICAL :: HasLngN
5009 : CHARACTER(LEN=255) :: a_name, LngName
5010 : INTEGER :: a_type
5011 :
5012 : !=======================================================================
5013 : ! NC_IsModelLevel begins here!
5014 : !=======================================================================
5015 :
5016 : ! Init
5017 0 : IsModelLevel = .FALSE.
5018 :
5019 : ! Check if there is a long_name attribute
5020 0 : a_name = "long_name"
5021 0 : HasLngN = Ncdoes_Attr_Exist ( fId, TRIM(lev_name), TRIM(a_name), a_type )
5022 :
5023 : ! Only if attribute exists...
5024 0 : IF ( HasLngN ) THEN
5025 : ! Read attribute
5026 0 : CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), LngName )
5027 :
5028 : ! See if this is a GEOS-Chem model level
5029 0 : IF ( INDEX( TRIM(LngName), "GEOS-Chem level" ) > 0 ) THEN
5030 0 : IsModelLevel = .TRUE.
5031 : ENDIF
5032 : ENDIF
5033 :
5034 0 : END FUNCTION NC_IsModelLevel
5035 : !EOC
5036 : !------------------------------------------------------------------------------
5037 : ! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group !
5038 : ! and NASA/GFSC, SIVO, Code 610.3 !
5039 : !------------------------------------------------------------------------------
5040 : !BOP
5041 : !
5042 : ! !IROUTINE: Nc_IsSigmaLevel
5043 : !
5044 : ! !DESCRIPTION: Function NC\_IsSigmaLevels returns true if (and only if) the
5045 : ! long name of the level variable name of the given file ID contains the
5046 : ! character "atmospheric_hybrid_sigma_pressure_coordinate".
5047 : !\\
5048 : !\\
5049 : ! !INTERFACE:
5050 : !
5051 0 : FUNCTION NC_IsSigmaLevel( fID, lev_name ) RESULT ( IsSigmaLevel )
5052 : !
5053 : ! !USES:
5054 : !
5055 : # include "netcdf.inc"
5056 : !
5057 : ! !INPUT PARAMETERS:
5058 : !
5059 : INTEGER, INTENT(IN) :: fID ! file ID
5060 : CHARACTER(LEN=*), INTENT(IN) :: lev_name ! level variable name
5061 : !
5062 : ! !RETURN VALUE:
5063 : !
5064 : LOGICAL :: IsSigmaLevel
5065 : !
5066 : ! !REVISION HISTORY:
5067 : ! 12 Dec 2014 - C. Keller - Initial version
5068 : ! See https://github.com/geoschem/ncdfutil for complete history
5069 : !EOP
5070 : !------------------------------------------------------------------------------
5071 : !BOC
5072 : !
5073 : ! !LOCAL VARIABLES:
5074 : !
5075 : ! Scalars
5076 : LOGICAL :: found
5077 : INTEGER :: a_type
5078 :
5079 : ! Strings
5080 : CHARACTER(LEN=255) :: a_name
5081 : CHARACTER(LEN=255) :: a_val
5082 :
5083 : !=======================================================================
5084 : ! NC_IsSigmaLevel begins here!
5085 : !=======================================================================
5086 :
5087 : ! Initialize
5088 0 : IsSigmaLevel = .FALSE.
5089 :
5090 : ! Check if there is a long_name attribute
5091 0 : a_name = "standard_name"
5092 0 : found = Ncdoes_Attr_Exist( fId, TRIM(lev_name), TRIM(a_name), a_type )
5093 :
5094 : ! First check if the "standard_name" attribute exists
5095 0 : IF ( found ) THEN
5096 :
5097 : ! Read "standard_name" attribute
5098 0 : CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), a_val )
5099 :
5100 : ELSE
5101 :
5102 : ! If the "standard_name" attribute isn't found, try "long_name"
5103 0 : a_name = "long_name"
5104 0 : found = Ncdoes_Attr_Exist( fId, TRIM(lev_name), TRIM(a_name), a_type )
5105 :
5106 : ! Read "long_name" attribute
5107 0 : IF ( found ) THEN
5108 0 : CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), a_val )
5109 : ENDIF
5110 : ENDIF
5111 :
5112 : ! Test if the attribute value indicates a hybrid sigma-pressure grid
5113 0 : IF ( INDEX( TRIM( a_val ), &
5114 : "atmospheric_hybrid_sigma_pressure_coordinate" ) > 0 ) THEN
5115 0 : IsSigmaLevel = .TRUE.
5116 : ENDIF
5117 :
5118 0 : END FUNCTION NC_IsSigmaLevel
5119 : !EOC
5120 : END MODULE HCO_NCDF_MOD
|
