Line data Source code
1 : !BOC
2 : #if defined ( MODEL_GCCLASSIC ) || defined( MODEL_WRF ) || defined( MODEL_CESM ) || defined( HEMCO_STANDALONE )
3 : ! The 'standard' HEMCO I/O module is used for:
4 : ! - HEMCO Standalone (HEMCO_STANDALONE)
5 : ! - GEOS-Chem 'Classic' (MODEL_GCCLASSIC)
6 : ! - WRF-GC (MODEL_WRF)
7 : ! - CESM-GC and CAM-Chem / HEMCO-CESM (MODEL_CESM)
8 : !EOC
9 : !------------------------------------------------------------------------------
10 : ! Harmonized Emissions Component (HEMCO) !
11 : !------------------------------------------------------------------------------
12 : !BOP
13 : !
14 : ! !MODULE: hcoio_write_mod.F90
15 : !
16 : ! !DESCRIPTION: Module HCOIO\_write\_mod.F90 is the HEMCO data output
17 : ! interface for the 'standard' model environment. It contains routines to
18 : ! write out diagnostics into a netCDF file.
19 : !\\
20 : !\\
21 : ! !INTERFACE:
22 : !
23 : MODULE HCOIO_Write_Mod
24 : !
25 : ! !USES:
26 : !
27 : USE HCO_ERROR_MOD
28 : USE HCO_DIAGN_MOD
29 :
30 : IMPLICIT NONE
31 : PRIVATE
32 : !
33 : ! !PUBLIC MEMBER FUNCTIONS:
34 : !
35 : PUBLIC :: HCOIO_Write
36 : !
37 : ! !PRIVATE MEMBER FUNCTIONS:
38 : !
39 : PRIVATE :: ConstructTimeStamp
40 : !
41 : ! !REMARKS:
42 : ! HEMCO diagnostics are still in testing mode. We will fully activate them
43 : ! at a later time. They will be turned on when debugging & unit testing.
44 : !
45 : ! !REVISION HISTORY:
46 : ! 04 May 2014 - C. Keller - Initial version
47 : ! See https://github.com/geoschem/hemco for complete history
48 : !EOP
49 : !------------------------------------------------------------------------------
50 : !BOC
51 : !
52 : ! !DEFINED PARAMETERS:
53 : !
54 : ! Fill value used in HEMCO diagnostics netCDF files.
55 : ! REAL(hp), PARAMETER :: FillValue = 1.e-31_hp
56 : REAL(sp), PARAMETER :: FillValue = HCO_MISSVAL
57 :
58 : CONTAINS
59 : !EOC
60 : !------------------------------------------------------------------------------
61 : ! Harmonized Emissions Component (HEMCO) !
62 : !------------------------------------------------------------------------------
63 : !BOP
64 : !
65 : ! !IROUTINE: HCOIO_write_std
66 : !
67 : ! !DESCRIPTION: Subroutine HCOIO\_write\_std writes diagnostics to
68 : ! netCDF file. If the ForceWrite flag is set to TRUE, all diagnostics are
69 : ! written out except they have already been written out during this time
70 : ! step. This option is usually only used at the end of a simulation run.
71 : ! If ForceWrite is False, only the diagnostics that are at the end of their
72 : ! time averaging interval are written. For example, if the current month
73 : ! is different from the previous (emissions) month, all diagnostics with
74 : ! hourly, daily and monthly time averaging intervals are written out.
75 : ! If the optional argument OnlyIfFirst is set to TRUE, diagnostics will
76 : ! only be written out if its nnGetCalls is 1. This can be used to avoid
77 : ! that diagnostics will be written out twice. The nnGetCalls is reset to
78 : ! zero the first time a diagnostics is updated. For diagnostics that
79 : ! point to data stored somewhere else (i.e. that simply contain a data
80 : ! pointer, nnGetCalls is never reset and keeps counting.
81 : !\\
82 : !\\
83 : ! !INTERFACE:
84 : !
85 0 : SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, &
86 : RC, PREFIX, UsePrevTime, &
87 : OnlyIfFirst, COL )
88 : !
89 : ! !USES:
90 : !
91 : USE HCO_m_netCDF_io_define
92 : USE HCO_m_netcdf_io_read
93 : USE HCO_m_netcdf_io_open
94 : USE HCO_Ncdf_Mod, ONLY : NC_Open
95 : USE HCO_Ncdf_Mod, ONLY : NC_Read_Time
96 : USE HCO_Ncdf_Mod, ONLY : NC_Read_Arr
97 : USE HCO_Ncdf_Mod, ONLY : NC_Create
98 : USE HCO_Ncdf_Mod, ONLY : NC_Close
99 : USE HCO_Ncdf_Mod, ONLY : NC_Var_Def
100 : USE HCO_Ncdf_Mod, ONLY : NC_Var_Write
101 : USE HCO_Ncdf_Mod, ONLY : NC_Get_RefDateTime
102 : USE HCO_CHARPAK_Mod, ONLY : TRANLC
103 : USE HCO_Chartools_Mod, ONLY : HCO_CharParse
104 : USE HCO_State_Mod, ONLY : HCO_State
105 : USE HCO_JulDay_Mod, ONLY : JulDay
106 : USE HCO_EXTLIST_MOD, ONLY : GetExtOpt, CoreNr
107 : USE HCO_Types_Mod, ONLY : DiagnCont
108 : USE HCO_Clock_Mod
109 :
110 : ! Parameters for netCDF routines
111 : include "netcdf.inc"
112 : !
113 : ! !INPUT PARAMETERS:
114 : !
115 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object
116 : LOGICAL, INTENT(IN ) :: ForceWrite ! Write all diagnostics?
117 : CHARACTER(LEN=*), OPTIONAL, INTENT(IN ) :: PREFIX ! File prefix
118 : LOGICAL, OPTIONAL, INTENT(IN ) :: UsePrevTime ! Use previous time
119 : LOGICAL, OPTIONAL, INTENT(IN ) :: OnlyIfFirst ! Only write if nnDiagn is 1
120 : INTEGER, OPTIONAL, INTENT(IN ) :: COL ! Collection Nr.
121 : !
122 : ! !INPUT/OUTPUT PARAMETERS:
123 : !
124 :
125 : INTEGER, INTENT(INOUT) :: RC ! Failure or success
126 : !
127 : ! !REVISION HISTORY:
128 : ! 12 Sep 2013 - C. Keller - Initial version
129 : ! See https://github.com/geoschem/hemco for complete history
130 : !EOP
131 : !------------------------------------------------------------------------------
132 : !BOC
133 : !
134 : ! !LOCAL VARIABLES:
135 : !
136 : INTEGER :: I, PS, CNT, levIdTmp, indexL, indexR
137 : REAL(dp) :: GMT, JD1, JD1985, JD_DELTA, THISDAY, P0
138 : REAL(sp) :: TMP, JD_DELTA_RND
139 : INTEGER :: YYYY, MM, DD, h, m, s
140 0 : REAL(sp), POINTER :: nctime(:)
141 0 : REAL(dp), POINTER :: Arr1D(:)
142 0 : INTEGER, POINTER :: Int1D(:)
143 0 : REAL(sp), POINTER :: Arr3D(:,:,:)
144 0 : REAL(sp), POINTER :: Arr4D(:,:,:,:)
145 0 : REAL(sp), POINTER :: Arr4DOld(:,:,:,:)
146 0 : REAL*8, POINTER :: timeVec(:)
147 0 : REAL(hp), POINTER :: hyam(:)
148 0 : REAL(hp), POINTER :: hybm(:)
149 : TYPE(DiagnCont), POINTER :: ThisDiagn
150 : INTEGER :: FLAG
151 : CHARACTER(LEN=255) :: ncFile
152 : CHARACTER(LEN=255) :: Pfx, title, Reference, Contact
153 : CHARACTER(LEN=255) :: myLName, mySName, myFterm
154 : CHARACTER(LEN=255) :: MSG
155 : CHARACTER(LEN=255) :: RefTime
156 : CHARACTER(LEN=4 ) :: Yrs
157 : CHARACTER(LEN=2 ) :: Mts, Dys, hrs, mns
158 : CHARACTER(LEN=31) :: myName, myUnit, OutOper
159 : CHARACTER(LEN=63) :: timeunit
160 : INTEGER :: fId, lonId, latId, levId, TimeId
161 : INTEGER :: VarCt
162 : INTEGER :: nLon, nLat, nLev, nLevTmp, nTime
163 : INTEGER :: Prc, L
164 : INTEGER :: lymd, lhms
165 : INTEGER :: refYYYY, refMM, refDD, refh, refm, refs
166 : LOGICAL :: EOI, DoWrite, PrevTime, FOUND
167 : LOGICAL :: NoLevDim, DefMode
168 : LOGICAL :: IsOldFile
169 :
170 : CHARACTER(LEN=255), PARAMETER :: LOC = 'HCOIO_WRITE_STD (hcoio_write_std_mod.F90)'
171 :
172 : !=================================================================
173 : ! HCOIO_WRITE_STD begins here!
174 : !=================================================================
175 :
176 : ! Init
177 0 : RC = HCO_SUCCESS
178 0 : CNT = 0
179 0 : Arr1D => NULL()
180 0 : Int1D => NULL()
181 0 : Arr3D => NULL()
182 0 : Arr4D => NULL()
183 0 : Arr4DOld => NULL()
184 0 : timeVec => NULL()
185 0 : nctime => NULL()
186 0 : ThisDiagn => NULL()
187 :
188 : ! Collection number
189 0 : PS = HcoState%Diagn%HcoDiagnIDDefault
190 0 : IF ( PRESENT(COL) ) PS = COL
191 :
192 : ! Check if it's time to write out this collection. Also set the
193 : ! end-of-interval EOI flag accordingly. This will be used lateron
194 : ! when calling Diagn_Get. Since all diagnostic containers in a
195 : ! given collection have the same output frequency, this is somewhat
196 : ! redundant (because we already check here if it is time to write
197 : ! out this particular collection). Keep it here for backwards
198 : ! consistency (ckeller, 8/6/2015).
199 0 : IF ( ForceWrite ) THEN
200 0 : DoWrite = .TRUE.
201 0 : EOI = .FALSE.
202 : ELSE
203 0 : DoWrite = DiagnCollection_IsTimeToWrite( HcoState, PS )
204 0 : EOI = .TRUE.
205 : ENDIF
206 :
207 : ! Create current time stamps (to be used to archive time stamps)
208 : CALL HcoClock_Get( HcoState%Clock,sYYYY=YYYY,sMM=MM,&
209 0 : sDD=DD,sH=h,sM=m,sS=s,RC=RC)
210 0 : IF ( RC /= HCO_SUCCESS ) THEN
211 0 : CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
212 0 : RETURN
213 : ENDIF
214 0 : lymd = YYYY*10000 + MM*100 + DD
215 0 : lhms = h *10000 + m *100 + s
216 :
217 : ! Leave here if it's not time to write diagnostics. On the first
218 : ! time step, set lastYMD and LastHMS to current dates.
219 0 : IF ( .NOT. DoWrite ) THEN
220 0 : IF ( .NOT. DiagnCollection_LastTimesSet(HcoState%Diagn,PS) ) THEN
221 : CALL DiagnCollection_Set ( HcoState%Diagn, COL=PS, &
222 0 : LastYMD=lymd, LastHMS=lhms, RC=RC )
223 : ENDIF
224 0 : RETURN
225 : ENDIF
226 :
227 : ! Inherit precision from HEMCO
228 0 : Prc = HP
229 :
230 : ! Get PrevTime flag from input argument or set to default (=> TRUE)
231 0 : IF ( PRESENT(UsePrevTime) ) THEN
232 0 : PrevTime = UsePrevTime
233 : ELSE
234 0 : PrevTime = .TRUE.
235 : ENDIF
236 :
237 : !-----------------------------------------------------------------
238 : ! Don't define level dimension if there are no 3D fields to write
239 : ! This is an optional feature. By default, all diagnostics have
240 : ! the full dimension definitions (lon,lat,lev,time) even if all
241 : ! output fields are only 2D. If the flag DiagnNoLevDim is
242 : ! enabled, the lev dimension is not defined if there are no 3D
243 : ! fields on the file.
244 : !-----------------------------------------------------------------
245 0 : NoLevDim = .FALSE.
246 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnNoLevDim', &
247 0 : OptValBool=NoLevDim, Found=Found, RC=RC )
248 0 : IF ( RC /= HCO_SUCCESS ) THEN
249 0 : CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
250 0 : RETURN
251 : ENDIF
252 0 : IF ( Found ) THEN
253 0 : IF ( NoLevDim ) THEN
254 :
255 : ! Loop over all diagnostics to see if any is 3D
256 0 : ThisDiagn => NULL()
257 : DO WHILE ( .TRUE. )
258 :
259 : ! Get next diagnostics in list. This will return the next
260 : ! diagnostics container that contains content.
261 : CALL Diagn_Get ( HcoState, EOI, &
262 0 : ThisDiagn, FLAG, RC, COL=PS )
263 0 : IF ( RC /= HCO_SUCCESS ) THEN
264 0 : CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
265 0 : RETURN
266 : ENDIF
267 0 : IF ( FLAG /= HCO_SUCCESS ) EXIT
268 :
269 : ! If this is a 3D diagnostics, we must write the level
270 : ! coordinate
271 0 : IF ( ThisDiagn%SpaceDim == 3 ) THEN
272 0 : NoLevDim = .FALSE.
273 0 : EXIT
274 : ENDIF
275 : ENDDO
276 : ENDIF
277 : ENDIF
278 :
279 : !-----------------------------------------------------------------
280 : ! Create output file
281 : !-----------------------------------------------------------------
282 :
283 : ! Define grid dimensions
284 0 : nLon = HcoState%NX
285 0 : nLat = HcoState%NY
286 0 : nLev = HcoState%NZ
287 0 : nTime = 1
288 :
289 : ! Initialize mirror variables
290 0 : allocate(Arr4D(nlon,nlat,nlev,ntime))
291 0 : allocate(Arr3D(nlon,nlat,ntime))
292 0 : Arr3D = 0.0_sp
293 0 : Arr4D = 0.0_sp
294 :
295 : ! Construct filename: diagnostics will be written into file
296 : ! PREFIX.YYYYMMDDhm.nc, where PREFIX is the input argument or
297 : ! (if not present) obtained from the HEMCO configuration file.
298 : CALL ConstructTimeStamp ( HcoState, PS, PrevTime, &
299 0 : YYYY, MM, DD, h, m, RC )
300 0 : IF ( RC /= HCO_SUCCESS ) THEN
301 0 : CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
302 0 : RETURN
303 : ENDIF
304 :
305 : ! Write datetime
306 0 : WRITE( Yrs, '(i4.4)' ) YYYY
307 0 : WRITE( Mts, '(i2.2)' ) MM
308 0 : WRITE( Dys, '(i2.2)' ) DD
309 0 : WRITE( hrs, '(i2.2)' ) h
310 0 : WRITE( mns, '(i2.2)' ) m
311 :
312 : ! Get prefix
313 0 : IF ( PRESENT(PREFIX) ) THEN
314 0 : Pfx = PREFIX
315 : ELSE
316 0 : CALL DiagnCollection_Get( HcoState%Diagn, PS, PREFIX=Pfx, RC=RC )
317 0 : IF ( RC /= HCO_SUCCESS ) THEN
318 0 : CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
319 0 : RETURN
320 : ENDIF
321 : ENDIF
322 0 : ncFile = TRIM(Pfx)//'.'//Yrs//Mts//Dys//hrs//mns//'.nc'
323 :
324 : ! Multiple time slice update. Comment out for now since it causes
325 : ! timestamping the filename twice (ewl, 10/19/18)
326 : ! Add default time stamp if no time tokens are in the file template.
327 : ! This also ensures backward compatibility.
328 : !IF ( INDEX(TRIM(ncFile),'$') <= 0 ) THEN
329 : ! ncFile = TRIM(ncFile)//'.$YYYY$MM$DD$HH$MN.nc'
330 : !ENDIF
331 : !CALL HCO_CharParse ( HcoState%Config, ncFile, YYYY, MM, DD, h, m, RC )
332 : !IF ( RC /= HCO_SUCCESS ) RETURN
333 :
334 : ! Use filename prefix for title, replacing '_' with spaces
335 : ! NOTE: Prefix can only contain up to two underscores
336 0 : indexL = SCAN( Pfx, '_', .FALSE. ) ! Return left-most position
337 0 : indexR = SCAN( Pfx, '_', .TRUE. ) ! Return right-most position
338 0 : IF ( indexL > 0 .AND. indexR > 0 ) THEN
339 : title = Pfx(1:indexL-1) // ' ' // &
340 : Pfx(indexL+1:indexR-1) // ' ' // &
341 0 : Pfx(indexR+1:)
342 0 : ELSE IF ( indexL > 0 .AND. indexR == 0 ) THEN
343 0 : title = Pfx(1:indexL-1) // ' ' // Pfx(indexL+1:)
344 : ELSE
345 0 : title = Pfx
346 : ENDIF
347 :
348 : ! verbose
349 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. PS==1 ) THEN
350 0 : MSG = 'Write diagnostics into file '//TRIM(ncFile)
351 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
352 : ENDIF
353 0 : IF ( HCO_IsVerb(HcoState%Config%Err,3) .AND. PS==1 ) THEN
354 0 : WRITE(MSG,*) '--> write level dimension: ', .NOT.NoLevDim
355 0 : CALL HCO_MSG( HcoState%Config%Err, MSG )
356 : ENDIF
357 :
358 : ! Check if file already exists. If so, add new diagnostics to this file
359 : ! (instead of creating a new one)
360 0 : INQUIRE( FILE=ncFile, EXIST=IsOldFile )
361 :
362 : ! Disable multiple time slice update since causes an issue writing
363 : ! restart files. Re-enable when restart files are written via HISTORY
364 : ! rather than HEMCO by deleting the forcing of IsOldFile below.
365 : ! (ewl, 10/19/18)
366 0 : IsOldFile = .FALSE.
367 :
368 : ! If file exists, open file and get time dimension
369 : IF ( IsOldFile ) THEN
370 : CALL Ncop_Wr( fID, ncFile )
371 : CALL NC_READ_TIME( fID, ntime, timeunit, timeVec, RC=RC )
372 :
373 : ! new file will have one more time dimension
374 : ntime = ntime + 1
375 :
376 : ! Create output file
377 : ELSE
378 :
379 : ! Define a variable for the number of levels, which will either be -1
380 : ! (if all 2D data) or the number of levels in the grid (for 3D data).
381 0 : IF ( NoLevDim ) THEN
382 0 : nLevTmp = -1
383 : ELSE
384 0 : nLevTmp = nLev
385 : ENDIF
386 :
387 : ! Define extra metadata for global attributes
388 0 : Reference = 'http://wiki.geos-chem.org/The_HEMCO_Users_Guide'
389 0 : Contact = 'GEOS-Chem Support Team (geos-chem-support@as.harvard.edu)'
390 :
391 : ! Create output file
392 : ! Pass CREATE_NC4 to make file format netCDF-4 (mps, 3/3/16)
393 : ! Now create netCDF file with time dimension as UNLIMITED (bmy, 3/8/17)
394 : CALL NC_Create( NcFile = NcFile, &
395 : Title = Title, &
396 : Reference = Reference, &
397 : Contact = Contact, &
398 : nLon = nLon, &
399 : nLat = nLat, &
400 : nLev = nLevTmp, &
401 : nTime = NF_UNLIMITED, &
402 : fId = fId, &
403 : lonId = lonId, &
404 : latId = latId, &
405 : levId = levId, &
406 : timeId = timeId, &
407 : VarCt = VarCt, &
408 0 : CREATE_NC4 =.TRUE. )
409 :
410 : ENDIF
411 :
412 : !-----------------------------------------------------------------
413 : ! Write grid dimensions (incl. time)
414 : !-----------------------------------------------------------------
415 0 : IF ( .NOT. IsOldFile ) THEN
416 :
417 : ! Write longitude axis variable ("lon") to file
418 : CALL NC_Var_Def( fId = fId, &
419 : lonId = lonId, &
420 : latId = -1, &
421 : levId = -1, &
422 : timeId = -1, &
423 : VarName = 'lon', &
424 : VarLongName = 'Longitude', &
425 : VarUnit = 'degrees_east', &
426 : Axis = 'X', &
427 : DataType = dp, &
428 : VarCt = VarCt, &
429 0 : Compress = .TRUE. )
430 0 : ALLOCATE( Arr1D( nLon ) )
431 0 : Arr1D = HcoState%Grid%XMID%Val(:,1)
432 0 : CALL NC_Var_Write( fId, 'lon', Arr1D=Arr1D )
433 0 : DEALLOCATE( Arr1D )
434 :
435 : ! Write latitude axis variable ("lat") to file
436 : CALL NC_Var_Def( fId = fId, &
437 : lonId = -1, &
438 : latId = latId, &
439 : levId = -1, &
440 : timeId = -1, &
441 : VarName = 'lat', &
442 : VarLongName = 'Latitude', &
443 : VarUnit = 'degrees_north', &
444 : Axis = 'Y', &
445 : DataType = dp, &
446 : VarCt = VarCt, &
447 0 : Compress = .TRUE. )
448 0 : ALLOCATE( Arr1D( nLat ) )
449 0 : Arr1D = HcoState%Grid%YMID%Val(1,:)
450 0 : CALL NC_Var_Write( fId, 'lat', Arr1D=Arr1D )
451 0 : DEALLOCATE( Arr1D )
452 :
453 : ! Write vertical grid parameters to file (if necessary)
454 0 : IF ( .NOT. NoLevDim ) THEN
455 :
456 : ! Reference pressure [Pa]
457 0 : P0 = 1.0e+05_dp
458 :
459 : ! Allocate vertical coordinate arrays
460 0 : ALLOCATE( Arr1D( nLev ) )
461 0 : ALLOCATE( hyam ( nLev ) )
462 0 : ALLOCATE( hybm ( nLev ) )
463 :
464 : ! Construct vertical level coordinates
465 0 : DO L = 1, nLev
466 :
467 : ! A parameter at grid midpoints
468 0 : hyam(L) = ( HcoState%Grid%zGrid%Ap(L) &
469 0 : + HcoState%Grid%zGrid%Ap(L+1) ) * 0.5_dp
470 :
471 : ! B parameter at grid midpoints
472 0 : hybm(L) = ( HcoState%Grid%zGrid%Bp(L) &
473 0 : + HcoState%Grid%zGrid%Bp(L+1) ) * 0.5_dp
474 :
475 : ! Vertical level coordinate
476 0 : Arr1d(L) = ( hyam(L) / P0 ) + hybm(L)
477 :
478 : ENDDO
479 :
480 : ! Write level axis variable ("lev") to file
481 : ! Define extra metadata for calls to NC_Var_Def
482 0 : myLName = 'hybrid level at midpoints ((A/P0)+B)'
483 0 : mySName = 'atmosphere_hybrid_sigma_pressure_coordinate'
484 0 : myFTerm = 'a: hyai b: hybi p0: P0 ps: PS'
485 : CALL NC_Var_Def( fId = fId, &
486 : lonId = -1, &
487 : latId = -1, &
488 : levId = levId, &
489 : timeId = -1, &
490 : VarName = 'lev', &
491 : VarLongName = MyLName, &
492 : StandardName = MySName, &
493 : FormulaTerms = myFTerm, &
494 : VarUnit = 'level', &
495 : Axis = 'Z', &
496 : Positive = 'up', &
497 : DataType = dp, &
498 : VarCt = VarCt, &
499 0 : Compress = .TRUE. )
500 0 : CALL NC_Var_Write( fId, 'lev', Arr1D=Arr1D )
501 :
502 : ! Write hybrid A coordinate ("hyam") to file
503 : ! Define extra metadata for calls to NC_Var_Def
504 0 : myLName = 'hybrid A coefficient at layer midpoints'
505 : CALL NC_Var_Def( fId = fId, &
506 : lonId = -1, &
507 : latId = -1, &
508 : levId = levId, &
509 : timeId = -1, &
510 : VarName = 'hyam', &
511 : VarLongName = MyLName, &
512 : VarUnit = 'Pa', &
513 : DataType = dp, &
514 : VarCt = VarCt, &
515 0 : Compress = .TRUE. )
516 0 : CALL NC_Var_Write ( fId, 'hyam', Arr1D=hyam )
517 :
518 : ! Write hybrid B coordinate ("hybm") to file
519 : ! Define extra metadata for calls to NC_Var_Def
520 0 : myLName = 'hybrid B coefficient at layer midpoints'
521 : CALL NC_Var_Def( fId = fId, &
522 : lonId = -1, &
523 : latId = -1, &
524 : levId = levId, &
525 : timeId = -1, &
526 : VarName = 'hybm', &
527 : VarLongName = MyLName, &
528 : VarUnit = '1', &
529 : DataType = dp, &
530 : VarCt = VarCt, &
531 0 : Compress = .TRUE. )
532 0 : CALL NC_Var_Write( fId, 'hybm', Arr1D=hybm )
533 :
534 : ! Write out reference pressure (P0) to file
535 : CALL NC_Var_Def( fId = fId, &
536 : lonId = -1, &
537 : latId = -1, &
538 : levId = -1, &
539 : timeId = -1, &
540 : VarName = 'P0', &
541 : VarLongName = 'Reference pressure', &
542 : VarUnit = 'Pa', &
543 : DataType = dp, &
544 : VarCt = VarCt, &
545 0 : Compress = .TRUE. )
546 0 : CALL NC_Var_Write( fId, 'P0', P0 )
547 :
548 : ! Deallocate arrays
549 0 : DEALLOCATE( Arr1d )
550 0 : DEALLOCATE( hyam )
551 0 : DEALLOCATE( hybm )
552 :
553 : ENDIF
554 : ENDIF
555 :
556 : !------------------------------------------------------------------------
557 : ! Write time axis variable ("time") to file
558 : !------------------------------------------------------------------------
559 :
560 : ! JD1 is the julian day of the data slice
561 0 : GMT = REAL(h,dp) + (REAL(m,dp)/60.0_dp) + (REAL(s,dp)/3600.0_dp)
562 0 : THISDAY = DD + ( GMT / 24.0_dp )
563 0 : JD1 = JULDAY ( YYYY, MM, THISDAY )
564 :
565 : ! Check if reference time is given in HEMCO configuration file
566 : CALL GetExtOpt ( HcoState%Config, CoreNr, 'DiagnRefTime', &
567 0 : OptValChar=RefTime, Found=Found, RC=RC )
568 0 : IF ( RC /= HCO_SUCCESS ) THEN
569 0 : CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
570 0 : RETURN
571 : ENDIF
572 :
573 : ! Use specified reference time (if available)
574 0 : IF ( Found ) THEN
575 0 : timeunit = ADJUSTL(TRIM(RefTime))
576 0 : CALL TRANLC( timeunit )
577 : CALL NC_GET_REFDATETIME( timeunit, refYYYY, refMM, refDD, refh, &
578 0 : refm, refs, RC )
579 0 : refs = 0
580 0 : IF ( RC /= HCO_SUCCESS ) THEN
581 0 : CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
582 0 : RETURN
583 : ENDIF
584 : GMT = REAL(MAX(refh,0),dp) + (REAL(MAX(refm,0),dp)/60.0_dp) + &
585 0 : (REAL(MAX(refs,0),dp)/3600.0_dp)
586 0 : THISDAY = refDD + ( GMT / 24.0_dp )
587 0 : JD1985 = JULDAY ( refYYYY, refMM, THISDAY )
588 :
589 : ! Use current time if not found
590 : ELSE
591 0 : WRITE(timeunit,100) YYYY,MM,DD,h,m,s
592 0 : JD1985 = JD1
593 : ENDIF
594 : 100 FORMAT ( 'hours since ',i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':',i2.2,' GMT' )
595 :
596 : ! Calculate time value
597 0 : JD_DELTA = (JD1 - JD1985 )
598 :
599 : ! Default is 'days since'. Adjust for 'hours since', 'minutes since',
600 : ! 'seconds since'.
601 0 : IF ( timeunit(1:4) == 'days' ) THEN
602 : ! all ok
603 0 : ELSEIF ( timeunit(1:5) == 'hours' ) THEN
604 0 : JD_DELTA = JD_DELTA * 24.0_dp
605 0 : ELSEIF ( timeunit(1:7) == 'minutes' ) THEN
606 0 : JD_DELTA = JD_DELTA * 24.0_dp * 60.0_dp
607 0 : ELSEIF ( timeunit(1:7) == 'seconds' ) THEN
608 0 : JD_DELTA = JD_DELTA * 24.0_dp * 3600.0_dp
609 : ELSE
610 : MSG = 'Unrecognized output reference time, will ' // &
611 0 : 'assume `days since`: '//TRIM(timeunit)
612 0 : CALL HCO_WARNING( MSG, WARNLEV=2, THISLOC=LOC, RC=RC )
613 : ENDIF
614 :
615 : ! Special case where we have an old file but it has the same time stamp: in
616 : ! that case simply overwrite the current values
617 : ! Comment out code for single precision rounded time (ewl, 10/18/18)
618 : !IF ( IsOldFile .AND. ntime == 2 .AND. timeVec(1) == JD_DELTA_RND ) THEN
619 0 : IF ( IsOldFile .AND. ntime == 2 ) THEN
620 0 : IF ( timeVec(1) == JD_DELTA ) THEN
621 0 : ntime = 1
622 : ENDIF
623 : ENDIF
624 0 : ALLOCATE( nctime(ntime) )
625 0 : IF ( IsOldFile .AND. ntime > 1 ) THEN
626 0 : nctime(1:ntime-1) = timeVec(:)
627 : ENDIF
628 0 : nctime(ntime) = JD_DELTA
629 :
630 0 : IF ( .NOT. IsOldFile ) THEN
631 : CALL NC_Var_Def( fId = fId, &
632 : lonId = -1, &
633 : latId = -1, &
634 : levId = -1, &
635 : timeId = timeId, &
636 : VarName = 'time', &
637 : VarLongName = 'Time', &
638 : VarUnit = TimeUnit, &
639 : Axis = 'T', &
640 : Calendar = 'gregorian', &
641 : DataType = 8, &
642 : VarCt = VarCt, &
643 0 : Compress = .TRUE. )
644 : ENDIF
645 0 : CALL NC_VAR_WRITE( fId, 'time', Arr1D=nctime )
646 0 : DEALLOCATE( nctime )
647 0 : IF ( ASSOCIATED(timeVec) ) DEALLOCATE( timeVec )
648 :
649 : !-----------------------------------------------------------------
650 : ! Write out grid box areas
651 : !-----------------------------------------------------------------
652 :
653 0 : IF ( .NOT. IsOldFile ) THEN
654 : CALL NC_Var_Def( fId = fId, &
655 : lonId = lonId, &
656 : latId = latId, &
657 : levId = -1, &
658 : timeId = -1, &
659 : VarName = 'AREA', &
660 : VarLongName = 'Grid box area', &
661 : VarUnit = 'm2', &
662 : DataType = Prc, &
663 : VarCt = VarCt, &
664 0 : Compress = .TRUE. )
665 0 : CALL NC_Var_Write ( fId, 'AREA', Arr2D=HcoState%Grid%Area_M2%Val )
666 : ENDIF
667 :
668 : !-----------------------------------------------------------------
669 : ! Write diagnostics
670 : !-----------------------------------------------------------------
671 :
672 : ! Run this section twice, first in define mode for metadata, then in
673 : ! data mode to write variables
674 0 : DO I=1,2
675 :
676 : ! Skip definition mode for existing file
677 0 : IF ( I==1 .AND. IsOldFile ) CYCLE
678 :
679 0 : IF (I==1) THEN
680 : ! Open netCDF define mode
681 0 : CALL NcBegin_Def( fID )
682 0 : DefMode=.TRUE.
683 : ELSE
684 : ! IF ( .NOT. IsOldFile ) THEN
685 : ! Close netCDF define mode
686 0 : CALL NcEnd_Def( fID )
687 : ! ENDIF
688 0 : DefMode=.False.
689 : ENDIF
690 :
691 : ! Loop over all diagnostics in diagnostics list
692 0 : ThisDiagn => NULL()
693 0 : DO WHILE ( .TRUE. )
694 :
695 : ! Get next diagnostics in list. This will return the next
696 : ! diagnostics container that contains content.
697 0 : CALL Diagn_Get ( HcoState, EOI, ThisDiagn, FLAG, RC, COL=PS )
698 0 : IF ( RC /= HCO_SUCCESS ) THEN
699 0 : CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
700 0 : RETURN
701 : ENDIF
702 0 : IF ( FLAG /= HCO_SUCCESS ) EXIT
703 :
704 : ! Only write diagnostics if this is the first Diagn_Get call for
705 : ! this container and time step.
706 0 : IF ( PRESENT( OnlyIfFirst ) ) THEN
707 0 : IF ( OnlyIfFirst .AND. ThisDiagn%nnGetCalls > 1 ) CYCLE
708 : ENDIF
709 :
710 : ! Define variable
711 0 : myName = ThisDiagn%cName
712 0 : myUnit = ThisDiagn%OutUnit
713 0 : IF ( ThisDiagn%SpaceDim == 3 ) THEN
714 0 : levIdTmp = levId
715 : ELSE
716 0 : levIdTmp = -1
717 : ENDIF
718 :
719 : ! Error check: this should never happen!
720 0 : IF ( levIdTmp > 0 .AND. NoLevDim ) THEN
721 : MSG = 'Level dimension undefined but 3D container found: ' &
722 0 : // TRIM(myName)
723 0 : CALL HCO_ERROR(MSG,RC,THISLOC=LOC)
724 0 : RETURN
725 : ENDIF
726 :
727 0 : IF (DefMode) THEN
728 :
729 : !------------------------------------
730 : ! Define variables in define mode
731 : !------------------------------------
732 :
733 : ! Define variable as single precision
734 : CALL NC_Var_Def( fId = fId, &
735 : lonId = lonId, &
736 : latId = latId, &
737 : levId = levIdTmp, &
738 : timeId = timeId, &
739 : VarName = TRIM(myName), &
740 : VarLongName = ThisDiagn%long_name, &
741 : VarUnit = TRIM(myUnit), &
742 : AvgMethod = ThisDiagn%AvgName, &
743 : MissingValue = FillValue, &
744 : DataType = sp, &
745 : VarCt = VarCt, &
746 : DefMode = DefMode, &
747 0 : Compress = .True. )
748 :
749 : ELSE
750 :
751 : !------------------------------------
752 : ! Write variables in data mode
753 : !------------------------------------
754 :
755 0 : IF ( IsOldFile .AND. ntime > 1 ) THEN
756 0 : IF ( ThisDiagn%SpaceDim == 3 ) THEN
757 : CALL NC_READ_ARR( fID, TRIM(myName), 1, nlon, 1, nlat, &
758 0 : 1, nlev, 1, ntime-1, ncArr=Arr4DOld, RC=RC )
759 0 : Arr4D(:,:,:,1:ntime-1) = Arr4DOld(:,:,:,:)
760 : ELSE
761 : CALL NC_READ_ARR( fID, TRIM(myName), 1, nlon, 1, nlat, &
762 0 : -1, -1, 1, ntime-1, ncArr=Arr4DOld, RC=RC )
763 0 : Arr3D(:,:,1:ntime-1) = Arr4DOld(:,:,1,:)
764 : ENDIF
765 0 : IF ( ASSOCIATED(Arr4DOld) ) DEALLOCATE(Arr4DOld)
766 : ENDIF
767 :
768 : ! Mirror data and write to file. The mirroring is required in
769 : ! order to add the time dimension. Otherwise, the data would
770 : ! have no time information!
771 0 : IF ( ThisDiagn%SpaceDim == 3 ) THEN
772 0 : IF ( ASSOCIATED(ThisDiagn%Arr3D) ) THEN
773 0 : Arr4D(:,:,:,ntime) = ThisDiagn%Arr3D%Val
774 0 : Arr4D(:,:,:,1) = ThisDiagn%Arr3D%Val
775 : ENDIF
776 0 : CALL NC_VAR_WRITE ( fId, TRIM(myName), Arr4D=Arr4D )
777 : ELSE
778 0 : IF ( ASSOCIATED(ThisDiagn%Arr2D) ) THEN
779 0 : Arr3D(:,:,ntime) = ThisDiagn%Arr2D%Val
780 0 : Arr3D(:,:,1) = ThisDiagn%Arr2D%Val
781 : ENDIF
782 0 : CALL NC_VAR_WRITE ( fId, TRIM(myName), Arr3D=Arr3D )
783 : ENDIF
784 :
785 : ! verbose
786 0 : IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. PS==1 ) THEN
787 0 : MSG = '--- Added diagnostics: '//TRIM(myName)
788 0 : CALL HCO_MSG(HcoState%Config%Err,MSG)
789 : ENDIF
790 : ENDIF
791 : ENDDO
792 : ENDDO
793 :
794 : !-----------------------------------------------------------------
795 : ! Cleanup
796 : !-----------------------------------------------------------------
797 :
798 : ! Close file
799 0 : CALL NC_CLOSE ( fId )
800 :
801 : ! Cleanup local variables
802 0 : Deallocate(Arr3D,Arr4D)
803 0 : ThisDiagn => NULL()
804 :
805 : ! Archive time stamp
806 : CALL DiagnCollection_Set ( HcoState%Diagn, COL=PS, &
807 0 : LastYMD=lymd, LastHMS=lhms, RC=RC )
808 :
809 : ! Return
810 0 : RC = HCO_SUCCESS
811 :
812 0 : END SUBROUTINE HCOIO_Write
813 : !EOC
814 : !------------------------------------------------------------------------------
815 : ! Harmonized Emissions Component (HEMCO) !
816 : !------------------------------------------------------------------------------
817 : !BOP
818 : !
819 : ! !IROUTINE: ConstructTimeStamp
820 : !
821 : ! !DESCRIPTION: Subroutine ConstructTimeStamp is a helper routine to construct
822 : ! the time stamp of a given diagnostics collection.
823 : !\\
824 : !\\
825 : ! !INTERFACE:
826 : !
827 0 : SUBROUTINE ConstructTimeStamp ( HcoState, PS, PrevTime, Yr, Mt, Dy, hr, mn, RC )
828 : !
829 : ! !USES:
830 : !
831 : USE HCO_State_Mod, ONLY : HCO_State
832 : USE HCO_Clock_Mod
833 : USE HCO_JULDAY_MOD
834 : !
835 : ! !INPUT/OUTPUT PARAMETERS:
836 : !
837 : TYPE(HCO_State), POINTER :: HcoState ! HEMCO state obj
838 : INTEGER, INTENT(IN ) :: PS ! collecion ID
839 : LOGICAL, INTENT(IN ) :: PrevTime ! Use previous time?
840 : !
841 : ! !INPUT/OUTPUT PARAMETERS:
842 : !
843 : INTEGER, INTENT(INOUT) :: RC ! Return code
844 : !
845 : ! !OUTPUT PARAMETERS:
846 : !
847 : INTEGER, INTENT( OUT) :: Yr
848 : INTEGER, INTENT( OUT) :: Mt
849 : INTEGER, INTENT( OUT) :: Dy
850 : INTEGER, INTENT( OUT) :: hr
851 : INTEGER, INTENT( OUT) :: mn
852 : !
853 : ! !REVISION HISTORY:
854 : ! 06 Nov 2015 - C. Keller - Initial version
855 : ! See https://github.com/geoschem/hemco for complete history
856 : !EOP
857 : !------------------------------------------------------------------------------
858 : !BOC
859 : !
860 : ! !LOCAL VARIABLES:
861 : !
862 : INTEGER :: Y2, M2, D2, h2, n2, s2
863 : INTEGER :: Y1, M1, D1, h1, n1, s1
864 : INTEGER :: LastYMD, LastHMS
865 : INTEGER :: YYYYMMDD, HHMMSS
866 : INTEGER :: OutTimeStamp
867 : REAL(dp) :: DAY, UTC, JD1, JD2, JDMID
868 : CHARACTER(LEN=255) :: MSG
869 : CHARACTER(LEN=255) :: LOC = 'ConstuctTimeStamp (hcoi_diagn_mod.F90)'
870 :
871 : !=================================================================
872 : ! ConstructTimeStamp begins here!
873 : !=================================================================
874 :
875 : ! Use HEMCO clock to create timestamp used in filename. Use previous
876 : ! time step if this option is selected.
877 0 : IF ( .NOT. PrevTime ) THEN
878 : CALL HcoClock_Get(HcoState%Clock,sYYYY=Y2,sMM=M2,&
879 0 : sDD=D2,sH=h2,sM=n2,sS=s2,RC=RC)
880 0 : IF ( RC /= HCO_SUCCESS ) THEN
881 0 : CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
882 0 : RETURN
883 : ENDIF
884 : ELSE
885 : CALL HcoClock_Get(HcoState%Clock,pYYYY=Y2,pMM=M2,&
886 0 : pDD=D2,pH=h2,pM=n2,pS=s2,RC=RC)
887 0 : IF ( RC /= HCO_SUCCESS ) THEN
888 0 : CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
889 0 : RETURN
890 : ENDIF
891 : ENDIF
892 :
893 : ! Get timestamp location for this collection
894 : CALL DiagnCollection_Get( HcoState%Diagn, PS, OutTimeStamp=OutTimeStamp, &
895 0 : LastYMD=LastYMD, LastHMS=LastHMS, RC=RC )
896 0 : IF ( RC /= HCO_SUCCESS ) THEN
897 0 : CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
898 0 : RETURN
899 : ENDIF
900 :
901 : ! Determine dates to be used:
902 :
903 : ! To use start date
904 0 : IF ( OutTimeStamp == HcoDiagnStart ) THEN
905 0 : Yr = FLOOR( MOD(LastYMD*1.d0, 100000000.d0 ) / 1.0d4 )
906 0 : Mt = FLOOR( MOD(LastYMD*1.d0, 10000.d0 ) / 1.0d2 )
907 0 : Dy = FLOOR( MOD(LastYMD*1.d0, 100.d0 ) / 1.0d0 )
908 0 : Hr = FLOOR( MOD(LastHMS*1.d0, 1000000.d0 ) / 1.0d4 )
909 0 : Mn = FLOOR( MOD(LastHMS*1.d0, 10000.d0 ) / 1.0d2 )
910 :
911 : ! Use mid point
912 0 : ELSEIF ( OutTimeStamp == HcoDiagnMid ) THEN
913 :
914 : ! Julian day of start interval:
915 0 : Y1 = FLOOR( MOD(LastYMD*1.d0, 100000000.d0 ) / 1.0d4 )
916 0 : M1 = FLOOR( MOD(LastYMD*1.d0, 10000.d0 ) / 1.0d2 )
917 0 : D1 = FLOOR( MOD(LastYMD*1.d0, 100.d0 ) / 1.0d0 )
918 0 : h1 = FLOOR( MOD(LastHMS*1.d0, 1000000.d0 ) / 1.0d4 )
919 0 : n1 = FLOOR( MOD(LastHMS*1.d0, 10000.d0 ) / 1.0d2 )
920 0 : s1 = FLOOR( MOD(LastHMS*1.d0, 100.d0 ) / 1.0d0 )
921 :
922 : UTC = ( REAL(h1,dp) / 24.0_dp ) + &
923 : ( REAL(n1,dp) / 1440.0_dp ) + &
924 0 : ( REAL(s1,dp) / 86400.0_dp )
925 0 : DAY = REAL(D1,dp) + UTC
926 0 : JD1 = JULDAY( Y1, M1, DAY )
927 :
928 : ! Julian day of end interval:
929 : UTC = ( REAL(h2,dp) / 24.0_dp ) + &
930 : ( REAL(n2,dp) / 1440.0_dp ) + &
931 0 : ( REAL(s2,dp) / 86400.0_dp )
932 0 : DAY = REAL(D2,dp) + UTC
933 0 : JD2 = JULDAY( Y2, M2, DAY )
934 :
935 : ! Julian day in the middle
936 0 : JDMID = ( JD1 + JD2 ) / 2.0_dp
937 :
938 : ! Tranlate back into dates
939 0 : CALL CALDATE( JDMID, YYYYMMDD, HHMMSS )
940 0 : Yr = FLOOR ( MOD( YYYYMMDD, 100000000) / 1.0e4_dp )
941 0 : Mt = FLOOR ( MOD( YYYYMMDD, 10000 ) / 1.0e2_dp )
942 0 : Dy = FLOOR ( MOD( YYYYMMDD, 100 ) / 1.0e0_dp )
943 0 : Hr = FLOOR ( MOD( HHMMSS, 1000000 ) / 1.0e4_dp )
944 0 : Mn = FLOOR ( MOD( HHMMSS, 10000 ) / 1.0e2_dp )
945 :
946 : ! Otherwise, use end date
947 : ELSE
948 0 : Yr = Y2
949 0 : Mt = M2
950 0 : Dy = D2
951 0 : Hr = h2
952 0 : Mn = n2
953 : ENDIF
954 :
955 : ! Return w/ success
956 0 : RC = HCO_SUCCESS
957 :
958 : END SUBROUTINE ConstructTimeStamp
959 : !EOC
960 : END MODULE HCOIO_WRITE_MOD
961 : #endif
|