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