From 8acf79eb17b5619fa47f4c4b2c034f82a32a78fd Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 12 Jul 2022 13:41:23 -0400 Subject: [PATCH 01/63] Bug fix: HEMCO masks specified box limits should not be read from disk src/Core/hco_config_mod.F90 - Add an IF block to handle the case of HEMCO masks that are specified as lon1/lat1/lon2/lat2. For these masks, we flag them as not to be read from disk (Lct%Dct%Dta%ncRead=.FALSE.) and that they are in local time (Lct%Dct%Dta%IsLocTime=.TRUE.) src/Core/hcoio_read_std_mod.F90 - Add an IF block that returns from routine HCOIO_Read for HEMCO masks specified as lon1/lat1/lon2/lat2. This commit should fix the issue raised in geoschem/HEMCO #153. Signed-off-by: Bob Yantosca --- src/Core/hco_config_mod.F90 | 11 +++++++++++ src/Core/hcoio_read_std_mod.F90 | 8 ++++++++ 2 files changed, 19 insertions(+) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index bee7fd7e..b7984cdd 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -2271,6 +2271,17 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) lon2 = Lct%Dct%Dta%ncMts(1) lat2 = Lct%Dct%Dta%ncMts(2) + ! If ncFile is passed as the lon1/lat1/lon2/lat2 instead + ! of netCDF file name, then set ncRead to false, so that + ! HEMCO won't try to read a file from disk. Also set the + ! IsLocTime flag to TRUE. This should fix Github issue + ! https://github.com/geoschem/HEMCO/issues/153. + ! -- Bob Yantosca (12 Jul 2022) + IF ( INDEX( Lct%Dct%Dta%ncFile, ".nc" ) == 0 ) THEN + Lct%Dct%Dta%ncRead = .FALSE. + Lct%Dct%Dta%IsLocTime = .TRUE. + ENDIF + ThisCover = CALC_COVERAGE( lon1, lon2, & lat1, lat2, & cpux1, cpux2, & diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 7bfb6b5a..8d554d4c 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -202,6 +202,14 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) !================================================================= LOC = 'HCOIO_READ (HCOIO_READ_STD_MOD.F90)' + ! Do not try to read a mask file where the mask bounding box limits + ! are given in the srcFile location, as there is no file to read. + ! This should fix https://github.com/geoschem/HEMCO/issues/153. + ! -- Bob Yantosca (12 Jul 2022) + IF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN + IF ( .not. Lct%Dct%Dta%ncRead ) RETURN + ENDIF + ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN From b1c9c6f37ba0a073b28bec3ec6c0d70f2f36b8a8 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 6 Dec 2022 15:59:29 -0500 Subject: [PATCH 02/63] Now print "data is treated as unitless" only when as debug output src/Core/hcoio_read_std_mod.F90 - Change warnlev from 1 to 2 in the call to HCO_Warning. This will only print the "data is treated as unitless" warning if "Warnings: 2" is defined in HEMCO_Config.rc. - TODO: Combine Verbose and Warnings into a single logical toggle. Signed-off-by: Bob Yantosca --- src/Core/hcoio_read_std_mod.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 7bfb6b5a..85a102ba 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -1094,10 +1094,11 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ! Prompt a warning if thisUnit is not recognized as unitless. + ! TODO: Merge warnings w/ verbose, and toggle with a simple on/off IF ( Flag /= 0 ) THEN MSG = 'Data is treated as unitless, but file attribute suggests ' // & 'it is not: ' // TRIM(thisUnit) // '. File: ' // TRIM(srcFile) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2 ) ENDIF ! Verbose mode From bc9c2e5cea277eec5164477e82f01d118edd5d3c Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 6 Dec 2022 16:58:30 -0500 Subject: [PATCH 03/63] Updates to hco_error_mod.F90 to facilitate reduction of logfile output src/Core/hco_error_mod.F90 - Define HCO_IsVerb as an interface of 2 overloaded subroutines (one that takes the VerbNr argument and one that does not). This will facilitate combining the Verbose and Warnings toggles into a single logical switch. - The HCO_IsVerb* routines have been rewritten to avoid ELSE statements, which is more computationally efficient. - Routine HCO_MsgErr now will only print the passed string if Verbose >= 3. - Also use WRITE( 6, '(a)' ) statements instead of PRINT*, so as to line up the printout with the first column. - Cosmetic changes Signed-off-by: Bob Yantosca --- src/Core/hco_error_mod.F90 | 158 +++++++++++++++++++++++++++---------- 1 file changed, 118 insertions(+), 40 deletions(-) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 734dc0cb..7ff4502c 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -113,6 +113,12 @@ MODULE HCO_Error_Mod MODULE PROCEDURE HCO_MsgNoErr MODULE PROCEDURE HCO_MsgErr END INTERFACE HCO_MSG + + INTERFACE HCO_IsVerb + MODULE PROCEDURE HCO_IsVerb_NoVerbNr + MODULE PROCEDURE HCO_IsVerb_VerbNr + END INTERFACE HCO_IsVerb + ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -455,11 +461,16 @@ SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2, Verb ) ! Don't print if this is not the root CPU IF ( .NOT. Err%IsRoot ) RETURN - ! Don't print if verbose level is smaller than verbose level of this - ! CPU. - IF ( PRESENT( Verb ) ) THEN - IF ( Verb < Err%Verbose ) RETURN - ENDIF + !---------------------------------------------------------------------- + ! REDUCE LOGFILE OUTPUT: Only print if VERBOSE=3 + ! TODO: Convert VERBOSE from integer to a logical on/off switch + !! Don't print if verbose level is smaller than verbose level of this + !! CPU. + !IF ( PRESENT( Verb ) ) THEN + ! IF ( Verb < Err%Verbose ) RETURN + !ENDIF + !---------------------------------------------------------------------- + IF ( .not. HCO_IsVerb( Err ) ) RETURN ENDIF ! Use standard output if file not open @@ -472,25 +483,23 @@ SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2, Verb ) IF (LUN > 0 ) THEN IF ( PRESENT(SEP1) ) THEN - WRITE(LUN,'(a)') REPEAT( SEP1, 79) + WRITE( LUN,'(a)' ) REPEAT( SEP1, 79 ) ENDIF IF ( PRESENT(MSG) ) THEN -! WRITE(LUN,*) TRIM(MSG) - WRITE(LUN,'(a)') TRIM(MSG) + WRITE( LUN,'(a)' ) TRIM( MSG ) ENDIF IF ( PRESENT(SEP2) ) THEN - WRITE(LUN,'(a)') REPEAT( SEP2, 79) + WRITE( LUN,'(a)' ) REPEAT( SEP2, 79 ) ENDIF ELSE IF ( PRESENT(SEP1) ) THEN - WRITE(*,'(a)') REPEAT( SEP1, 79) + WRITE( 6, '(a)' ) REPEAT( SEP1, 79 ) ENDIF IF ( PRESENT(MSG) ) THEN -! WRITE(*,*) TRIM(MSG) - WRITE(*,'(a)') TRIM(MSG) + WRITE( 6, '(a)' ) TRIM( MSG ) ENDIF IF ( PRESENT(SEP2) ) THEN - WRITE(*,'(a)') REPEAT( SEP2, 79) + WRITE( 6, '(a)' ) REPEAT( SEP2, 79 ) ENDIF ENDIF ENDIF @@ -535,12 +544,21 @@ SUBROUTINE HCO_MSGnoErr( Msg, Sep1, Sep2, Verb ) ! HCO_MSG begins here !====================================================================== - IF ( PRESENT(SEP1) ) THEN - WRITE(*,'(a)') REPEAT( SEP1, 79) + !---------------------------------------------------------------------- + ! REDUCE LOGFILE OUTPUT: Only print if VERBOSE=3 + ! TODO: Convert VERBOSE from integer to a logical on/off switch + ! -- Bob Yantosca (05 Dec 2022) + IF ( Verb < 3 ) RETURN + !---------------------------------------------------------------------- + + IF ( PRESENT( SEP1 ) ) THEN + WRITE( 6,'(a)' ) REPEAT( SEP1, 79 ) + ENDIF + IF ( PRESENT( msg ) ) THEN + WRITE( 6, '(a)' ) TRIM( msg ) ENDIF - IF ( PRESENT(MSG) ) PRINT *, TRIM(MSG) - IF ( PRESENT(SEP2) ) THEN - WRITE(*,'(a)') REPEAT( SEP2, 79) + IF ( PRESENT( SEP2 ) ) THEN + WRITE( 6,'(a)' ) REPEAT( SEP2, 79 ) ENDIF END SUBROUTINE HCO_MsgNoErr @@ -607,7 +625,7 @@ SUBROUTINE HCO_Enter( Err, thisLoc, RC ) Err%Loc(Err%CurrLoc) = thisLoc ! Track location if enabled - IF ( Err%Verbose >= 3 ) THEN + IF ( HCO_IsVerb( Err ) ) THEN WRITE(MSG,100) TRIM(thisLoc), Err%CurrLoc CALL HCO_Msg( Err, MSG ) ENDIF @@ -659,7 +677,7 @@ SUBROUTINE HCO_Leave( Err, RC ) IF ( .NOT. ASSOCIATED(Err) ) RETURN ! Track location if enabled - IF ( Err%Verbose >= 3 ) THEN + IF ( HCO_IsVerb( Err ) ) THEN WRITE(MSG,110) TRIM(Err%Loc(Err%CurrLoc)), Err%CurrLoc CALL HCO_MSG( Err, MSG ) ENDIF @@ -858,15 +876,59 @@ END FUNCTION HCO_VERBOSE_INQ !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: HCO_IsVerb +! !IROUTINE: HCO_IsVerb_NoVerbNr +! +! !DESCRIPTION: Returns true if the HEMCO verbose number is set to 3 or larger. +! Does not use an "Verb" argument +!\\ +!\\ +! !INTERFACE: +! + FUNCTION HCO_IsVerb_NoVerbNr( Err ) RESULT ( IsVerb ) +! +! !INPUT PARAMETERS: +! + TYPE(HcoErr), POINTER :: Err ! Error object +! +! !OUTPUT PARAMETERS: +! + LOGICAL :: isVerb +! +! !REMARKS: +! TODO: Convert VERBOSE to a simple logical on/off switch. +!EOP +!------------------------------------------------------------------------------ +!BOC + + !====================================================================== + ! HCO_IsVerb begins here + !====================================================================== + + ! Initialize + isVerb = .FALSE. + + ! Return if the Err object is null + IF ( .not. ASSOCIATED( Err ) ) RETURN + + ! Check if "Verbose: 3" was set in the HEMCO_Config.rc file + isVerb = ( Err%Verbose >= 3 ) + + END FUNCTION HCO_IsVerb_NoVerbNr +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCO_IsVerb_VerbNr ! -! !DESCRIPTION: Function HCO\_IsVerb returns true if the HEMCO verbose number -! is equal to or larger than the passed number. +! !DESCRIPTION: Function HCO\_IsVerb\_VerbNr returns true if the HEMCO +! verbose number is equal to or larger than the passed number. !\\ !\\ ! !INTERFACE: ! - FUNCTION HCO_IsVerb ( Err, VerbNr ) RESULT ( IsVerb ) + FUNCTION HCO_IsVerb_VerbNr( Err, VerbNr ) RESULT ( IsVerb ) ! ! !INPUT PARAMETERS: ! @@ -877,6 +939,9 @@ FUNCTION HCO_IsVerb ( Err, VerbNr ) RESULT ( IsVerb ) ! LOGICAL :: IsVerb ! +! !REMARKS: +! HCO_IsVerb will be phased out and replaced by HCO_IsVerbose. +! ! !REVISION HISTORY: ! 15 Mar 2015 - C. Keller - Initialization ! See https://github.com/geoschem/hemco for complete history @@ -885,16 +950,20 @@ FUNCTION HCO_IsVerb ( Err, VerbNr ) RESULT ( IsVerb ) !BOC !====================================================================== - ! HCO_IsVerb begins here + ! HCO_IsVerb_VerbNr begins here !====================================================================== - IF ( .NOT. ASSOCIATED(Err) ) THEN - IsVerb = .FALSE. - ELSE - IsVerb = ( Err%Verbose >= VerbNr ) - ENDIF + ! Initialize + isVerb = .FALSE. + + ! Return FALSE if the Err object is NULL + IF ( .NOT. ASSOCIATED( Err ) ) RETURN - END FUNCTION HCO_IsVerb + ! Otherwise determine if this verbose level is greater or equal + ! to the verbose level specified in HEMCO_Config.rc + isVerb = ( Err%Verbose >= VerbNr ) + + END FUNCTION HCO_IsVerb_VerbNr !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -1019,18 +1088,27 @@ SUBROUTINE HCO_LogFile_Open( Err, RC ) LUN = Err%LUN ! Log gets written to file ENDIF - ! Write header - WRITE( LUN, '(a)' ) REPEAT( '-', 79) - WRITE( LUN, '(a12, a)' ) 'Using HEMCO ', HCO_VERSION - WRITE( LUN, '(a)' ) + !------------------------------------------------------------------ + ! REDUCE LOGFILE OUTPUT: + ! Only write splash screen when VERBOSE=3 + ! TODO: Change VERBOSE from integer to a logical on/off switch + ! -- Bob Yantosca (05 Dec 2022) + !------------------------------------------------------------------ + IF ( HCO_IsVerb( Err ) ) THEN + + ! Write header + WRITE( LUN, '(a)' ) REPEAT( '-', 79) + WRITE( LUN, '(a12, a)' ) 'Using HEMCO ', HCO_VERSION + WRITE( LUN, '(a)' ) #ifdef USE_REAL8 - WRITE( LUN, 100 ) - 100 FORMAT('HEMCO precision (hp) is set to is 8-byte real (aka REAL*8)') + WRITE( LUN, 100 ) +100 FORMAT('HEMCO precision (hp) is set to is 8-byte real (aka REAL*8)') #else - WRITE( LUN, 110 ) - 110 FORMAT('HEMCO precision (hp) is set to is 4-byte real (aka REAL*4)') + WRITE( LUN, 110 ) +110 FORMAT('HEMCO precision (hp) is set to is 4-byte real (aka REAL*4)') #endif - WRITE( LUN, '(a)' ) REPEAT( '-', 79) + WRITE( LUN, '(a)' ) REPEAT( '-', 79) + ENDIF Err%FirstOpen = .FALSE. ENDIF From b139d402826864e9d9074e9f744bbcae4cf217b8 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 6 Dec 2022 16:59:39 -0500 Subject: [PATCH 04/63] HEMCO extensions now display a consistent message (verbose or not) src/Extensions/hcox_custom_mod.F90 src/Extensions/hcox_dustdead_mod.F90 src/Extensions/hcox_dustginoux_mod.F90 src/Extensions/hcox_finn_mod.F90 src/Extensions/hcox_gc_POPs_mod.F90 src/Extensions/hcox_gc_RnPbBe_mod.F90 src/Extensions/hcox_iodine_mod.F90 src/Extensions/hcox_lightnox_mod.F90 src/Extensions/hcox_megan_mod.F90 src/Extensions/hcox_paranox_mod.F90 src/Extensions/hcox_seaflux_mod.F90 src/Extensions/hcox_seasalt_mod.F90 src/Extensions/hcox_template_mod.F90x src/Extensions/hcox_tomas_dustdead_mod.F src/Extensions/hcox_tomas_jeagle_mod.F90 src/Extensions/hcox_volcano_mod.f90 - If VERBOSE is not set to the highest setting (currently 3), then each extension will print a string to stdout of the format "Using HEMCO extension Name (Description)" - If VERBOSE is set to the highest setting (currently 3), then the extension will print the standardized string plus other informational messages. - This will allow users to see which HEMCO extensions are activated, but not necessarily get a lot of unnecessary printout unless they set VERBOSE properly. Signed-off-by: Bob Yantosca --- src/Extensions/hcox_custom_mod.F90 | 13 +++++++++--- src/Extensions/hcox_dustdead_mod.F | 11 ++++++++-- src/Extensions/hcox_dustginoux_mod.F90 | 11 ++++++++-- src/Extensions/hcox_finn_mod.F90 | 12 +++++++++-- src/Extensions/hcox_gc_POPs_mod.F90 | 11 ++++++++-- src/Extensions/hcox_gc_RnPbBe_mod.F90 | 11 ++++++++-- src/Extensions/hcox_gfed_mod.F90 | 12 +++++++++-- src/Extensions/hcox_iodine_mod.F90 | 11 ++++++++-- src/Extensions/hcox_lightnox_mod.F90 | 12 +++++++++-- src/Extensions/hcox_megan_mod.F90 | 12 +++++++++-- src/Extensions/hcox_paranox_mod.F90 | 27 ++++++++++++++++++------ src/Extensions/hcox_seaflux_mod.F90 | 12 +++++++++-- src/Extensions/hcox_seasalt_mod.F90 | 11 ++++++++-- src/Extensions/hcox_soilnox_mod.F90 | 11 ++++++++-- src/Extensions/hcox_template_mod.F90x | 11 ++++++++-- src/Extensions/hcox_tomas_dustdead_mod.F | 12 +++++++++-- src/Extensions/hcox_tomas_jeagle_mod.F90 | 13 ++++++++++++ src/Extensions/hcox_volcano_mod.F90 | 11 +++++++++- 18 files changed, 185 insertions(+), 39 deletions(-) diff --git a/src/Extensions/hcox_custom_mod.F90 b/src/Extensions/hcox_custom_mod.F90 index 1975ad8d..e95ba4c3 100644 --- a/src/Extensions/hcox_custom_mod.F90 +++ b/src/Extensions/hcox_custom_mod.F90 @@ -312,10 +312,17 @@ SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC ) Inst%IceSrcIDs(:) = HcoIDs(N:nSpc) ! Verbose mode - IF ( verb ) THEN - MSG = 'Use custom emissions module (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG ) + IF ( Hcostate%amIRoot ) THEN + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: Custom (custom emissions module)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = 'Use the following species (Name: HcoID):' CALL HCO_MSG(HcoState%Config%Err,MSG) DO N = 1, nSpc diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F index acb17d0e..4c779537 100644 --- a/src/Extensions/hcox_dustdead_mod.F +++ b/src/Extensions/hcox_dustdead_mod.F @@ -696,9 +696,16 @@ SUBROUTINE HCOX_DustDead_Init ( HcoState, ExtName, ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use DEAD dust emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: DustDead (dust mobilization)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only IF ( Inst%ExtNrAlk > 0 ) THEN MSG = 'Use dust alkalinity option' CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) diff --git a/src/Extensions/hcox_dustginoux_mod.F90 b/src/Extensions/hcox_dustginoux_mod.F90 index 34c47981..86e38db9 100644 --- a/src/Extensions/hcox_dustginoux_mod.F90 +++ b/src/Extensions/hcox_dustginoux_mod.F90 @@ -560,9 +560,16 @@ SUBROUTINE HcoX_DustGinoux_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use Ginoux dust emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: DustGinoux (dust mobilization)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only IF ( Inst%ExtNrAlk > 0 ) THEN MSG = 'Use dust alkalinity option' CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) diff --git a/src/Extensions/hcox_finn_mod.F90 b/src/Extensions/hcox_finn_mod.F90 index 0b6aa655..9414ed78 100644 --- a/src/Extensions/hcox_finn_mod.F90 +++ b/src/Extensions/hcox_finn_mod.F90 @@ -874,8 +874,16 @@ SUBROUTINE HCOX_FINN_Init( HcoState, ExtName, ExtState, RC ) ! Write to log file IF ( HcoState%amIRoot ) THEN - MSG = 'Use FINN extension' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + + ! Write the name of the extension regardless of the verbose setting + MSG = 'Using HEMCO extension: FINN (biomass burning)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Other print statements will only be written as debug output WRITE(MSG,*) ' - Use daily data : ', Inst%UseDay CALL HCO_MSG(HcoState%Config%Err,MSG ) ENDIF diff --git a/src/Extensions/hcox_gc_POPs_mod.F90 b/src/Extensions/hcox_gc_POPs_mod.F90 index 7f0bc1c1..fe51c01d 100644 --- a/src/Extensions/hcox_gc_POPs_mod.F90 +++ b/src/Extensions/hcox_gc_POPs_mod.F90 @@ -1668,9 +1668,16 @@ SUBROUTINE HCOX_GC_POPs_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use GC_POPs emissions module (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: GC_POPs (POPs emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = 'Use the following species (Name: HcoID):' CALL HCO_MSG(HcoState%Config%Err,MSG) DO N = 1, nSpc diff --git a/src/Extensions/hcox_gc_RnPbBe_mod.F90 b/src/Extensions/hcox_gc_RnPbBe_mod.F90 index 39159cb4..cd701ad6 100644 --- a/src/Extensions/hcox_gc_RnPbBe_mod.F90 +++ b/src/Extensions/hcox_gc_RnPbBe_mod.F90 @@ -601,9 +601,16 @@ SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use gc_RnPbBe emissions module (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: GC_RnPbBe (radionuclide emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = 'Use the following species (Name: HcoID):' CALL HCO_MSG(HcoState%Config%Err,MSG) DO N = 1, nSpc diff --git a/src/Extensions/hcox_gfed_mod.F90 b/src/Extensions/hcox_gfed_mod.F90 index f6b19716..079dbe06 100644 --- a/src/Extensions/hcox_gfed_mod.F90 +++ b/src/Extensions/hcox_gfed_mod.F90 @@ -766,8 +766,16 @@ SUBROUTINE HCOX_GFED_Init ( HcoState, ExtName, ExtState, RC ) ! Prompt to log file IF ( HcoState%amIRoot ) THEN - MSG = 'Use GFED extension' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: GFED (biomass burning)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only WRITE(MSG,*) ' - Use GFED-4 : ', Inst%IsGFED4 CALL HCO_MSG(HcoState%Config%Err,MSG ) WRITE(MSG,*) ' - Use daily scale factors : ', Inst%DoDay diff --git a/src/Extensions/hcox_iodine_mod.F90 b/src/Extensions/hcox_iodine_mod.F90 index e92083ee..059616db 100644 --- a/src/Extensions/hcox_iodine_mod.F90 +++ b/src/Extensions/hcox_iodine_mod.F90 @@ -449,9 +449,16 @@ SUBROUTINE HCOX_Iodine_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use inorganic iodine emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-') + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: Inorg_Iodine (HOI and I2 emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only IF ( Inst%CalcHOI ) THEN WRITE(MSG,*) 'HOI: ', TRIM(SpcNames(1)), Inst%IDTHOI CALL HCO_MSG(HcoState%Config%Err,MSG) diff --git a/src/Extensions/hcox_lightnox_mod.F90 b/src/Extensions/hcox_lightnox_mod.F90 index dce8a24e..eb6c4aa8 100644 --- a/src/Extensions/hcox_lightnox_mod.F90 +++ b/src/Extensions/hcox_lightnox_mod.F90 @@ -948,8 +948,16 @@ SUBROUTINE HCOX_LightNOx_Init( HcoState, ExtName, ExtState, RC ) ! Echo info about this extension IF ( HcoState%amIRoot ) THEN - MSG = 'Use lightning NOx emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + + ! Print the name of the module regardless of verbose + msg = 'Using HEMCO extension: LightNOx (lightning NOx emissions' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Other information will be printed only when verbose is true WRITE(MSG,*) ' - Use species ', TRIM(SpcNames(1)), '->', Inst%IDTNO CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Use GEOS-5 flash rates: ', Inst%LLFR diff --git a/src/Extensions/hcox_megan_mod.F90 b/src/Extensions/hcox_megan_mod.F90 index 4277bcc3..68960479 100644 --- a/src/Extensions/hcox_megan_mod.F90 +++ b/src/Extensions/hcox_megan_mod.F90 @@ -3548,8 +3548,16 @@ SUBROUTINE HCOX_Megan_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot) THEN - MSG = 'Use MEGAN biogenic emissions (extension module)' - CALL HCO_MSG( HcoState%Config%Err, MSG, SEP1='-' ) + + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: MEGAN (biogenic emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only WRITE(MSG,*) '- Use offline biogenic VOCs? ', Inst%OFFLINE_BIOGENICVOC CALL HCO_MSG( HcoState%Config%Err, MSG ) ENDIF diff --git a/src/Extensions/hcox_paranox_mod.F90 b/src/Extensions/hcox_paranox_mod.F90 index 208556df..472bbbe8 100644 --- a/src/Extensions/hcox_paranox_mod.F90 +++ b/src/Extensions/hcox_paranox_mod.F90 @@ -1080,8 +1080,16 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use ParaNOx ship emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + + ! Write the name of the extension regardless of the verbose setting + MSG = 'Using HEMCO extension: ParaNOx (ship emission plumes)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write the rest of the information only when verbose is set MSG = ' - Use the following species: (MW, emitted as HEMCO ID) ' CALL HCO_MSG(HcoState%Config%Err,MSG ) WRITE(MSG,"(a,F5.2,I5)") ' NO : ', Inst%MW_NO, Inst%IDTNO @@ -1275,7 +1283,8 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'LUT source dir', & OptValChar=Inst%LutDir, RC=RC) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) + CALL HCO_ERROR( & + 'PARANOX: Could not read "LUT source dir"!', RC, THISLOC=LOC ) RETURN ENDIF @@ -1284,7 +1293,8 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) ! provide some dummy variables here CALL HCO_CharParse( HcoState%Config, Inst%LutDir, -999, -1, -1, -1, -1, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) + CALL HCO_ERROR( & + 'PARANOX: Error encountered in "HCO_CharParse"', RC, THISLOC=LOC ) RETURN ENDIF @@ -1293,7 +1303,8 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'LUT data format', & OptValChar=Dummy, RC=RC) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC ) + CALL HCO_ERROR( & + 'PARANOX: Could not read "LUT data format"', RC, THISLOC=LOC ) RETURN ENDIF IF ( TRIM(Dummy) == 'txt' ) Inst%IsNc = .FALSE. @@ -1307,13 +1318,15 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) IF ( Inst%IsNc ) THEN CALL READ_PARANOX_LUT_NC( HcoState, Inst, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC ) + CALL HCO_ERROR( & + 'PARANOX: Error in "READ_PARANOX_LUT_NC"!', RC, THISLOC=LOC ) RETURN ENDIF ELSE CALL READ_PARANOX_LUT_TXT( HcoState, Inst, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) + CALL HCO_ERROR( & + 'PARANOX: Error in "READ_PARANOX_LUT_NC"!', RC, THISLOC=LOC ) RETURN ENDIF ENDIF diff --git a/src/Extensions/hcox_seaflux_mod.F90 b/src/Extensions/hcox_seaflux_mod.F90 index 5fe4c4eb..f269cfde 100644 --- a/src/Extensions/hcox_seaflux_mod.F90 +++ b/src/Extensions/hcox_seaflux_mod.F90 @@ -698,8 +698,16 @@ SUBROUTINE HCOX_SeaFlux_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use air-sea flux emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-' ) + + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: SeaFlux (air-sea flux emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = ' - Use species:' CALL HCO_MSG(HcoState%Config%Err,MSG ) ENDIF diff --git a/src/Extensions/hcox_seasalt_mod.F90 b/src/Extensions/hcox_seasalt_mod.F90 index 10df31c9..58a91e3e 100644 --- a/src/Extensions/hcox_seasalt_mod.F90 +++ b/src/Extensions/hcox_seasalt_mod.F90 @@ -998,9 +998,16 @@ SUBROUTINE HCOX_SeaSalt_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use sea salt aerosol emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: SeaSalt (sea salt aerosol emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only IF ( HcoState%MarinePOA ) THEN MSG = 'Use marine organic aerosols option' CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) diff --git a/src/Extensions/hcox_soilnox_mod.F90 b/src/Extensions/hcox_soilnox_mod.F90 index 0fa0855f..c36c8a2b 100644 --- a/src/Extensions/hcox_soilnox_mod.F90 +++ b/src/Extensions/hcox_soilnox_mod.F90 @@ -825,9 +825,16 @@ SUBROUTINE HCOX_SoilNOx_Init( HcoState, ExtName, ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use soil NOx emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: SoilNOx (soil NOx emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only WRITE(MSG,*) ' - NOx species : ', TRIM(SpcNames(1)), Inst%IDTNO CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - NOx scale factor : ', Inst%SpcScalVal(1) diff --git a/src/Extensions/hcox_template_mod.F90x b/src/Extensions/hcox_template_mod.F90x index b9ec7c91..6d293ccf 100644 --- a/src/Extensions/hcox_template_mod.F90x +++ b/src/Extensions/hcox_template_mod.F90x @@ -253,9 +253,16 @@ CONTAINS ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use emissions extension :' - CALL HCO_MSG( HcoState%Config%Err, MSG ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: ()' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = ' - use the following species (Name, HcoID, Scaling):' CALL HCO_MSG( HcoState%Config%Err, MSG) DO N = 1, Inst%nSpc diff --git a/src/Extensions/hcox_tomas_dustdead_mod.F b/src/Extensions/hcox_tomas_dustdead_mod.F index 11e1672a..b960b240 100644 --- a/src/Extensions/hcox_tomas_dustdead_mod.F +++ b/src/Extensions/hcox_tomas_dustdead_mod.F @@ -709,9 +709,17 @@ SUBROUTINE HCOX_TOMAS_DustDead_Init( HcoState, ExtName, ExtState, ! Verbose mode IF ( Hcostate%amIRoot ) THEN - MSG = 'Use DEAD dust emissions (extension module)' - CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: TOMAS_DustDead ' + & // 'dust mobilization for TOMAS)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + + ! Write all other messages as debug printout only MSG = 'Use the following species (Name: HcoID):' CALL HCO_MSG(HcoState%Config%Err,MSG) DO N = 1, nSpc diff --git a/src/Extensions/hcox_tomas_jeagle_mod.F90 b/src/Extensions/hcox_tomas_jeagle_mod.F90 index 8dfb7294..2b41325b 100644 --- a/src/Extensions/hcox_tomas_jeagle_mod.F90 +++ b/src/Extensions/hcox_tomas_jeagle_mod.F90 @@ -382,6 +382,19 @@ SUBROUTINE HCOX_TOMAS_Jeagle_Init( HcoState, ExtName, ExtState, RC ) RETURN ENDIF + ! Only print on the root core + IF ( HcoState%amIRoot ) THEN + + ! Write the name of the extension regardless of the verbose setting + msg = & + 'Using HEMCO extension: TOMAS_Jeagle (sea salt emissions for TOMAS)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + ENDIF + ! Create Instance Inst => NULL() CALL InstCreate ( ExtNr, ExtState%TOMAS_Jeagle, Inst, RC ) diff --git a/src/Extensions/hcox_volcano_mod.F90 b/src/Extensions/hcox_volcano_mod.F90 index 8f6c9c17..e560c8d5 100644 --- a/src/Extensions/hcox_volcano_mod.F90 +++ b/src/Extensions/hcox_volcano_mod.F90 @@ -354,7 +354,16 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) ! Extension Nr. ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) - IF ( ExtNr <= 0 ) THEN + + IF ( ExtNr > 0 ) THEN + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + ELSE + CALL HCO_Msg( msg, verb=3 ) ! Without separator line + ENDIF + ELSE MSG = 'The Volcano extension is turned off.' CALL HCO_MSG( HcoState%Config%Err, MSG ) RETURN From e63b67bad3004b782cb9c460c50d7e75b3d32df8 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 8 Dec 2022 12:36:22 -0500 Subject: [PATCH 05/63] Remove verbose numbers from calls to HCO_IsVerb We have changed calls to HCO_IsVerb( HcoState%Config%Err, 3 ) HCO_IsVerb( HcoState%Config%Err, 2 ) HCO_IsVerb( HcoState%Config%Err, 1 ) to HCO_IsVerb( HcoState%Config%Err ) because we now use a logical on/off (stored in Err%doVerbose) to toggle verbose output instead of the numerical levels. Other related modifications: src/Core/hco_calc_mod.F90 - Rewrite IF block where EOL is computed to avoid ELSE statement src/Core/hco_config_mod.F90 - Now read "Verbose: true" or "Verbose: false" from HEMCO_Config.rc - Skip reading "Warnings" - Remove Warnings argument from call to HCO_Error_Set src/Core/hco_emislist_mod.F90 - Remove 3rd argument (verbose level) from call to HCO_PrintDataCont src/Core/hco_error_mod.F90 - Restore HCO_IsVerb to a single subroutine and not an overloaded module interface - Add doVerbose logical variable to the TYPE(HcoErr) - Remove verb argument from HCO_MSGErr routine - Refactor logic in HCO_MSGErr to avoid ELSE blocks - Change type of verb argument in HCO_MSGNoErr from integer to logical - Remove Verbose and Warnings integer arguments in HCO_ErrorSet routine, and add doVerbose logical argument src/Core/hco_logfile_mod.F90 - Remove integer argument "Verbose" from HCO_PrintList - Remove Verbose from call to HCO_PrintDataCont - Remove integer Verbose argument in subroutine HCO_PrintDataCont src/Core/hco_readlist_mod.F90 - Remove integer argument "verb" from ReadList_Print routine - Remove 3rd argument from calls to HCO_PrintList src/Extensions/hcox_custom_mod.F90 src/Extensions/hcox_dustdead_mod.F90 src/Extensions/hcox_dustginoux_mod.F90 src/Extensions/hcox_finn_mod.F90 src/Extensions/hcox_gc_RnPbBe_mod.F90 src/Extensions/hcox_gfed_mod.F90 src/Extensions/hcox_iodine_mod.F90 src/Extensions/lightnox_mod.F90 src/Extensions/megan_mod.F90 src/Extensions/hcox_paranox_mod.F90 src/Extensions/hcox_seaflux_mod.F90 src/Extensions/hcox_seasalt_mod.F90 src/Extensions/hcox_soilnox_mod.F90 src/Extensions/hcox_template_mod.F90 src/Extensions/hcox_tomas_dustdead_mod.F90 src/Extensions/hcox_tomas/jeagle_mod.F90 src/Extensions/hcox_volcano_mod.F90 - Change verb=3 to verb=.TRUE. in calls to HCO_Msg Signed-off-by: Bob Yantosca --- src/Core/hco_calc_mod.F90 | 41 +++-- src/Core/hco_clock_mod.F90 | 3 +- src/Core/hco_config_mod.F90 | 93 +++++++---- src/Core/hco_datacont_mod.F90 | 2 +- src/Core/hco_diagn_mod.F90 | 14 +- src/Core/hco_emislist_mod.F90 | 6 +- src/Core/hco_error_mod.F90 | 199 +++++++---------------- src/Core/hco_extlist_mod.F90 | 6 +- src/Core/hco_geotools_mod.F90 | 8 +- src/Core/hco_interp_mod.F90 | 16 +- src/Core/hco_logfile_mod.F90 | 14 +- src/Core/hco_readlist_mod.F90 | 29 ++-- src/Core/hco_restart_mod.F90 | 18 +- src/Core/hco_scale_mod.F90 | 14 +- src/Core/hco_state_mod.F90 | 2 +- src/Core/hco_timeshift_mod.F90 | 10 +- src/Core/hco_vertgrid_mod.F90 | 2 +- src/Core/hcoio_messy_mod.F90 | 2 +- src/Core/hcoio_read_mapl_mod.F90 | 2 +- src/Core/hcoio_read_std_mod.F90 | 30 ++-- src/Core/hcoio_util_mod.F90 | 22 +-- src/Core/hcoio_write_std_mod.F90 | 6 +- src/Extensions/hcox_custom_mod.F90 | 6 +- src/Extensions/hcox_dustdead_mod.F | 4 +- src/Extensions/hcox_dustginoux_mod.F90 | 6 +- src/Extensions/hcox_finn_mod.F90 | 6 +- src/Extensions/hcox_gc_POPs_mod.F90 | 4 +- src/Extensions/hcox_gc_RnPbBe_mod.F90 | 4 +- src/Extensions/hcox_gfed_mod.F90 | 4 +- src/Extensions/hcox_iodine_mod.F90 | 4 +- src/Extensions/hcox_lightnox_mod.F90 | 4 +- src/Extensions/hcox_megan_mod.F90 | 4 +- src/Extensions/hcox_paranox_mod.F90 | 6 +- src/Extensions/hcox_seaflux_mod.F90 | 6 +- src/Extensions/hcox_seasalt_mod.F90 | 6 +- src/Extensions/hcox_soilnox_mod.F90 | 4 +- src/Extensions/hcox_state_mod.F90 | 20 +-- src/Extensions/hcox_template_mod.F90x | 4 +- src/Extensions/hcox_tomas_dustdead_mod.F | 4 +- src/Extensions/hcox_tomas_jeagle_mod.F90 | 4 +- src/Extensions/hcox_volcano_mod.F90 | 10 +- 41 files changed, 289 insertions(+), 360 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index 4a0ca596..302efce9 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -247,7 +247,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) DoDiagn = HcoState%Options%AutoFillDiagn !Write AutoFill diagnostics? ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE (MSG, *) 'Run HEMCO calculation w/ following options:' CALL HCO_MSG ( HcoState%Config%Err, MSG ) WRITE (MSG, "(A20,I5)") 'Extension number:', ExtNr @@ -278,11 +278,8 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) ! Do until end of EmisList (==> loop over all emission containers) DO ! Have we reached the end of the list? - IF ( FLAG /= HCO_SUCCESS ) THEN - EOL = .TRUE. - ELSE - EOL = .FALSE. - ENDIF + EOL = .FALSE. + IF ( FLAG /= HCO_SUCCESS ) EOL = .TRUE. ! ------------------------------------------------------------ ! Select container and update all working variables & arrays. @@ -394,7 +391,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) SpcFlx(:,:,:) = SpcFlx(:,:,:) + CatFlx(:,:,:) ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Added category emissions to species array: ' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Species : ', PrevSpc @@ -455,7 +452,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) OutArr(:,:,:) = OutArr(:,:,:) + SpcFlx(:,:,:) ! testing only - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Added total emissions to output array: ' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Species: ', PrevSpc @@ -571,7 +568,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) ENDIF ! verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Calculating emissions for species ', & TRIM(HcoState%Spc(ThisSpc)%SpcName) CALL HCO_MSG( HcoState%Config%Err, MSG, SEP1='-', SEP2='-' ) @@ -704,7 +701,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC ) OutArr => NULL() ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE (MSG, *) 'HEMCO emissions successfully calculated!' CALL HCO_MSG ( HcoState%Config%Err, MSG ) ENDIF @@ -881,7 +878,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & MaskFractions = HcoState%Options%MaskFractions ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Evaluate field ', TRIM(BaseDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1=' ') ENDIF @@ -1123,7 +1120,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! if scale factors are only defined for a given time range and ! the simulation datetime is outside of this range. IF ( .NOT. FileData_ArrIsDefined(ScalDct%Dta) ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN MSG = 'Skip scale factor '//TRIM(ScalDct%cName)// & ' because it is not defined for this datetime.' CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -1132,7 +1129,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ENDIF ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN MSG = 'Applying scale factor ' // TRIM(ScalDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1236,8 +1233,8 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & MASK(I,J,:) = MASK(I,J,:) * TMPVAL ! testing only - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. I==1 .AND. J==1 ) THEN - write(MSG,*) 'Mask field ', TRIM(ScalDct%cName), & + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. I==1 .AND. J==1 ) THEN + write(MSG,*) 'Mask field ', TRIM(ScalDct%cName), & ' found and added to temporary mask.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1341,7 +1338,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ENDDO !LL ! Verbose mode - if ( HCO_IsVerb(HcoState%Config%Err,3) .and. i == ix .and. j == iy ) then + if ( HCO_IsVerb(HcoState%Config%Err) .and. i == ix .and. j == iy ) then write(MSG,*) 'Scale field ', TRIM(ScalDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) write(MSG,*) 'Time slice: ', tIdx @@ -1488,7 +1485,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & IF(RC /= HCO_SUCCESS) RETURN ! testing only - verb = HCO_IsVerb(HcoState%Config%Err,1) + verb = HCO_IsVerb(HcoState%Config%Err) IX = 60 !40 !19 43 61 IY = 32 !36 !33 26 37 @@ -2949,7 +2946,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & MaskFractions = HcoState%Options%MaskFractions ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) ) THEN WRITE(MSG,*) 'Evaluate field ', TRIM(BaseDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1=' ') ENDIF @@ -3166,7 +3163,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & ! if scale factors are only defined for a given time range and ! the simulation datetime is outside of this range. IF ( .NOT. FileData_ArrIsDefined(ScalDct%Dta) ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Skip scale factor '//TRIM(ScalDct%cName)// & ' because it is not defined for this datetime.' CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -3175,7 +3172,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & ENDIF ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN MSG = 'Applying scale factor ' // TRIM(ScalDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -3274,7 +3271,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & MASK(I,J,:) = MASK(I,J,:) * TMPVAL ! testing only - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. I==1 .AND. J==1 ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. I==1 .AND. J==1 ) THEN write(MSG,*) 'Mask field ', TRIM(ScalDct%cName), & ' found and added to temporary mask.' CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -3379,7 +3376,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & ENDDO !LL ! Verbose mode - if ( HCO_IsVerb(HcoState%Config%Err,3) .and. i == ix .and. j == iy ) then + if ( HCO_IsVerb(HcoState%Config%Err) .and. i == ix .and. j == iy ) then write(MSG,*) 'Scale field ', TRIM(ScalDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) write(MSG,*) 'Time slice: ', tIdx diff --git a/src/Core/hco_clock_mod.F90 b/src/Core/hco_clock_mod.F90 index 7e399e30..15b414ed 100644 --- a/src/Core/hco_clock_mod.F90 +++ b/src/Core/hco_clock_mod.F90 @@ -1,3 +1,4 @@ + !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ @@ -607,7 +608,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, & ! ---------------------------------------------------------------- ! Verbose mode ! ---------------------------------------------------------------- - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( NewStep ) THEN WRITE(MSG,110) Clock%ThisYear, Clock%ThisMonth, & Clock%ThisDay, Clock%ThisHour, & diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 689b165a..d3f309e4 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -555,8 +555,8 @@ SUBROUTINE SetReadList( HcoState, RC ) HcoState%SetReadListCalled = .TRUE. ! Debug - IF ( HCO_IsVerb( HcoState%Config%Err, 1 ) ) THEN - CALL ReadList_Print( HcoState, HcoState%ReadLists, 1 ) + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL ReadList_Print( HcoState, HcoState%ReadLists ) ENDIF ! Leave w/ success @@ -1354,7 +1354,7 @@ SUBROUTINE BracketCheck( HcoConfig, STAT, LINE, SKIP, RC ) !====================================================================== ! Init - verb = HCO_IsVerb( HcoConfig%Err, 1 ) + verb = HCO_IsVerb( HcoConfig%Err ) ! Get name of this bracket IF ( STAT == 5 .OR. STAT == 6 ) THEN @@ -1587,7 +1587,7 @@ SUBROUTINE AddShadowFields( HcoConfig, Lct, Cats, nCat, RC ) ENDIF ! Init - verb = HCO_IsVerb( HcoConfig%Err, 1 ) + verb = HCO_IsVerb( HcoConfig%Err ) Shd => NULL() @@ -1750,7 +1750,7 @@ SUBROUTINE AddZeroScal( HcoConfig, RC ) Lct%Dct%Dta => Dta ! verbose mode - IF ( HCO_IsVerb( HcoConfig%Err, 2 ) ) THEN + IF ( HCO_IsVerb( HcoConfig%Err ) ) THEN MSG = 'Created a fake scale factor with zeros' CALL HCO_MSG(HcoConfig%Err,MSG) MSG = 'This field will be used to artificially expand ' // & @@ -1991,9 +1991,10 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! !LOCAL VARIABLES: ! ! Scalars + LOGICAL :: doVerbose LOGICAL :: FOUND INTEGER :: I, N, POS - INTEGER :: verb + !INTEGER :: verb INTEGER :: warn ! Strings @@ -2105,16 +2106,31 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) !----------------------------------------------------------------------- IF ( .NOT. ASSOCIATED(HcoConfig%Err) ) THEN + !-------------------------------------------------------------------- + !! Verbose mode? + !CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & + ! OptValInt=verb, FOUND=FOUND, RC=RC ) + !IF ( RC /= HCO_SUCCESS ) THEN + ! msg = 'Error looking for "Verbose" HEMCO_Config.rc!' + ! CALL HCO_Error( msg, RC, thisLoc=loc ) + ! RETURN + !ENDIF + !IF ( .NOT. FOUND ) THEN + ! verb = 3 + ! WRITE(*,*) 'Setting `Verbose` not found in HEMCO logfile - use 3' + !ENDIF + !-------------------------------------------------------------------- + ! Verbose mode? - CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & - OptValInt=verb, FOUND=FOUND, RC=RC ) + CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & + OptValBool=doVerbose, found=found, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN msg = 'Error looking for "Verbose" HEMCO_Config.rc!' CALL HCO_Error( msg, RC, thisLoc=loc ) RETURN ENDIF IF ( .NOT. FOUND ) THEN - verb = 3 + doVerbose=.FALSE. WRITE(*,*) 'Setting `Verbose` not found in HEMCO logfile - use 3' ENDIF @@ -2131,18 +2147,22 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) WRITE(*,*) 'Setting `Logfile` not found in HEMCO logfile - use `HEMCO.log`' ENDIF - ! Prompt warnings to logfile? - CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', & - OptValInt=warn, FOUND=FOUND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - msg = 'Error looking for "Warnings" in HEMCO_Config.rc!' - CALL HCO_Error( msg, RC, thisLoc=loc ) - RETURN - ENDIF - IF ( .NOT. FOUND ) THEN - warn = 3 - WRITE(*,*) 'Setting `Warnings` not found in HEMCO logfile - use 3' - ENDIF + !--------------------------------------------------------------------- + ! REDUCE LOGFILE OUTPUT: + ! Combine verbose and warnings (bmy, 07 Dec 2022) + !! Prompt warnings to logfile? + !CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', & + ! OptValInt=warn, FOUND=FOUND, RC=RC ) + !IF ( RC /= HCO_SUCCESS ) THEN + ! msg = 'Error looking for "Warnings" in HEMCO_Config.rc!' + ! CALL HCO_Error( msg, RC, thisLoc=loc ) + ! RETURN + !ENDIF + !IF ( .NOT. FOUND ) THEN + ! warn = 3 + ! WRITE(*,*) 'Setting `Warnings` not found in HEMCO logfile - use 3' + !ENDIF + !--------------------------------------------------------------------- ! Initialize (standard) HEMCO tokens CALL HCO_SetDefaultToken( HcoConfig, RC ) @@ -2158,9 +2178,12 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) IF ( TRIM(LogFile) == HCO_GetOpt(HcoConfig%ExtList,'Wildcard') ) & LogFile = '*' + !! We should now have everything to define the HEMCO error settings + !CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & + ! verb, warn, RC ) ! We should now have everything to define the HEMCO error settings - CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & - verb, warn, RC ) + CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & + doVerbose, RC ) IF ( RC /= HCO_SUCCESS ) THEN msg = 'Error encountered in routine "Hco_Error_Set"!' CALL HCO_Error( msg, RC, thisLoc=loc ) @@ -2260,7 +2283,7 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) IF ( cpux2 >= 180 ) cpux2 = cpux2 - 360 ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Start to prepare fields for registering!' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'This CPU x-range: ', cpux1, cpux2 @@ -2282,7 +2305,7 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) ENDIF ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Prepare ', TRIM(Lct%Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2300,7 +2323,7 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) Lct%Dct%HcoID = ThisHcoID ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Assigned HEMCO species ID: ', Lct%Dct%HcoID CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2380,7 +2403,7 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) Lct%Dct%Dta%ncYrs(:) = -999 Lct%Dct%Dta%ncMts(:) = -999 - IF ( HCO_IsVerb(HcoSTate%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoSTate%Config%Err ) ) THEN WRITE(MSG,*) 'Coverage: ', Lct%Dct%Dta%Cover CALL HCO_MSG( HcoState%Config%Err, msg ) ENDIF @@ -2500,7 +2523,7 @@ SUBROUTINE Register_Base( HcoState, RC ) ENDIF IF ( Ignore ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) & 'Register_Base: Ignore (and remove) base field ', & TRIM(Lct%Dct%cName) @@ -2515,7 +2538,7 @@ SUBROUTINE Register_Base( HcoState, RC ) ENDIF ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Register_Base: Checking ', TRIM(Lct%Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='-') ENDIF @@ -2550,7 +2573,7 @@ SUBROUTINE Register_Base( HcoState, RC ) ENDIF ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Container ID : ', Lct%Dct%cID CALL HCO_MSG( HcoState%Config%Err, msg ) WRITE(MSG,*) 'Assigned targetID: ', targetID @@ -2583,7 +2606,7 @@ SUBROUTINE Register_Base( HcoState, RC ) ENDIF ! Print some information if verbose mode is on - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Base field registered: ', TRIM(Lct%Dct%cName) CALL HCO_MSG( HcoState%Config%Err, msg ) ENDIF @@ -2727,7 +2750,7 @@ SUBROUTINE Register_Scal( HcoState, RC ) ENDIF ! Print some information if verbose mode is on - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Scale field registered: ', TRIM(Lct%Dct%cName) CALL HCO_MSG( HcoState%Config%Err, msg ) ENDIF @@ -2896,7 +2919,7 @@ SUBROUTINE Get_targetID( HcoState, Lct, targetID, RC ) IF ( (mskLct%Dct%DctType == HCO_DCTTYPE_MASK ) .AND. & (mskLct%Dct%Dta%Cover == 0 ) ) THEN targetID = -999 - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Data not defined over this CPU, skip ' // & TRIM(Lct%Dct%cName) CALL HCO_MSG( HcoState%Config%Err, msg ) @@ -3035,7 +3058,7 @@ SUBROUTINE Get_targetID( HcoState, Lct, targetID, RC ) ! replace all values of Lct. Hence, set targetID to -999 ! (= ignore container) and return here. IF ( (tmpLct%Dct%Hier > Hier) .AND. (tmpCov==1) ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Skip container ', TRIM(Lct%Dct%cName), & ' because of ', TRIM(tmpLct%Dct%cName) CALL HCO_MSG( HcoState%Config%Err, msg ) @@ -4526,7 +4549,7 @@ SUBROUTINE ExtractSrcDim( HcoConfig, SrcDim, Dta, Lscal1, Lscal2, RC ) ENDIF ! Verbose - IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,2) ) THEN + IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err ) ) THEN WRITE(MSG,*) 'Will use additional dimension on file ', & TRIM(Dta%ncFile), ': ', TRIM(Dta%ArbDimName), ' = ', & TRIM(Dta%ArbDimVal) diff --git a/src/Core/hco_datacont_mod.F90 b/src/Core/hco_datacont_mod.F90 index a8a9b743..286f112f 100644 --- a/src/Core/hco_datacont_mod.F90 +++ b/src/Core/hco_datacont_mod.F90 @@ -401,7 +401,7 @@ SUBROUTINE cIDList_Create( HcoState, List, RC ) ENDIF ! Set verbose flag - verbose = HCO_IsVerb ( HcoState%Config%Err, 3 ) + verbose = HCO_IsVerb ( HcoState%Config%Err ) ! Set # of data container in list HcoState%nnDataCont = ListCont_Length( List ) diff --git a/src/Core/hco_diagn_mod.F90 b/src/Core/hco_diagn_mod.F90 index 9a3ec465..59d35452 100644 --- a/src/Core/hco_diagn_mod.F90 +++ b/src/Core/hco_diagn_mod.F90 @@ -942,7 +942,7 @@ SUBROUTINE Diagn_Create( HcoState, cName, & ! Exit if found IF ( FOUND ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Diagnostics already exists - ', & 'will not be added again: ', TRIM(cName) CALL HCO_MSG ( HcoState%Config%Err, MSG ) @@ -1106,7 +1106,7 @@ SUBROUTINE Diagn_Create( HcoState, cName, & ThisDiagn%AreaScal = 1.0_hp / Scal ENDIF - IF (HCO_IsVerb(HcoState%Config%Err,3)) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) ) THEN WRITE(MSG, *) ' ThisDiagn%AreaScal = ', ThisDiagn%AreaScal CALL HCO_MSG( HcoState%Config%Err, MSG) WRITE(MSG, *) ' ThisDiagn%MassScal = ', ThisDiagn%MassScal @@ -1213,7 +1213,7 @@ SUBROUTINE Diagn_Create( HcoState, cName, & ThisColl%nnDiagn = ThisColl%nnDiagn + 1 ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,'(a, i4)') 'Successfully added diagnostic '// & TRIM(ThisDiagn%cName) // ' to collection ', PS CALL HCO_MSG ( HcoState%Config%Err, MSG ) @@ -1934,7 +1934,7 @@ SUBROUTINE Diagn_UpdateDriver( HcoState, cID, cName, & CYCLE ENDIF - IF (HCO_IsVerb(HcoState%Config%Err, 3)) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'ThisDiagn%cName: ', trim(ThisDiagn%cName) CALL HCO_MSG(HcoState%Config%Err, MSG) WRITE(MSG,*) 'ThisDiagn%AvgFlag: ', ThisDiagn%AvgFlag @@ -2232,7 +2232,7 @@ SUBROUTINE Diagn_UpdateDriver( HcoState, cID, cName, & ThisDiagn%nnGetCalls = 0 ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,'(a,a,a,I3,a)') 'Successfully updated diagnostics: ', & TRIM(ThisDiagn%cName), ' (counter:', ThisDiagn%Counter, ')' CALL HCO_MSG ( HcoState%Config%Err, MSG ) @@ -3774,7 +3774,7 @@ SUBROUTINE Diagn_Print ( HcoState, Dgn, VerbNr ) CALL HCO_MSG(HcoState%Config%Err,MSG) ! Eventually add details - IF ( HCO_IsVerb( HcoState%Config%Err, VerbNr ) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN ! General information WRITE(MSG,*) ' --> Collection : ', Dgn%CollectionID @@ -3927,7 +3927,7 @@ SUBROUTINE DiagnCollection_Create ( Diagn, NX, NY, NZ, & ! verbose IF ( PRESENT(HcoState) ) THEN - IF ( HCO_IsVerb( HcoState%Config%Err, 1 ) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Created diagnostics collection: ' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,'(a21,i2)') ' - Collection ID : ', COL diff --git a/src/Core/hco_emislist_mod.F90 b/src/Core/hco_emislist_mod.F90 index 41e05005..a77b77e4 100644 --- a/src/Core/hco_emislist_mod.F90 +++ b/src/Core/hco_emislist_mod.F90 @@ -106,7 +106,7 @@ SUBROUTINE EmisList_Add( Dct, HcoState, RC ) IF(RC /= HCO_SUCCESS) RETURN ! Set verbose flag - VERBOSE = HCO_IsVerb( HcoState%Config%Err, 2 ) + VERBOSE = HCO_IsVerb( HcoState%Config%Err ) ! Init Lct => NULL() @@ -148,7 +148,7 @@ SUBROUTINE EmisList_Add( Dct, HcoState, RC ) IF ( VERBOSE ) THEN MSG = 'Container added to EmisList:' CALL HCO_MSG(HcoState%Config%Err,MSG) - CALL HCO_PrintDataCont( HcoState, Lct%Dct, 3 ) + CALL HCO_PrintDataCont( HcoState, Lct%Dct ) ENDIF ! Leave w/ success @@ -472,7 +472,7 @@ SUBROUTINE EmisList_Pass( HcoState, Lct, RC ) TargetLct => NULL() ! Verbose mode - verb = HCO_IsVerb( HcoState%Config%Err, 2 ) + verb = HCO_IsVerb( HcoState%Config%Err ) ! Initialize Add flag. This fill only be set to FALSE ! if the data of the current container is added to the data of diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 7ff4502c..a6f4551a 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -114,11 +114,6 @@ MODULE HCO_Error_Mod MODULE PROCEDURE HCO_MsgErr END INTERFACE HCO_MSG - INTERFACE HCO_IsVerb - MODULE PROCEDURE HCO_IsVerb_NoVerbNr - MODULE PROCEDURE HCO_IsVerb_VerbNr - END INTERFACE HCO_IsVerb - ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -131,8 +126,9 @@ MODULE HCO_Error_Mod ! TYPE, PUBLIC :: HcoErr LOGICAL :: FirstOpen = .TRUE. - LOGICAL :: IsRoot = .FALSE. - LOGICAL :: LogIsOpen = .FALSE. + LOGICAL :: IsRoot = .FALSE. + LOGICAL :: LogIsOpen = .FALSE. + LOGICAL :: doVerbose = .FALSE. INTEGER :: Warnings = 0 INTEGER :: Verbose = 0 INTEGER :: nWarnings = 0 @@ -429,7 +425,7 @@ END SUBROUTINE HCO_WarningNoErr !\\ ! !INTERFACE: ! - SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2, Verb ) + SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2 ) ! ! !INPUT PARAMETERS: ! @@ -437,7 +433,9 @@ SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2, Verb ) CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: Msg CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep1 CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep2 - INTEGER, INTENT(IN ), OPTIONAL :: Verb +! +! !REMARKS: +! Refactored to avoid ELSE statements, which are a computational bottleneck. ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -445,63 +443,39 @@ SUBROUTINE HCO_MSGErr( Err, Msg, Sep1, Sep2, Verb ) !EOP !------------------------------------------------------------------------------ !BOC - LOGICAL :: IsOpen - INTEGER :: LUN + INTEGER :: LUN - !====================================================================== + !======================================================================= ! HCO_MSG begins here - !====================================================================== + !======================================================================= - ! Check if Err object is indeed defined - IF ( .NOT. ASSOCIATED(Err) ) THEN - IsOpen = .FALSE. - ELSE - IsOpen = Err%LogIsOpen - - ! Don't print if this is not the root CPU - IF ( .NOT. Err%IsRoot ) RETURN - - !---------------------------------------------------------------------- - ! REDUCE LOGFILE OUTPUT: Only print if VERBOSE=3 - ! TODO: Convert VERBOSE from integer to a logical on/off switch - !! Don't print if verbose level is smaller than verbose level of this - !! CPU. - !IF ( PRESENT( Verb ) ) THEN - ! IF ( Verb < Err%Verbose ) RETURN - !ENDIF - !---------------------------------------------------------------------- - IF ( .not. HCO_IsVerb( Err ) ) RETURN - ENDIF + ! Exit if Err is NULL + IF ( .NOT. ASSOCIATED( Err) ) RETURN - ! Use standard output if file not open - IF ( .NOT. IsOpen ) THEN - IF ( PRESENT(MSG) ) PRINT *, TRIM(MSG) + ! Exit if we are not on the root core + IF ( .NOT. Err%IsRoot ) RETURN - ! Print message to error file - ELSE - LUN = Err%LUN + ! Exit if Verbose is turned off + IF ( .not. Err%doVerbose ) RETURN - IF (LUN > 0 ) THEN - IF ( PRESENT(SEP1) ) THEN - WRITE( LUN,'(a)' ) REPEAT( SEP1, 79 ) - ENDIF - IF ( PRESENT(MSG) ) THEN - WRITE( LUN,'(a)' ) TRIM( MSG ) - ENDIF - IF ( PRESENT(SEP2) ) THEN - WRITE( LUN,'(a)' ) REPEAT( SEP2, 79 ) - ENDIF - ELSE - IF ( PRESENT(SEP1) ) THEN - WRITE( 6, '(a)' ) REPEAT( SEP1, 79 ) - ENDIF - IF ( PRESENT(MSG) ) THEN - WRITE( 6, '(a)' ) TRIM( MSG ) - ENDIF - IF ( PRESENT(SEP2) ) THEN - WRITE( 6, '(a)' ) REPEAT( SEP2, 79 ) - ENDIF - ENDIF + !======================================================================= + ! Write message + !======================================================================= + + ! Get the file unit, or if the file is not open, use stdout + LUN = Err%LUN + IF ( ( .not. Err%LogIsOpen ) .or. ( LUN <= 0 ) ) LUN = 6 + + ! If logfile is open then write to it + ! Otherwise write to stdout (unit #6) + IF ( PRESENT(SEP1) ) THEN + WRITE( LUN,'(a)' ) REPEAT( SEP1, 79 ) + ENDIF + IF ( PRESENT(MSG) ) THEN + WRITE( LUN,'(a)' ) TRIM( MSG ) + ENDIF + IF ( PRESENT(SEP2) ) THEN + WRITE( LUN,'(a)' ) REPEAT( SEP2, 79 ) ENDIF END SUBROUTINE HCO_MsgErr @@ -531,7 +505,7 @@ SUBROUTINE HCO_MSGnoErr( Msg, Sep1, Sep2, Verb ) CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: Msg CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep1 CHARACTER(LEN=1), INTENT(IN ), OPTIONAL :: Sep2 - INTEGER, INTENT(IN ), OPTIONAL :: Verb + LOGICAL, INTENT(IN ), OPTIONAL :: Verb ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -544,21 +518,18 @@ SUBROUTINE HCO_MSGnoErr( Msg, Sep1, Sep2, Verb ) ! HCO_MSG begins here !====================================================================== - !---------------------------------------------------------------------- - ! REDUCE LOGFILE OUTPUT: Only print if VERBOSE=3 - ! TODO: Convert VERBOSE from integer to a logical on/off switch - ! -- Bob Yantosca (05 Dec 2022) - IF ( Verb < 3 ) RETURN - !---------------------------------------------------------------------- + ! Exit if verbose is not requested + IF ( .not. Verb ) RETURN + ! Print message and optional separator lines IF ( PRESENT( SEP1 ) ) THEN - WRITE( 6,'(a)' ) REPEAT( SEP1, 79 ) + WRITE( 6, '(a)' ) REPEAT( SEP1, 79 ) ENDIF IF ( PRESENT( msg ) ) THEN WRITE( 6, '(a)' ) TRIM( msg ) ENDIF IF ( PRESENT( SEP2 ) ) THEN - WRITE( 6,'(a)' ) REPEAT( SEP2, 79 ) + WRITE( 6, '(a)' ) REPEAT( SEP2, 79 ) ENDIF END SUBROUTINE HCO_MsgNoErr @@ -718,8 +689,8 @@ END SUBROUTINE HCO_Leave !\\ ! !INTERFACE: ! - SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & - Verbose, WarningLevel, RC ) + SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, doVerbose, RC ) + ! ! !INPUT PARAMETERS: ! @@ -729,8 +700,7 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: Verbose ! verbose level - INTEGER, INTENT(INOUT) :: WarningLevel ! warning level + LOGICAL, INTENT(INOUT) :: doVerbose INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: @@ -758,20 +728,21 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & ! Set verbose to -1 if this is not the root CPU. This will disable any ! log-file messages IF ( .NOT. am_I_Root ) THEN - Verbose = -1 - WarningLevel = 0 + !Verbose = -1 + !WarningLevel = 0 + doVerbose = .FALSE. ENDIF ! Pass values Err%IsRoot = am_I_Root Err%LogFile = TRIM(LogFile) - Err%Verbose = Verbose - Err%Warnings = WarningLevel + Err%doVerbose = doVerbose + !Err%Warnings = WarningLevel ! Init misc. values Err%FirstOpen = .TRUE. Err%LogIsOpen = .FALSE. - Err%nWarnings = 0 + !Err%nWarnings = 0 Err%CurrLoc = 0 ! If Logfile is set to '*', set lun to -1 (--> write into default file). @@ -876,7 +847,7 @@ END FUNCTION HCO_VERBOSE_INQ !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: HCO_IsVerb_NoVerbNr +! !IROUTINE: HCO_IsVerb_NoVerb ! ! !DESCRIPTION: Returns true if the HEMCO verbose number is set to 3 or larger. ! Does not use an "Verb" argument @@ -884,7 +855,7 @@ END FUNCTION HCO_VERBOSE_INQ !\\ ! !INTERFACE: ! - FUNCTION HCO_IsVerb_NoVerbNr( Err ) RESULT ( IsVerb ) + FUNCTION HCO_IsVerb( Err ) RESULT ( IsVerb ) ! ! !INPUT PARAMETERS: ! @@ -911,59 +882,9 @@ FUNCTION HCO_IsVerb_NoVerbNr( Err ) RESULT ( IsVerb ) IF ( .not. ASSOCIATED( Err ) ) RETURN ! Check if "Verbose: 3" was set in the HEMCO_Config.rc file - isVerb = ( Err%Verbose >= 3 ) + isVerb = Err%doVerbose - END FUNCTION HCO_IsVerb_NoVerbNr -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCO_IsVerb_VerbNr -! -! !DESCRIPTION: Function HCO\_IsVerb\_VerbNr returns true if the HEMCO -! verbose number is equal to or larger than the passed number. -!\\ -!\\ -! !INTERFACE: -! - FUNCTION HCO_IsVerb_VerbNr( Err, VerbNr ) RESULT ( IsVerb ) -! -! !INPUT PARAMETERS: -! - TYPE(HcoErr), POINTER :: Err ! Error object - INTEGER, INTENT(IN) :: VerbNr -! -! !OUTPUT PARAMETERS: -! - LOGICAL :: IsVerb -! -! !REMARKS: -! HCO_IsVerb will be phased out and replaced by HCO_IsVerbose. -! -! !REVISION HISTORY: -! 15 Mar 2015 - C. Keller - Initialization -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - - !====================================================================== - ! HCO_IsVerb_VerbNr begins here - !====================================================================== - - ! Initialize - isVerb = .FALSE. - - ! Return FALSE if the Err object is NULL - IF ( .NOT. ASSOCIATED( Err ) ) RETURN - - ! Otherwise determine if this verbose level is greater or equal - ! to the verbose level specified in HEMCO_Config.rc - isVerb = ( Err%Verbose >= VerbNr ) - - END FUNCTION HCO_IsVerb_VerbNr + END FUNCTION HCO_IsVerb !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -1082,18 +1003,10 @@ SUBROUTINE HCO_LogFile_Open( Err, RC ) ! Write header on first call IF ( Err%FirstOpen ) THEN - IF ( Err%LUN < 0 ) THEN - LUN = 6 ! Log gets written to stdout - ELSE - LUN = Err%LUN ! Log gets written to file - ENDIF + LUN = Err%Lun ! Log gets written to file + IF ( Err%LUN < 0 ) LUN = 6 ! ,,, or to stdout if file isn't open - !------------------------------------------------------------------ - ! REDUCE LOGFILE OUTPUT: - ! Only write splash screen when VERBOSE=3 - ! TODO: Change VERBOSE from integer to a logical on/off switch - ! -- Bob Yantosca (05 Dec 2022) - !------------------------------------------------------------------ + ! Only write the version info if verbose output is requested IF ( HCO_IsVerb( Err ) ) THEN ! Write header diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index f4fc012e..50cd26bf 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -235,7 +235,7 @@ SUBROUTINE AddExt( HcoConfig, ExtName, ExtNr, InUse, Spcs, RC ) ENDIF ! Verbose - IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,2) .AND. InUse ) THEN + IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err) .AND. InUse ) THEN WRITE(MSG,*) 'Added HEMCO extension: ', TRIM(ExtName), ExtNr CALL HCO_MSG(HcoConfig%Err,MSG) ENDIF @@ -935,7 +935,7 @@ SUBROUTINE SetExtNr( HcoConfig, ExtNr, ExtName, RC ) !====================================================================== ! verbose? - verb = HCO_IsVerb( HcoConfig%Err, 1 ) + verb = HCO_IsVerb( HcoConfig%Err ) ! Pass name to module and set to lower case IF ( PRESENT(ExtName) ) THEN @@ -1241,7 +1241,7 @@ SUBROUTINE HCO_AddOpt ( HcoConfig, OptName, OptValue, ExtNr, RC, & ThisExt%Opts => NewOpt ! Verbose - IF ( VRB .AND. HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,2) ) THEN + IF ( VRB .AND. HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err) ) THEN MSG = 'Added the following option: ' // TRIM(OptName)//': '//TRIM(OptValue) CALL HCO_MSG(HcoConfig%Err,MSG) ENDIF diff --git a/src/Core/hco_geotools_mod.F90 b/src/Core/hco_geotools_mod.F90 index 4db1c2e5..f77d1a34 100644 --- a/src/Core/hco_geotools_mod.F90 +++ b/src/Core/hco_geotools_mod.F90 @@ -830,7 +830,7 @@ SUBROUTINE HCO_CalcVertGrid ( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) ! Verbose statements IF ( HcoState%amIRoot .AND. FIRST .AND. & - HCO_IsVerb(HcoState%Config%Err,2) ) THEN + HCO_IsVerb(HcoState%Config%Err) ) THEN Verb = .TRUE. ENDIF IF ( Verb ) THEN @@ -1406,7 +1406,7 @@ SUBROUTINE HCO_SetPBLm( HcoState, FldName, PBLM, DefVal, RC ) ENDIF ! Verbose - IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( FOUND ) THEN WRITE(MSG,*) 'HEMCO PBL heights obtained from field ',TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-') @@ -1432,7 +1432,7 @@ SUBROUTINE HCO_SetPBLm( HcoState, FldName, PBLM, DefVal, RC ) FOUND = .TRUE. ! Verbose - IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'HEMCO PBL heights obtained from provided 2D field.' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-') ENDIF @@ -1457,7 +1457,7 @@ SUBROUTINE HCO_SetPBLm( HcoState, FldName, PBLM, DefVal, RC ) FOUND = .TRUE. ! Verbose - IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'HEMCO PBL heights uniformly set to ', DefVal CALL HCO_MSG(HcoState%Config%Err,MSG,SEP2='-') ENDIF diff --git a/src/Core/hco_interp_mod.F90 b/src/Core/hco_interp_mod.F90 index ec8df383..e6c87391 100644 --- a/src/Core/hco_interp_mod.F90 +++ b/src/Core/hco_interp_mod.F90 @@ -203,7 +203,7 @@ SUBROUTINE REGRID_MAPA2A( HcoState, NcArr, LonE, LatE, Lct, RC ) REGR_4D => NULL() ! Check for verbose mode - verb = HCO_IsVerb(HcoState%Config%Err, 3 ) + verb = HCO_IsVerb( HcoState%Config%Err ) ! get longitude / latitude sizes nLonEdge = SIZE(LonE,1) @@ -667,7 +667,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDIF ! Check for verbose mode - verb = HCO_IsVerb(HcoState%Config%Err, 3 ) + verb = HCO_IsVerb( HcoState%Config%Err ) IF ( verb ) THEN MSG = 'Vertically interpolate model levels: '//TRIM(Lct%Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -721,7 +721,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDDO ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = '# of input levels = # of output levels - passed as is.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -791,7 +791,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDDO ! T ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Mapped ', nlev, ' levels onto native GEOS-5 levels.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -864,7 +864,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDDO ! T ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GEOS-5 levels.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -935,7 +935,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDDO ! T ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GISS levels.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -962,7 +962,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ENDDO ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err, 3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Could not find vertical interpolation key - ', & 'kept the original ', nlev, ' levels.' CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -976,7 +976,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ! Error check / verbose mode !=================================================================== IF ( DONE ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err, 2) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Did vertical regridding for ',TRIM(Lct%Dct%cName),':' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Number of original levels: ', nlev diff --git a/src/Core/hco_logfile_mod.F90 b/src/Core/hco_logfile_mod.F90 index 5f28bb3a..6207d1a3 100644 --- a/src/Core/hco_logfile_mod.F90 +++ b/src/Core/hco_logfile_mod.F90 @@ -76,7 +76,7 @@ SUBROUTINE HCO_Spec2Log( HcoState, ID ) MSG = 'Species ' // TRIM(HcoState%Spc(ID)%SpcName) CALL HCO_MSG(HcoState%Config%Err,MSG) - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN write(MSG,*) '--> HcoID : ', HcoState%Spc(ID)%HcoID CALL HCO_MSG(HcoState%Config%Err,MSG) write(MSG,*) '--> ModID : ', HcoState%Spc(ID)%ModID @@ -105,7 +105,7 @@ END SUBROUTINE HCO_Spec2Log !\\ ! !INTERFACE: ! - SUBROUTINE HCO_PrintList ( HcoState, List, Verbose ) + SUBROUTINE HCO_PrintList ( HcoState, List ) ! ! !USES: ! @@ -116,7 +116,6 @@ SUBROUTINE HCO_PrintList ( HcoState, List, Verbose ) ! TYPE(HCO_STATE),POINTER :: HcoState TYPE(ListCont), POINTER :: List - INTEGER, INTENT(IN) :: Verbose ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -138,7 +137,7 @@ SUBROUTINE HCO_PrintList ( HcoState, List, Verbose ) TmpLct => List DO WHILE ( ASSOCIATED(TmpLct) ) IF ( ASSOCIATED(TmpLct%Dct) ) THEN - CALL HCO_PrintDataCont(HcoState,TmpLct%Dct,Verbose) + CALL HCO_PrintDataCont( HcoState,TmpLct%Dct ) ENDIF TmpLct => TmpLct%NextCont ENDDO @@ -160,7 +159,7 @@ END SUBROUTINE HCO_PrintList !\\ ! !INTERFACE: ! - SUBROUTINE HCO_PrintDataCont ( HcoState, Dct, Verbose ) + SUBROUTINE HCO_PrintDataCont ( HcoState, Dct ) ! ! !USES ! @@ -171,7 +170,6 @@ SUBROUTINE HCO_PrintDataCont ( HcoState, Dct, Verbose ) ! TYPE(HCO_STATE),POINTER :: HcoState TYPE(DataCont), POINTER :: Dct - INTEGER, INTENT(IN) :: Verbose ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -220,13 +218,13 @@ SUBROUTINE HCO_PrintDataCont ( HcoState, Dct, Verbose ) ENDIF ! Print name for verbose > 0 - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Container ' // TRIM(Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF ! Eventually add details - IF ( HCO_IsVerb(HcoState%Config%Err,Verbose) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN ! General information write(MSG,*) ' -->Data type : ', Dct%DctType diff --git a/src/Core/hco_readlist_mod.F90 b/src/Core/hco_readlist_mod.F90 index eb1ffdf6..4adb2980 100644 --- a/src/Core/hco_readlist_mod.F90 +++ b/src/Core/hco_readlist_mod.F90 @@ -114,7 +114,7 @@ SUBROUTINE ReadList_Set( HcoState, Dct, RC ) ENDIF ! Verbose mode - verb = HCO_IsVerb( HcoState%Config%Err, 2 ) + verb = HCO_IsVerb( HcoState%Config%Err ) ! Add container to ReadList according to update freqency. ! Fields in list 'Hour' will be updated (i.e. re-read) every hour, @@ -201,7 +201,7 @@ SUBROUTINE ReadList_Set( HcoState, Dct, RC ) IF ( Verb ) THEN WRITE(MSG,*) 'New container set to ReadList:' CALL HCO_MSG(HcoState%Config%Err, MSG) - CALL HCO_PrintDataCont( HcoState, Dct, 3 ) + CALL HCO_PrintDataCont( HcoState, Dct ) ENDIF ! Leave w/ success @@ -269,7 +269,7 @@ SUBROUTINE ReadList_Read( HcoState, RC, ReadAll ) ENDIF ! Verbose mode - verb = HCO_IsVerb( HcoState%Config%Err, 1 ) + verb = HCO_IsVerb( HcoState%Config%Err ) ! Read all fields? RdAll = .FALSE. @@ -457,7 +457,7 @@ SUBROUTINE ReadList_Fill( HcoState, ReadList, RC ) ENDIF ! Verbose mode? - verb = HCO_IsVerb ( HcoState%Config%Err, 2 ) + verb = HCO_IsVerb ( HcoState%Config%Err ) ! Loop over all containers Lct => ReadList @@ -749,7 +749,7 @@ END SUBROUTINE ReadList_Init !\\ ! !INTERFACE: ! - SUBROUTINE ReadList_Print( HcoState, ReadLists, verb ) + SUBROUTINE ReadList_Print( HcoState, ReadLists ) ! ! !USES: ! @@ -759,7 +759,6 @@ SUBROUTINE ReadList_Print( HcoState, ReadLists, verb ) ! TYPE(HCO_State), POINTER :: HcoState TYPE(RdList), POINTER :: ReadLists - INTEGER, INTENT(IN) :: verb ! verbose number ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -775,38 +774,38 @@ SUBROUTINE ReadList_Print( HcoState, ReadLists, verb ) ! ================================================================ ! Nothing to do if HEMCO verbose level is below passed verbose number - IF ( .NOT. HCO_IsVerb(HcoState%Config%Err,verb) ) RETURN + IF ( .NOT. HCO_IsVerb(HcoState%Config%Err ) ) RETURN ! Print content of all lists IF ( ASSOCIATED(ReadLists) .and. HcoState%amIRoot ) THEN WRITE(MSG,*) 'Contents of one-time list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Once, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Once ) WRITE(MSG,*) 'Contents of year list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Year, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Year ) WRITE(MSG,*) 'Contents of month list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Month, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Month ) WRITE(MSG,*) 'Contents of day list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Day, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Day ) WRITE(MSG,*) 'Contents of 3-hour list:' - CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Hour3, verb ) + CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=' ) + CALL HCO_PrintList ( HcoState, ReadLists%Hour3 ) WRITE(MSG,*) 'Contents of hour list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Hour, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Hour ) WRITE(MSG,*) 'Contents of always-to-read list:' CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1='=') - CALL HCO_PrintList ( HcoState, ReadLists%Always, verb ) + CALL HCO_PrintList ( HcoState, ReadLists%Always ) ELSE WRITE(MSG,*) 'ReadList not defined yet!!' diff --git a/src/Core/hco_restart_mod.F90 b/src/Core/hco_restart_mod.F90 index 2096a273..d80c78c1 100644 --- a/src/Core/hco_restart_mod.F90 +++ b/src/Core/hco_restart_mod.F90 @@ -336,7 +336,7 @@ SUBROUTINE HCO_RestartGet_3D( HcoState, Name, Arr3D, & ENDIF ! Log output - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot .AND. FLD ) THEN MSG = 'Obtained restart variable from ESMF internal state: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -361,7 +361,7 @@ SUBROUTINE HCO_RestartGet_3D( HcoState, Name, Arr3D, & Arr3D = Ptr3D ! Log output - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Obtained restart variable from HEMCO config: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -380,7 +380,7 @@ SUBROUTINE HCO_RestartGet_3D( HcoState, Name, Arr3D, & IF ( PRESENT(Def3D) ) THEN Arr3D = Def3D FLD = .TRUE. - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Filled restart variable with default 3D field: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -389,7 +389,7 @@ SUBROUTINE HCO_RestartGet_3D( HcoState, Name, Arr3D, & ELSEIF( PRESENT(DefVal) ) THEN Arr3D = DefVal FLD = .TRUE. - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Filled restart variable with default scalar: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -497,7 +497,7 @@ SUBROUTINE HCO_RestartGet_2D( HcoState, Name, Arr2D, & ENDIF ! Log output - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot .AND. FLD ) THEN MSG = 'Obtained restart variable from ESMF internal state: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -523,7 +523,7 @@ SUBROUTINE HCO_RestartGet_2D( HcoState, Name, Arr2D, & Arr2D = Ptr2D ! Log output - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Obtained restart variable from HEMCO config: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -543,7 +543,7 @@ SUBROUTINE HCO_RestartGet_2D( HcoState, Name, Arr2D, & IF ( PRESENT(Def2D) ) THEN Arr2D = Def2D FLD = .TRUE. - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Filled restart variable with default 2D field: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -553,7 +553,7 @@ SUBROUTINE HCO_RestartGet_2D( HcoState, Name, Arr2D, & ELSEIF( PRESENT(DefVal) ) THEN Arr2D = DefVal FLD = .TRUE. - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot ) THEN MSG = 'Filled restart variable with default scalar: '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -569,7 +569,7 @@ SUBROUTINE HCO_RestartGet_2D( HcoState, Name, Arr2D, & IF ( PRESENT(FILLED) ) FILLED = FLD ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN IF ( HcoState%amIRoot .AND. .NOT. FLD ) THEN MSG = 'No restart field found (2D): '//TRIM(Name) CALL HCO_MSG(HcoState%Config%Err,MSG) diff --git a/src/Core/hco_scale_mod.F90 b/src/Core/hco_scale_mod.F90 index 2853a180..42656bdd 100644 --- a/src/Core/hco_scale_mod.F90 +++ b/src/Core/hco_scale_mod.F90 @@ -129,7 +129,7 @@ SUBROUTINE HCO_ScaleInit( HcoState, RC ) SpcScal(N) = ScalFactor ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE (MSG,*) 'Will use universal emission scale factor for ', & TRIM(HcoState%Spc(N)%SpcName),': ',SpcScal(N) CALL HCO_MSG ( HcoState%Config%Err, MSG ) @@ -243,7 +243,7 @@ SUBROUTINE HCO_ScaleArr3D_sp( HcoState, HcoID, Arr3D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr3D = Arr3D * ScalFact ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) '3D field scaled by factor of ',ScalFact CALL HCO_MSG ( HcoState%Config%Err, MSG ) ENDIF @@ -307,7 +307,7 @@ SUBROUTINE HCO_ScaleArr3D_dp( HcoState, HcoID, Arr3D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr3D = Arr3D * ScalFact ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) '3D field scaled by factor of ',ScalFact CALL HCO_MSG ( HcoState%Config%Err, MSG ) ENDIF @@ -370,7 +370,7 @@ SUBROUTINE HCO_ScaleArr2D_sp( HcoState, HcoID, Arr2D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr2D = Arr2D * ScalFact ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) '2D field scaled by factor of ',ScalFact CALL HCO_MSG ( HcoState%Config%Err, MSG ) ENDIF @@ -433,7 +433,7 @@ SUBROUTINE HCO_ScaleArr2D_dp( HcoState, HcoID, Arr2D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr2D = Arr2D * ScalFact ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) '2D field scaled by factor of ',ScalFact CALL HCO_MSG ( HcoState%Config%Err, MSG ) ENDIF @@ -495,7 +495,7 @@ SUBROUTINE HCO_ScaleArr1D_sp( HcoState, HcoID, Arr1D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr1D = Arr1D * ScalFact ! Verbose mode - !IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + !IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN ! WRITE(MSG,*) '1D field scaled by factor of ',ScalFact ! CALL HCO_MSG ( HcoState%Config%Err, MSG ) !ENDIF @@ -557,7 +557,7 @@ SUBROUTINE HCO_ScaleArr1D_dp( HcoState, HcoID, Arr1D, RC ) IF ( ScalFact /= 1.0_hp ) THEN Arr1D = Arr1D * ScalFact ! Verbose mode - !IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + !IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN ! WRITE(MSG,*) '1D field scaled by factor of ',ScalFact ! CALL HCO_MSG ( HcoState%Config%Err, MSG ) !ENDIF diff --git a/src/Core/hco_state_mod.F90 b/src/Core/hco_state_mod.F90 index 0aaea47f..fb2cf2a2 100644 --- a/src/Core/hco_state_mod.F90 +++ b/src/Core/hco_state_mod.F90 @@ -498,7 +498,7 @@ SUBROUTINE HcoState_Init( HcoState, HcoConfig, nSpecies, RC ) HcoState%AlltIDx => NULL() ! Verbose mode - IF ( HCO_IsVerb(HcoConfig%Err,1) ) THEN + IF ( HCO_IsVerb( HcoConfig%Err ) ) THEN WRITE(MSG,'(A68)') 'Initialized HEMCO state. Will use the following settings:' CALL HCO_MSG(HcoConfig%Err,MSG) WRITE(MSG,'(A33,I2)') 'Unit tolerance : ', UnitTolerance diff --git a/src/Core/hco_timeshift_mod.F90 b/src/Core/hco_timeshift_mod.F90 index 8baba679..4dd81c72 100644 --- a/src/Core/hco_timeshift_mod.F90 +++ b/src/Core/hco_timeshift_mod.F90 @@ -180,7 +180,7 @@ SUBROUTINE TimeShift_Set( HcoConfig, Dta, shift, RC ) ENDIF ! verbose mode - IF ( HCO_IsVerb(HcoConfig%Err,2) ) THEN + IF ( HCO_IsVerb( HcoConfig%Err ) ) THEN WRITE(MSG,*) 'Will shift time stamp of field ', TRIM(Dta%ncPara), & ': ', TRIM(tShift) CALL HCO_MSG(HcoConfig%Err,MSG) @@ -378,7 +378,7 @@ SUBROUTINE TimeShift_Apply( HcoState, Lct, & nDy = oDy nHr = 0 nMn = 0 - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Options set to cap time shift - set to low bound' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -388,7 +388,7 @@ SUBROUTINE TimeShift_Apply( HcoState, Lct, & nDy = oDy nHr = 23 nMn = 59 - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Options set to cap time shift - set to high bound' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -396,7 +396,7 @@ SUBROUTINE TimeShift_Apply( HcoState, Lct, & ENDIF ! verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Adjusted time stamp of field ', TRIM(Lct%Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Time shift (YMDhms): ', Lct%Dct%Dta%tShift @@ -413,7 +413,7 @@ SUBROUTINE TimeShift_Apply( HcoState, Lct, & Mn = nMn ! verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,'(a27,i4.4,a1,i2.2,a1,i2.2,a1,i2.2,a1,i2.2)') 'Adjusted Yr/Mt/Dy-Hr:Mn = ',Yr,'/',Mt,'/',Dy,'-',Hr,':',Mn CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Core/hco_vertgrid_mod.F90 b/src/Core/hco_vertgrid_mod.F90 index 89733b75..cd8826d8 100644 --- a/src/Core/hco_vertgrid_mod.F90 +++ b/src/Core/hco_vertgrid_mod.F90 @@ -259,7 +259,7 @@ SUBROUTINE HCO_VertGrid_Define( HcoConfig, zGrid, nz, Ap, Bp, RC ) ENDIF ! Verbose - IF ( HcoConfig%amIRoot .AND. HCO_IsVerb(HcoConfig%Err,1) ) THEN + IF ( HcoConfig%amIRoot .AND. HCO_IsVerb( HcoConfig%Err ) ) THEN WRITE(MSG,*) ' HEMCO vertical sigma-hybrid coordinates: ' CALL HCO_MSG(HcoConfig%Err,MSG) WRITE(MSG,*) 'Ap [Pa] (first and last): ', zGrid%Ap(1), zGrid%Ap(nz+1) diff --git a/src/Core/hcoio_messy_mod.F90 b/src/Core/hcoio_messy_mod.F90 index 608db066..54cf38a5 100644 --- a/src/Core/hcoio_messy_mod.F90 +++ b/src/Core/hcoio_messy_mod.F90 @@ -178,7 +178,7 @@ SUBROUTINE HCO_MESSY_REGRID ( HcoState, NcArr, & ArrOut => NULL() ! verbose? - verb = HCO_IsVerb(HcoState%Config%Err,3) + verb = HCO_IsVerb( HcoState%Config%Err ) ! Horizontal dimension of input data NXIN = SIZE(NcArr,1) diff --git a/src/Core/hcoio_read_mapl_mod.F90 b/src/Core/hcoio_read_mapl_mod.F90 index 74c4a856..192d795e 100644 --- a/src/Core/hcoio_read_mapl_mod.F90 +++ b/src/Core/hcoio_read_mapl_mod.F90 @@ -116,7 +116,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) Ptr2D => NULL() ! Verbose? - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Reading from ExtData: ' // TRIM(Lct%Dct%Dta%ncFile) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 85a102ba..2ea02532 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -248,7 +248,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) NY = HcoState%NY ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Processing container: ', TRIM(Lct%Dct%cName) CALL HCO_MSG( HcoState%Config%Err, MSG, SEP1='-' ) ENDIF @@ -432,7 +432,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) IF ( ncLun > 0 ) THEN ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Reading from existing stream: ', TRIM(srcFile) CALL HCO_MSG( HcoState%Config%Err, MSG ) ENDIF @@ -442,7 +442,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NC_OPEN ( TRIM(srcFile), ncLun ) ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Opening file: ', TRIM(srcFile) CALL HCO_MSG( HcoState%Config%Err, MSG ) ENDIF @@ -729,7 +729,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Will read vertical levels ', lev1, ' to ', lev2 CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -758,7 +758,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! ---------------------------------------------------------------- ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Reading variable ', TRIM(Lct%Dct%Dta%ncPara) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -894,7 +894,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ncArr = (wgt1 * ncArr) + (wgt2 * ncArr2) ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Interpolated data between two files:' CALL HCO_MSG(HcoState%Config%Err,MSG) MSG = '- File 1: ' // TRIM(srcFile) @@ -1037,7 +1037,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ncArr = ncArr / REAL(nYears,sp) ! Verbose - IF ( HcoState%amIRoot .AND. HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HcoState%amIRoot .AND. HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,110) TRIM(Lct%Dct%cName), Yr1, Yr2 CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1102,7 +1102,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Based on srcUnit attribute (', TRIM(Lct%Dct%Dta%OrigUnit), & '), no unit conversion is performed.' CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -1156,7 +1156,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ! Verbose mode - IF ( HcoState%amIRoot .and. HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HcoState%amIRoot .and. HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Unit conversion settings: ' CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) '- Year, month : ', ncYr, ncMt @@ -1182,14 +1182,14 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Verbose mode IF ( UnitFactor /= 1.0_hp ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Data was in units of ', TRIM(thisUnit), & ' - converted to HEMCO units by applying ', & 'scale factor ', UnitFactor CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF ELSE - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Data was in units of ', TRIM(thisUnit), & ' - unit conversion factor is ', UnitFactor CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -1320,7 +1320,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) IF ( nlev > 1 ) THEN UseMESSy = .TRUE. - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) ' ==> WRF/CESM: Always forcing MESSy regridding for number of verticals', nlev, IsModelLevel CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1338,7 +1338,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Use MESSy regridding !----------------------------------------------------------------- IF ( UseMESSy ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) ' ==> Use MESSy regridding (NCREGRID)' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1379,7 +1379,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Ported from the original WRF-GC implementation (hplin, 5/27/20) !-------------------------------------------------------------- IF ( nlev > 1 .AND. IsModelLevel ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) ' ==> WRF/CESM: Writing in fixed sigma coordinates for GEOS-Chem levels', nlon, nlat CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1472,7 +1472,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Use map_a2a regridding !----------------------------------------------------------------- ELSE - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) ' ==> Use map_a2a regridding' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Core/hcoio_util_mod.F90 b/src/Core/hcoio_util_mod.F90 index 8fe97cd3..fd57f987 100644 --- a/src/Core/hcoio_util_mod.F90 +++ b/src/Core/hcoio_util_mod.F90 @@ -157,7 +157,7 @@ SUBROUTINE GET_TIMEIDX( HcoState, Lct, & CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) RETURN ENDIF - verb = HCO_IsVerb(HcoState%Config%Err,3) + verb = HCO_IsVerb( HcoState%Config%Err ) ! Initialize local variables for safety's sake nTime = 0 @@ -1118,7 +1118,7 @@ SUBROUTINE GetIndex2Interp ( HcoState, Lct, & !================================================================= ! Verbose mode? - verb = HCO_IsVerb(HcoState%Config%Err,3) + verb = HCO_IsVerb( HcoState%Config%Err ) ! If the originally wanted datetime was below the available data ! range, set all weights to the first index. @@ -1573,7 +1573,7 @@ SUBROUTINE SrcFile_Parse ( HcoState, Lct, srcFile, FOUND, RC, & srcFile = Lct%Dct%Dta%ncFile ! verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Parsing source file and replacing tokens' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2105,7 +2105,7 @@ SUBROUTINE GetArbDimIndex( HcoState, Lun, Lct, ArbIdx, RC ) ENDIF ! Verbose - IF ( HcoState%amIRoot .AND. HCO_IsVerb( HcoState%Config%Err, 2 ) ) THEN + IF ( HcoState%amIRoot .AND. HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Additional dimension ', TRIM(Lct%Dct%Dta%ArbDimName), & ' in ', TRIM(Lct%Dct%Dta%ncFile), ': use index ', & ArbIdx, ' (set: ', Lct%Dct%Dta%ArbDimVal, ')' @@ -2255,7 +2255,7 @@ SUBROUTINE HCOIO_ReadCountryValues ( HcoState, Lct, RC ) Vals => NULL() ! verbose mode? - Verb = HCO_IsVerb(HcoState%Config%Err,2) + Verb = HCO_IsVerb( HcoState%Config%Err ) ! Verbose IF ( Verb ) THEN @@ -2313,7 +2313,7 @@ SUBROUTINE HCOIO_ReadCountryValues ( HcoState, Lct, RC ) CIDS = NINT(CNTR) ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = '- Use ID mask ' // TRIM(LINE) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2379,7 +2379,7 @@ SUBROUTINE HCOIO_ReadCountryValues ( HcoState, Lct, RC ) ENDDO ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) '- Obtained values for ',TRIM(CNT),' ==> ID:', CID CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2478,7 +2478,7 @@ SUBROUTINE HCOIO_ReadFromConfig( HcoState, Lct, RC ) Vals => NULL() ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG, *) 'Read from config file: ', TRIM(Lct%Dct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -3011,14 +3011,14 @@ SUBROUTINE GetDataVals ( HcoState, Lct, ValStr, Vals, RC ) ! Verbose mode IF ( UnitFactor /= 1.0_hp ) THEN - IF ( HCO_IsVerb(HcoState%Config%Err,1) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Data was in units of ', TRIM(Lct%Dct%Dta%OrigUnit), & ' - converted to HEMCO units by applying ', & 'scale factor ', UnitFactor CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF ELSE - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Data was in units of ', TRIM(Lct%Dct%Dta%OrigUnit), & ' - unit conversion factor is ', UnitFactor CALL HCO_MSG(HcoState%Config%Err,MSG) @@ -3454,7 +3454,7 @@ SUBROUTINE ReadMath( HcoState, Lct, ValStr, Vals, N, RC ) Vals(I) = Val ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Evaluated function: ',TRIM(func),' --> ', Val CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Core/hcoio_write_std_mod.F90 b/src/Core/hcoio_write_std_mod.F90 index d2bb893e..7c076e51 100644 --- a/src/Core/hcoio_write_std_mod.F90 +++ b/src/Core/hcoio_write_std_mod.F90 @@ -346,11 +346,11 @@ SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, & ENDIF ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. PS==1 ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) .AND. PS==1 ) THEN MSG = 'Write diagnostics into file '//TRIM(ncFile) CALL HCO_MSG( HcoState%Config%Err, MSG ) ENDIF - IF ( HCO_IsVerb(HcoState%Config%Err,3) .AND. PS==1 ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) .AND. PS==1 ) THEN WRITE(MSG,*) '--> write level dimension: ', .NOT.NoLevDim CALL HCO_MSG( HcoState%Config%Err, MSG ) ENDIF @@ -783,7 +783,7 @@ SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, & ENDIF ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. PS==1 ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err ) .AND. PS==1 ) THEN MSG = '--- Added diagnostics: '//TRIM(myName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Extensions/hcox_custom_mod.F90 b/src/Extensions/hcox_custom_mod.F90 index e95ba4c3..92e303db 100644 --- a/src/Extensions/hcox_custom_mod.F90 +++ b/src/Extensions/hcox_custom_mod.F90 @@ -257,7 +257,6 @@ SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC ) ! INTEGER :: ExtNr, N, nSpc, AS INTEGER, ALLOCATABLE :: HcoIDs(:) - LOGICAL :: verb CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:) CHARACTER(LEN=255) :: MSG, LOC TYPE(MyInst), POINTER :: Inst @@ -277,7 +276,6 @@ SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC ) CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) RETURN ENDIF - verb = HCO_IsVerb(HcoState%Config%Err,1) Inst => NULL() CALL InstCreate ( ExtNr, ExtState%Custom, Inst, RC ) @@ -317,9 +315,9 @@ SUBROUTINE HCOX_Custom_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: Custom (custom emissions module)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F index 4c779537..6b0051af 100644 --- a/src/Extensions/hcox_dustdead_mod.F +++ b/src/Extensions/hcox_dustdead_mod.F @@ -700,9 +700,9 @@ SUBROUTINE HCOX_DustDead_Init ( HcoState, ExtName, ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: DustDead (dust mobilization)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_dustginoux_mod.F90 b/src/Extensions/hcox_dustginoux_mod.F90 index 86e38db9..8eb206ad 100644 --- a/src/Extensions/hcox_dustginoux_mod.F90 +++ b/src/Extensions/hcox_dustginoux_mod.F90 @@ -3,7 +3,7 @@ !------------------------------------------------------------------------------ !BOP ! -! !MODULE: hemcox_dustginoux_mod.F90 +! !MODULE: hcox_dustginoux_mod.F90 ! ! !DESCRIPTION: Paul GINOUX dust source function. This subroutine updates ! the surface mixing ratio of dust aerosols for NDSTBIN size bins. The @@ -564,9 +564,9 @@ SUBROUTINE HcoX_DustGinoux_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: DustGinoux (dust mobilization)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_finn_mod.F90 b/src/Extensions/hcox_finn_mod.F90 index 9414ed78..2faf8031 100644 --- a/src/Extensions/hcox_finn_mod.F90 +++ b/src/Extensions/hcox_finn_mod.F90 @@ -876,11 +876,11 @@ SUBROUTINE HCOX_FINN_Init( HcoState, ExtName, ExtState, RC ) IF ( HcoState%amIRoot ) THEN ! Write the name of the extension regardless of the verbose setting - MSG = 'Using HEMCO extension: FINN (biomass burning)' + msg = 'Using HEMCO extension: FINN (biomass burning)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Other print statements will only be written as debug output diff --git a/src/Extensions/hcox_gc_POPs_mod.F90 b/src/Extensions/hcox_gc_POPs_mod.F90 index fe51c01d..fcc16402 100644 --- a/src/Extensions/hcox_gc_POPs_mod.F90 +++ b/src/Extensions/hcox_gc_POPs_mod.F90 @@ -1672,9 +1672,9 @@ SUBROUTINE HCOX_GC_POPs_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: GC_POPs (POPs emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_gc_RnPbBe_mod.F90 b/src/Extensions/hcox_gc_RnPbBe_mod.F90 index cd701ad6..36cd5983 100644 --- a/src/Extensions/hcox_gc_RnPbBe_mod.F90 +++ b/src/Extensions/hcox_gc_RnPbBe_mod.F90 @@ -605,9 +605,9 @@ SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: GC_RnPbBe (radionuclide emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_gfed_mod.F90 b/src/Extensions/hcox_gfed_mod.F90 index 079dbe06..5496d2f3 100644 --- a/src/Extensions/hcox_gfed_mod.F90 +++ b/src/Extensions/hcox_gfed_mod.F90 @@ -770,9 +770,9 @@ SUBROUTINE HCOX_GFED_Init ( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: GFED (biomass burning)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_iodine_mod.F90 b/src/Extensions/hcox_iodine_mod.F90 index 059616db..6370bd8f 100644 --- a/src/Extensions/hcox_iodine_mod.F90 +++ b/src/Extensions/hcox_iodine_mod.F90 @@ -453,9 +453,9 @@ SUBROUTINE HCOX_Iodine_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: Inorg_Iodine (HOI and I2 emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_lightnox_mod.F90 b/src/Extensions/hcox_lightnox_mod.F90 index eb6c4aa8..97d55c99 100644 --- a/src/Extensions/hcox_lightnox_mod.F90 +++ b/src/Extensions/hcox_lightnox_mod.F90 @@ -952,9 +952,9 @@ SUBROUTINE HCOX_LightNOx_Init( HcoState, ExtName, ExtState, RC ) ! Print the name of the module regardless of verbose msg = 'Using HEMCO extension: LightNOx (lightning NOx emissions' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Other information will be printed only when verbose is true diff --git a/src/Extensions/hcox_megan_mod.F90 b/src/Extensions/hcox_megan_mod.F90 index 68960479..a3ade34e 100644 --- a/src/Extensions/hcox_megan_mod.F90 +++ b/src/Extensions/hcox_megan_mod.F90 @@ -3552,9 +3552,9 @@ SUBROUTINE HCOX_Megan_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: MEGAN (biogenic emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_paranox_mod.F90 b/src/Extensions/hcox_paranox_mod.F90 index 472bbbe8..5f1b9c65 100644 --- a/src/Extensions/hcox_paranox_mod.F90 +++ b/src/Extensions/hcox_paranox_mod.F90 @@ -1082,11 +1082,11 @@ SUBROUTINE HCOX_ParaNOx_Init( HcoState, ExtName, ExtState, RC ) IF ( HcoState%amIRoot ) THEN ! Write the name of the extension regardless of the verbose setting - MSG = 'Using HEMCO extension: ParaNOx (ship emission plumes)' + msg = 'Using HEMCO extension: ParaNOx (ship emission plumes)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write the rest of the information only when verbose is set diff --git a/src/Extensions/hcox_seaflux_mod.F90 b/src/Extensions/hcox_seaflux_mod.F90 index f269cfde..8d4e8950 100644 --- a/src/Extensions/hcox_seaflux_mod.F90 +++ b/src/Extensions/hcox_seaflux_mod.F90 @@ -190,7 +190,7 @@ SUBROUTINE HCOX_SeaFlux_Run( ExtState, HcoState, RC ) IF ( ExtState%SeaFlux <= 0 ) RETURN ! Verbose? - verbose = HCO_IsVerb(HcoState%Config%Err,1) + verbose = HCO_IsVerb( HcoState%Config%Err ) ! Nullify Arr2D => NULL() @@ -702,9 +702,9 @@ SUBROUTINE HCOX_SeaFlux_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: SeaFlux (air-sea flux emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! With separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! W/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_seasalt_mod.F90 b/src/Extensions/hcox_seasalt_mod.F90 index 58a91e3e..8e34a49f 100644 --- a/src/Extensions/hcox_seasalt_mod.F90 +++ b/src/Extensions/hcox_seasalt_mod.F90 @@ -1002,11 +1002,11 @@ SUBROUTINE HCOX_SeaSalt_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: SeaSalt (sea salt aerosol emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF - + ! Write all other messages as debug printout only IF ( HcoState%MarinePOA ) THEN MSG = 'Use marine organic aerosols option' diff --git a/src/Extensions/hcox_soilnox_mod.F90 b/src/Extensions/hcox_soilnox_mod.F90 index c36c8a2b..53915189 100644 --- a/src/Extensions/hcox_soilnox_mod.F90 +++ b/src/Extensions/hcox_soilnox_mod.F90 @@ -829,9 +829,9 @@ SUBROUTINE HCOX_SoilNOx_Init( HcoState, ExtName, ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: SoilNOx (soil NOx emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_state_mod.F90 b/src/Extensions/hcox_state_mod.F90 index d4515838..9899a37e 100644 --- a/src/Extensions/hcox_state_mod.F90 +++ b/src/Extensions/hcox_state_mod.F90 @@ -1290,7 +1290,7 @@ SUBROUTINE ExtDat_Set_2R ( HcoState, ExtDat, & ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1335,7 +1335,7 @@ SUBROUTINE ExtDat_Set_2R ( HcoState, ExtDat, & IF ( PRESENT(Filled) ) Filled = .TRUE. ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Set extension field pointer to external data: ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1489,7 +1489,7 @@ SUBROUTINE ExtDat_Set_2S ( HcoState, ExtDat, & ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1534,7 +1534,7 @@ SUBROUTINE ExtDat_Set_2S ( HcoState, ExtDat, & IF ( PRESENT(Filled) ) Filled = .TRUE. ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Set extension field pointer to external data: ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1688,7 +1688,7 @@ SUBROUTINE ExtDat_Set_2I ( HcoState, ExtDat, & ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1733,7 +1733,7 @@ SUBROUTINE ExtDat_Set_2I ( HcoState, ExtDat, & IF ( PRESENT(Filled) ) Filled = .TRUE. ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Set extension field pointer to external data: ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1901,7 +1901,7 @@ SUBROUTINE ExtDat_Set_3R ( HcoState, ExtDat, FldName, & ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -1947,7 +1947,7 @@ SUBROUTINE ExtDat_Set_3R ( HcoState, ExtDat, FldName, & IF ( PRESENT(Filled) ) Filled = .TRUE. ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Set extension field pointer to external data: ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2118,7 +2118,7 @@ SUBROUTINE ExtDat_Set_3S ( HcoState, ExtDat, FldName, & ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Will fill extension field from HEMCO data list field ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -2164,7 +2164,7 @@ SUBROUTINE ExtDat_Set_3S ( HcoState, ExtDat, FldName, & IF ( PRESENT(Filled) ) Filled = .TRUE. ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN MSG = 'Set extension field pointer to external data: ' // TRIM(FldName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF diff --git a/src/Extensions/hcox_template_mod.F90x b/src/Extensions/hcox_template_mod.F90x index 6d293ccf..fd397696 100644 --- a/src/Extensions/hcox_template_mod.F90x +++ b/src/Extensions/hcox_template_mod.F90x @@ -257,9 +257,9 @@ CONTAINS ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: ()' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_tomas_dustdead_mod.F b/src/Extensions/hcox_tomas_dustdead_mod.F index b960b240..baad5a2d 100644 --- a/src/Extensions/hcox_tomas_dustdead_mod.F +++ b/src/Extensions/hcox_tomas_dustdead_mod.F @@ -714,9 +714,9 @@ SUBROUTINE HCOX_TOMAS_DustDead_Init( HcoState, ExtName, ExtState, msg = 'Using HEMCO extension: TOMAS_DustDead ' & // 'dust mobilization for TOMAS)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ! Write all other messages as debug printout only diff --git a/src/Extensions/hcox_tomas_jeagle_mod.F90 b/src/Extensions/hcox_tomas_jeagle_mod.F90 index 2b41325b..51089376 100644 --- a/src/Extensions/hcox_tomas_jeagle_mod.F90 +++ b/src/Extensions/hcox_tomas_jeagle_mod.F90 @@ -389,9 +389,9 @@ SUBROUTINE HCOX_TOMAS_Jeagle_Init( HcoState, ExtName, ExtState, RC ) msg = & 'Using HEMCO extension: TOMAS_Jeagle (sea salt emissions for TOMAS)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ENDIF diff --git a/src/Extensions/hcox_volcano_mod.F90 b/src/Extensions/hcox_volcano_mod.F90 index e560c8d5..7168ae11 100644 --- a/src/Extensions/hcox_volcano_mod.F90 +++ b/src/Extensions/hcox_volcano_mod.F90 @@ -359,9 +359,9 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) ! Write the name of the extension regardless of the verbose setting msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( msg, verb=3, sep1='-' ) ! With separator line + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator ELSE - CALL HCO_Msg( msg, verb=3 ) ! Without separator line + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator ENDIF ELSE MSG = 'The Volcano extension is turned off.' @@ -721,7 +721,7 @@ SUBROUTINE ReadVolcTable( HcoState, ExtState, Inst, RC ) ENDDO ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Number of volcanoes: ', nVolc CALL HCO_MSG( HcoState%Config%Err, MSG) ENDIF @@ -1048,7 +1048,7 @@ SUBROUTINE EmitVolc( HcoState, ExtState, Inst, SO2d, SO2e, RC ) ENDDO ! testing - !IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + !IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN ! WRITE(MSG,*) 'Total eruptive emissions of volcano ', N, ' [kgS/s]: ', volcE ! CALL HCO_MSG(HcoState%Config%Err,MSG) ! WRITE(MSG,*) 'Total degassing emissions of volcano ', N, ' [kgS/s]: ', volcD @@ -1063,7 +1063,7 @@ SUBROUTINE EmitVolc( HcoState, ExtState, Inst, SO2d, SO2e, RC ) ENDIF ! verbose - IF ( HCO_IsVerb(HcoState%Config%Err,3) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN WRITE(MSG,*) 'Total eruptive emissions [kgS/s]: ', totE CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Total degassing emissions [kgS/s]: ', totD From 8da388401148394b96c4eff9e30f60cddf709555 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 8 Dec 2022 15:34:00 -0500 Subject: [PATCH 06/63] Remove WARNLEV argument from HCO_Warning src/Core/hco_calc_mod.F90 src/Core/hco_clock_mod.F90 src/Core/hco_diagn_mod.F90 src/Core/hco_geotools_mod.F90 src/Core/hcoio_read_std_mod.F90 src/Core/hcoio_util_mod.F90 src/Core/hcoio_write_std_F90 src/Extensions/hcox_volcano_mod.F90 - Removed the WARNLEV argument from calls to HCO_Warning, as warnings are now printed when "Verbose: true" is in HEMCO_Config.rc src/Core/hco_error_mod.f90 - Removed WARNLEV argument from HCO_WarningErr and HCO_WarningNoErr module routines - Add verb argument to HCO_WarningNoErr module routine - Removed the WARNLEV argument from calls to HCO_Warning, as warnings are now printed when "Verbose: true" is in HEMCO_Config.rc Signed-off-by: Bob Yantosca --- src/Core/hco_calc_mod.F90 | 4 ++-- src/Core/hco_clock_mod.F90 | 2 +- src/Core/hco_diagn_mod.F90 | 10 +++++----- src/Core/hco_error_mod.F90 | 23 ++++++++++------------- src/Core/hco_geotools_mod.F90 | 6 +++--- src/Core/hcoio_read_std_mod.F90 | 22 +++++++++++----------- src/Core/hcoio_util_mod.F90 | 23 +++++++++-------------- src/Core/hcoio_write_std_mod.F90 | 2 +- src/Extensions/hcox_volcano_mod.F90 | 2 +- 9 files changed, 43 insertions(+), 51 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index 302efce9..8ca898e0 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -2064,7 +2064,7 @@ SUBROUTINE HCO_EvalFld_2D( HcoState, cName, Arr2D, RC, FOUND ) UseLL = MIN( MAX(useLL,1), SIZE(Arr3D,3) ) IF ( UseLL /= 1 ) THEN WRITE(MSG,*) "2D data was emitted above surface - this information might be lost: " , TRIM(cName), UseLL - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC, WARNLEV=2 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ! Pass 3D data to 2D array @@ -2626,7 +2626,7 @@ SUBROUTINE GetIdx( HcoState, I, J, alt, altu, lidx, RC ) IF ( lidx == -1 .AND. alt >= altt ) THEN lidx = HcoState%NZ WRITE(MSG,*) 'Level is above max. grid box level - use top level ', alt - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC, WARNLEV=2 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) RETURN ENDIF diff --git a/src/Core/hco_clock_mod.F90 b/src/Core/hco_clock_mod.F90 index 15b414ed..a0028395 100644 --- a/src/Core/hco_clock_mod.F90 +++ b/src/Core/hco_clock_mod.F90 @@ -321,7 +321,7 @@ SUBROUTINE HcoClock_InitTzPtr( HcoState, RC ) IF ( .NOT. ASSOCIATED(HcoState%Clock) ) THEN CALL HCO_WARNING( HcoState%Config%Err, & 'CANNOT SET TIMEZONES - HEMCO CLOCK IS NOT DEFINED', & - RC, WARNLEV=1, THISLOC='HcoClock_InitTzPtr (hco_clock_mod.F90)' ) + RC, THISLOC='HcoClock_InitTzPtr (hco_clock_mod.F90)' ) RETURN ENDIF diff --git a/src/Core/hco_diagn_mod.F90 b/src/Core/hco_diagn_mod.F90 index 59d35452..3d911c93 100644 --- a/src/Core/hco_diagn_mod.F90 +++ b/src/Core/hco_diagn_mod.F90 @@ -384,7 +384,7 @@ SUBROUTINE HcoDiagn_Init( HcoState, RC ) ELSE WRITE(MSG,*) 'Unrecognized output time stamp location: ', & TRIM(OutTimeStampChar), ' - will use default (start)' - CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC,WARNLEV=1) + CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC) OutTimeStamp = HcoDiagnStart ENDIF ENDIF @@ -495,7 +495,7 @@ SUBROUTINE HcoDiagn_Init( HcoState, RC ) ELSE WRITE(MSG,*) 'Unrecognized output time stamp location: ', & TRIM(OutTimeStampChar), ' - will use default (start)' - CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC,WARNLEV=1) + CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,THISLOC=LOC) OutTimeStamp = HcoDiagnStart ENDIF ENDIF @@ -3137,7 +3137,7 @@ SUBROUTINE DiagnCont_PrepareOutput( HcoState, DgnCont, RC ) ! Prompt warning MSG = 'Diagnostics counter is zero - return empty array: ' // & TRIM(DgnCont%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC, WARNLEV=2 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -3531,7 +3531,7 @@ SUBROUTINE DiagnCont_Link_2D( DgnCont, ThisColl, Trgt2D, RC, HcoState ) MSG = 'Target diagnostics has AutoFill flag of 1 - reset to 0: ' & // TRIM(DgnCont%cName) IF ( PRESENT(HcoState) ) THEN - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC, WARNLEV=2 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ELSE WRITE(*,*) 'HEMCO WARNING: ', TRIM(MSG) ENDIF @@ -3644,7 +3644,7 @@ SUBROUTINE DiagnCont_Link_3D( DgnCont, ThisColl, Trgt3D, RC, HcoState ) MSG = 'Target diagnostics has autofill flag of 1 - reset to 0: ' & // TRIM(DgnCont%cName) IF ( PRESENT(HcoState) ) THEN - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC, WARNLEV=2 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ELSE WRITE(*,*) 'HEMCO WARNING: ', TRIM(MSG) ENDIF diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index a6f4551a..e78d06b2 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -298,13 +298,12 @@ END SUBROUTINE HCO_ErrorNoErr !\\ ! !INTERFACE: ! - SUBROUTINE HCO_WarningErr( Err, ErrMsg, RC, WARNLEV, THISLOC ) + SUBROUTINE HCO_WarningErr( Err, ErrMsg, RC, THISLOC ) ! ! !INPUT PARAMETERS" ! TYPE(HcoErr), POINTER :: Err CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg - INTEGER , INTENT(IN ), OPTIONAL :: WARNLEV CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC ! ! !INPUT/OUTPUT PARAMETERS: @@ -324,13 +323,8 @@ SUBROUTINE HCO_WarningErr( Err, ErrMsg, RC, WARNLEV, THISLOC ) ! HCO_WARNING begins here !====================================================================== - IF ( PRESENT(WARNLEV) ) THEN - WLEV = WARNLEV - ELSE - WLEV = 3 - ENDIF - - IF ( Err%Warnings >= WLEV ) THEN + ! Only print warnings when verbose output is requested + IF ( HCO_IsVerb( Err ) ) THEN ! Print warning MSG = 'HEMCO WARNING: ' // TRIM( ErrMsg ) @@ -367,12 +361,12 @@ END SUBROUTINE HCO_WarningErr !\\ ! !INTERFACE: ! - SUBROUTINE HCO_WarningNoErr( ErrMsg, RC, WARNLEV, THISLOC ) + SUBROUTINE HCO_WarningNoErr( ErrMsg, RC, verb, THISLOC ) ! ! !INPUT PARAMETERS" ! CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg - INTEGER , INTENT(IN ), OPTIONAL :: WARNLEV + LOGICAL , INTENT(IN ), OPTIONAL :: verb CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC ! ! !INPUT/OUTPUT PARAMETERS: @@ -392,14 +386,17 @@ SUBROUTINE HCO_WarningNoErr( ErrMsg, RC, WARNLEV, THISLOC ) ! HCO_WARNING begins here !====================================================================== + ! Exit if verbose output is not requested + IF ( .not. verb ) RETURN + ! Print warning MSG = 'HEMCO WARNING: ' // TRIM( ErrMsg ) - WRITE(*,*) TRIM(MSG) + WRITE( 6, '(a)' ) TRIM(MSG) ! Print location IF ( PRESENT(THISLOC) ) THEN MSG = '--> LOCATION: ' // TRIM(THISLOC) - WRITE(*,*) TRIM(MSG) + WRITE( 6, '(a)' ) TRIM(MSG) ENDIF ! Return w/ success diff --git a/src/Core/hco_geotools_mod.F90 b/src/Core/hco_geotools_mod.F90 index f77d1a34..9d14df0d 100644 --- a/src/Core/hco_geotools_mod.F90 +++ b/src/Core/hco_geotools_mod.F90 @@ -1165,7 +1165,7 @@ SUBROUTINE HCO_CalcVertGrid ( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) 'This may affect the accuracy of vertical grid ' // & 'quantities. It is recommended you provide PSFC via '// & 'the model-HEMCO interface or the HEMCO configuration file!' - CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC ) ENDIF ! Verbose @@ -1299,14 +1299,14 @@ SUBROUTINE HCO_CalcVertGrid ( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) 'some extensions to fail. HEMCO tries to calculate ' // & 'ZSFC from surface pressure and air temperature, but ' // & 'at least one of these variables seem to be missing.' - CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC ) ENDIF IF ( .NOT. FoundBXHEIGHT .AND. FIRST .AND. HcoState%amIRoot ) THEN MSG = 'Cannot set boxheights BXHEIGHT_M. This may cause ' // & 'some extensions to fail. HEMCO tries to calculate ' // & 'BXHEIGHT from pressure edges and air temperature, but ' // & 'at least one of these variables seem to be missing.' - CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err,MSG, RC, THISLOC=LOC ) ENDIF ENDIF ENDIF diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 2ea02532..10e78fd5 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -268,7 +268,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) doPrintWarning = .FALSE. MSG = 'No further attempts will be made to read file: ' // & TRIM( Lct%Dct%Dta%NcFile ) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) ENDIF ! Return without reading @@ -317,7 +317,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL FileData_Cleanup( Lct%Dct%Dta, DeepClean=.FALSE. ) MSG = 'No valid file found for current simulation time - data '// & 'will be ignored for time being - ' // TRIM(Lct%Dct%cName) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) CALL HCO_LEAVE ( HcoState%Config%Err, RC ) RETURN ENDIF @@ -358,7 +358,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) TRIM(srcFile) // ' - Cannot get field ' // & TRIM(Lct%Dct%cName) // '. Please check file name ' // & 'and time (incl. time range flag) in the config. file' - CALL HCO_Warning( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_Warning( HcoState%Config%Err, MSG, RC ) ! Write a msg to stdout (NOT FOUND) WRITE( 6, 300 ) TRIM( srcFile ) @@ -371,7 +371,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) MSG = 'No valid file found for current simulation time - '// & 'data will be ignored for time being - ' // & TRIM(Lct%Dct%cName) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) ! Write a msg to stdout (OPTIONAL) WRITE( 6, 310 ) TRIM( srcFile ) @@ -385,7 +385,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) TRIM(srcFile) // ' - Cannot get field ' // & TRIM(Lct%Dct%cName) // '. Please check file name ' // & 'and time (incl. time range flag) in the config. file' - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) ! Write a msg to stdout (NOT FOUND) WRITE( 6, 300 ) TRIM(srcFile) @@ -507,7 +507,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL FileData_Cleanup( Lct%Dct%Dta, DeepClean=.FALSE.) MSG = 'Simulation time is outside of time range provided for '//& TRIM(Lct%Dct%cName) // ' - field is ignored for the time being!' - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) DoReturn = .TRUE. CALL HCO_LEAVE ( HcoState%Config%Err, RC ) ENDIF @@ -539,7 +539,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL FileData_Cleanup( Lct%Dct%Dta, DeepClean=.FALSE. ) MSG = 'Cannot find field ' // TRIM(Lct%Dct%cName) // & '. Will be ignored for time being.' - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) CALL HCO_LEAVE ( HcoState%Config%Err, RC ) RETURN ENDIF @@ -1098,7 +1098,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) IF ( Flag /= 0 ) THEN MSG = 'Data is treated as unitless, but file attribute suggests ' // & 'it is not: ' // TRIM(thisUnit) // '. File: ' // TRIM(srcFile) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) ENDIF ! Verbose mode @@ -1123,7 +1123,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL HCO_ERROR( MSG, RC ) RETURN ELSE - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=3 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) ENDIF ENDIF @@ -1212,7 +1212,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ncArr = ncArr * HcoState%TS_EMIS MSG = 'Data converted from kg/m3/s to kg/m3: ' // & TRIM(Lct%Dct%cName) // ': ' // TRIM(thisUnit) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) ! Unitless data ELSEIF ( AreaFlag == -1 .AND. TimeFlag == -1 ) THEN @@ -1227,7 +1227,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ncArr = ncArr / HcoState%TS_EMIS MSG = 'Data converted from kg/m2 to kg/m2/s: ' // & TRIM(Lct%Dct%cName) // ': ' // TRIM(thisUnit) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=1 ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) ! Emission data that is not per area (i.e. kg/s) needs to be converted ! to per area manually. diff --git a/src/Core/hcoio_util_mod.F90 b/src/Core/hcoio_util_mod.F90 index fd57f987..281d47e7 100644 --- a/src/Core/hcoio_util_mod.F90 +++ b/src/Core/hcoio_util_mod.F90 @@ -197,7 +197,7 @@ SUBROUTINE GET_TIMEIDX( HcoState, Lct, & IF ( (refYear <= 1900) .AND. (nTime > 0) ) THEN MSG = 'ncdf reference year is prior to 1901 - ' // & 'time stamps may be wrong!' - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1 ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC ) ENDIF ! verbose mode @@ -1235,7 +1235,7 @@ SUBROUTINE GetIndex2Interp ( HcoState, Lct, & 'slice. Interpolation will be performed from ', & availYMDhm(tidx1), ' to ', availYMDhm(tidx2), '. Data ', & 'container: ', TRIM(Lct%Dct%cName) - CALL HCO_WARNING(HcoState%Config%Err, MSG, RC, WARNLEV=1, THISLOC=LOC) + CALL HCO_WARNING(HcoState%Config%Err, MSG, RC, THISLOC=LOC) ENDIF ! Calculate weights wgt1 and wgt2 to be given to slice 1 and @@ -1483,7 +1483,7 @@ SUBROUTINE Normalize_Area( HcoState, Array, nlon, LatEdge, FN, RC ) ! Prompt a warning WRITE(MSG,*) 'No area unit found in ' // TRIM(FN) // ' - convert to m-2!' - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, THISLOC=LOC ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ! Leave w/ success RC = HCO_SUCCESS @@ -2403,7 +2403,7 @@ SUBROUTINE HCOIO_ReadCountryValues ( HcoState, Lct, RC ) Lct%Dct%Dta%IsLocTime = .TRUE. MSG = 'Data assigned to mask regions will be treated in local time: '//& TRIM(Lct%Dct%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2, THISLOC=LOC ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ! Cleanup @@ -2563,8 +2563,7 @@ SUBROUTINE HCOIO_ReadFromConfig( HcoState, Lct, RC ) Lct%Dct%Dta%IsLocTime = .TRUE. MSG = 'Scale factors read from file are treated as local time: '// & TRIM(Lct%Dct%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, WARNLEV=2, & - THISLOC=LOC ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ENDIF @@ -2970,22 +2969,19 @@ SUBROUTINE GetDataVals ( HcoState, Lct, ValStr, Vals, RC ) FileArr(1,1,1,:) = 0.0_hp MSG = 'Base field outside of range - set to zero: ' // & TRIM(Lct%Dct%cName) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, & - THISLOC=LOC ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) #if defined( MODEL_GEOS ) ELSEIF ( Lct%Dct%DctType == HCO_DCTTYPE_MASK ) THEN FileArr(1,1,1,:) = 0.0_hp MSG = 'Mask outside of range - set to zero: ' // & TRIM(Lct%Dct%cName) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, & - THISLOC=LOC ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) #endif ELSE FileArr(1,1,1,:) = 1.0_hp MSG = 'Scale factor outside of range - set to one: ' // & TRIM(Lct%Dct%cName) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, & - THISLOC=LOC ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ELSE FileArr(1,1,1,:) = FileVals(IDX1:IDX2) @@ -3035,8 +3031,7 @@ SUBROUTINE GetDataVals ( HcoState, Lct, ValStr, Vals, RC ) FileArr = FileArr * HcoState%TS_EMIS MSG = 'Data converted from kg/m3/s to kg/m3: ' // & TRIM(Lct%Dct%cName) // ': ' // TRIM(Lct%Dct%Dta%OrigUnit) - CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, WARNLEV=1, & - THISLOC=LOC ) + CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ! ... emissions or unitless ... ELSEIF ( (AreaFlag == -1 .AND. TimeFlag == -1) .OR. & diff --git a/src/Core/hcoio_write_std_mod.F90 b/src/Core/hcoio_write_std_mod.F90 index 7c076e51..071ba429 100644 --- a/src/Core/hcoio_write_std_mod.F90 +++ b/src/Core/hcoio_write_std_mod.F90 @@ -609,7 +609,7 @@ SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, & ELSE MSG = 'Unrecognized output reference time, will ' // & 'assume `days since`: '//TRIM(timeunit) - CALL HCO_WARNING( MSG, WARNLEV=2, THISLOC=LOC, RC=RC ) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ! Special case where we have an old file but it has the same time stamp: in diff --git a/src/Extensions/hcox_volcano_mod.F90 b/src/Extensions/hcox_volcano_mod.F90 index 7168ae11..620f5d9c 100644 --- a/src/Extensions/hcox_volcano_mod.F90 +++ b/src/Extensions/hcox_volcano_mod.F90 @@ -762,7 +762,7 @@ SUBROUTINE ReadVolcTable( HcoState, ExtState, Inst, RC ) ELSE WRITE(MSG,*) 'No volcano data found for year/mm/dd: ', YYYY, MM, DD - CALL HCO_WARNING(HcoState%Config%Err,MSG,RC,WARNLEV=1,THISLOC=LOC) + CALL HCO_WARNING( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) ENDIF ! Now read records From 65a4f30d2f0744447c0267853a9555b7992e1445 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 8 Dec 2022 15:45:06 -0500 Subject: [PATCH 07/63] Set "Verbose: false" by default in HEMCO_*Config.rc.* templates CHANGELOG.md - Updated accordingly run/HEMCO_sa_Config.rc.template run/HEMCO_Config.rc.sample - Removed warnings - Changed Verbose: 0 to Verbose: false Signed-off-by: Bob Yantosca --- CHANGELOG.md | 15 +++++++++++++++ run/HEMCO_Config.rc.sample | 3 +-- run/HEMCO_sa_Config.template | 3 +-- 3 files changed, 17 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index fbdc3e5d..5917e272 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,21 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased 3.6.0] +### Added + - HEMCO extensions now display a first-time message, whether + `Verbose` is `true` or `false`. + +### Changed + - `Verbose` is now a `true/false` variable in + `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` + - HEMCO warnings are now only generated when `Verbose: true` is found in + the HEMCO configuration file (no more numerical levels) + +### Removed + - Warnings is now removed from `run/HEMCO_sa_Config.rc` and + `run/HEMCO_Config.rc.sample` + ## [3.5.2] - 2022-11-29 ### Added - Added sanitizer option for detecting memory leaks in HEMCO diff --git a/run/HEMCO_Config.rc.sample b/run/HEMCO_Config.rc.sample index 9b0055fa..d3550dab 100644 --- a/run/HEMCO_Config.rc.sample +++ b/run/HEMCO_Config.rc.sample @@ -35,8 +35,7 @@ Separator: / Unit tolerance: 1 Negative values: 0 Only unitless scale factors: false -Verbose: 0 -Warnings: 1 +Verbose: false ### END SECTION SETTINGS ### diff --git a/run/HEMCO_sa_Config.template b/run/HEMCO_sa_Config.template index 1e253f3c..77f094e6 100644 --- a/run/HEMCO_sa_Config.template +++ b/run/HEMCO_sa_Config.template @@ -61,8 +61,7 @@ DiagnFreq: 00000100 000000 #----------------------------------------------------- Unit tolerance: 1 Negative values: 0 -Verbose: 0 -Warnings: 1 +Verbose: false #----------------------------------------------------- # Additional settings #----------------------------------------------------- From 81f4cf07466de1a657c88c8c8c05d3d7a297909b Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 8 Dec 2022 16:37:04 -0500 Subject: [PATCH 08/63] Minor formatting updates to CHANGELOG.md CHANGELOG.md - Keep all bullet points on one line so to avoid line breaks when rendering in GitHub Signed-off-by: Bob Yantosca --- CHANGELOG.md | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5917e272..095d08b1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,14 +7,11 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased 3.6.0] ### Added - - HEMCO extensions now display a first-time message, whether - `Verbose` is `true` or `false`. + - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. ### Changed - - `Verbose` is now a `true/false` variable in - `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - - HEMCO warnings are now only generated when `Verbose: true` is found in - the HEMCO configuration file (no more numerical levels) + - `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` + - HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) ### Removed - Warnings is now removed from `run/HEMCO_sa_Config.rc` and From 301dde96b83671ec53d2a413626aa3bca4221e6d Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Mon, 12 Dec 2022 10:26:18 -0500 Subject: [PATCH 09/63] Minor updates in run/HEMCO_sa_Config.template run/HEMCO_sa_Config.template - Now set "Logfile: *", which will direct all output to the stdout (aka screen). This can be piped to a log file with the tee command - Remove reference to separate Verbose and Warnings flags; we now only need set Verbose to "true" to obtain maximum debug printout Signed-off-by: Bob Yantosca --- run/HEMCO_sa_Config.template | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/HEMCO_sa_Config.template b/run/HEMCO_sa_Config.template index 77f094e6..46510bad 100644 --- a/run/HEMCO_sa_Config.template +++ b/run/HEMCO_sa_Config.template @@ -57,7 +57,7 @@ DiagnPrefix: OutputDir/HEMCO_sa_diagnostics DiagnFreq: 00000100 000000 #----------------------------------------------------- # Debugging options -# (set verbose and warnings to 3 for maximum output) +# (set verbose to true to toggle debug printout) #----------------------------------------------------- Unit tolerance: 1 Negative values: 0 From 766eb0c9be42ba15708a95940c2746f24c0a9017 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Mon, 12 Dec 2022 10:32:49 -0500 Subject: [PATCH 10/63] Set Logfile in HEMCO_sa_Config.rc.template to * run/HEMCO_sa_Config.template - We forgot to refresh add this modification in the prior commit; "Logfile: HEMCO.log" is now changed to "Logfile: *", which will send output to the stdout. This can be piped to a log with either the Unix > or tee commands. This is now consistent with the settings of HEMCO_Config.rc in GEOS-Chem. Signed-off-by: Bob Yantosca --- run/HEMCO_sa_Config.template | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/HEMCO_sa_Config.template b/run/HEMCO_sa_Config.template index 46510bad..e9bb229a 100644 --- a/run/HEMCO_sa_Config.template +++ b/run/HEMCO_sa_Config.template @@ -39,7 +39,7 @@ GridFile: {GRID_FILE} SpecFile: HEMCO_sa_Spec.rc TimeFile: HEMCO_sa_Time.rc DiagnFile: HEMCO_Diagn.rc -Logfile: HEMCO.log +Logfile: * #----------------------------------------------------- # Settings for HEMCO grid #----------------------------------------------------- From 5041a2000d5d35eb4670fa49303b34d28309edd3 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 14 Dec 2022 14:33:00 -0500 Subject: [PATCH 11/63] Update logic so that Verbose will be set if integer values are found src/Core/hco_config_mod.F90 - Updated the program logic so that HEMCO verbose output will be computed properly if Verbose is specified as a logical value, or if Verbose and Warnings are specified as integer values (as was done previously). - This is necessary in order to avoid conflicts when using GEOS-Chem in external models such as CESM or WRF. Signed-off-by: Bob Yantosca --- src/Core/hco_config_mod.F90 | 173 ++++++++++++++++++++++++++---------- 1 file changed, 124 insertions(+), 49 deletions(-) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index d3f309e4..8ab38f2e 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -1991,14 +1991,14 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! !LOCAL VARIABLES: ! ! Scalars - LOGICAL :: doVerbose - LOGICAL :: FOUND - INTEGER :: I, N, POS - !INTEGER :: verb - INTEGER :: warn + LOGICAL :: doVerbose, found + LOGICAL :: foundVerb, foundWarn + LOGICAL :: verboseBool + INTEGER :: I, N, POS + INTEGER :: verb, warn ! Strings - CHARACTER(LEN=255) :: Line + CHARACTER(LEN=255) :: line CHARACTER(LEN=255) :: loc CHARACTER(LEN=255) :: LogFile CHARACTER(LEN=255) :: DiagnPrefix @@ -2013,6 +2013,7 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! Enter Loc = 'ReadSettings (hco_config_mod.F90)' + !----------------------------------------------------------------------- ! Read settings and add them as options to core extensions !----------------------------------------------------------------------- @@ -2031,6 +2032,16 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! Return if EOF IF ( EOF ) EXIT + ! Test if the Verbose flag is logical. We need to know this ahead + ! of time in order to avoid input errors (i.e. reading characters + ! when integers are expected) in the code that follows below. + ! -- Bob Yantosca (14 Dec 2022) + IF ( INDEX( line, 'Verbose' ) > 0 ) THEN + verboseBool = ( & + ( INDEX( line, 't' ) > 0 ) .or. ( INDEX( line, 'f' ) > 0 ) .or. & + ( INDEX( line, 'T' ) > 0 ) .or. ( INDEX( line, 'F' ) > 0 ) ) + ENDIF + ! Exit here if end of section encountered IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) EXIT @@ -2103,35 +2114,116 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! HEMCO variables. Only the first time the settings are read (settings ! can be read multiple times if nested HEMCO configuration files are ! used) + ! + ! NOTE: In HEMCO 3.7.0, the Verbose and Warnings integers in the + ! HEMCO_Config.rc file have been replaced with "Verbose: true". + ! Update the logic to make the test for Verbose backwards compatible + ! with HEMCO_Config.files prior to HEMCO 3.7.0. + ! -- Bob Yantosca (14 Dec 2022) !----------------------------------------------------------------------- IF ( .NOT. ASSOCIATED(HcoConfig%Err) ) THEN - !-------------------------------------------------------------------- - !! Verbose mode? - !CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & - ! OptValInt=verb, FOUND=FOUND, RC=RC ) - !IF ( RC /= HCO_SUCCESS ) THEN - ! msg = 'Error looking for "Verbose" HEMCO_Config.rc!' - ! CALL HCO_Error( msg, RC, thisLoc=loc ) - ! RETURN - !ENDIF - !IF ( .NOT. FOUND ) THEN - ! verb = 3 - ! WRITE(*,*) 'Setting `Verbose` not found in HEMCO logfile - use 3' - !ENDIF - !-------------------------------------------------------------------- - - ! Verbose mode? - CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & - OptValBool=doVerbose, found=found, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - msg = 'Error looking for "Verbose" HEMCO_Config.rc!' - CALL HCO_Error( msg, RC, thisLoc=loc ) - RETURN - ENDIF - IF ( .NOT. FOUND ) THEN - doVerbose=.FALSE. - WRITE(*,*) 'Setting `Verbose` not found in HEMCO logfile - use 3' + ! Initialize + doVerbose = .FALSE. + verb = 0 + warn = 0 + + ! Check if Verbose is a logical entry in HEMCO_Config.rc + IF ( verboseBool ) THEN + + !----------------------------------------------------------------- + ! "Verbose: true" or "Verbose: false" was found + !----------------------------------------------------------------- + + ! First look for Verbose (logical). This is now the default + ! inthe HEMCO_Config.rc file for HEMCO 3.7.0 and later. + CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & + OptValBool=doVerbose, found=found, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Error looking for "Verbose" (logical) in HEMCO_Config.rc!' + CALL HCO_Error( msg, RC, thisLoc=loc ) + RETURN + ENDIF + + ! Print status message + IF ( doVerbose ) THEN + msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is ON' + ELSE + msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is OFF' + ENDIF + CALL HCO_Msg( msg, verb=.TRUE. ) + + ELSE + + !----------------------------------------------------------------- + ! "Verbose: true" or "Verbose: false" was not found + !----------------------------------------------------------------- + + ! Check for Verbose (integer) + CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & + OptValInt=verb, found=foundVerb, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Error looking for "Verbose" (integer) in HEMCO_Config.rc!' + CALL HCO_Error( msg, RC, thisLoc=loc ) + RETURN + ENDIF + + IF ( foundVerb .and. verb > 0 ) THEN + + ! Toggle HEMCO verbose output on for nonzero integer values + doVerbose = .TRUE. + msg = NEW_LINE( 'A' ) // & + 'HEMCO verbose output is ON.' // & + NEW_LINE( 'A' ) // & + 'Numbered Verbose and Warning options are deprecated.' // & + NEW_LINE( 'A' ) // & + 'Please use "Verbose: true:" or "Verbose: false" for ' // & + 'controlling verbose output.' + CALL HCO_Msg( msg, verb=.TRUE. ) + + ELSE + + ! Verbose (logical) and Verbose (integer) were not found, + ! now look for Warnings (integer) + CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', & + OptValInt=warn, found=foundWarn, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = & + 'Error looking for "Warnings" (integer) in HEMCO_Config.rc!' + CALL HCO_Error( msg, RC, thisLoc=loc ) + RETURN + ENDIF + IF ( foundWarn .and. warn > 0 ) THEN + + ! Toggle HEMCO verbose output on + ! (Verbose = 0; Warnings > 0) + doVerbose = .TRUE. + msg = & + NEW_LINE( 'A' ) // & + 'HEMCO verbose output is ON.' // & + NEW_LINE( 'A' ) // & + 'Numbered Verbose and Warning options are deprecated.' // & + NEW_LINE( 'A' ) // & + 'Please use "Verbose: true:" or "Verbose: false" for ' // & + 'controlling verbose output.' + CALL HCO_Msg( msg, verb=.TRUE. ) + + ELSE + + ! Toggle HEMCO verbose off + ! (Verbose: false, Verbose = 0 and Warnings = 0) + doVerbose = .FALSE. + msg = & + NEW_LINE( 'A' ) // & + 'HEMCO verbose output is OFF.' // & + NEW_LINE( 'A' ) // & + 'Numbered Verbose and Warning options are deprecated.' // & + NEW_LINE( 'A' ) // & + 'Please use "Verbose: true:" or "Verbose: false" for ' // & + 'controlling verbose output.' + CALL HCO_Msg( msg, verb=.TRUE. ) + ENDIF + ENDIF ENDIF ! Logfile to write into @@ -2147,23 +2239,6 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) WRITE(*,*) 'Setting `Logfile` not found in HEMCO logfile - use `HEMCO.log`' ENDIF - !--------------------------------------------------------------------- - ! REDUCE LOGFILE OUTPUT: - ! Combine verbose and warnings (bmy, 07 Dec 2022) - !! Prompt warnings to logfile? - !CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', & - ! OptValInt=warn, FOUND=FOUND, RC=RC ) - !IF ( RC /= HCO_SUCCESS ) THEN - ! msg = 'Error looking for "Warnings" in HEMCO_Config.rc!' - ! CALL HCO_Error( msg, RC, thisLoc=loc ) - ! RETURN - !ENDIF - !IF ( .NOT. FOUND ) THEN - ! warn = 3 - ! WRITE(*,*) 'Setting `Warnings` not found in HEMCO logfile - use 3' - !ENDIF - !--------------------------------------------------------------------- - ! Initialize (standard) HEMCO tokens CALL HCO_SetDefaultToken( HcoConfig, RC ) IF ( RC /= HCO_SUCCESS ) THEN From 098f91ea3979eb4a39315803ea66756fda92a767 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 14 Dec 2022 15:22:27 -0500 Subject: [PATCH 12/63] Remove unused code in HEMCO/Core routines src/Core/hco_config_mod.F90 - Removed commented-out call to HCO_ERROR_SET (with verb & warn args) src/Core/hco_error_mod.F90 - Removed HCO_VERBOSE_INQ (this now does the same thing as HCO_IsVerb, and is superfluous) - Remove Warnings and Verbose from TYPE(HcoErr) - Remove Verbose and WarningLevel variables - Remove Err%Warnings from logfile output src/Core/hcoio_read_std_mod.F90 - Removed "TODO" comment Signed-off-by: Bob Yantosca --- src/Core/hco_config_mod.F90 | 3 -- src/Core/hco_error_mod.F90 | 60 +++------------------------------ src/Core/hcoio_read_std_mod.F90 | 1 - 3 files changed, 4 insertions(+), 60 deletions(-) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 8ab38f2e..3ad8b760 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -2253,9 +2253,6 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) IF ( TRIM(LogFile) == HCO_GetOpt(HcoConfig%ExtList,'Wildcard') ) & LogFile = '*' - !! We should now have everything to define the HEMCO error settings - !CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & - ! verb, warn, RC ) ! We should now have everything to define the HEMCO error settings CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & doVerbose, RC ) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index e78d06b2..08de3135 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -66,7 +66,6 @@ MODULE HCO_Error_Mod PUBLIC :: HCO_ERROR_SET PUBLIC :: HCO_ERROR_FINAL PUBLIC :: HCO_IsVerb - PUBLIC :: HCO_VERBOSE_INQ PUBLIC :: HCO_LOGFILE_OPEN PUBLIC :: HCO_LOGFILE_CLOSE ! @@ -129,8 +128,6 @@ MODULE HCO_Error_Mod LOGICAL :: IsRoot = .FALSE. LOGICAL :: LogIsOpen = .FALSE. LOGICAL :: doVerbose = .FALSE. - INTEGER :: Warnings = 0 - INTEGER :: Verbose = 0 INTEGER :: nWarnings = 0 INTEGER :: CurrLoc = -1 CHARACTER(LEN=255), POINTER :: Loc(:) => NULL() @@ -725,8 +722,6 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, doVerbose, RC ) ! Set verbose to -1 if this is not the root CPU. This will disable any ! log-file messages IF ( .NOT. am_I_Root ) THEN - !Verbose = -1 - !WarningLevel = 0 doVerbose = .FALSE. ENDIF @@ -734,12 +729,10 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, doVerbose, RC ) Err%IsRoot = am_I_Root Err%LogFile = TRIM(LogFile) Err%doVerbose = doVerbose - !Err%Warnings = WarningLevel ! Init misc. values Err%FirstOpen = .TRUE. Err%LogIsOpen = .FALSE. - !Err%nWarnings = 0 Err%CurrLoc = 0 ! If Logfile is set to '*', set lun to -1 (--> write into default file). @@ -803,51 +796,9 @@ END SUBROUTINE HCO_Error_Final !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: HCO_Verbose_Inq +! !IROUTINE: HCO_IsVerb ! -! !DESCRIPTION: Function HCO\_Verbose\_Inq returns the HEMCO verbose number. -!\\ -!\\ -! !INTERFACE: -! - FUNCTION HCO_VERBOSE_INQ ( ERR ) RESULT ( VerbNr ) -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(HcoErr), POINTER :: Err ! Error object -! -! !OUTPUT PARAMETERS: -! - INTEGER :: VerbNr -! -! !REVISION HISTORY: -! 15 Mar 2015 - C. Keller - Initialization -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - - !====================================================================== - ! HCO_VERBOSE_INQ begins here - !====================================================================== - - IF ( .NOT. ASSOCIATED(Err) ) THEN - VerbNr = -1 - ELSE - VerbNr = Err%Verbose - ENDIF - - END FUNCTION HCO_VERBOSE_INQ -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCO_IsVerb_NoVerb -! -! !DESCRIPTION: Returns true if the HEMCO verbose number is set to 3 or larger. -! Does not use an "Verb" argument +! !DESCRIPTION: Returns true if the HEMCO verbose output is turned on. !\\ !\\ ! !INTERFACE: @@ -861,9 +812,6 @@ FUNCTION HCO_IsVerb( Err ) RESULT ( IsVerb ) ! !OUTPUT PARAMETERS: ! LOGICAL :: isVerb -! -! !REMARKS: -! TODO: Convert VERBOSE to a simple logical on/off switch. !EOP !------------------------------------------------------------------------------ !BOC @@ -1001,7 +949,7 @@ SUBROUTINE HCO_LogFile_Open( Err, RC ) ! Write header on first call IF ( Err%FirstOpen ) THEN LUN = Err%Lun ! Log gets written to file - IF ( Err%LUN < 0 ) LUN = 6 ! ,,, or to stdout if file isn't open + IF ( Err%LUN < 0 ) LUN = 6 ! or to stdout if file isn't open ! Only write the version info if verbose output is requested IF ( HCO_IsVerb( Err ) ) THEN @@ -1083,7 +1031,7 @@ SUBROUTINE HCO_LogFile_Close( Err, ShowSummary ) CALL HCO_MSG ( Err, MSG, SEP1='-' ) WRITE(MSG,'(A16,I1,A12,I6)') & - 'Warnings (level ', Err%Warnings, ' or lower): ', Err%nWarnings + 'Warnings: ', Err%nWarnings CALL HCO_MSG ( Err, MSG, SEP2='-' ) ENDIF diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 10e78fd5..73b863a5 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -1094,7 +1094,6 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ! Prompt a warning if thisUnit is not recognized as unitless. - ! TODO: Merge warnings w/ verbose, and toggle with a simple on/off IF ( Flag /= 0 ) THEN MSG = 'Data is treated as unitless, but file attribute suggests ' // & 'it is not: ' // TRIM(thisUnit) // '. File: ' // TRIM(srcFile) From 1fd3bf58eb70e3abb2ac064da15cd256cab04d62 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 15 Dec 2022 11:21:52 -0500 Subject: [PATCH 13/63] GCHP bug fix: Remove numerical argument to HCO_IsVerb src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 - Remove the 2nd numerical argument from calls to HCO_IsVerb. These are no longer necessary as we have removed verbose levels. Signed-off-by: Bob Yantosca --- src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 b/src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 index c2406dfa..f9b407a3 100644 --- a/src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 +++ b/src/Interfaces/MAPL_ESMF/hcoi_esmf_mod.F90 @@ -549,7 +549,7 @@ SUBROUTINE HCO_Imp2Ext2S( HcoState, ExtDat, FldName, RC ) Ptr2D => NULL() ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND.HcoState%amIRoot ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND.HcoState%amIRoot ) THEN CALL HCO_MSG('Passed from import to ExtState: '//TRIM(FldName)) ENDIF @@ -632,7 +632,7 @@ SUBROUTINE HCO_Imp2Ext3S( HcoState, ExtDat, FldName, RC ) Ptr3D => NULL() ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. HcoState%amIRoot ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. HcoState%amIRoot ) THEN CALL HCO_MSG('Passed from import to ExtState: '//TRIM(FldName)) ENDIF @@ -727,7 +727,7 @@ SUBROUTINE HCO_Imp2Ext2R( HcoState, ExtDat, FldName, RC, Fld ) ENDIF ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. HcoState%amIRoot ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. HcoState%amIRoot ) THEN CALL HCO_MSG(HcoState%Config%Err,'Passed from import to ExtState: '//TRIM(FldName)) ENDIF @@ -810,7 +810,7 @@ SUBROUTINE HCO_Imp2Ext3R( HcoState, ExtDat, FldName, RC ) Ptr3D => NULL() ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. HcoState%amIRoot ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. HcoState%amIRoot ) THEN CALL HCO_MSG('Passed from import to ExtState: '//TRIM(FldName)) ENDIF @@ -887,7 +887,7 @@ SUBROUTINE HCO_Imp2Ext2I( HcoState, ExtDat, FldName, RC ) Ptr2D => NULL() ! Verbose - IF ( HCO_IsVerb(HcoState%Config%Err,2) .AND. HcoState%amIRoot ) THEN + IF ( HCO_IsVerb(HcoState%Config%Err) .AND. HcoState%amIRoot ) THEN CALL HCO_MSG('Passed from import to ExtState: '//TRIM(FldName)) ENDIF From 3fc2f5c92bde18d89a217a193ae31ab7db918920 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 15 Dec 2022 16:10:28 -0500 Subject: [PATCH 14/63] Remove src/Shared/NcdfUtil/perl folder; add src/SharedNcdfUtil/README.md src/Shared/NcdfUtil/README.md - Added a readme describing contents of this folder. Also now directs users to the https://github.com/geoschem/netcdf-scripts repository where isCoards, nc_chunk.pl, etc. scripts are now maintained. src/Shared/NcdfUtil/perl/ - Removed this folder Signed-off-by: Bob Yantosca --- src/Shared/NcdfUtil/README.md | 29 + src/Shared/NcdfUtil/perl/.gitignore | 9 - src/Shared/NcdfUtil/perl/StrTrim.pm | 188 --- src/Shared/NcdfUtil/perl/definitions_a1.rc | 269 --- src/Shared/NcdfUtil/perl/definitions_a3cld.rc | 83 - src/Shared/NcdfUtil/perl/definitions_a3dyn.rc | 85 - .../NcdfUtil/perl/definitions_a3mstc.rc | 74 - .../NcdfUtil/perl/definitions_a3mste.rc | 74 - src/Shared/NcdfUtil/perl/definitions_cn.rc | 79 - src/Shared/NcdfUtil/perl/definitions_i3.rc | 75 - src/Shared/NcdfUtil/perl/isCoards | 1437 ----------------- src/Shared/NcdfUtil/perl/ncCodeDef | 790 --------- src/Shared/NcdfUtil/perl/ncCodeRead | 628 ------- src/Shared/NcdfUtil/perl/ncCodeWrite | 533 ------ src/Shared/NcdfUtil/perl/nc_chunk.pl | 207 --- src/Shared/NcdfUtil/perl/nc_definitions.rc | 154 -- 16 files changed, 29 insertions(+), 4685 deletions(-) create mode 100644 src/Shared/NcdfUtil/README.md delete mode 100644 src/Shared/NcdfUtil/perl/.gitignore delete mode 100755 src/Shared/NcdfUtil/perl/StrTrim.pm delete mode 100644 src/Shared/NcdfUtil/perl/definitions_a1.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_a3cld.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_a3dyn.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_a3mstc.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_a3mste.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_cn.rc delete mode 100644 src/Shared/NcdfUtil/perl/definitions_i3.rc delete mode 100755 src/Shared/NcdfUtil/perl/isCoards delete mode 100755 src/Shared/NcdfUtil/perl/ncCodeDef delete mode 100755 src/Shared/NcdfUtil/perl/ncCodeRead delete mode 100755 src/Shared/NcdfUtil/perl/ncCodeWrite delete mode 100755 src/Shared/NcdfUtil/perl/nc_chunk.pl delete mode 100644 src/Shared/NcdfUtil/perl/nc_definitions.rc diff --git a/src/Shared/NcdfUtil/README.md b/src/Shared/NcdfUtil/README.md new file mode 100644 index 00000000..da0b0c7a --- /dev/null +++ b/src/Shared/NcdfUtil/README.md @@ -0,0 +1,29 @@ +# NcdfUtil: NetCDF Utility routines for GEOS-Chem + +This folder contains netCDF utiliity routines for GEOS-Chem. + +## Contents + +- `CMakeLists.txt`: CMake build file +- `charpak_mod.F90`: Copy of `Headers/charpak_mod.F90`, used locally. +- `julday_mod.F90`: Copy of `Headers/julday_mod.F90`, used locally. +- `m_do_err_out.F90`: Error handling module +- `m_netcdf_io_checks.F90`: Error checking routines +- `m_netcdf_io_close.F90`: Routines to close netCDF files +- `m_netcdf_io_create.F90`: Routines to create netCDF files +- `m_netcdf_io_define.F90`: Routines to define netCDF variables +- `m_netcdf_io_get_dimlen.F90`: Reoutines +- `m_netcdf_io_handle_err.F90`: Error checking routines +- `m_netcdf_io_open.F90`: Routines for opening netCDF files +- `m_netcdf_io_readattr.F90`: Routines for reading netCDF attributes +- `m_netcdf_io_read.F90`: Routines for reading data to a netCDF file +- `m_netcdf_io_write.F90`: Routines for writing data to a netCDF file +- `ncdf_mod.F90`: Convenience routines for netCDF handling +- `TestNcdfUtil.F90`: Test program + +## Scripts + +We have now moved netCDF utility scripts (such as `isCoards` and `nc_chunk.pl`) to a separate Github repository. You may download them from https://github.com/geoschem/netcdf-scripts. + + + diff --git a/src/Shared/NcdfUtil/perl/.gitignore b/src/Shared/NcdfUtil/perl/.gitignore deleted file mode 100644 index 595a31e4..00000000 --- a/src/Shared/NcdfUtil/perl/.gitignore +++ /dev/null @@ -1,9 +0,0 @@ -*.[oax] -*.mod -*.MOD -*~* -geos -geostomas -geosapm -*.nc -*.F \ No newline at end of file diff --git a/src/Shared/NcdfUtil/perl/StrTrim.pm b/src/Shared/NcdfUtil/perl/StrTrim.pm deleted file mode 100755 index 8c10bf7e..00000000 --- a/src/Shared/NcdfUtil/perl/StrTrim.pm +++ /dev/null @@ -1,188 +0,0 @@ -#!/usr/bin/perl -w - -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: StrTrim -# -# !DESCRIPTION: This Perl package contains routines for splitting a line -# into substrings and removing trailing and leading whitespace. Used by -# the ncCode* scripts. -#\\ -#\\ -# !INTERFACE: -# -package StrTrim; -# -# !USES: -# - require 5.003; # Need this version of Perl or newer - use English; # Use English language - use Carp; # Get detailed error messages - use strict; # Force explicit variable declarations (like IMPLICIT NONE) -# -# -# !PUBLIC MEMBER FUNCTIONS: -# &trim($) -# &splitLine($$) -# -# !CALLING SEQUENCE: -# use StrTrim qw( trim splitLine extractFile ); -# -# !REVISION HISTORY: -# 30 Jan 2012 - R. Yantosca - Initial version -# 26 Mar 2012 - R. Yantosca - Add function &extractFile -#EOP -#------------------------------------------------------------------------------ -#BOC -BEGIN { - - #========================================================================= - # The BEGIN method lists the names to export to the calling routine - #========================================================================= - use Exporter (); - use vars qw( $VERSION @ISA @EXPORT_OK ); - - $VERSION = 1.00; # version number - @ISA = qw( Exporter ); # export method - @EXPORT_OK = qw( &trim &splitLine &extractFile ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: trim -# -# !DESCRIPTION: Routine trim removes leading and trailing whitespace from -# a string (analogous to IDL's Strtrim( str, 2 ) command). -#\\ -#\\ -# !INTERFACE: -# -sub trim($) { -# -# !CALLING SEQUENCE: -# $string = &trim( $string ); -# -# !REMARKS: -# Found online at this URL: -# http://www.somacon.com/p114.php -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC - - # Shift the @_ array - my $string = shift; - - # Remove leading whitespace - $string =~ s/^\s+//; - - # Remove trailing whitespace - $string =~ s/\s+$//; - - # Return - return( $string ); -} -#EOP -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: splitLine -# -# !DESCRIPTION: Routine splitLine splits a line on a given delimiter, and -# strips white space. Convenience wrapper for the Perl "split" function. -#\\ -#\\ -# !INTERFACE: -# -sub splitLine($$) { -# -# !INPUT PARAMETERS: -# - # Line to be split, and the delimeter character - # Don't strip the white from $value if $noSplitVal==1 - my( $line, $delim ) = @_; -# -# !CALLING SEQUENCE: -# ( $name, $value ) = &splitLine( $line ); -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Split the line - my @subStr = split( $delim, $line ); - my $name = &trim( $subStr[0] ); - my $value = &trim( $subStr[1] ); - - # Return substrings - return( $name, $value ); -} -#EOP -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: extractFile -# -# !DESCRIPTION: Routine extractFile splits a full Unix path name into a -# directory string and a file name. -#\\ -#\\ -# !INTERFACE: -# -sub extractFile($) { -# -# !INPUT PARAMETERS: -# - # Full Unix path name - my( $path ) = @_; -# -# !CALLING SEQUENCE: -# ( $file, $dir ) = &extractFile( $path ); -# -# !REVISION HISTORY: -# 26 Mar 2012 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $pos = -1; - my $lastPos = -1; - my $dir = ""; - my $file = ""; - - # Search for the last "/" character in the file path - # This is the place where to split the file & directory - while ( ( $pos = index( $path, '/', $pos ) ) > -1 ) { - $lastPos = $pos; - $pos++; - } - - # Directory part of the path - $dir = substr( $path, 0, $lastPos+1 ); - - # Filename part of the path - $file = substr( $path, $lastPos+1, length( $path ) - $lastPos ); - - # Return substrings - return( $file, $dir ); -} -#EOC -END {} diff --git a/src/Shared/NcdfUtil/perl/definitions_a1.rc b/src/Shared/NcdfUtil/perl/definitions_a1.rc deleted file mode 100644 index c48fe28b..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_a1.rc +++ /dev/null @@ -1,269 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_a1.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A1 filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 A1 met field file. -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = a1_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.A1.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NX -lat = State_Grid%NY -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -time = INTEGER::time -time:long_name = time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 01:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 010000 -#- -ALBEDO = REAL*4::lon,lat,time -ALBEDO:long_name = Surface albedo -ALBEDO:units = fraction -ALBEDO:gamap_category = GMAO-2D -#- -CLDTOT = REAL*4::lon,lat,time -CLDTOT:long_name = Total cloud fraction -CLDTOT:units = fraction -CLDTOT:gamap_category = GMAO-2D -#- -EFLUX = REAL*4::lon,lat,time -EFLUX:long_name = Latent heat flux positive upward -EFLUX:units = W m-2 -EFLUX:gamap_category = GMAO-2D -#- -EVAP = REAL*4::lon,lat,time -EVAP:long_name = Surface evaporation -EVAP:units = kg m-2 s-2 -EVAP:gamap_category = GMAO-2D -#- -FRSEAICE = REAL*4::lon,lat,time -FRSEAICE:long_name = Fraction of sea ice on surface -FRSEAICE:units = fraction -FRSEAICE:gamap_category = GMAO-2D -#- -FRSNO = REAL*4::lon,lat,time -FRSNO:long_name = Fractional snow-covered area -FRSNO:units = fraction -FRSNO:gamap_category = GMAO-2D -#- -GRN = REAL*4::lon,lat,time -GRN:long_name = Vegetation greenness fraction -GRN:units = fraction -GRN:gamap_category = GMAO-2D -#- -GWETROOT = REAL*4::lon,lat,time -GWETROOT:long_name = Root zone soil wetness -GWETROOT:units = fraction -GWETROOT:gamap_category = GMAO-2D -#- -GWETTOP = REAL*4::lon,lat,time -GWETTOP:long_name = Top soil wetness -GWETTOP:units = fraction -GWETTOP:gamap_category = GMAO-2D -#- -HFLUX = REAL*4::lon,lat,time -HFLUX:long_name = Sensible heat flux positive upward -HFLUX:units = W m-2 -HFLUX:gamap_category = GMAO-2D -#- -LAI = REAL*4::lon,lat,time -LAI:long_name = Leaf area index -LAI:units = m2 m-2 -LAI:gamap_category = GMAO-2D -#- -LWI = REAL*4::lon,lat,time -LWI:long_name = Land/water/ice flags -LWI:units = unitless -LWI:gamap_category = GMAO-2D -#- -LWGNT = REAL*4::lon,lat,time -LWGNT:long_name = Net longwave flux at the ground -LWGNT:units = W m-2 -LWGNT:gamap_category = GMAO-2D -#- -LWTUP = REAL*4::lon,lat,time -LWTUP:long_name = Upward longwave flux at top of atmosphere TOA -LWTUP:units = W m-2 -LWTUP:gamap_category = GMAO-2D -#- -PARDF = REAL*4::lon,lat,time -PARDF:long_name = Surface downward PAR diffuse flux -PARDF:units = W m-2 -PARDF:gamap_category = GMAO-2D -#- -PARDR = REAL*4::lon,lat,time -PARDR:long_name = Surface downward PAR beam flux -PARDR:units = W m-2 -PARDR:gamap_category = GMAO-2D -#- -PBLH = REAL*4::lon,lat,time -PBLH:long_name = Planetary boundary layer height above surface -PBLH:units = m -PBLH:gamap_category = GMAO-2D -#- -PRECANV = REAL*4::lon,lat,time -PRECANV:long_name = Surface precipitation flux from anvils -PRECANV:units = kg m-2 s-1 -PRECANV:gamap_category = GMAO-2D -#- -PRECCON = REAL*4::lon,lat,time -PRECCON:long_name = Surface precipitation flux from convection -PRECCON:units = kg m-2 s-1 -PRECCON:gamap_category = GMAO-2D -#- -PRECLSC = REAL*4::lon,lat,time -PRECLSC:long_name = Surface precipitation flux from large-scale -PRECLSC:units = kg m-2 s-1 -PRECLSC:gamap_category = GMAO-2D -#- -PRECSNO = REAL*4::lon,lat,time -PRECSNO:long_name = Surface precipitation flux from snow -PRECSNO:units = kg m-2 s-1 -PRECSNO:gamap_category = GMAO-2D -#- -PRECTOT = REAL*4::lon,lat,time -PRECTOT:long_name = Total surface precipitation flux -PRECTOT:units = kg m-2 s-1 -PRECTOT:gamap_category = GMAO-2D -#- -QV2M = REAL*4::lon,lat,time -QV2M:long_name = Specific humidity at 2m above the displacement height -QV2M:units = kg kg-1 -QV2M:gamap_category = GMAO-2D -#- -SEAICE00 = REAL*4::lon,lat,time -SEAICE00:long_name = Fraction of grid box that has 0-10% sea ice coverage -SEAICE00:units = fraction -SEAICE00:gamap_category = GMAO-2D -#- -SEAICE10 = REAL*4::lon,lat,time -SEAICE10:long_name = Fraction of grid box that has 10-20% sea ice coverage -SEAICE10:units = fraction -SEAICE10:gamap_category = GMAO-2D -#- -SEAICE20 = REAL*4::lon,lat,time -SEAICE20:long_name = Fraction of grid box that has 20-30% sea ice coverage -SEAICE20:units = fraction -SEAICE20:gamap_category = GMAO-2D -#- -SEAICE30 = REAL*4::lon,lat,time -SEAICE30:long_name = Fraction of grid box that has 30-40% sea ice coverage -SEAICE30:units = fraction -SEAICE30:gamap_category = GMAO-2D -#- -SEAICE40 = REAL*4::lon,lat,time -SEAICE40:long_name = Fraction of grid box that has 40-50% sea ice coverage -SEAICE40:units = fraction -SEAICE40:gamap_category = GMAO-2D -#- -SEAICE50 = REAL*4::lon,lat,time -SEAICE50:long_name = Fraction of grid box that has 50-60% sea ice coverage -SEAICE50:units = fraction -SEAICE50:gamap_category = GMAO-2D -#- -SEAICE60 = REAL*4::lon,lat,time -SEAICE60:long_name = Fraction of grid box that has 60-70% sea ice coverage -SEAICE60:units = fraction -SEAICE60:gamap_category = GMAO-2D -#- -SEAICE70 = REAL*4::lon,lat,time -SEAICE70:long_name = Fraction of grid box that has 70-80% sea ice coverage -SEAICE70:units = fraction -SEAICE70:gamap_category = GMAO-2D -#- -SEAICE80 = REAL*4::lon,lat,time -SEAICE80:long_name = Fraction of grid box that has 80-90% sea ice coverage -SEAICE80:units = fraction -SEAICE80:gamap_category = GMAO-2D -#- -SEAICE90 = REAL*4::lon,lat,time -SEAICE90:long_name = Fraction of grid box that has 90-100% sea ice coverage -SEAICE90:units = fraction -SEAICE90:gamap_category = GMAO-2D -#- -SLP = REAL*4::lon,lat,time -SLP:long_name = Sea level pressure -SLP:units = hPa -SLP:gamap_category = GMAO-2D -#- -SNODP = REAL*4::lon,lat,time -SNODP:long_name = Snow depth -SNODP:units = m -SNODP:gamap_category = GMAO-2D -#- -SNOMAS = REAL*4::lon,lat,time -SNOMAS:long_name = Snow mass -SNOMAS:units = kg m-2 -#- -SWGDN = REAL*4::lon,lat,time -SWGDN:long_name = Surface incident shortwave flux -SWGDN:units = W m-2 -SWGDN:gamap_category = GMAO-2D -#- -TROPPT = REAL*4::lon,lat,time -TROPPT:long_name = Temperature-based tropopause pressure -TROPPT:units = hPa -TROPPT:gamap_category = GMAO-2D -#- -TS = REAL*4::lon,lat,time -TS:long_name = Surface skin temperature -TS:units = K -TS:gamap_category = GMAO-2D -#- -T2M = REAL*4::lon,lat,time -T2M:long_name = Temperature 2m above displacement height -T2M:units = K -T2M:gamap_category = GMAO-2D -#- -U10M = REAL*4::lon,lat,time -U10M:long_name = Eastward wind 10m above displacement height -U10M:units = m s-1 -U10M:gamap_category = GMAO-2D -#- -USTAR = REAL*4::lon,lat,time -USTAR:long_name = Friction velocity -USTAR:units = m s-1 -USTAR:gamap_category = GMAO-2D -#- -V10M = REAL*4::lon,lat,time -V10M:long_name = Northward wind 10m above displacement height -V10M:units = m s-1 -V10M:gamap_category = GMAO-2D -#- -Z0M = REAL*4::lon,lat,time -Z0M:long_name = Roughness length, momentum -Z0M:units = m -Z0M:gamap_category = GMAO-2D - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_a3cld.rc b/src/Shared/NcdfUtil/perl/definitions_a3cld.rc deleted file mode 100644 index 238e6492..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_a3cld.rc +++ /dev/null @@ -1,83 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_a3cld.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3cld filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 A3cld met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = a3cld_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.A3cld.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NZ -lat = State_Grid%NY -lev = State_Grid%NZ -time = 1 - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 03:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 030000 -#- -CLOUD = REAL*4::lon,lat,lev,time -CLOUD:long_name = Total cloud fraction in grid box -CLOUD:units = unitless -CLOUD:gamap_category = GMAO-3D$ -#- -OPTDEPTH = REAL*4::lon,lat,lev,time -OPTDEPTH:long_name = Total in-cloud optical thickness (visible band) -OPTDEPTH:units = unitless -OPTDEPTH:gamap_category = GMAO-3D$ -#- -QI = REAL*4::lon,lat,lev,time -QI:long_name = Cloud ice water mixing ratio -QI:units = kg kg-1 -QI:gamap_category = GMAO-3D$ -#- -QL = REAL*4::lon,lat,lev,time -QL:long_name = Cloud liquid water mixing ratio -QL:units = kg kg-1 -QL:gamap_category = GMAO-3D$ -#- -TAUCLI = REAL*4::lon,lat,lev,time -TAUCLI:long_name = In-cloud ice optical thickness (visible band) -TAUCLI:units = unitless -TAUCLI:gamap_category = GMAO-3D$ -#- -TAUCLW = REAL*4::lon,lat,lev,time -TAUCLW:long_name = In-cloud water optical thickness (visible band) -TAUCLW:units = unitless -TAUCLW:gamap_category = GMAO-3D$ - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_a3dyn.rc b/src/Shared/NcdfUtil/perl/definitions_a3dyn.rc deleted file mode 100644 index 852737b8..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_a3dyn.rc +++ /dev/null @@ -1,85 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_a3dyn.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3dyn filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 A3dyn met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = a3dyn_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.A3dyn.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NX -lat = State_Grid%NY -lev = State_Grid%NZ -ap = State_Grid%NZ+1 -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 03:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 030000 -#- -CMFMC = REAL*4::lon,lat,ap,time -CMFMC:long_name = Upward moist convective mass flux -CMFMC:units = kg m-2 s-2 -CMFMC:gamap_category = GMAO-3D$ -#- -DTRAIN = REAL*4::lon,lat,lev,time -DTRAIN:long_name = Detrainment cloud mass flux -DTRAIN:units = kg m-2 s-2 -DTRAIN:gamap_category = GMAO-3D$ -#- -OMEGA = REAL*4::lon,lat,lev,time -OMEGA:long_name = Vertical pressure velocity -OMEGA:units = Pa s-1 -OMEGA:gamap_category = GMAO-3D$ -#- -RH = REAL*4::lon,lat,lev,time -RH:long_name = Relative humidity -RH:units = fraction -RH:gamap_category = GMAO-3D$ -#- -U = REAL*4::lon,lat,lev,time -U:long_name = Eastward component of wind -U:units = m s-1 -U:gamap_category = GMAO-3D$ -#- -V = REAL*4::lon,lat,lev,time -V:long_name = Northward component of wind -V:units = m s-1 -V:gamap_category = GMAO-3D$ - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_a3mstc.rc b/src/Shared/NcdfUtil/perl/definitions_a3mstc.rc deleted file mode 100644 index ef314fa6..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_a3mstc.rc +++ /dev/null @@ -1,74 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_a3mstc.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3mstC filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 A3mstC met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = a3mstc_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.A3mstC.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NX -lat = State_Grid%NY -lev = State_Grid%NZ -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 03:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 030000 -#- -DQRCU = REAL*4::lon,lat,lev,time -DQRCU:long_name = Precipitation production rate -- convective -DQRCU:units = kg kg-1 s-1 -DQRCU:gamap_category = GMAO-3D$ -#- -DQRLSAN = REAL*4::lon,lat,lev,time -DQRLSAN:long_name = Precipitation production rate -- large scale + anvil -DQRLSAN:units = kg kg-1 s-1 -DQRLSAN:gamap_category = GMAO-3D$ -#- -REEVAPCN = REAL*4::lon,lat,lev,time -REEVAPCN:long_name = Evaporation of precipitating convective condensate -REEVAPCN:units = kg kg-1 s-1 -REEVAPCN:gamap_category = GMAO-3D$ -#- -REEVAPLS = REAL*4::lon,lat,lev,time -REEVAPLS:long_name = Evaporation of precipitating large-scale & anvil condensate -REEVAPLS:units = kg kg-1 -REEVAPLS:gamap_category = GMAO-3D$ - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_a3mste.rc b/src/Shared/NcdfUtil/perl/definitions_a3mste.rc deleted file mode 100644 index 2e53b2ad..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_a3mste.rc +++ /dev/null @@ -1,74 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_a3mste.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3mstE filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 A3mstE met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = a3mste_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.A3mstE.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NZ -lat = State_Grid%NY -lev = State_Grid%NZ+1 -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 03:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 030000 -#- -PFICU = REAL*4::lon,lat,lev.time -PFICU:long_name = Downward flux of ice precipitation (convective) -PFICU:units = kg m-2 s-1 -PFICU:gamap_category = GMAO-3D$ -#- -PFILSAN = REAL*4::lon,lat,lev.time -PFILSAN:long_name = Downward flux of ice precipitation (large scale + anvil) -PFILSAN:units = kg m-2 s-1 -PFILSAN:gamap_category = GMAO-3D$ -#- -PFLCU = REAL*4::lon,lat,lev.time -PFLCU:long_name = Downward flux of liquid precipitation (convective) -PFLCU:units = kg m-2 s-1 -PFLCU:gamap_category = GMAO-3D$ -#- -PFLLSAN = REAL*4::lon,lat,lev.time -PFLLSAN:long_name = Downward flux of liquid precipitation (large scale + anvil) -PFLLSAN:units = kg m-2 s-1 -PFLLSAN:gamap_category = GMAO-3D$ - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_cn.rc b/src/Shared/NcdfUtil/perl/definitions_cn.rc deleted file mode 100644 index fd26ef4e..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_cn.rc +++ /dev/null @@ -1,79 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_cn.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 CN filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 CN met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = cn_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.CN.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NX -lat = State_Grid%NY -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:long_name = time -time:units = minutes since 2011-01-01 00:00:00.0 -time:delta_t = 0000-00-00 00:00:00 -time:begin_date = 20110101 -time:begin_time = 000000 -time:time_increment = 000000 -#- -FRLAKE = REAL*4::lon,lat,time -FRLAKE:long_name = Fraction of lake type in grid box -FRLAKE:units = fraction -FRLAKE:gamap_category = GMAO-2D -#- -FRLAND = REAL*4::lon,lat,time -FRLAND:long_name = Fraction of land in grid box -FRLAND:units = fraction -FRLAND:gamap_category = GMAO-2D -#- -FRLANDIC = REAL*4::lon,lat,time -FRLANDIC:long_name = Fraction of land ice in grid box -FRLANDIC:units = fraction -FRLANDIC:gamap_category = GMAO-2D -#- -FROCEAN = REAL*4::lon,lat,time -FROCEAN:long_name = Fraction of ocean in grid box -FROCEAN:units = fraction -FROCEAN:gamap_category = GMAO-2D -#- -PHIS = REAL*4::lon,lat,time -PHIS:long_name = Surface geopotential -PHIS:units = m2 s-2 -PHIS:gamap_category = GMAO-2D - -#EOP diff --git a/src/Shared/NcdfUtil/perl/definitions_i3.rc b/src/Shared/NcdfUtil/perl/definitions_i3.rc deleted file mode 100644 index 558217d6..00000000 --- a/src/Shared/NcdfUtil/perl/definitions_i3.rc +++ /dev/null @@ -1,75 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: definitions_i3.rc -# -# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 I3 filename, -# variables, and attributes for use with the ncCode* scripts. Also defines -# the names of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# This file has been customized to generate GEOS-Chem Fortran code that -# will read data from a GEOS-5.7.2 I3 met field file. -# -# !REVISION HISTORY: -# 01 Feb 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Read File = i3_read.F -netCDF FileHandle = fId -netCDF FileName = GEOS572.YYYYMMDD.I3.4x5.nc - - -### !DIMENSIONS: -lon = State_Grid%NX -lat = State_Grid%NY -lev = State_Grid%NZ -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:long_name = time -time:units = minutes since YYYY-MM-DD 00:00:00.0 -time:delta_t = 0000-00-00 03:00:00 -time:begin_date = YYYYMMDD -time:begin_time = 000000 -time:time_increment = 030000 -#- -PS = REAL*4::lon,lat,time -PS:long_name = Surface pressure -PS:units = hPa -PS:gamap_category = GMAO-2D -#- -PV = REAL*4::lon,lat,lev,time -PV:long_name = Ertel potential vorticity -PV:units = K m-2 kg-1 s-1 -PV:gamap_category = GMAO-3D$ - -QV = REAL*4::lon,lat,lev,time -QV:long_name = Specific humidity -QV:units = kg kg-1 -QV:gamap_category = GMAO-3D$ -#- -T = REAL*4::lon,lat,lev,time -T:long_name = Temperature -T:units = K -T:gamap_category = GMAO-3D$ - -#EOP diff --git a/src/Shared/NcdfUtil/perl/isCoards b/src/Shared/NcdfUtil/perl/isCoards deleted file mode 100755 index a13817de..00000000 --- a/src/Shared/NcdfUtil/perl/isCoards +++ /dev/null @@ -1,1437 +0,0 @@ -#!/usr/bin/perl -w - -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: isCoards -# -# !DESCRIPTION: Scans output of "ncdump" to determine if a netCDF file -# adheres to the COARDS conventions. -#\\ -#\\ -# !USES: -# - require 5.003; # Need this version of Perl or newer - use English; # Use English language - use Carp; # Get detailed error messages - use strict; # Explicitly declare all variables -# -# !PUBLIC DATA MEMBERS: -# - # Scalars - our $zFound = 0; - - # Strings - our $conventions = ""; - our $format = ""; - our $history = ""; - our $inputFile = ""; - our $latitudes = ""; - our $levels = ""; - our $iLevels = ""; - our $longitudes = ""; - our $references = ""; - our $sep = '->'; - our $times = ""; - our $title = ""; - - # Arrays - our @dims = (); - our @vars = (); - our @GOOD = (); - our @BAD = (); - our @OPT = (); - - # Hashes - our %add_offset = (); - our %axis = (); - our %calendar = (); - our %FillValue = (); - our %longName = (); - our %missing_value = (); - our %numDims = (); - our %positive = (); - our %scale_factor = (); - our %units = (); - our %varDims = (); -# -# !PUBLIC MEMBER FUNCTIONS: -# &main() : Driver function -# -# !PRIVATE MEMBER FUNCTIONS: -# &isMonotonic($) : Checks index variables for monotonicity -# &isFirstValueZero($): Checks if the first time point is zero (GCHP req) -# &analyzeTime($) : Checks the "time" variable for COARDS compliance -# &analyzeLev($) : Checks the "lev" variable for COARDS compliance -# &analyzeLat($) : Checks the "lat" variable for COARDS compliance -# &analyzeLon($) : Checks the "lon" variable for COARDS compliance -# &analyzeVar($) : Checks each netCDF" variable for COARDS compliance -# &analyzeGlobAtts() : Checks netCDF global attributes for COARDS compliance -# &analyzeResults() : Calls the &analyze* routines and prints results -# &parseFile($) : Calls ncdump and parses the output into Perl variables -# -# !REMARKS: -# (1) Assumes a version of "ncdump" is installed on your system. -# (2) isCoards may have some limitations. We have written this primarily -# to check COARDS compliance for netCDF files that will be read -# by the HEMCO emissions component (part of GEOS-Chem). -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: isMonotonic -# -# !DESCRIPTION: Checks a list of values to make sure that it is monotonically -# increasing. If it is monotonically increasing, it will return a value -# of 0 (success). If not, it will return a value of -1 (failure). -#\\ -#\\ -# !INTERFACE: -# -sub isMonotonic($) { -# -# !INPUT PARAMETERS: -# - # Comma-separated list of values - my ( $list ) = @_; -# -# !RETURN VALUE: -# - # String to indicate return status - my $result = ""; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Scalars - my $diff = 0; - my $direction = 0; - - # Arrays - my @result = split( /,/, $list ); - - # If there is only one value, then return with success - if ( scalar( @result ) == 1 ) { return( "is a single value" ); } - - # Get the direction of the list, as determined by the 1st 2 elements. - $diff = $result[1] - $result[0]; - if ( $diff > 0 ) { $direction = 1; } - elsif ( $diff == 0 ) { $direction = 0; } - else { $direction = -1; } - - # If the direction is zero then this means we have repeat values - if ( $direction == 0 ) { return( "has repeat values" ); } - - # Loop thru the rest of the array - for ( my $i = 1; $i < scalar( @result ); $i++ ) { - - # Take the difference of this element w/r/t the last element - $diff = $result[$i] - $result[$i-1]; - - # Make sure that the difference is going in the same direction - # as the rest of the index array. If not, then exit with failure. - if ( !( $diff>0 == $direction>0 ) ) { return( "is not monotonic" ); } - } - - # If we have gotten this far, then the list of values is either - # monotonically increasing or decreasing. Return with success. - if ( $direction == 1 ) { return( "is monotonically increasing" ); } - else { return( "is monotonically decreasing" ); } -} -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: isFirstValueZero -# -# !DESCRIPTION: Checks to see if the first value in a list is zero -#\\ -#\\ -# !INTERFACE: -# -sub isFirstValueZero($) { -# -# !INPUT PARAMETERS: -# - # Comma-separated list of values - my ( $list ) = @_; -# -# !RETURN VALUE: -# - # String to indicate return status - my $result = ""; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Arrays - my @result = split( /,/, $list ); - - # Test the first value - if ( $result[0] == "0" ) { return "[0] = 0 (this is required for GCHP)" } - else { return "[0] != 0 (this is required for GCHP)" } -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeTime -# -# !DESCRIPTION: Checks the attributes of the time variable to see if -# they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeTime($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Scalars - my $exists = 0; - - # Strings - my $msg = ""; - my $value = ""; - - # %%%%% Ensure variable is declared w/ the dimension of the same name - if ( $varDims{$var} =~ "$var" ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with dimension "time\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check if times are monotonic - $value = &isMonotonic( $times ); - if ( $value eq "has repeat values" || $value eq "is not monotonic" ) { - $msg = qq/$sep $var $value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var $value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Make sure the first time is zero (this is a GCHP req) - $value = &isFirstValueZero( $times ); - if ( $value =~ "!= 0" ) { - $msg = qq/$sep $var$value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var$value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Check the axis attribute (optional) - $value = $axis{$var}; - if ( defined( $value ) && $value =~ m/[Tt]/ ) { - $msg = qq/$sep $var:axis =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:axis = "T"\n/; - @OPT = ( @OPT, $msg ); - } - - # %%%%% Check the calendar attribute - $value = $calendar{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/gregorian/ || - $value =~ m/standard/ || - $value =~ m/noleap/ ) { - $msg = qq/$sep $var:calendar =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:calendar should be either "gregorian", "noleap", or "standard"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:calendar is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/[Tt][Ii][Mm][Ee]/ ) { - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name (or time:standard_name) should be "Time"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:long_name (or time:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/days since/ || - $value =~ m/hours since/ || - $value =~ m/minutes since/ || - $value =~ m/seconds since/ ) { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/"$sep $var:units" should be "{days,hours,minutes,seconds} since" a reference date\/time"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/"$sep $var:units" is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeLev -# -# !DESCRIPTION: Checks the attributes of the lev variable to see if -# they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeILev($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $msg = ""; - my $value = ""; - - # %%%%% Ensure variable is declared with the dimension of the same name - if ( $varDims{$var} = "$var" ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with dimension "lev"\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check if levels are monotonic - $value = &isMonotonic( $levels ); - if ( $value eq "has repeat values" || $value eq "is not monotonic" ) { - $msg = qq/$sep $var $value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var $value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Check the axis attribute (optional) - $value = $axis{$var}; - if ( defined( $value ) && $value =~ m/[Zz]/ ) { - $msg = qq/$sep $var:axis =$value\n/; - $zFound = 1; - @GOOD = ( @GOOD, $msg ); - } else { - if ( $zFound == 0 ) { - $msg = qq/$sep Consider adding $var:axis = "Z"\n/; - @OPT = ( @OPT, $msg ); - } - } - - # %%%%% Check the positive attribute (optional) - $value = $positive{$var}; - if ( defined( $value ) && ( $value =~ m/[Uu][Pp]/ || - $value =~ m/[Dd][Oo][Ww][Nn]/ ) ) { - $msg = qq/$sep $var:positive =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:positive = "up" (or "down", as the case may be)\n/; - @OPT = ( @OPT, $msg ); - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/hybrid level at interfaces/ || - $value =~ m/GEOS-Chem levels/ || - $value =~ m/lev/ || - $value =~ m/sigma/ || - $value =~ m/eta/ || - $value =~ m/level/ || - $value =~ m/layer/ ) { - - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name should be "ilev" or "hybrid level at interfaces", etc.\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/sigmal/ || $value =~ m/eta/ || - $value =~ m/level/ || $value =~ m/layer/ || - $value =~ m/1/ ) { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:units should be dimensionless (e.g. "sigma_level", "1")\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:units is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeLev -# -# !DESCRIPTION: Checks the attributes of the lev variable to see if -# they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeLev($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $msg = ""; - my $value = ""; - - # %%%%% Ensure variable is declared with the dimension of the same name - if ( $varDims{$var} = "$var" ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with dimension "lev"\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check if levels are monotonic - $value = &isMonotonic( $levels ); - if ( $value eq "has repeat values" || $value eq "is not monotonic" ) { - $msg = qq/$sep $var $value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var $value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Check the axis attribute (optional) - $value = $axis{$var}; - if ( defined( $value ) && $value =~ m/[Zz]/ ) { - $msg = qq/$sep $var:axis =$value\n/; - $zFound = 1; - @GOOD = ( @GOOD, $msg ); - } else { - if ( $zFound == 0 ) { - $msg = qq/$sep Consider adding $var:axis = "Z"\n/; - @OPT = ( @OPT, $msg ); - } - } - - # %%%%% Check the positive attribute (optional) - $value = $positive{$var}; - if ( defined( $value ) && ( $value =~ m/[Uu][Pp]/ || - $value =~ m/[Dd][Oo][Ww][Nn]/ ) ) { - $msg = qq/$sep $var:positive =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:positive = "up" (or "down", as the case may be)\n/; - @OPT = ( @OPT, $msg ); - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/hybrid level at midpoints/ || - $value =~ m/GEOS-Chem levels/ || - $value =~ m/lev/ || - $value =~ m/sigma/ || - $value =~ m/eta/ || - $value =~ m/level/ || - $value =~ m/layer/ ) { - - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name should be "lev" or "hybrid level at midpoints", etc.\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/sigmal/ || $value =~ m/eta/ || - $value =~ m/level/ || $value =~ m/layer/ || - $value =~ m/1/ ) { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:units should be dimensionless (e.g. "sigma_level", "1")\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:units is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeLat -# -# !DESCRIPTION: Checks the attributes of the lat variable to see if -# they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeLat($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $msg = ""; - my $value = ""; - - # %%%%% Ensure variable is declared with the dimension of the same name - if ( $varDims{$var} = "$var" ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with dimension "lev"\n/; - @BAD = ( @BAD, $msg ); - } - - if ( $var =~ m/[Ll][Aa][Tt]/ ) { - # %%%%% Check if latitudes are monotonic - $value = &isMonotonic( $latitudes ); - if ( $value eq "has repeat values" || $value eq "is not monotonic" ) { - $msg = qq/$sep $var $value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var $value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Check the axis attribute (optional) - $value = $axis{$var}; - if ( defined( $value) && $value =~ m/[Yy]/ ) { - $msg = qq/$sep $var:axis =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:axis = "Y"\n/; - @OPT = ( @OPT, $msg ); - } - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/[Ll][Aa][Tt][Ii][Tt][Uu][Dd][Ee]/ ) { - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name should be "Latitude"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the :units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/degrees_north/ ) { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:units should be "degrees_north"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:units is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeLon -# -# !DESCRIPTION: Checks the attributes of the lat variable to see if -# they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeLon($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $msg = ""; - my $value = ""; - - # %%%%% Ensure variable is declared with the dimension of the same name - if ( $varDims{$var} = "$var" ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with dimension "lon"\n/; - @BAD = ( @BAD, $msg ); - } - - if ( $var =~ m/[Ll][Oo][Nn]/ ) { - # %%%%% Check if latitudes are monotonic (skip for GCHP) - $value = &isMonotonic( $longitudes ); - if ( $value eq "has repeat values" || $value eq "is not monotonic" ) { - $msg = qq/$sep $var $value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var $value\n/; - @GOOD = ( @GOOD, $msg ); - } - - # %%%%% Check the axis attribute (optional / skip for GCHP) - $value = $axis{$var}; - if ( defined( $value ) && $value =~ m/[Xx]/ ) { - $msg = qq/$sep $var:axis =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:axis ="X"\n/; - @OPT = ( @OPT, $msg ); - } - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/[Ll][Oo][Nn][Gg][Ii][Tt][Uu][Dd][Ee]/ ) { - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) should be "Longitude"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/degrees_east/ ) { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:units should be "degrees_east"\n/; - @BAD = ( @BAD, $msg ); - } - } else { - $msg = qq/$sep $var:units is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeVar -# -# !DESCRIPTION: Checks the attributes of a (non-index) netCDF variable -# to see if they adhere to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeVar($) { -# -# !INPUT PARAMETERS: -# - # Variable name (from ncdump output) - my ( $var ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: - - # Scalars - my $i = 0; - my $foundDims = 0; - - # Strings - my $msg = ""; - my $value = ""; - my $dim = ""; - my $dimsInVar = $varDims{$var}; - - # %%%%% Check to see if each dimension is valid - foreach $dim ( @dims ) { - - # Special handling for hyai and hybi, which have "ilev" as a dimension - # which can easily be confused with "lev". Use a strict equality - # for these variables instead of a pattern match. (bmy, 4/30/18) - if ( $var eq "hyai" || $var eq "hybi" ) { - if ( $dimsInVar eq $dim ) { $foundDims++; } - } else { - if ( $dimsInVar =~ m/$dim/ ) { $foundDims++; } - } - } - - # %%%%% Check if $var has the right # of dimensions - if ( $foundDims == $numDims{$var} ) { - $msg = qq/$sep $var($varDims{$var})\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var needs to be declared with ($varDims{$var})\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the long_name attribute - $value = $longName{$var}; - if ( defined( $value ) && $value ne "" ) { - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep $var:long_name (or $var:standard_name) is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check the units attribute - $value = $units{$var}; - if ( defined( $value ) ) { - if ( $value =~ m/[Uu][Nn][Ii][Tt][Ll][Ee][Ss][Ss]/ || - $value =~ m/[Nn][Aa]/ ) { - $msg = qq/$sep $var:units =$value\n/; - @BAD = ( @BAD, $msg ); - } else { - $msg = qq/$sep $var:units =$value\n/; - @GOOD = ( @GOOD, $msg ); - } - } else { - $msg = qq/$sep $var:units is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # Skip checking certain attributes for index variables that are - # automatically added to the netCDF file - if ( $var eq "hyai" || $var eq "hybi" || - $var eq "hyam" || $var eq "hybm" || - $var eq "AREA" ) { return( $? ); } - - # %%%%% Check the _FillValue attribute (optional) - $value = $FillValue{$var}; - if ( defined( $value ) && $value ne "" ) { - $msg = qq/$sep $var:long_name =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:_FillValue\n/; - @OPT = ( @OPT, $msg ); - } - - # %%%%% Check the missing_value attribute (optional) - $value = $missing_value{$var}; - if ( defined( $value ) && $value ne "" ) { - $msg = qq/$sep $var:missing_value =$value\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding $var:missing_value\n/; - @OPT = ( @OPT, $msg ); - } - -# # %%%%% Check the add_offset attribute (optional) -# $value = $add_offset{$var}; -# if ( defined( $value ) && $value ne "" ) { -# $msg = qq/$sep $var:add_offset =$value\n/; -# @GOOD = ( @GOOD, $msg ); -# } else { -# $msg = qq/$sep Consider adding $var:add_offset\n/; -# @OPT = ( @OPT, $msg ); -# } -# -# # %%%%% Check the scale_factor attribute (optional) -# $value = $scale_factor{$var}; -# if ( defined( $value ) && $value ne "" ) { -# $msg = qq/$sep $var:scale_factor =$value\n/; -# @GOOD = ( @GOOD, $msg ); -# } else { -# $msg = qq/$sep Consider adding $var:scale_factor\n/; -# @OPT = ( @OPT, $msg ); -# } - - # Return with error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeGlobAtts -# -# !DESCRIPTION: Checks if the global attributes of a netCDF file adhere -# to the COARDS standard. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeGlobAtts() { -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Strings - my $msg = ""; - - #------------------------------------------------------------------------- - # Required global attributes: Conventions, History, Title - #------------------------------------------------------------------------- - - # %%%%% Check Conventions - if ( $conventions ne "" ) { - $msg = qq/$sep conventions:$conventions\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep The "conventions" global attribute is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check History - if ( $history ne "" ) { - $msg = qq/$sep history:$history\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep The "history" global attribute is missing\n/; - @BAD = ( @BAD, $msg ); - } - - # %%%%% Check Title - if ( $title ne "" ) { - $msg = qq/$sep title:$title\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep The "title" global attribute is missing\n/; - @BAD = ( @BAD, $msg ); - } - - #------------------------------------------------------------------------- - # Required global attributes: Format, Reference or References - #------------------------------------------------------------------------- - - # %%%%% Check Format - if ( $format ne "" ) { - $msg = qq/$sep format:$format\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding the "format" global attribute\n/; - @OPT = ( @OPT, $msg ); - } - - # %%%%% Check References - if ( $references ne "" ) { - $msg = qq/$sep references:$references\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Consider adding the "references" global attribute\n/; - @OPT = ( @OPT, $msg ); - } - - # Return with error code - return( $? ); -} -#EOP -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: analyzeResults -# -# !DESCRIPTION: Calls routines to analyze if the given netCDF file -# is COARDS-compliant. Prints results to stdout. -#\\ -#\\ -# !INTERFACE: -# -sub analyzeResults() { -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Scalars - my $badDimFound = 0; - - # Strings - my $line = ""; - my $dim = ""; - my $msg = ""; - my $var = ""; - - #========================================================================= - # Loop over the output of ncdump, line by line - #========================================================================= - - # Check dimensions: Only lon, lat, lev, ilev, and time are acceptable; - # Otherwise GCHP simulations will die when reading the file (bmy, 6/14/18) - foreach $dim ( @dims ) { - if ( ( $dim =~ m/[Tt][Ii][Mm][Ee]/ ) || - ( $dim =~ m/[Ii][Ll][Ee][Vv]/ ) || - ( $dim =~ m/[Ll][Ee][Vv]/ ) || - ( $dim =~ m/[Ll][Aa][Tt]/ ) || - ( $dim =~ m/[Ll][Oo][Nn]/ ) || - ( $dim =~ m/[Xx][Dd][Ii][Mm]/ ) || # GCHP only - ( $dim =~ m/[Yy][Dd][Ii][Mm]/ ) || # GCHP only - ( $dim =~ m/nf/ ) || # GCHP only - ( $dim =~ m/ncontact/ ) || # GCHP only - ( $dim =~ m/orientationStrLen/ ) ) { # GCHP only - $msg = qq/$sep Dimension "$dim" adheres to standard usage\n/; - @GOOD = ( @GOOD, $msg ); - } else { - $msg = qq/$sep Dimension "$dim" is non-standard usage,\n which will cause GCHP to fail during file read.\n PLEASE REMOVE THIS DIMENSION AND ALL VARIABLES THAT USE IT!!!\n/; - @BAD = ( @BAD, $msg ); - $badDimFound = 1; - } - } - - # Don't even bother analyzing the rest of the file if one of the dimensions - # is non-standard. Skip to printing the results (bmy, 6/14/18) - if ( $badDimFound == 1 ) { goto printResults; } - - # Check variables - foreach $var ( @vars ) { - - # Si - if ( $var =~ m/anchor/ ) { } - elsif ( $var =~ m/contact/ ) { } - elsif ( $var =~ m/nf/ ) { } - elsif ( $var =~ m/orientation/ ) { } - elsif ( $var =~ m/orientationStrLen/ ) { } - elsif ( $var =~ m/lats/ ) { } - elsif ( $var =~ m/lons/ ) { } - - # Analyze these dimensions for COARDS compliance - elsif ( $var =~ m/[Tt][Ii][Mm][Ee]/ ) { &analyzeTime( $var ); } - elsif ( $var =~ m/[Ii][Ll][Ee][Vv]/ ) { &analyzeILev( $var ); } - elsif ( $var =~ m/[Ll][Ee][Vv]/ ) { &analyzeLev ( $var ); } - elsif ( $var =~ m/[Ll][Aa][Tt]/ ) { &analyzeLat ( $var ); } - elsif ( $var =~ m/[Yy][Dd][Ii][Mm]/ ) { &analyzeLat ( $var ); } - elsif ( $var =~ m/[Ll][Oo][Nn]/ ) { &analyzeLon ( $var ); } - elsif ( $var =~ m/[Xx][Dd][Ii][Mm]/ ) { &analyzeLon ( $var ); } - else { &analyzeVar ( $var ); } - } - - # Check global attributes - &analyzeGlobAtts(); - -printResults: - #========================================================================= - # Report things that are in COARDS compliance - #========================================================================= - print "="x75 . "\n"; - print "Filename: $inputFile\n"; - print "="x75 . "\n"; - print "\nThe following items adhere to the COARDS standard:\n"; - print "-"x75 . "\n"; - foreach $line ( @GOOD ) { print "$line" } - - #========================================================================= - # Report things that are not in COARDS compliance - #========================================================================= - print "\nThe following items DO NOT ADHERE to the COARDS standard:\n"; - print "-"x75 . "\n"; - foreach $line ( @BAD ) { print "$line" } - - - #========================================================================= - # Report things that are not in COARDS compliance - #========================================================================= - print "\nThe following optional items are RECOMMENDED:\n"; - print "-"x75 . "\n"; - foreach $line ( @OPT ) { print "$line" } - - print "\nFor more information how to fix non COARDS-compliant items, see:\n"; - print "http://wiki.geos-chem.org/Preparing_data_files_for_use_with_HEMCO\n"; - - # Return w/ error code - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: parseFile -# -# !DESCRIPTION: Runs "ncdump" on a netCDF file and parses the output into -# variables for later analysis. -#\\ -#\\ -# !INTERFACE: -# -sub parseFile($) { -# -# !INPUT PARAMETERS: -# - # netCDF file to scan (from command line) - my ( $fileName ) = @_; -# -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - # Strings - my $dimList = ""; - my $dimName = ""; - my $key = ""; - my $line = ""; - my $value = ""; - my $varName = ""; - - # Scalars - my $inDims = 0; - my $inVars = 0; - my $inAtts = 0; - my $inData = 0; - my $inLon = 0; - my $inLat = 0; - my $inLev = 0; - my $inILev = 0; - my $inTime = 0; - - # Arrays - my @result = (); - my @result2 = (); - my @text = qx( ncdump -c $fileName ); - - #========================================================================= - # Loop over the output of ncdump, line by line - #========================================================================= - foreach $line ( @text ) { - - # Remove newline - chomp( $line ); - - # Find out which section of the ncdump output this line is in - if ( $line =~ m/dimensions:/ ) { $inDims = 1; $inVars = 0; - $inAtts = 0, $inData = 0 } - if ( $line =~ m/variables:/ ) { $inDims = 0; $inVars = 1; - $inAtts = 0, $inData = 0 } - if ( $line =~ m/global attributes:/ ) { $inDims = 0; $inVars = 0; - $inAtts = 1, $inData = 0 } - if ( $line =~ m/data:/ ) { $inDims = 0; $inVars = 0; - $inAtts = 0, $inData = 1 } - - #====================================================================== - # Dimensions section - #====================================================================== - if ( $inDims ) { - - # Look for dimension names (split on the "=" sign) - @result = split( /=/, $line ); - if ( scalar( @result ) == 2 ) { - $dimName = $result[0]; - $dimName =~ s/\s+$//g; - $dimName =~ s/\t//g; - @dims = ( @dims, $dimName ); - } - } - - #====================================================================== - # Variables section - #====================================================================== - if ( $inVars ) { - - #-------------------------------------------------------------------- - # Look for the variable names - # - # In the ncdump output, lines with () are variable names. - # and the dimension list ins contained in parentheses. - #-------------------------------------------------------------------- - - # Variables are - if ( $line =~ m/\(/ && - $line =~ m/\)/ && - !( $line =~ m/long_name/ || $line =~ m/standard_name/ ) ) { - - # Get the variable name (first split on the "(", then on the space) - # and append to the list of variables - @result = split( /\(/, $line ); - @result2 = split( / /, $result[0] ); - $varName = $result2[1]; - @vars = ( @vars, $varName ); - - # Get the dimension list for each variable and save to a hash - $dimList = $result[1]; - $dimList =~ s/\s+$//g; - $dimList =~ s/ //g; - $dimList =~ s/\)//g; - $dimList =~ s/;//g; - $varDims{$varName} = $dimList; - - # Get the # of dimensions for each variable and save to a hash - @result2 = split( /,/, $dimList ); - $numDims{$varName} = scalar( @result2 ); - - } - - #-------------------------------------------------------------------- - # Look for variable attributes and save into hashes - #-------------------------------------------------------------------- - - # add_offset - if ( $line =~ m/$varName:add_offset/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $add_offset{$varName} = $result[1]; - } - - # axis - if ( $line =~ m/$varName:axis/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $axis{$varName} = $result[1]; - } - - # calendar - if ( $line =~ m/$varName:calendar/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $calendar{$varName} = $result[1]; - } - - # _FillValue - if ( $line =~ m/$varName:_FillValue/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $FillValue{$varName} = $result[1]; - } - - # long_name or standard_name - if ( $line =~ m/$varName:long_name/ || - $line =~ m/$varName:standard_name/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $longName{$varName} = $result[1]; - } - - # missing_value - if ( $line =~ m/$varName:missing_value/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $missing_value{$varName} = $result[1]; - } - - # positive - if ( $line =~ m/$varName:positive/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $positive{$varName} = $result[1]; - } - - # scale_factor - if ( $line =~ m/$varName:scale_factor/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $scale_factor{$varName} = $result[1]; - } - - # units - if ( $line =~ m/$varName:units/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $units{$varName} = $result[1]; - } - } - - #====================================================================== - # Global attributes section - #====================================================================== - if ( $inAtts ) { - - # Conventions - if ( $line =~ m/:[Cc][Oo][Nn][Vv][Ee][Nn][Tt][Ii][Oo][Nn][Ss]/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $conventions = $result[1]; - } - - # Format - if ( $line =~ m/:[Ff][Oo][Rr][Mm][Aa][Tt]/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $format = $result[1]; - } - - # History - if ( $line =~ m/:[Hh][Ii][Ss][Tt][Oo][Rr][Yy]/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $history = $result[1]; - } - - # Title - if ( $line =~ m/:[Tt][Ii][Tt][Ll][Ee]/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $title = $result[1]; - } - - # References - if ( $line =~ m/:[Rr][Ee][Ff][Ee][Rr][Ee][Nn][Cc][Ee]/ ) { - @result = split( /=/, $line ); - $result[1] =~ s/\;//g; - $references = $result[1]; - } - } - - #====================================================================== - # Data section - #====================================================================== - if ( $inData ) { - - # Take extra care to distinguish "ilev" from "lev" - if ( $line =~ m/[Ll][Ee][Vv]/ ) { - if ( $line =~ m/[Ii][Ll][Ee][Vv]/ ) { $inILev = 1; $inLev = 0; } - else { $inLev = 1; $inILev = 0; } - } - - # Save level interface values into a string - if ( $inILev ) { $iLevels .= "$line"; } - if ( $inILev && $line =~ m/;/ ) { $inILev = 0; } - - # Save level midpoint values into a string - if ( $inLev ) { $levels .= "$line"; } - if ( $inLev && $line =~ m/;/ ) { $inLev = 0; } - - # Save time values into a string - if ( $line =~ m/[Tt][Ii][Mm][Ee]/ ) { $inTime = 1 } - if ( $inTime ) { $times .= "$line"; } - if ( $inTime && $line =~ m/;/ ) { $inTime = 0; } - - # Save latitude values into a string - if ( $line =~ m/[Ll][Aa][Tt]/ ) { $inLat = 1 } - if ( $inLat ) { $latitudes .= "$line"; } - if ( $inLat && $line =~ m/;/ ) { $inLat = 0; } - - # Save Ydim values into a string (use $latitudes variable) - if ( $line =~ m/[Yy][Dd][Ii][Mm]/ ) { $inLat = 1 } - if ( $inLat ) { $latitudes .= "$line"; } - if ( $inLat && $line =~ m/;/ ) { $inLat = 0; } - - # Save longitude values into a string - if ( $line =~ m/[Ll][Oo][Nn]/ ) { $inLon = 1 } - if ( $inLon ) { $longitudes .= "$line"; } - if ( $inLon && $line =~ m/;/ ) { $inLon = 0; } - - # Save Xdim values into a string (use $longitudes variable) - if ( $line =~ m/[Xx][Dd][Ii][Mm]/ ) { $inLon = 1 } - if ( $inLon ) { $longitudes .= "$line"; } - if ( $inLon && $line =~ m/;/ ) { $inLon = 0; } - } - } - - #========================================================================= - # Post-processing - #========================================================================= - - # Remove extra characters from the times string - if ( $times ne "" ) { - @result = split( /=/, $times ); - $times = $result[1]; - $times =~ s/ //g; - $times =~ s/;//g; - } - - # Remove extra characters from the iLevels string - if ( $iLevels ne "" ) { - @result = split( /=/, $iLevels ); - $iLevels = $result[1]; - $iLevels =~ s/ //g; - $iLevels =~ s/;//g; - } - - # Remove extra characters from the levels string - if ( $levels ne "" ) { - @result = split( /=/, $levels ); - $levels = $result[1]; - $levels =~ s/ //g; - $levels =~ s/;//g; - } - - # Remove extra characters from the latitudes string - if ( $latitudes ne "" ) { - @result = split( /=/, $latitudes ); - $latitudes = $result[1]; - $latitudes =~ s/ //g; - $latitudes =~ s/;//g; - } - - # Remove extra characters from the longitudes string - if ( $longitudes ne "" ) { - @result = split( /=/, $longitudes ); - $longitudes = $result[1]; - $longitudes =~ s/ //g; - $longitudes =~ s/;//g; - } - - # Pass error code back to main program - return( $? ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: main -# -# !DESCRIPTION: Driver program for isCoards. Calls routines &parseFile -# and &analyzeResults. -#\\ -#\\ -# !INTERFACE: -# -sub main() { -# -#EOP -#------------------------------------------------------------------------------ -#BOC - if ( scalar( @ARGV ) == 1 ) { - - # Save filename as a global variable for later use - $inputFile = $ARGV[0]; - - # Scan the output of "ncdump" into Perl variables - &parseFile( $inputFile ); - - # Determine if the file is COARDS-compliant - &analyzeResults(); - - } else { - - # Otherwise exit with error - print "Usage: isCoards FILENAME\n"; - exit( -1 ); - - } - - # Return with error code - return( $? ) -} - -#------------------------------------------------------------------------------ - -# Call main routine -main(); - -# Return error code -exit( $? ); diff --git a/src/Shared/NcdfUtil/perl/ncCodeDef b/src/Shared/NcdfUtil/perl/ncCodeDef deleted file mode 100755 index 50dae713..00000000 --- a/src/Shared/NcdfUtil/perl/ncCodeDef +++ /dev/null @@ -1,790 +0,0 @@ -#!/usr/bin/perl -w - -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: ncCodeDef -# -# !DESCRIPTION: This Perl script automatically creates a Fortran subroutine -# that creates a netCDF file and specifies the relevant variables and -# attributes. The Fortran subroutine (named DEFINE\_NETCDF\_FILE) contains -# calls to the proper NcdfUtilities library routines. -#\\ -#\\ -# !USES: -# - require 5.003; # Need this version of Perl or newer - use English; # Use English language - use Carp; # Get detailed error messages - use strict 'refs'; # Do not allow symbolic references - use strict 'subs'; # Treat all barewords as syntax errors - use StrTrim qw( &trim - &splitLine - &extractFile ); # Get string handling routines -# -# !PRIVATE MEMBER FUNCTIONS: -# &readRcFile($) -# &writeFortranVars($@) -# &writeFortranCalls($@) -# &handleFileName($$) -# &handleGlobalAtts($$) -# &handleDimensions($$) -# &handleVariables($$) -# -# !PUBLIC MEMBER FUNCTIONS: -# &main() -# -# !PUBLIC DATA MEMBERS: -# - $F_ID = ""; # netCDF file ID -# -# !CALLING SEQUENCE: -# ncCodeCreate RESOURCE-FILE-NAME -# -# !REMARKS: -# Some hand-editing of the output Fortran subroutine may be necessary. -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -# 30 Jan 2012 - R. Yantosca - Now get trim, splitline routines from the -# Perl module "StrTrim.pm" -# 30 Jan 2012 - R. Yantosca - Now write ProTeX comment headers -# 31 Jan 2012 - R. Yantosca - Minor edits for consistency -# 07 Mar 2012 - R. Yantosca - Minor fix, ignore comment lines -#EOP -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: readRcFile -# -# !DESCRIPTION: Routine readRcFile reads the resource file which describes -# the variables, attributes, and dimensions of the netCDF file. -#\\ -#\\ -# !INTERFACE: -# -sub readRcFile($) { -# -# !INPUT PARAMETERS: -# - # $fileName : Input file that describes the netCDF file - my ( $fileName ) = @_; -# -# !CALLING SEQUENCE: -# &readRcFile( RESOURCE-FILE-NAME ); -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -# 27 Jan 2012 - R. Yantosca - Now get output filename from the resource file -# 07 Mar 2012 - R. Yantosca - Minor fix, ignore comment lines -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my $cmdFile = ""; - my $line = ""; - my @lines = (); - my $name = ""; - - #-------------------------------------------------- - # Read variable settings from the resource file - #-------------------------------------------------- - open( I, "<$fileName" ) or die "Cannot open $fileName!\n"; - chomp( @lines = ); - close( I ); - - #-------------------------------------------------- - # Write Fortran commands to the output file - #-------------------------------------------------- - - # Pre-get a few quantities before creating the - # output file with the fortran code - foreach $line ( @lines ) { - - # Skip comment lines - if ( !( substr( $line, 0, 1 ) eq '#' ) ) { - - # Name of output file w/ Fortran code - if ( $line =~ 'Fortran Def File' ) { - ( $name, $cmdFile ) = &splitLine( $line, '=' ); - } - - # NetCDF file ID (aka filehandle) - if ( $line =~ 'netCDF FileHandle' ) { - ( $name, $F_ID ) = &splitLine( $line, '=' ); - } - } - } - - # Open the file that will ho - open( O, ">$cmdFile" ) or die "Cannot open $cmdFile\n"; - - # Pass thru @lines array so that we can declare Fortran variables - &writeFortranVars( \*O, @lines ); - - # Pass thru @lines array again to write - &writeFortranCalls( \*O, @lines ); - - #-------------------------------------------------- - # Cleanup and quit - #-------------------------------------------------- - - # Close output file - close( O ); - - # Return - return( 0 ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: writeFortranVars -# -# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran -# variable declarations that are needed for use with the NcdfUtilities -# library routines. -#\\ -#\\ -# !INTERFACE: -# -sub writeFortranVars($@) { -# -# !INPUT PARAMETERS: -# - # $O : File handle - # @lines : Contents of the resource file - my ( $O, @lines ) = @_; -# -# !CALLING SEQUENCE: -# &writeFortranVars( \*O, @lines ); -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my @subStr = (); - my $name = ""; - my $value = ""; - my $txt = ""; - - #------------------------------------------------------- - # Write USE statements - #------------------------------------------------------- - $txt .= < ); - close( I ); - - #-------------------------------------------------- - # Write Fortran commands to the output file - #-------------------------------------------------- - - # Pre-get a few quantities before creating the - # output file with the fortran code - foreach $line ( @lines ) { - - # Skip comment lines - if ( !( substr( $line, 0, 1 ) eq '#' ) ) { - - # Name of output file w/ Fortran code - if ( $line =~ 'Fortran Read File' ) { - ( $name, $cmdFile ) = &splitLine( $line, '=' ); - } - - # NetCDF file ID (aka filehandle) - if ( $line =~ 'netCDF FileHandle' ) { - ( $name, $F_ID ) = &splitLine( $line, '=' ); - } - } - } - - # Open the file that will ho - open( O, ">$cmdFile" ) or die "Cannot open $cmdFile\n"; - - # Pass thru @lines array so that we can declare Fortran variables - &writeFortranVars( \*O, @lines ); - - # Pass thru @lines array again to write - &writeFortranCalls( \*O, @lines ); - - #-------------------------------------------------- - # Cleanup and quit - #-------------------------------------------------- - - # Close output file - close( O ); - - # Return - return( 0 ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: writeFortranVars -# -# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran -# variable declarations that are needed for use with the NcdfUtilities -# library routines. -#\\ -#\\ -# !INTERFACE: -# -sub writeFortranVars($@) { -# -# !INPUT PARAMETERS: -# - # $O : File handle - # @lines : Contents of the resource file - my ( $O, @lines ) = @_; -# -# !CALLING SEQUENCE: -# &writeFortranVars( \*O, @lines ); -# -# !REVISION HISTORY: -# 30 Jan 2012 - R. Yantosca - Initial version -# 31 Jan 2012 - R. Yantosca - Minor edits for consistency -# 01 Feb 2012 - R. Yantosca - Fix typo in output ProTeX header -# 09 Jul 2012 - R. Yantosca - Now make fId a local variable -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my @subStr = (); - my $name = ""; - my $value = ""; - my $varName = ""; - my $varSize = ""; - my $varType = ""; - my $varDim = ""; - my $nDims = ""; - my @dims = (); - my $dimDef = ""; - my $txt = ""; - - #------------------------------------------------------- - # Write USE statements - #------------------------------------------------------- - $txt .= < ); - close( I ); - - #---------------------------------------------- - # Write Fortran commands to the output file - #---------------------------------------------- - - # Parse the file first to pre-get a few quantities - foreach $line ( @lines ) { - - # Skip comment lines - if ( !( substr( $line, 0, 1 ) eq '#' ) ) { - - # Name of output file w/ Fortran code - if ( $line =~ 'Fortran Write File' ) { - ( $name, $cmdFile ) = &splitLine( $line, '=' ); - } - - # NetCDF file ID (aka filehandle) - if ( $line =~ 'netCDF FileHandle' ) { - ( $name, $F_ID ) = &splitLine( $line, '=' ); - } - } - } - - # Open the file that will ho - open( O, ">$cmdFile" ) or die "Cannot open output file $cmdFile!\n"; - - # Pass thru @lines array so that we can declare Fortran variables - &writeFortranVars( \*O, @lines ); - - # Pass thru @lines array again to write - &writeFortranCalls( \*O, @lines ); - - #---------------------------------------------- - # Cleanup and quit - #---------------------------------------------- - - # Close output file - close( O ); - - # Return - return( 0 ); -} -#EOC -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: writeFortranVars -# -# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran -# variable declarations that are needed for use with the NcdfUtilities -# library routines. -#\\ -#\\ -# !INTERFACE: -# -sub writeFortranVars($@) { -# -# !INPUT PARAMETERS: -# - # $O : File handle - # @lines : Contents of the resource file - my ( $O, @lines ) = @_; -# -# !CALLING SEQUENCE: -# &writeFortranVars( \*O, @lines ); -# -# !REVISION HISTORY: -# 30 Jan 2012 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC -# -# !LOCAL VARIABLES: -# - my @subStr = (); - my $name = ""; - my $value = ""; - my $varName = ""; - my $varSize = ""; - my $varType = ""; - my $varDim = ""; - my $nDims = ""; - my @dims = (); - my $dimDef = ""; - my $txt = ""; - - #------------------------------------------------------- - # Write USE statements - #------------------------------------------------------- - $txt .= < 0 ) { - - # Create chunking command for lon dimension - # Create the chinking - if ( $line =~ m/[Ll][0o][Nn]/ ) { - $lonCmd = $line; - $lonCmd =~ s/ = /\//g; - $lonCmd =~ s/ ;//g; - $lonCmd =~ s/^\s+|\s+$//g - } - - # Create chunking command for lat dimension - if ( $line =~ m/[Ll][Aa][Tt]/ ) { - $latCmd = $line; - $latCmd =~ s/ = /\//g; - $latCmd =~ s/ ;//g; - $latCmd =~ s/^\s+|\s+$//g - } - - # Create chunking command for level midpoints dimension - if ( $line =~ m/[Ll][Ee][Vv]/ ) { - @subStrs = split( ' = ', $line ); - $levCmd = "$subStrs[0]/1"; - $levCmd =~ s/^\s+|\s+$//g - } - - # Create chunking command for level interfaces dimension - if ( $line =~ m/[Ii][Ll][Ee][Vv]/ ) { - @subStrs = split( ' = ', $line ); - $levCmd = "$subStrs[0]/1"; - $levCmd =~ s/^\s+|\s+$//g - } - - # Create chunking command for time dimension - if ( $line =~ m/[Tt][Ii][Mm][Ee]/ ) { - @subStrs = split( ' = ', $line ); - $timeCmd = "$subStrs[0]/1"; - $timeCmd =~ s/^\s+|\s+$//g - } - - } - - # We have exited the dimensions section - if ( $line =~ m/variables:/ ) { goto quit; } - } - -quit: - - # Chunking command - if ( $levCmd eq "" && $timeCmd eq "" ) - { $cmd = "nccopy -c $lonCmd,$latCmd"; } - elsif ( $levCmd eq "" ) - { $cmd = "nccopy -c $lonCmd,$latCmd,$timeCmd"; } - else - { $cmd = "nccopy -c $lonCmd,$latCmd,$levCmd,$timeCmd"; } - - # Deflation command - if ( $deflate > 0 ) { $cmd .= " -d$deflate" } - - # Add file name to the command - $cmd .= " $ncFile tmp.nc; mv tmp.nc $ncFile"; - print "$cmd\n"; - - # Execute the command - $result = qx/$cmd/; - chomp( $result ); - if ( $result ne "" ) { print "$result\n"; } - - # Exit and pass status code back - return( $? ); -} -#EOP -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model ! -#------------------------------------------------------------------------------ -#BOP -# -# !IROUTINE: main -# -# !DESCRIPTION: Driver program for the nc_chunk.pl script. -#\\ -#\\ -# !INTERFACE: -# -sub main(@) { -# -# !REVISION HISTORY: -# 12 Apr 2018 - R. Yantosca - Initial version -#EOP -#------------------------------------------------------------------------------ -#BOC - - # Error message - my $errMsg = "Usage: nc_chunk.pl NETCDF-FILE-NAME"; - - # If the user passes a filename from the command line, use it - # Otherwise, default to "UnitTest.input" - if ( scalar( @ARGV ) == 2 ) { &chunkTheFile( @ARGV, ); } - elsif ( scalar( @ARGV ) == 1 ) { &chunkTheFile( @ARGV, 0 ); } - else { print "$errMsg\n"; exit( -1 ); } - - # Exit and pass status code backq - return( $? ); -} -#EOC - -#------------------------------------------------------------------------------ - -# Call main program -main(); - -# Exit and pass status code back to Unix shell -exit( $? ); diff --git a/src/Shared/NcdfUtil/perl/nc_definitions.rc b/src/Shared/NcdfUtil/perl/nc_definitions.rc deleted file mode 100644 index cb9c91bf..00000000 --- a/src/Shared/NcdfUtil/perl/nc_definitions.rc +++ /dev/null @@ -1,154 +0,0 @@ -#------------------------------------------------------------------------------ -# GEOS-Chem Global Chemical Transport Model # -#------------------------------------------------------------------------------ -#BOP -# -# !MODULE: nc_definitions.rc -# -# !DESCRIPTION: Resource file that defines the netCDF filename, variables, -# and attributes for use with the ncCode* scripts. Also defines the names -# of the files where Fortran code will be written to. -#\\ -#\\ -# !REMARKS: -# In the FILENAME section: -# --------------------------------------------------------------------------- -# Fortran Def File : Output file (generated by ncCodeDef) containing the -# Fortran calls to define the netCDF vars and atts -# Fortran Write File : Output file (generated by ncCodeWrite) containing the -# Fortran calls to write data to the netCDF file -# Fortran Read File : Output file (generated by ncCodeRead) containing the -# Fortran calls to read data from the netCDF file -# netCDF FileHandle : netCDF file ID variable (usually fId or nc_id) -# netCDF FileName : Name of the netCDF file that the Fortran code will -# write to and read from -# . -# In the GLOBAL ATTRIBUTES section: -# ---------------------------------------------------------------------------- -# Global attributes are specified with a declaration such as: -# . -# title = netCDF file to contain XYZ data -# . -# Where the name and value of each attribute is separated by an equals sign. -# -# In the DIMENSIONS section: -# ---------------------------------------------------------------------------- -# netCDF dimensions are specified with declarations such as: -# . -# lon = 72 -# lat = 46 -# lev = 72 -# time = 1 -# . -# Each dimension of your Fortran data arrays must have a corresponding -# netCDF dimension. We recommend using lon, lat, lev/press/alt, and -# time as standard dimension names. -# . -# In the VARIABLES section: -# ---------------------------------------------------------------------------- -# You may separate variables from each other for clarity with a "#" or "#-" -# comment. -# . -# netCDF variables are specified with a declaration such as: -# . -# PS = REAL*4::lon,lat,time -# . -# where the variable name is to the left of the equals sign. The variable -# type (in this case, REAL*4) and the variable dimensions are to the right -# of the equals sign, separated by the a double colon "::". -# . -# netCDF variable attributes are specified by a declaration such as: -# . -# PS:long_name = Surface pressure -# . -# where the variable name and attribute name are to the left of the equals -# sign and separated from each other by a single colon ":". -# . -# Guidelines for COARDS compliance: -# ---------------------------------------------------------------------------- -# (1 ) Index array variables must have the same name as the netCDF dimensions -# that are used to declare them. -# (2 ) Index array data should be monotonically increasing (i.e. longitude -# from -180 to 180 or 0 to 360, latitude from -90 to 90, etc.). -# (3 ) All variables should have "long_name" and "units" attributes. -# (4 ) Dimension and attribute names should be in lower case. -# (5 ) Longitude should have units of "degrees_east". -# (6 ) Latitude should have units of "degrees north". -# (6 ) All variables should have a "time" dimension, even if there is only -# one time value. -# (7 ) The "time" dimension should have units of -# "hours since YYYY-MM-DD hh:mm:ss.s GMT", or -# "minutes since YYYY-MM-DD hh:mm:ss.s GMT" -# (8 ) To specify a 3 hour timestep, for example, the "delta_t" attribute of -# "time" variable should have the value "0000-00-00 03:00:00", etc. -# -# Also, for compatibility with the GAMAP visualization package, please add -# the "gamap_category" attribute to each variable. -# -# !REVISION HISTORY: -# 27 Jan 2012 - R. Yantosca - Initial version -#------------------------------------------------------------------------------ - -### !FILENAME: -Fortran Def File = nc_define.F -Fortran Write File = nc_write.F -Fortran Read File = nc_read.F -netCDF FileHandle = fId -netCDF FileName = GEOSCHEM.nc - - -### !GLOBAL ATTRIBUTES: -title = Generated by ncCodeCreate script -history = 27 Jan 2011 -conventions = COARDS -format = netCDF-3 -model = GEOS5 -nlayers = 72 -start_date = 20110101 -start_time = 00:00:00.0 -end_date = 20110101 -end_time = 23:59:59.0 -delta_lon = 5 -delta_lat = 4 -delta_time = 000000 - - -### !DIMENSIONS: -lon = 72 -lat = 46 -lev = 72 -time = 1 - - -### !VARIABLES: -lon = REAL*4::lon -lon:long_name = longitude -lon:units = degrees_east -#- -lat = REAL*4::lat -lat:long_name = latitude -lat:units = degrees_north -#- -lev = REAL*4::lev -lev:long_name = levels -lev:units = unitless -#- -time = INTEGER::time -time:long_name = time -time:units = minutes from 2011-01-01 00:00:00 GMT -time:delta_t = 0000-00-00 00:00:00 -time:begin_date = 20110101 -time:begin_time = 000000 -time:time_increment = 000000 -#- -PS = REAL*4::lon,lat,time -PS:long_name = Surface pressure -PS:units = hPa -PS:gamap_category = GMAO-2D -#- -T = REAL*4::lon,lat,lev,time -T:long_name = Temperature -T:units = K -T:gamap_category = GMAO-3D$ - -#EOP From 824b07f0489bbf322ac77b650127c2d2071d62b2 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 22 Dec 2022 15:48:21 -0500 Subject: [PATCH 15/63] Now look for Verbose and VerboseOnCores in HEMCO_Config.rc src/Core/hco_config_mod.F90 - Simplify the prior code: - Read the Verbose setting from HEMCO_Config.rc - Read the VerboseOnCores setting from HEMCO_Config.rc (string) and define the doVerboseOnRoot logical flag accordingly - Now pass doVerbose and doVerboseOnRoot to HCO_Error_Set routine - Print an informational message src/Core/hco_error_mod.F90 - The HCO_Error_Set routine now accepts doVerboseOnRoot as an argument - Use both doVerbose and doVerboseOnRoot to set Err%doVerbose (which will determine if verbose is printed on the root core or on all cores) Signed-off-by: Bob Yantosca --- src/Core/hco_config_mod.F90 | 154 +++++++++--------------------------- src/Core/hco_error_mod.F90 | 33 ++++---- 2 files changed, 56 insertions(+), 131 deletions(-) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 3ad8b760..bcbcafb4 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -1991,13 +1991,12 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! !LOCAL VARIABLES: ! ! Scalars - LOGICAL :: doVerbose, found - LOGICAL :: foundVerb, foundWarn - LOGICAL :: verboseBool - INTEGER :: I, N, POS - INTEGER :: verb, warn + LOGICAL :: doVerbose, doVerboseOnRoot, found + INTEGER :: I, N, POS ! Strings + CHARACTER(LEN=10) :: onCores + CHARACTER(LEN=15) :: verboseMsg CHARACTER(LEN=255) :: line CHARACTER(LEN=255) :: loc CHARACTER(LEN=255) :: LogFile @@ -2032,16 +2031,6 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! Return if EOF IF ( EOF ) EXIT - ! Test if the Verbose flag is logical. We need to know this ahead - ! of time in order to avoid input errors (i.e. reading characters - ! when integers are expected) in the code that follows below. - ! -- Bob Yantosca (14 Dec 2022) - IF ( INDEX( line, 'Verbose' ) > 0 ) THEN - verboseBool = ( & - ( INDEX( line, 't' ) > 0 ) .or. ( INDEX( line, 'f' ) > 0 ) .or. & - ( INDEX( line, 'T' ) > 0 ) .or. ( INDEX( line, 'F' ) > 0 ) ) - ENDIF - ! Exit here if end of section encountered IF ( INDEX ( LINE, 'END SECTION' ) > 0 ) EXIT @@ -2114,117 +2103,50 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ! HEMCO variables. Only the first time the settings are read (settings ! can be read multiple times if nested HEMCO configuration files are ! used) - ! - ! NOTE: In HEMCO 3.7.0, the Verbose and Warnings integers in the - ! HEMCO_Config.rc file have been replaced with "Verbose: true". - ! Update the logic to make the test for Verbose backwards compatible - ! with HEMCO_Config.files prior to HEMCO 3.7.0. - ! -- Bob Yantosca (14 Dec 2022) !----------------------------------------------------------------------- IF ( .NOT. ASSOCIATED(HcoConfig%Err) ) THEN ! Initialize - doVerbose = .FALSE. - verb = 0 - warn = 0 + doVerbose = .FALSE. + doVerboseOnRoot = .FALSE. + onCores = '' - ! Check if Verbose is a logical entry in HEMCO_Config.rc - IF ( verboseBool ) THEN + ! First look for Verbose + CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & + OptValBool=doVerbose, found=found, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Error looking for "Verbose" in HEMCO_Config.rc!' + CALL HCO_Error( msg, RC, thisLoc=loc ) + RETURN + ENDIF - !----------------------------------------------------------------- - ! "Verbose: true" or "Verbose: false" was found - !----------------------------------------------------------------- + ! First look for Verbose (logical). This is now the default + ! inthe HEMCO_Config.rc file for HEMCO 3.7.0 and later. + CALL GetExtOpt( HcoConfig, CoreNr, 'VerboseOnCores', & + OptValChar=onCores, found=found, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Error looking for "VerboseOnCores in HEMCO_Config.rc!' + CALL HCO_Error( msg, RC, thisLoc=loc ) + RETURN + ENDIF - ! First look for Verbose (logical). This is now the default - ! inthe HEMCO_Config.rc file for HEMCO 3.7.0 and later. - CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & - OptValBool=doVerbose, found=found, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - msg = 'Error looking for "Verbose" (logical) in HEMCO_Config.rc!' - CALL HCO_Error( msg, RC, thisLoc=loc ) - RETURN - ENDIF + ! Set a flag if Verbose output is to be done on the root core only + ! (if false, it will be done on all cores) + CALL TranLC( onCores ) + doVerboseOnRoot = ( TRIM( onCores ) == "root" ) - ! Print status message - IF ( doVerbose ) THEN - msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is ON' + ! Print status message + IF ( doVerbose ) THEN + msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is ON ' + IF ( doVerboseOnRoot ) THEN + msg = TRIM( msg ) // ' (root core only)' ELSE - msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is OFF' + msg = TRIM( msg ) // ' (all cores)' ENDIF - CALL HCO_Msg( msg, verb=.TRUE. ) - ELSE - - !----------------------------------------------------------------- - ! "Verbose: true" or "Verbose: false" was not found - !----------------------------------------------------------------- - - ! Check for Verbose (integer) - CALL GetExtOpt( HcoConfig, CoreNr, 'Verbose', & - OptValInt=verb, found=foundVerb, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - msg = 'Error looking for "Verbose" (integer) in HEMCO_Config.rc!' - CALL HCO_Error( msg, RC, thisLoc=loc ) - RETURN - ENDIF - - IF ( foundVerb .and. verb > 0 ) THEN - - ! Toggle HEMCO verbose output on for nonzero integer values - doVerbose = .TRUE. - msg = NEW_LINE( 'A' ) // & - 'HEMCO verbose output is ON.' // & - NEW_LINE( 'A' ) // & - 'Numbered Verbose and Warning options are deprecated.' // & - NEW_LINE( 'A' ) // & - 'Please use "Verbose: true:" or "Verbose: false" for ' // & - 'controlling verbose output.' - CALL HCO_Msg( msg, verb=.TRUE. ) - - ELSE - - ! Verbose (logical) and Verbose (integer) were not found, - ! now look for Warnings (integer) - CALL GetExtOpt( HcoConfig, CoreNr, 'Warnings', & - OptValInt=warn, found=foundWarn, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - msg = & - 'Error looking for "Warnings" (integer) in HEMCO_Config.rc!' - CALL HCO_Error( msg, RC, thisLoc=loc ) - RETURN - ENDIF - IF ( foundWarn .and. warn > 0 ) THEN - - ! Toggle HEMCO verbose output on - ! (Verbose = 0; Warnings > 0) - doVerbose = .TRUE. - msg = & - NEW_LINE( 'A' ) // & - 'HEMCO verbose output is ON.' // & - NEW_LINE( 'A' ) // & - 'Numbered Verbose and Warning options are deprecated.' // & - NEW_LINE( 'A' ) // & - 'Please use "Verbose: true:" or "Verbose: false" for ' // & - 'controlling verbose output.' - CALL HCO_Msg( msg, verb=.TRUE. ) - - ELSE - - ! Toggle HEMCO verbose off - ! (Verbose: false, Verbose = 0 and Warnings = 0) - doVerbose = .FALSE. - msg = & - NEW_LINE( 'A' ) // & - 'HEMCO verbose output is OFF.' // & - NEW_LINE( 'A' ) // & - 'Numbered Verbose and Warning options are deprecated.' // & - NEW_LINE( 'A' ) // & - 'Please use "Verbose: true:" or "Verbose: false" for ' // & - 'controlling verbose output.' - CALL HCO_Msg( msg, verb=.TRUE. ) - ENDIF - ENDIF + msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is OFF' ENDIF + CALL HCO_Msg( msg, verb=.TRUE. ) ! Logfile to write into CALL GetExtOpt( HcoConfig, CoreNr, 'Logfile', & @@ -2254,8 +2176,8 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) LogFile = '*' ! We should now have everything to define the HEMCO error settings - CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & - doVerbose, RC ) + CALL HCO_ERROR_SET( HcoConfig%amIRoot, HcoConfig%Err, LogFile, & + doVerbose, doVerboseOnRoot, RC ) IF ( RC /= HCO_SUCCESS ) THEN msg = 'Error encountered in routine "Hco_Error_Set"!' CALL HCO_Error( msg, RC, thisLoc=loc ) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 08de3135..fad5aff5 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -683,19 +683,22 @@ END SUBROUTINE HCO_Leave !\\ ! !INTERFACE: ! - SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, doVerbose, RC ) + SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & + doVerbose, doVerboseOnRoot, RC ) ! ! !INPUT PARAMETERS: ! - LOGICAL, INTENT(IN) :: am_I_Root ! Root CPU? - TYPE(HcoErr), POINTER :: Err ! Error object - CHARACTER(LEN=*), INTENT(IN) :: LogFile ! logfile path+name + LOGICAL, INTENT(IN) :: am_I_Root ! Root CPU? + TYPE(HcoErr), POINTER :: Err ! Error object + CHARACTER(LEN=*), INTENT(IN) :: LogFile ! logfile path+name ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT(INOUT) :: doVerbose - INTEGER, INTENT(INOUT) :: RC + LOGICAL, INTENT(INOUT) :: doVerbose ! Verbose output T/F? + LOGICAL, INTENT(INOUT) :: doVerboseOnRoot ! =T: Verbose on root + ! =F: Verbose on all + INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -719,16 +722,16 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, doVerbose, RC ) ALLOCATE(Err%Loc(MAXNEST)) Err%Loc(:) = '' - ! Set verbose to -1 if this is not the root CPU. This will disable any - ! log-file messages - IF ( .NOT. am_I_Root ) THEN - doVerbose = .FALSE. - ENDIF - ! Pass values - Err%IsRoot = am_I_Root - Err%LogFile = TRIM(LogFile) - Err%doVerbose = doVerbose + Err%IsRoot = am_I_Root + Err%LogFile = TRIM(LogFile) + + ! Specify if verbose will be printed on the root core, or all cores + IF ( doVerboseOnRoot ) THEN + Err%doVerbose = ( doVerbose .and. am_I_Root ) + ELSEgctee + Err%doVerbose = doVerbose + ENDIF ! Init misc. values Err%FirstOpen = .TRUE. From 78238dfc9e180d2a7f10e69763d00c284b9d1741 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 22 Dec 2022 16:03:13 -0500 Subject: [PATCH 16/63] Remove typo in hco_error_mod.F90 src/Core/hco_error_mod.F90 - Remove extraneous characters at line 732 Signed-off-by: Bob Yantosca --- src/Core/hco_error_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index fad5aff5..7339fef9 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -729,7 +729,7 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & ! Specify if verbose will be printed on the root core, or all cores IF ( doVerboseOnRoot ) THEN Err%doVerbose = ( doVerbose .and. am_I_Root ) - ELSEgctee + ELSE Err%doVerbose = doVerbose ENDIF From 6d1df55b4b55edde82ccb6a588a911a03e532e69 Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Tue, 7 Feb 2023 12:10:52 -0500 Subject: [PATCH 17/63] Update GFED4 biomass burning emission factors and add furans MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Tess Carter (MIT) provided updates for the GFED extension, including: 1) Updating VOC’s to Andreae et al. (2019) 2) Adding biomass emissions for existing GEOS-Chem species that do not have biomass emissions 3) Adding a lumped species (representing 3 compounds) for furans References: Carter, T. S., et al., An improved representation of fire non-methane organic gases (NMOGs) in models: emissions to reactivity, Atmos. Chem. Phys., 22, 12093–12111, https://doi.org/10.5194/acp-22-12093-2022, 2022. Andreae, M. O., Emission of trace gases and aerosols from biomass burning – an updated assessment, Atmos. Chem. Phys., 19, 8523–8546, https://doi.org/10.5194/acp-19-8523-2019, 2019.  Signed-off-by: Melissa Sulprizio --- src/Extensions/hcox_gfed_include_gfed4.H | 424 ++++++++++++++--------- 1 file changed, 266 insertions(+), 158 deletions(-) diff --git a/src/Extensions/hcox_gfed_include_gfed4.H b/src/Extensions/hcox_gfed_include_gfed4.H index c139d22c..d3103e11 100644 --- a/src/Extensions/hcox_gfed_include_gfed4.H +++ b/src/Extensions/hcox_gfed_include_gfed4.H @@ -48,84 +48,85 @@ ! CO GFED4_SPEC_NAME(1)="CO" -Inst%GFED4_EMFAC(1,1)=6.30E-02_hp -Inst%GFED4_EMFAC(1,2)=1.27E-01_hp -Inst%GFED4_EMFAC(1,3)=8.80E-02_hp -Inst%GFED4_EMFAC(1,4)=9.30E-02_hp -Inst%GFED4_EMFAC(1,5)=2.10E-01_hp -Inst%GFED4_EMFAC(1,6)=1.02E-01_hp +Inst%GFED4_EMFAC(1,1)=6.90E-02_hp +Inst%GFED4_EMFAC(1,2)=1.21E-01_hp +Inst%GFED4_EMFAC(1,3)=1.13E-01_hp +Inst%GFED4_EMFAC(1,4)=1.04E-01_hp +Inst%GFED4_EMFAC(1,5)=2.60E-01_hp +Inst%GFED4_EMFAC(1,6)=7.60E-02_hp ! ALK4 (Higher_Alkanes) - convert from kgC to kg GFED4_SPEC_NAME(2)="ALK4" -Inst%GFED4_EMFAC(2,1)=5.50E-05_hp * 58.12_hp/(4.3_hp*12.0_hp) -Inst%GFED4_EMFAC(2,2)=3.49E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) -Inst%GFED4_EMFAC(2,3)=2.25E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) -Inst%GFED4_EMFAC(2,4)=7.20E-05_hp * 58.12_hp/(4.3_hp*12.0_hp) -Inst%GFED4_EMFAC(2,5)=7.20E-05_hp * 58.12_hp/(4.3_hp*12.0_hp) -Inst%GFED4_EMFAC(2,6)=3.40E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,1)=8.68E-05_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,2)=3.04E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,3)=2.21E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,4)=1.58E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,5)=1.00E-03_hp * 58.12_hp/(4.3_hp*12.0_hp) +Inst%GFED4_EMFAC(2,6)=2.24E-04_hp * 58.12_hp/(4.3_hp*12.0_hp) ! ACET (C3H6O) GFED4_SPEC_NAME(3)="ACET" -Inst%GFED4_EMFAC(3,1)=1.60E-04_hp -Inst%GFED4_EMFAC(3,2)=7.50E-04_hp -Inst%GFED4_EMFAC(3,3)=5.40E-04_hp +Inst%GFED4_EMFAC(3,1)=4.70E-04_hp +Inst%GFED4_EMFAC(3,2)=1.59E-03_hp +Inst%GFED4_EMFAC(3,3)=7.60E-04_hp Inst%GFED4_EMFAC(3,4)=6.30E-04_hp -Inst%GFED4_EMFAC(3,5)=1.25E-03_hp -Inst%GFED4_EMFAC(3,6)=4.50E-04_hp +Inst%GFED4_EMFAC(3,5)=9.10E-04_hp +Inst%GFED4_EMFAC(3,6)=7.10E-04_hp -! MEK +! MEK as 2-butanone GFED4_SPEC_NAME(4)="MEK" -Inst%GFED4_EMFAC(4,1)=1.81E-04_hp -Inst%GFED4_EMFAC(4,2)=2.20E-04_hp -Inst%GFED4_EMFAC(4,3)=1.30E-04_hp +Inst%GFED4_EMFAC(4,1)=1.30E-04_hp +Inst%GFED4_EMFAC(4,2)=1.60E-04_hp +Inst%GFED4_EMFAC(4,3)=2.30E-04_hp Inst%GFED4_EMFAC(4,4)=5.00E-04_hp -Inst%GFED4_EMFAC(4,5)=5.00E-04_hp -Inst%GFED4_EMFAC(4,6)=9.00E-04_hp +Inst%GFED4_EMFAC(4,5)=3.40E-04_hp +Inst%GFED4_EMFAC(4,6)=5.80E-04_hp ! ALD2 (C2H4O) GFED4_SPEC_NAME(5)="ALD2" -Inst%GFED4_EMFAC(5,1)=5.70E-04_hp -Inst%GFED4_EMFAC(5,2)=7.70E-04_hp -Inst%GFED4_EMFAC(5,3)=7.70E-04_hp -Inst%GFED4_EMFAC(5,4)=1.55E-03_hp -Inst%GFED4_EMFAC(5,5)=3.27E-03_hp -Inst%GFED4_EMFAC(5,6)=1.24E-03_hp +Inst%GFED4_EMFAC(5,1)=8.40E-04_hp +Inst%GFED4_EMFAC(5,2)=8.10E-04_hp +Inst%GFED4_EMFAC(5,3)=1.21E-03_hp +Inst%GFED4_EMFAC(5,4)=2.26E-03_hp +Inst%GFED4_EMFAC(5,5)=1.16E-03_hp +Inst%GFED4_EMFAC(5,6)=1.80E-03_hp ! PRPE (C3H6 + Higher_Alkenes) +!tsc added 1,3-butadiene GFED4_SPEC_NAME(6)="PRPE" -Inst%GFED4_EMFAC(6,1)=7.90E-04_hp + 1.33E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) -Inst%GFED4_EMFAC(6,2)=1.13E-03_hp + 3.85E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) -Inst%GFED4_EMFAC(6,3)=6.10E-04_hp + 3.69E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) -Inst%GFED4_EMFAC(6,4)=6.40E-04_hp + 2.67E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) -Inst%GFED4_EMFAC(6,5)=3.05E-03_hp + 2.27E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) -Inst%GFED4_EMFAC(6,6)=6.80E-04_hp + 3.33E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,1)=4.60E-04_hp + 2.58E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,2)=6.70E-04_hp + 3.64E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,3)=6.00E-04_hp + 4.24E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,4)=8.60E-04_hp + 4.04E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,5)=1.14E-03_hp + 1.13E-03_hp * 42.08_hp/(3.0_hp*12.0_hp) +Inst%GFED4_EMFAC(6,6)=4.70E-04_hp + 3.50E-04_hp * 42.08_hp/(3.0_hp*12.0_hp) ! C3H8 GFED4_SPEC_NAME(7)="C3H8" -Inst%GFED4_EMFAC(7,1)=1.00E-04_hp -Inst%GFED4_EMFAC(7,2)=4.40E-04_hp -Inst%GFED4_EMFAC(7,3)=2.20E-04_hp -Inst%GFED4_EMFAC(7,4)=1.26E-04_hp -Inst%GFED4_EMFAC(7,5)=1.26E-04_hp -Inst%GFED4_EMFAC(7,6)=2.80E-04_hp +Inst%GFED4_EMFAC(7,1)=1.30E-04_hp +Inst%GFED4_EMFAC(7,2)=2.90E-04_hp +Inst%GFED4_EMFAC(7,3)=2.80E-04_hp +Inst%GFED4_EMFAC(7,4)=5.30E-04_hp +Inst%GFED4_EMFAC(7,5)=9.90E-04_hp +Inst%GFED4_EMFAC(7,6)=1.70E-04_hp ! CH2O GFED4_SPEC_NAME(8)="CH2O" -Inst%GFED4_EMFAC(8,1)=7.30E-04_hp -Inst%GFED4_EMFAC(8,2)=1.86E-03_hp -Inst%GFED4_EMFAC(8,3)=2.09E-03_hp -Inst%GFED4_EMFAC(8,4)=1.73E-03_hp -Inst%GFED4_EMFAC(8,5)=1.40E-03_hp -Inst%GFED4_EMFAC(8,6)=2.08E-03_hp +Inst%GFED4_EMFAC(8,1)=1.23E-03_hp +Inst%GFED4_EMFAC(8,2)=1.75E-03_hp +Inst%GFED4_EMFAC(8,3)=2.04E-03_hp +Inst%GFED4_EMFAC(8,4)=2.40E-03_hp +Inst%GFED4_EMFAC(8,5)=1.07E-03_hp +Inst%GFED4_EMFAC(8,6)=1.80E-03_hp ! C2H6 GFED4_SPEC_NAME(9)="C2H6" -Inst%GFED4_EMFAC(9,1)=6.60E-04_hp -Inst%GFED4_EMFAC(9,2)=1.79E-03_hp -Inst%GFED4_EMFAC(9,3)=6.30E-04_hp -Inst%GFED4_EMFAC(9,4)=7.10E-04_hp -Inst%GFED4_EMFAC(9,5)=7.10E-04_hp -Inst%GFED4_EMFAC(9,6)=9.10E-04_hp +Inst%GFED4_EMFAC(9,1)=4.20E-04_hp +Inst%GFED4_EMFAC(9,2)=9.70E-04_hp +Inst%GFED4_EMFAC(9,3)=6.90E-04_hp +Inst%GFED4_EMFAC(9,4)=8.80E-04_hp +Inst%GFED4_EMFAC(9,5)=1.85E-03_hp +Inst%GFED4_EMFAC(9,6)=7.90E-04_hp ! SO2 GFED4_SPEC_NAME(10)="SO2" @@ -174,147 +175,147 @@ Inst%GFED4_EMFAC(14,6)=3.11E-03_hp ! MGLY (CH3COCHO) GFED4_SPEC_NAME(15)="MGLY" -Inst%GFED4_EMFAC(15,1)=7.30E-04_hp -Inst%GFED4_EMFAC(15,2)=7.30E-04_hp -Inst%GFED4_EMFAC(15,3)=7.30E-04_hp -Inst%GFED4_EMFAC(15,4)=7.30E-04_hp -Inst%GFED4_EMFAC(15,5)=7.30E-04_hp -Inst%GFED4_EMFAC(15,6)=7.30E-04_hp +Inst%GFED4_EMFAC(15,1)=4.00E-04_hp +Inst%GFED4_EMFAC(15,2)=5.70E-04_hp +Inst%GFED4_EMFAC(15,3)=2.70E-04_hp +Inst%GFED4_EMFAC(15,4)=4.90E-04_hp +Inst%GFED4_EMFAC(15,5)=2.30E-04_hp +Inst%GFED4_EMFAC(15,6)=5.50E-04_hp ! BENZ (C6H6) GFED4_SPEC_NAME(16)="BENZ" -Inst%GFED4_EMFAC(16,1)=2.00E-04_hp -Inst%GFED4_EMFAC(16,2)=1.11E-03_hp -Inst%GFED4_EMFAC(16,3)=2.70E-04_hp -Inst%GFED4_EMFAC(16,4)=3.90E-04_hp -Inst%GFED4_EMFAC(16,5)=3.19E-03_hp -Inst%GFED4_EMFAC(16,6)=1.50E-04_hp +Inst%GFED4_EMFAC(16,1)=3.30E-04_hp +Inst%GFED4_EMFAC(16,2)=5.70E-04_hp +Inst%GFED4_EMFAC(16,3)=4.20E-04_hp +Inst%GFED4_EMFAC(16,4)=3.80E-04_hp +Inst%GFED4_EMFAC(16,5)=8.70E-04_hp +Inst%GFED4_EMFAC(16,6)=2.70E-04_hp ! TOLU (C7H8) GFED4_SPEC_NAME(17)="TOLU" -Inst%GFED4_EMFAC(17,1)=8.00E-05_hp -Inst%GFED4_EMFAC(17,2)=4.80E-04_hp -Inst%GFED4_EMFAC(17,3)=1.90E-04_hp -Inst%GFED4_EMFAC(17,4)=2.60E-04_hp -Inst%GFED4_EMFAC(17,5)=1.55E-03_hp -Inst%GFED4_EMFAC(17,6)=1.90E-04_hp +Inst%GFED4_EMFAC(17,1)=1.90E-04_hp +Inst%GFED4_EMFAC(17,2)=3.50E-04_hp +Inst%GFED4_EMFAC(17,3)=2.70E-04_hp +Inst%GFED4_EMFAC(17,4)=2.30E-04_hp +Inst%GFED4_EMFAC(17,5)=4.50E-04_hp +Inst%GFED4_EMFAC(17,6)=1.70E-04_hp ! XYLE (C8H10) GFED4_SPEC_NAME(18)="XYLE" -Inst%GFED4_EMFAC(18,1)=1.40E-05_hp -Inst%GFED4_EMFAC(18,2)=1.80E-04_hp -Inst%GFED4_EMFAC(18,3)=1.30E-04_hp -Inst%GFED4_EMFAC(18,4)=1.10E-04_hp -Inst%GFED4_EMFAC(18,5)=1.10E-04_hp -Inst%GFED4_EMFAC(18,6)=1.14E-04_hp +Inst%GFED4_EMFAC(18,1)=8.60E-05_hp +Inst%GFED4_EMFAC(18,2)=1.10E-04_hp +Inst%GFED4_EMFAC(18,3)=1.60E-04_hp +Inst%GFED4_EMFAC(18,4)=8.60E-05_hp +Inst%GFED4_EMFAC(18,5)=2.30E-04_hp +Inst%GFED4_EMFAC(18,6)=1.00E-04_hp ! C2H4 GFED4_SPEC_NAME(19)="C2H4" -Inst%GFED4_EMFAC(19,1)=8.20E-04_hp -Inst%GFED4_EMFAC(19,2)=1.42E-03_hp -Inst%GFED4_EMFAC(19,3)=1.17E-03_hp -Inst%GFED4_EMFAC(19,4)=1.06E-03_hp -Inst%GFED4_EMFAC(19,5)=2.57E-03_hp -Inst%GFED4_EMFAC(19,6)=1.46E-03_hp +Inst%GFED4_EMFAC(19,1)=8.30E-04_hp +Inst%GFED4_EMFAC(19,2)=1.54E-03_hp +Inst%GFED4_EMFAC(19,3)=1.11E-03_hp +Inst%GFED4_EMFAC(19,4)=1.11E-03_hp +Inst%GFED4_EMFAC(19,5)=1.47E-03_hp +Inst%GFED4_EMFAC(19,6)=1.00E-03_hp ! C2H2 GFED4_SPEC_NAME(20)="C2H2" -Inst%GFED4_EMFAC(20,1)=2.40E-04_hp -Inst%GFED4_EMFAC(20,2)=1.80E-04_hp -Inst%GFED4_EMFAC(20,3)=2.60E-04_hp -Inst%GFED4_EMFAC(20,4)=4.40E-04_hp -Inst%GFED4_EMFAC(20,5)=6.00E-05_hp +Inst%GFED4_EMFAC(20,1)=3.10E-04_hp +Inst%GFED4_EMFAC(20,2)=2.80E-04_hp +Inst%GFED4_EMFAC(20,3)=3.10E-04_hp +Inst%GFED4_EMFAC(20,4)=3.50E-04_hp +Inst%GFED4_EMFAC(20,5)=1.10E-04_hp Inst%GFED4_EMFAC(20,6)=2.70E-04_hp ! GLYC (HOCH2CHO) GFED4_SPEC_NAME(21)="GLYC" -Inst%GFED4_EMFAC(21,1)=2.50E-04_hp -Inst%GFED4_EMFAC(21,2)=8.60E-04_hp -Inst%GFED4_EMFAC(21,3)=8.60E-04_hp -Inst%GFED4_EMFAC(21,4)=7.40E-04_hp -Inst%GFED4_EMFAC(21,5)=7.40E-04_hp -Inst%GFED4_EMFAC(21,6)=7.10E-04_hp +Inst%GFED4_EMFAC(21,1)=1.30E-04_hp +Inst%GFED4_EMFAC(21,2)=3.80E-04_hp +Inst%GFED4_EMFAC(21,3)=3.90E-04_hp +Inst%GFED4_EMFAC(21,4)=3.30E-04_hp +Inst%GFED4_EMFAC(21,5)=1.10E-04_hp +Inst%GFED4_EMFAC(21,6)=3.20E-03_hp ! CO2 GFED4_SPEC_NAME(22)="CO2" -Inst%GFED4_EMFAC(22,1)=1.69E+00_hp -Inst%GFED4_EMFAC(22,2)=1.49E+00_hp -Inst%GFED4_EMFAC(22,3)=1.65E+00_hp -Inst%GFED4_EMFAC(22,4)=1.64E+00_hp -Inst%GFED4_EMFAC(22,5)=1.70E+00_hp -Inst%GFED4_EMFAC(22,6)=1.59E+00_hp +Inst%GFED4_EMFAC(22,1)=1.66E+00_hp +Inst%GFED4_EMFAC(22,2)=1.453E+00_hp +Inst%GFED4_EMFAC(22,3)=1.57E+00_hp +Inst%GFED4_EMFAC(22,4)=1.62E+00_hp +Inst%GFED4_EMFAC(22,5)=1.59E+00_hp +Inst%GFED4_EMFAC(22,6)=1.43E+00_hp ! CH4 GFED4_SPEC_NAME(23)="CH4" -Inst%GFED4_EMFAC(23,1)=1.94E-03_hp -Inst%GFED4_EMFAC(23,2)=5.96E-03_hp -Inst%GFED4_EMFAC(23,3)=3.36E-03_hp -Inst%GFED4_EMFAC(23,4)=5.07E-03_hp -Inst%GFED4_EMFAC(23,5)=2.08E-02_hp -Inst%GFED4_EMFAC(23,6)=5.82E-03_hp +Inst%GFED4_EMFAC(23,1)=2.70E-03_hp +Inst%GFED4_EMFAC(23,2)=5.50E-03_hp +Inst%GFED4_EMFAC(23,3)=5.20E-03_hp +Inst%GFED4_EMFAC(23,4)=6.50E-03_hp +Inst%GFED4_EMFAC(23,5)=9.10E-03_hp +Inst%GFED4_EMFAC(23,6)=5.70E-03_hp ! HCOOH GFED4_SPEC_NAME(24)="HCOOH" Inst%GFED4_EMFAC(24,1)=2.10E-04_hp -Inst%GFED4_EMFAC(24,2)=5.70E-04_hp -Inst%GFED4_EMFAC(24,3)=2.80E-04_hp -Inst%GFED4_EMFAC(24,4)=7.90E-04_hp -Inst%GFED4_EMFAC(24,5)=3.80E-04_hp -Inst%GFED4_EMFAC(24,6)=1.00E-03_hp +Inst%GFED4_EMFAC(24,2)=1.04E-03_hp +Inst%GFED4_EMFAC(24,3)=9.10E-04_hp +Inst%GFED4_EMFAC(24,4)=4.90E-04_hp +Inst%GFED4_EMFAC(24,5)=2.90E-04_hp +Inst%GFED4_EMFAC(24,6)=5.60E-04_hp ! DMS (C2H6S) GFED4_SPEC_NAME(25)="DMS" -Inst%GFED4_EMFAC(25,1)=1.30E-06_hp -Inst%GFED4_EMFAC(25,2)=4.65E-06_hp -Inst%GFED4_EMFAC(25,3)=8.00E-06_hp -Inst%GFED4_EMFAC(25,4)=1.35E-06_hp -Inst%GFED4_EMFAC(25,5)=1.35E-06_hp -Inst%GFED4_EMFAC(25,6)=1.30E-06_hp +Inst%GFED4_EMFAC(25,1)=8.00E-06_hp +Inst%GFED4_EMFAC(25,2)=2.30E-06_hp +Inst%GFED4_EMFAC(25,3)=1.40E-05_hp +Inst%GFED4_EMFAC(25,4)=2.20E-06_hp +Inst%GFED4_EMFAC(25,5)=4.50E-05_hp +Inst%GFED4_EMFAC(25,6)=5.00E-05_hp ! ISOP (C5H8) GFED4_SPEC_NAME(26)="ISOP" -Inst%GFED4_EMFAC(26,1)=3.90E-05_hp -Inst%GFED4_EMFAC(26,2)=1.50E-04_hp -Inst%GFED4_EMFAC(26,3)=9.90E-05_hp -Inst%GFED4_EMFAC(26,4)=1.30E-04_hp -Inst%GFED4_EMFAC(26,5)=1.38E-03_hp -Inst%GFED4_EMFAC(26,6)=3.80E-04_hp +Inst%GFED4_EMFAC(26,1)=1.01E-04_hp +Inst%GFED4_EMFAC(26,2)=7.40E-05_hp +Inst%GFED4_EMFAC(26,3)=1.00E-04_hp +Inst%GFED4_EMFAC(26,4)=1.00E-04_hp +Inst%GFED4_EMFAC(26,5)=5.20E-04_hp +Inst%GFED4_EMFAC(26,6)=1.70E-04_hp ! MTPA (C10H16) - not carried per carbon GFED4_SPEC_NAME(27)="MTPA" -Inst%GFED4_EMFAC(27,1)=8.10E-05_hp -Inst%GFED4_EMFAC(27,2)=2.00E-03_hp -Inst%GFED4_EMFAC(27,3)=2.00E-03_hp +Inst%GFED4_EMFAC(27,1)=1.04E-04_hp +Inst%GFED4_EMFAC(27,2)=1.53E-03_hp +Inst%GFED4_EMFAC(27,3)=1.17E-03_hp Inst%GFED4_EMFAC(27,4)=1.50E-04_hp -Inst%GFED4_EMFAC(27,5)=1.50E-04_hp -Inst%GFED4_EMFAC(27,6)=5.00E-06_hp +Inst%GFED4_EMFAC(27,5)=8.00E-05_hp +Inst%GFED4_EMFAC(27,6)=2.70E-05_hp ! MOH (CH3OH) - not carried per carbon GFED4_SPEC_NAME(28)="MOH" -Inst%GFED4_EMFAC(28,1)=1.18E-03_hp -Inst%GFED4_EMFAC(28,2)=2.82E-03_hp -Inst%GFED4_EMFAC(28,3)=1.74E-03_hp -Inst%GFED4_EMFAC(28,4)=2.43E-03_hp -Inst%GFED4_EMFAC(28,5)=8.46E-03_hp -Inst%GFED4_EMFAC(28,6)=3.29E-03_hp +Inst%GFED4_EMFAC(28,1)=1.35E-03_hp +Inst%GFED4_EMFAC(28,2)=2.33E-03_hp +Inst%GFED4_EMFAC(28,3)=2.20E-03_hp +Inst%GFED4_EMFAC(28,4)=2.80E-03_hp +Inst%GFED4_EMFAC(28,5)=2.50E-03_hp +Inst%GFED4_EMFAC(28,6)=3.30E-03_hp ! EOH (C2H5OH) GFED4_SPEC_NAME(29)="EOH" -Inst%GFED4_EMFAC(29,1)=2.40E-05_hp -Inst%GFED4_EMFAC(29,2)=5.50E-05_hp -Inst%GFED4_EMFAC(29,3)=1.00E-04_hp -Inst%GFED4_EMFAC(29,4)=3.70E-05_hp -Inst%GFED4_EMFAC(29,5)=3.70E-05_hp -Inst%GFED4_EMFAC(29,6)=3.50E-05_hp +Inst%GFED4_EMFAC(29,1)=3.60E-05_hp +Inst%GFED4_EMFAC(29,2)=5.80E-05_hp +Inst%GFED4_EMFAC(29,3)=7.60E-05_hp +Inst%GFED4_EMFAC(29,4)=6.70E-05_hp +Inst%GFED4_EMFAC(29,5)=1.70E-04_hp +Inst%GFED4_EMFAC(29,6)=5.00E-05_hp ! ACTA (CH3COOH) - not carried per carbon GFED4_SPEC_NAME(30)="ACTA" -Inst%GFED4_EMFAC(30,1)=3.55E-03_hp -Inst%GFED4_EMFAC(30,2)=4.41E-03_hp -Inst%GFED4_EMFAC(30,3)=2.13E-03_hp -Inst%GFED4_EMFAC(30,4)=3.05E-03_hp -Inst%GFED4_EMFAC(30,5)=8.97E-03_hp -Inst%GFED4_EMFAC(30,6)=5.59E-03_hp +Inst%GFED4_EMFAC(30,1)=2.31E-03_hp +Inst%GFED4_EMFAC(30,2)=3.80E-03_hp +Inst%GFED4_EMFAC(30,3)=2.74E-03_hp +Inst%GFED4_EMFAC(30,4)=3.30E-03_hp +Inst%GFED4_EMFAC(30,5)=4.90E-03_hp +Inst%GFED4_EMFAC(30,6)=6.10E-03_hp ! SOAP GFED4_SPEC_NAME(31)="SOAP" @@ -336,21 +337,21 @@ Inst%GFED4_EMFAC(32,6)=4.48E-08_hp ! AGW -- AGRI ! HAC - not traced per carbon - from Akagi et al, 2011 GFED4_SPEC_NAME(33)="HAC" -Inst%GFED4_EMFAC(33,1)=4.50E-04_hp !SAV - Savannah -Inst%GFED4_EMFAC(33,2)=0.00E+00_hp !BORF - Boreal -Inst%GFED4_EMFAC(33,3)=0.00E+00_hp !TEMP - Temperate -Inst%GFED4_EMFAC(33,4)=1.13E-03_hp !DEFO - Tropical -Inst%GFED4_EMFAC(33,5)=1.92E-03_hp !PET - Peatland -Inst%GFED4_EMFAC(33,6)=3.77E-03_hp !AGW - Crop residue +Inst%GFED4_EMFAC(33,1)=5.60E-04_hp !SAV - Savannah +Inst%GFED4_EMFAC(33,2)=2.10E-03_hp !BORF - Boreal +Inst%GFED4_EMFAC(33,3)=1.13E-03_hp !TEMP - Temperate +Inst%GFED4_EMFAC(33,4)=1.81E-03_hp !DEFO - Tropical +Inst%GFED4_EMFAC(33,5)=6.40E-04_hp !PET - Peatland +Inst%GFED4_EMFAC(33,6)=3.12E-03_hp !AGW - Crop residue ! GLYX - not traced per carbon GFED4_SPEC_NAME(34)="GLYX" -Inst%GFED4_EMFAC(34,1)=9.95E-04_hp -Inst%GFED4_EMFAC(34,2)=9.95E-04_hp -Inst%GFED4_EMFAC(34,3)=9.95E-04_hp -Inst%GFED4_EMFAC(34,4)=9.95E-04_hp -Inst%GFED4_EMFAC(34,5)=9.95E-04_hp -Inst%GFED4_EMFAC(34,6)=9.95E-04_hp +Inst%GFED4_EMFAC(34,1)=3.30E-04_hp +Inst%GFED4_EMFAC(34,2)=5.90E-04_hp +Inst%GFED4_EMFAC(34,3)=5.40E-04_hp +Inst%GFED4_EMFAC(34,4)=5.00E-04_hp +Inst%GFED4_EMFAC(34,5)=1.30E-03_hp +Inst%GFED4_EMFAC(34,6)=2.40E-04_hp ! HCl GFED4_SPEC_NAME(35)="HCl" @@ -361,5 +362,112 @@ Inst%GFED4_EMFAC(35,4)=1.3E-04_hp Inst%GFED4_EMFAC(35,5)=8.0E-06_hp Inst%GFED4_EMFAC(35,6)=1.8E-04_hp +! RCHO +GFED4_SPEC_NAME(36)="RCHO" +Inst%GFED4_EMFAC(36,1)=1.2E-03_hp +Inst%GFED4_EMFAC(36,2)=9.4E-04_hp +Inst%GFED4_EMFAC(36,3)=8.6E-04_hp +Inst%GFED4_EMFAC(36,4)=1.4E-03_hp +Inst%GFED4_EMFAC(36,5)=1.4E-03_hp +Inst%GFED4_EMFAC(36,6)=1.7E-03_hp + +! 1,3-butadiene +GFED4_SPEC_NAME(37)="BUTA" +Inst%GFED4_EMFAC(37,1)=9.5E-05_hp +Inst%GFED4_EMFAC(37,2)=8.9E-05_hp +Inst%GFED4_EMFAC(37,3)=1.25E-04_hp +Inst%GFED4_EMFAC(37,4)=1.5E-04_hp +Inst%GFED4_EMFAC(37,5)=2.2E-04_hp +Inst%GFED4_EMFAC(37,6)=1.6E-04_hp + +! Dimethylfuran +GFED4_SPEC_NAME(38)="DMFU" +Inst%GFED4_EMFAC(38,1)=6.3E-05_hp !SAV - Savannah +Inst%GFED4_EMFAC(38,2)=1.0E-04_hp !BORF - Boreal +Inst%GFED4_EMFAC(38,3)=7.0E-05_hp !TEMP - Temperate +Inst%GFED4_EMFAC(38,4)=8.5E-05_hp !DEFO - Tropical +Inst%GFED4_EMFAC(38,5)=1.4E-04_hp !PET - Peatland +Inst%GFED4_EMFAC(38,6)=9.8E-05_hp !AGW - Crop residue + +! Furan by itself +! GFED4_SPEC_NAME(39)="FURA" +! Inst%GFED4_EMFAC(39,1)=2.9E-04_hp !SAV - Savannah +! Inst%GFED4_EMFAC(39,2)=3.6E-04_hp !BORF - Boreal +! Inst%GFED4_EMFAC(39,3)=4.1E-04_hp !TEMP - Temperate +! Inst%GFED4_EMFAC(39,4)=3.3E-04_hp !DEFO - Tropical +! Inst%GFED4_EMFAC(39,5)=1.07E-03_hp !PET - Peatland +! Inst%GFED4_EMFAC(39,6)=9.0E-04_hp !AGW - Crop residue + +! 2-methylfuran +!GFED4_SPEC_NAME(41)="MFUR" +!Inst%GFED4_EMFAC(41,1)=2.0E-04_hp !SAV - Savannah +!Inst%GFED4_EMFAC(41,2)=4.2E-04_hp !BORF - Boreal +!Inst%GFED4_EMFAC(41,3)=3.4E-04_hp !TEMP - Temperate +!Inst%GFED4_EMFAC(41,4)=2.8E-04_hp !DEFO - Tropical +!Inst%GFED4_EMFAC(41,5)=3.1E-04_hp !PET - Peatland +!Inst%GFED4_EMFAC(41,6)=5.3E-04_hp !AGW - Crop residue + +! Furan with DMFU and 2-methyl +GFED4_SPEC_NAME(39)="FURA" +Inst%GFED4_EMFAC(39,1)=5.5E-04_hp !SAV - Savannah +Inst%GFED4_EMFAC(39,2)=8.8E-04_hp !BORF - Boreal +Inst%GFED4_EMFAC(39,3)=8.2E-04_hp !TEMP - Temperate +Inst%GFED4_EMFAC(39,4)=7.0E-04_hp !DEFO - Tropical +Inst%GFED4_EMFAC(39,5)=1.52E-03_hp !PET - Peatland +Inst%GFED4_EMFAC(39,6)=1.53E-03_hp !AGW - Crop residue + +! Furfural +GFED4_SPEC_NAME(40)="FURF" +Inst%GFED4_EMFAC(40,1)=7.3E-04_hp !SAV - Savannah +Inst%GFED4_EMFAC(40,2)=6.1E-04_hp !BORF - Boreal +Inst%GFED4_EMFAC(40,3)=5.2E-04_hp !TEMP - Temperate +Inst%GFED4_EMFAC(40,4)=7.7E-04_hp !DEFO - Tropical +Inst%GFED4_EMFAC(40,5)=1.10E-03_hp !PET - Peatland +Inst%GFED4_EMFAC(40,6)=1.03E-03_hp !AGW - Crop residue + +! Acrolein +!GFED4_SPEC_NAME(36)="ACRO" +!Inst%GFED4_EMFAC(36,1)=4.8E-04_hp +!Inst%GFED4_EMFAC(36,2)=3.3E-04_hp +!Inst%GFED4_EMFAC(36,3)=3.4E-04_hp +!Inst%GFED4_EMFAC(36,4)=6.5E-04_hp +!Inst%GFED4_EMFAC(36,5)=2.7E-04_hp +!Inst%GFED4_EMFAC(36,6)=6.2E-04_hp + +! butenenitriles +!GFED4_SPEC_NAME(42)="BNIT" +!Inst%GFED4_EMFAC(42,1)=1.3E-05_hp !SAV - Savannah +!Inst%GFED4_EMFAC(42,2)=1.4E-04_hp !BORF - Boreal +!Inst%GFED4_EMFAC(42,3)=6.2E-05_hp !TEMP - Temperate +!Inst%GFED4_EMFAC(42,4)=1.2E-04_hp !DEFO - Tropical +!Inst%GFED4_EMFAC(42,5)=0E+01_hp !PET - Peatland +!Inst%GFED4_EMFAC(42,6)=2.2E-04_hp !AGW - Crop residue + +! Styrene +!GFED4_SPEC_NAME(43)="STYR" +!Inst%GFED4_EMFAC(43,1)=5.6E-05_hp !SAV - Savannah +!Inst%GFED4_EMFAC(43,2)=1.3E-04_hp !BORF - Boreal +!Inst%GFED4_EMFAC(43,3)=6.6E-05_hp !TEMP - Temperate +!Inst%GFED4_EMFAC(43,4)=2.8E-05_hp !DEFO - Tropical +!Inst%GFED4_EMFAC(43,5)=5.5E-05_hp !PET - Peatland +!Inst%GFED4_EMFAC(43,6)=4.3E-05_hp !AGW - Crop residue + +! Phenol +GFED4_SPEC_NAME(44)="PHEN" +Inst%GFED4_EMFAC(44,1)=4.3E-04_hp !SAV - Savannah +Inst%GFED4_EMFAC(44,2)=7.5E-04_hp !BORF - Boreal +Inst%GFED4_EMFAC(44,3)=2.5E-04_hp !TEMP - Temperate +Inst%GFED4_EMFAC(44,4)=2.3E-04_hp !DEFO - Tropical +Inst%GFED4_EMFAC(44,5)=4.7E-04_hp !PET - Peatland +Inst%GFED4_EMFAC(44,6)=8.9E-04_hp !AGW - Crop residue + +! Methylvinylketone +GFED4_SPEC_NAME(45)="MVK" +Inst%GFED4_EMFAC(45,1)=2.3E-04_hp !SAV - Savannah +Inst%GFED4_EMFAC(45,2)=9.9E-05_hp !BORF - Boreal +Inst%GFED4_EMFAC(45,3)=1.65E-04_hp !TEMP - Temperate +Inst%GFED4_EMFAC(45,4)=3.9E-04_hp !DEFO - Tropical +Inst%GFED4_EMFAC(45,5)=5.7E-05_hp !PET - Peatland +Inst%GFED4_EMFAC(45,6)=4.8E-04_hp !AGW - Crop residue !EOC From 46ec25b40e16586655cb3c8edf7bc7ddafa59b5c Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Tue, 7 Feb 2023 13:36:21 -0500 Subject: [PATCH 18/63] Update HEMCO version to 3.7.0 Signed-off-by: Melissa Sulprizio --- CMakeLists.txt | 2 +- src/Core/hco_error_mod.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 943e063d..77196450 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,7 +1,7 @@ # HEMCO/CMakeLists.txt cmake_minimum_required(VERSION 3.5) -project(HEMCO VERSION 3.6.0 LANGUAGES Fortran) +project(HEMCO VERSION 3.7.0 LANGUAGES Fortran) # Reminder: Make sure to also update version in src/Core/hco_error_mod.F90 #----------------------------------------------------------------------------- diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index d1947101..40889261 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -105,7 +105,7 @@ MODULE HCO_Error_Mod #endif ! HEMCO version number. - CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.6.0' + CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.7.0' INTERFACE HCO_Error MODULE PROCEDURE HCO_ErrorNoErr From 0be4c02b0191ebf6f7dc88385dccb2550d707100 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 16:48:48 -0500 Subject: [PATCH 19/63] Deprecate HEMCO_CESM preprocessor constant. Now use MODEL_CESM --- src/Core/hco_types_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Core/hco_types_mod.F90 b/src/Core/hco_types_mod.F90 index 5053d19f..34af66cf 100644 --- a/src/Core/hco_types_mod.F90 +++ b/src/Core/hco_types_mod.F90 @@ -94,9 +94,9 @@ MODULE HCO_TYPES_MOD INTEGER :: HcoID ! HEMCO species ID INTEGER :: ModID ! Model species ID CHARACTER(LEN= 31) :: SpcName ! species names -#ifdef HEMCO_CESM +#ifdef MODEL_CESM INTEGER :: DimMax ! Maximum dimensions supported: 2 (2-D), 3 (3-D) - ! HEMCO_CESM only, as 3-D emissions must be listed + ! CESM model only, as 3-D emissions must be listed ! in extfrc_list to be supported by CESM/CAM. #endif END TYPE ModSpc From ff7bf67e08cbc299ffe839b3919f8a4572df748e Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 2 Mar 2023 17:21:12 -0500 Subject: [PATCH 20/63] Remove mention of HEMCO_CESM in comments --- src/Core/hcoio_read_std_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 7bfb6b5a..c0ec9f19 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -1354,7 +1354,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Note: This seems to be a soft restriction - removing this ! does not conflict with MESSy regridding. Need to check (hplin, 5/30/20) - ! This has to be used for WRF-GC and HEMCO_CESM so ifdefd out + ! This has to be used for WRF-GC and CESM so ifdefd out #endif #if defined( MODEL_WRF ) || defined( MODEL_CESM ) From 7e014910658b10ada531ff6d7029eac51f85f1e9 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 7 Mar 2023 10:53:29 -0500 Subject: [PATCH 21/63] Updated the CHANGELOG.md for mask bug fixes going into 3.7.0 CHANGELOG.md - Add sentence about not reading masks if filename is '-' - Add sentence about bug fix in #163 for ESMF environment and masks Signed-off-by: Bob Yantosca --- CHANGELOG.md | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b0e2923..fae3fedc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,16 +7,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased 3.7.0] ### Added - - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. - - Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts +- HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. +- Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts ### Changed - - `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - - HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) +- `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` +- HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) +### Fixed +- Do not read masks if the filename is `-` (non-ESMF environments only) +- Always assume partial coverage when reading masks in an ESMF environment (#163) + ### Removed - - Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - - Removed the `src/Shared/NcdfUtil/perl` folder +- Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` +- Removed the `src/Shared/NcdfUtil/perl` folder ## [3.6.2] - 2023-03-02 ### Added From 5dbaa2a7851ec933c260facd9956075401d7b447 Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Tue, 7 Mar 2023 11:36:22 -0500 Subject: [PATCH 22/63] Increase species in hcox_gfed_mod.F90 to allow for furans and other newly added species In the previous commit, emission factors were added for furans, PHEN, MVK, ISOP, ACTA, MGLY, MYLX, RCHO. NSPEC at the top of hcox_gfed_mod.F90 needed to be increased to accommodate the new species. Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 7 +++++++ src/Extensions/hcox_gfed_mod.F90 | 3 +-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 47541bc1..aa781546 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,13 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased 3.7.0] +### Added + - Added GFED4 biomass burning emissions for furans, PHEN, MVK, ISOP, ACTA, MGLY, MYLX, RCHO + +## Changed + - Updated GFED4 emission factors for VOCs to Andreae et al. (2019) + ## [3.6.0] - 2023-02-01 ### Added - Added MAPL_ESMF compiler option for use with GCHP and GEOS diff --git a/src/Extensions/hcox_gfed_mod.F90 b/src/Extensions/hcox_gfed_mod.F90 index f6b19716..d76d9414 100644 --- a/src/Extensions/hcox_gfed_mod.F90 +++ b/src/Extensions/hcox_gfed_mod.F90 @@ -92,8 +92,7 @@ MODULE HCOX_GFED_MOD ! N_SPEC : Max. number of species !================================================================= INTEGER, PARAMETER :: N_EMFAC = 6 - INTEGER, PARAMETER :: N_SPEC = 35 ! increase from 34 (v12.5.0 default) - ! to 35 for MOH + INTEGER, PARAMETER :: N_SPEC = 45 ! ! !PRIVATE TYPES: ! From 3e453a6b895a465d48c65ddee8de437a431e63e9 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 10 Mar 2023 19:15:19 -0500 Subject: [PATCH 23/63] Remove computational bottlenecks from hco_calc_mod.F90 src/Core/hco_calc_mod.F90 - Remove ELSE blocks by use of "never-nesting" technique - Abstract reused code into subroutines - Collapse parallel DO loops - Add Dynamic scaling to DO loops where expedient Signed-off-by: Bob Yantosca --- src/Core/hco_calc_mod.F90 | 561 ++++++++++++++++++++++++++------------ 1 file changed, 385 insertions(+), 176 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index 3ddb185a..ebf3d1c6 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -799,8 +799,8 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object TYPE(DataCont), POINTER :: BaseDct ! base emission ! container - REAL(hp), INTENT(INOUT) :: OUTARR_3D(nI,nJ,nL) ! output array - REAL(hp), INTENT(INOUT) :: MASK (nI,nJ,nL) ! mask array + REAL(hp), INTENT(INOUT) :: outArr_3D(nI,nJ,nL) ! output array + REAL(hp), INTENT(INOUT) :: mask (nI,nJ,nL) ! mask array INTEGER, INTENT(INOUT) :: RC ! ! !OUTPUT PARAMETERS: @@ -831,15 +831,15 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & TYPE(DataCont), POINTER :: LevDct2 ! Scalars - REAL(sp) :: TMPVAL, MaskScale - REAL(hp) :: DilFact + REAL(sp) :: tmpVal, MaskScale + REAL(hp) :: outData REAL(hp) :: ScalFact - INTEGER :: tIDx, IDX + INTEGER :: tIDx, IDX INTEGER :: totLL, nnLL - INTEGER :: I, J, L, N + INTEGER :: I, J, L, N INTEGER :: LowLL, UppLL, ScalLL, TmpLL - INTEGER :: ERROR - CHARACTER(LEN=255) :: MSG, LOC + INTEGER :: EC, ERROR + CHARACTER(LEN=255) :: MSG, LOC LOGICAL :: NegScalExist LOGICAL :: MaskFractions LOGICAL :: isLevDct1 @@ -874,7 +874,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ENDIF ! Initialize mask. By default, assume that we use all grid boxes. - MASK(:,:,:) = 1.0_hp + MASK = 1.0_hp MaskFractions = HcoState%Options%MaskFractions ! Verbose @@ -896,7 +896,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Set base emissions ! ---------------------------------------------------------------- - ! Initialize ERROR. Will be set to 1 if error occurs below + ! Initialize ERROR. Will be set if error occurs below ERROR = 0 ! Initialize variables to compute average vertical level index @@ -906,24 +906,24 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & !----------------------------------------------------------------- ! Check for level index containers ! Move error checks here, outside of the parallel DO loop + ! Remove ELSE blocks for efficiency !----------------------------------------------------------------- + LevDct1 => NULL() IF ( BaseDct%levScalID1 > 0 ) THEN CALL Pnt2DataCont( HcoState, BaseDct%levScalID1, LevDct1, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) RETURN ENDIF - ELSE - LevDct1 => NULL() ENDIF + + LevDct2 => NULL() IF ( BaseDct%levScalID2 > 0 ) THEN CALL Pnt2DataCont( HcoState, BaseDct%levScalID2, LevDct2, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) RETURN ENDIF - ELSE - LevDct2 => NULL() ENDIF ! Test whether LevDct1 and LevDct2 are associated @@ -931,6 +931,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & isLevDct2 = ASSOCIATED( LevDct2 ) ! Get the units of LevDct1 (if it exists) + LevDct1_Unit = -1 IF ( isLevDct1 ) THEN LevDct1_Unit = GetEmisLUnit( HcoState, LevDct1 ) IF ( LevDct1_Unit < 0 ) THEN @@ -939,11 +940,10 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & RC = HCO_FAIL RETURN ENDIF - ELSE - LevDct1_Unit = -1 ENDIF ! Get the units of LevDct2 (if it exists) + LevDct2_Unit = -1 IF ( isLevDct2 ) THEN LevDct2_Unit = GetEmisLUnit( HcoState, LevDct2 ) IF ( LevDct2_Unit < 0 ) THEN @@ -951,8 +951,6 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) RETURN ENDIF - ELSE - LevDct2_Unit = -1 ENDIF ! Throw an error if boxheight is missing and the units are in meters @@ -975,45 +973,53 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ENDIF ENDIF + ! Reset the error flag before the loop + ERROR = 0 + !------------------------------------------------------------------------ ! Loop over all latitudes and longitudes - ! - ! NOTE: It is OK to exit from the "I" loop, because only - ! the "J" loop is being parallelized (bmy, 3/8/21) !------------------------------------------------------------------------ !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED ) & - !$OMP PRIVATE( I, J, L, tIdx, TMPVAL, DilFact, LowLL, UppLL )& + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, L, tIdx, tmpVal, LowLL, UppLL, EC )& !$OMP REDUCTION( +:totLL )& - !$OMP REDUCTION( +:nnLL ) + !$OMP REDUCTION( +:nnLL )& + !$OMP COLLAPSE( 2 )& + !$OMP SCHEDULE( DYNAMIC, 8 ) DO J = 1, nJ DO I = 1, nI + ! Continue to end of loop if an error has occurred + ! (we cannot exit from a parallel loop) + IF ( ERROR > 0 ) CYCLE + ! Zero private variables for safety's sake tmpVal = 0.0_hp - dilFact = 0.0_hp lowLL = 0 uppLL = 0 - + EC = HCO_SUCCESS + ! Get current time index for this container and at this location tIDx = tIDx_GetIndx( HcoState, BaseDct%Dta, I, J ) IF ( tIDx < 1 ) THEN WRITE(MSG,*) 'Cannot get time slice index at location ',I,J,& ': ', TRIM(BaseDct%cName), tIDx ERROR = 1 - EXIT + CYCLE ENDIF ! Get lower and upper vertical index CALL GetVertIndx( HcoState, BaseDct, isLevDct1, LevDct1, & LevDct1_Unit, isLevDct2, LevDct2, LevDct2_Unit, & I, J, LowLL, UppLL, & - RC ) - IF ( RC /= HCO_SUCCESS ) THEN + RC=EC ) + + ! trap error + IF ( EC /= HCO_SUCCESS ) THEN WRITE(MSG,*) 'Error getting vertical index at location ',I,J,& ': ', TRIM(BaseDct%cName) ERROR = 1 ! Will cause error - EXIT + CYCLE ENDIF ! Update variables for computing the average level @@ -1024,51 +1030,32 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & DO L = LowLL, UppLL ! Get base value. Use uniform value if scalar field. - IF ( BaseDct%Dta%SpaceDim == 1 ) THEN - TMPVAL = BaseDct%Dta%V2(tIDx)%Val(1,1) - ELSEIF ( BaseDct%Dta%SpaceDim == 2 ) THEN - TMPVAL = BaseDct%Dta%V2(tIDx)%Val(I,J) - ELSE - TMPVAL = BaseDct%Dta%V3(tIDx)%Val(I,J,L) - ENDIF - - ! If it's a missing value, mask box as unused and set value to zero - IF ( TMPVAL == HCO_MISSVAL ) THEN - MASK(I,J,:) = 0.0_hp - OUTARR_3D(I,J,L) = 0.0_hp - - ! Pass base value to output array - ELSE - - ! Get dilution factor. Never dilute 3D emissions. - IF ( BaseDct%Dta%SpaceDim == 3 ) THEN - DilFact = 1.0_hp - - ! If emission level mode is 2, copy emissions to all level - ! A separate scale factor should be used to distribute vertically - ELSE IF ( BaseDct%Dta%EmisLmode == 2 ) THEN - DilFact = 1.0_hp + tmpVal = Get_Data_From_DataCont( I, J, L, tIdx, BaseDct ) - ! 2D dilution factor - ELSE - CALL GetDilFact( & - HcoState, BaseDct%Dta%EmisL1, & - BaseDct%Dta%EmisL1Unit, BaseDct%Dta%EmisL2, & - BaseDct%Dta%EmisL2Unit, I, & - J, L, & - LowLL, UppLL, & - DilFact, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'Error getting dilution factor at ',I,J,& - ': ', TRIM(BaseDct%cName) - ERROR = 1 - EXIT - ENDIF - ENDIF - - ! Scale base emission by dilution factor - OUTARR_3D(I,J,L) = DilFact * TMPVAL + ! If it's a missing value, mask box as unused + ! and set value to zero. + IF ( tmpVal == HCO_MISSVAL ) THEN + mask(I,J,:) = 0.0_hp + outArr_3D(I,J,L) = 0.0_hp + CYCLE + ENDIF + + ! Otherwise, apply the vertical dilution factor (if necessary) + CALL Apply_Dilution_Factor( I = I, & + J = J, & + L = L, & + LowLL = LowLL, & + UppLL = UppLL, & + HcoState = HcoState, & + BaseDct = BaseDct, & + inData = tmpVal, & + outData = outArr_3D(I,J,L), & + RC = EC ) + + IF ( EC /= HCO_SUCCESS ) THEN + ERROR = 1 ENDIF + ENDDO !L ENDDO !I @@ -1164,16 +1151,20 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & !-------------------------------------------------------------------- ! Loop over all latitudes and longitudes - ! - ! NOTE: It is OK to CYCLE or EXIT from the "I" loop, because - ! only the "J" loop is being parallelized (bmy, 3/8/21) !-------------------------------------------------------------------- !$OMP PARALLEL DO & !$OMP DEFAULT( SHARED )& - !$OMP PRIVATE( I, J, tIdx, TMPVAL, L, LowLL, UppLL, tmpLL, MaskScale ) + !$OMP PRIVATE( I, J, tIdx, tmpVal, L )& + !$OMP PRIVATE( LowLL, UppLL, tmpLL, MaskScale, EC )& + !$OMP COLLAPSE( 2 )& + !$OMP SCHEDULE( DYNAMIC, 8 ) DO J = 1, nJ DO I = 1, nI + ! Continue to end of loop if an error has occurred + ! (we cannot exit from a parallel loop) + IF ( ERROR > 0 ) CYCLE + ! ------------------------------------------------------------ ! If there is a mask associated with this scale factors, check ! if this grid box is within or outside of the mask region. @@ -1188,10 +1179,10 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! If there is a mask applied to this scale factor ... IF ( isMaskDct ) THEN - CALL GetMaskVal ( MaskDct, I, J, MaskScale, MaskFractions, RC ) - IF ( RC /= HCO_SUCCESS ) THEN + CALL GetMaskVal ( MaskDct, I, J, MaskScale, MaskFractions, EC ) + IF ( EC /= HCO_SUCCESS ) THEN ERROR = 4 - EXIT + CYCLE ENDIF ENDIF @@ -1204,7 +1195,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & WRITE(*,*) 'Cannot get time slice index at location ',I,J,& ': ', TRIM(ScalDct%cName), tIDx ERROR = 3 - EXIT + CYCLE ENDIF ! Check if this is a mask. If so, add mask values to the MASK @@ -1216,10 +1207,10 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & IF ( ScalDct%DctType == HCO_DCTTYPE_MASK ) THEN ! Get mask value - CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, RC ) - IF ( RC /= HCO_SUCCESS ) THEN + CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, EC ) + IF ( EC /= HCO_SUCCESS ) THEN ERROR = 4 - EXIT + CYCLE ENDIF ! Pass to output mask @@ -1248,32 +1239,25 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & CALL GetVertIndx( HcoState, BaseDct, isLevDct1, & LevDct1, LevDct1_Unit, isLevDct2, & LevDct2, LevDct2_Unit, I, & - J, LowLL, UppLL, RC ) + J, LowLL, UppLL, & + RC=EC ) IF ( RC /= HCO_SUCCESS ) THEN ERROR = 1 ! Will cause error - EXIT + CYCLE ENDIF ! Loop over all vertical levels of the base field DO L = LowLL,UppLL + ! If the vertical level exceeds the number of available ! scale factor levels, use the highest available level. - IF ( L > ScalLL ) THEN - TmpLL = ScalLL ! Otherwise use the same vertical level index. - ELSE - TmpLL = L - ENDIF + TmpLL = L + IF ( L > ScalLL ) TmpLL = ScalLL ! Get scale factor for this grid box. Use same uniform ! value if it's a scalar field - IF ( ScalDct%Dta%SpaceDim == 1 ) THEN - TMPVAL = ScalDct%Dta%V2(tidx)%Val(1,1) - ELSEIF ( ScalDct%Dta%SpaceDim == 2 ) THEN - TMPVAL = ScalDct%Dta%V2(tidx)%Val(I,J) - ELSE - TMPVAL = ScalDct%Dta%V3(tidx)%Val(I,J,TmpLL) - ENDIF + tmpVal = Get_Data_From_DataCont( I, J, L, tIdX, ScalDct ) ! Set missing value to one IF ( TMPVAL == HCO_MISSVAL ) TMPVAL = 1.0_sp @@ -1298,37 +1282,27 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & WRITE(*,*) 'Negative scale factor at ',I,J,TmpLL,tidx,& ': ', TRIM(ScalDct%cName), TMPVAL ERROR = 1 ! Will cause error - EXIT + CYCLE ENDIF ENDIF ! ------------------------------------------------------- ! Apply scale factor in accordance to field operator ! ------------------------------------------------------- - - ! Oper 1: multiply - IF ( ScalDct%Oper == 1 ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) * TMPVAL - - ! Oper -1: divide - ELSEIF ( ScalDct%Oper == -1 ) THEN - ! Ignore zeros to avoid NaN - IF ( TMPVAL /= 0.0_sp ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) / TMPVAL - ENDIF - - ! Oper 2: square - ELSEIF ( ScalDct%Oper == 2 ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) * TMPVAL * TMPVAL - - ! Return w/ error otherwise (Oper 3 is only allowed for masks!) - ELSE - WRITE(*,*) 'Illegal operator for ', TRIM(ScalDct%cName), ScalDct%Oper - ERROR = 2 ! Will cause error - EXIT + CALL Apply_Scale_Factor( I = I, & + J = J, & + L = L, & + ScalDct = ScalDct, & + scalFac = tmpVal, & + dataVal = outArr_3D(I,J,L), & + RC = EC ) + + IF ( EC /= HCO_SUCCESS ) THEN + ERROR = 2 + CYCLE ENDIF - - ENDDO !LL + + ENDDO ! Verbose mode if ( HCO_IsVerb(HcoState%Config%Err) .and. i == ix .and. j == iy ) then @@ -1393,6 +1367,219 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & CALL HCO_LEAVE ( HcoState%Config%Err, RC ) END SUBROUTINE Get_Current_Emissions + + + FUNCTION Get_Value_From_DataCont( I, J, L, tIdx, Dct ) RESULT( val ) + + INTEGER INTENT(IN) :: I + INTEGER INTENT(IN) :: J + INTEGER INTENT(IN) :: L + INTEGER, INTENT(IN) :: tIdx + TYPE(DataCont), POINTER :: Dct + + REAL(sp) :: val + + ! Data is a 1-D scaler: Return a uniform value + IF ( Dct%Dta%SpaceDim == 1 ) THEN + val = BaseDct%Dta%V2(tIDx)%Val(1,1) + RETURN + ENDIF + + ! Data is a 2-D array: Return value at (I,J) + IF ( Dct%Dta%SpaceDim == 2 ) THEN + val = BaseDct%Dta%V2(tIDx)%Val(I,J) + RETURN + ENDIF + + ! Data is a 3-D array: Return value at (I,J,L) + val = BaseDct%Dta%V3(tIDx)%Val(I,J,L) + + END FUNCTION Get_Value_From_DataCont +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Apply_Dilution_Factor +! +! !DESCRIPTION: Applies the dilution factor to input data. This algorithm +! has been abstracted out of Get_Current_Emissions for computational +! efficiency. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Apply_Dilution_Factor( I, J, L, LowLL, & + UppLL, HcoState, BaseDct, inData, & + outData, RC ) +! +! !USES: +! + USE HCO_Error_Mod + USE HCO_State_Mod, ONLY : HCO_State +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: I ! Longitude (or X-dim) index + INTEGER, INTENT(IN) :: J ! Latitude (or Y-dim) index + INTEGER, INTENT(IN) :: L ! Vertical level index + INTEGER, INTENT(IN) :: LowLL ! Lower level for emissions + INTEGER, INTENT(IN) :: UppLL ! Upper level for emissions + TYPE(DataCont), POINTER :: BaseDct ! Base data container + REAL(sp), INTENT(IN) :: inData ! Input data +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object + REAL(hp), INTENT(INOUT) :: outData ! Data w/ dil. factor applied +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Scalars + REAL(hp) :: dilFact + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc + + !======================================================================== + ! Apply_Dilution_Factor begins here! + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'Apply_Dilution_Factor (in src/Core/hco_calc_mod.F90)' + dilFact = 0.0_hp + + !======================================================================== + ! Get dilution factor. Never dilute 3D emissions. + !======================================================================== + IF ( BaseDct%Dta%SpaceDim == 3 ) THEN + outData = inData + RETURN + ENDIF + + !======================================================================== + ! If emission level mode is 2, copy emissions to all level + ! A separate scale factor should be used to distribute vertically + !======================================================================== + IF ( BaseDct%Dta%EmisLmode == 2 ) THEN + outData = inData + RETURN + ENDIF + + !======================================================================== + ! Otherwise, compute the vertical dilution factor + ! and apply it to the input data. + !======================================================================== + CALL GetDilFact( I = I, & + J = J, & + L = L, & + LowLL = LowLL, & + UppLL = UppLL, & + HcoState = HcoState, & + EmisL1 = BaseDct%Dta%EmisL1, & + EmisL1Unit = BaseDct%Dta%EmisL1Unit, & + EmisL2 = BaseDct%Dta%EmisL2, & + EmisL2Unit = BaseDct%Dta%EmisL2Unit, & + DilFact = dilFact, & + RC = RC ) + + ! Trap error + IF ( RC /= HCO_SUCCESS ) THEN + WRITE(*,*) 'Error getting dilution factor at ',I,J,& + ': ', TRIM(BaseDct%cName) + RC = 1 + RETURN + ENDIF + + ! Scale base emission by dilution factor + outData = dilFact * inData + + END SUBROUTINE Apply_Dilution_Factor +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Apply_Scale_Factor +! +! !DESCRIPTION: Applies scale factors to the input +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Apply_Scale_Factor( I, J, L, ScalDct, scalFac, dataVal, RC ) +! +! !USES: +! + USE HCO_Error_Mod +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: I ! Longitude (or X-dim) index + INTEGER, INTENT(IN) :: J ! Latitude (or Y-dim) index + INTEGER, INTENT(IN) :: L ! Vertical level index + TYPE(DataCont), POINTER :: ScalDct ! Scale Factor data container + REAL(sp), INTENT(IN) :: scalFac ! Scale factor +! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(hp), INTENT(INOUT) :: dataVal ! Data to be scaled +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure +! +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + !======================================================================= + ! Apply_Scale_Factor begins here! + !======================================================================= + + ! Initialize + RC = HCO_SUCCESS + + ! Oper 1: multiply + IF ( ScalDct%Oper == 1 ) THEN + dataVal = dataVal * scalFac + RETURN + ENDIF + + ! Oper -1: divide + IF ( ScalDct%Oper == -1 ) THEN + IF ( scalFac /= 0.0_sp ) THEN + dataVal = dataVal / scalFac + ENDIF + RETURN + ENDIF + + ! Oper 2: square + IF ( ScalDct%Oper == 2 ) THEN + dataVal = dataVal * scalFac * scalFac + RETURN + ENDIF + + ! Return w/ error otherwise (Oper 3 is only allowed for masks!) + WRITE(*,*) 'Illegal operator for ', & + TRIM(ScalDct%cName), ScalDct%Oper + RC = 2 ! Will cause error + + END SUBROUTINE Apply_Scale_Factor !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -1504,12 +1691,18 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & ! Loop over all grid boxes !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED ) & - !$OMP PRIVATE( I, J, LowLL, UppLL, tIdx, IJFILLED, L ) & - !$OMP PRIVATE( TMPVAL, N, IDX, ScalDct, ScalLL, tmpLL, MaskScale ) + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, LowLL, UppLL, tIdx, IJFILLED, L )& + !$OMP PRIVATE( TMPVAL, N, IDX, ScalDct, ScalLL, tmpLL, MaskScale )& + !$OMP COLLAPSE( 2 )& + !$OMP SCHEDULE( DYNAMIC, 8 ) DO J = 1, nJ DO I = 1, nI + ! Continue to end of loop if an error has occurred + ! (we cannot exit from a parallel loop) + IF ( ERROR > 0 ) CYCLE + ! ------------------------------------------------------------- ! Set base emissions ! ------------------------------------------------------------- @@ -1519,14 +1712,10 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & ! necessarily extent over the entire troposphere but only cover ! the effectively filled vertical levels. For most inventories, ! this is only the first model level. - IF ( BaseDct%Dta%SpaceDim==3 ) THEN - LowLL = 1 - UppLL = SIZE(BaseDct%Dta%V3(1)%Val,3) - ELSE - !LowLL = BaseDct%Dta%Lev2D - !UppLL = BaseDct%Dta%Lev2D - LowLL = 1 - UppLL = 1 + LowLL = 1 + UppLL = 1 + IF ( BaseDct%Dta%SpaceDim == 3 ) THEN + UppLL = SIZE( BaseDct%Dta%V3(1)%Val, 3 ) ENDIF ! Precalculate timeslice index. The data containers can @@ -1540,7 +1729,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & write(MSG,*) 'Cannot get time slice index at location ',I,J,& ': ', TRIM(BaseDct%cName) ERROR = 3 - EXIT + CYCLE ENDIF ! # of levels w/ defined emissions @@ -1590,13 +1779,13 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & CALL Pnt2DataCont( HcoState, IDX, ScalDct, RC ) IF ( RC /= HCO_SUCCESS ) THEN ERROR = 4 - EXIT + CYCLE ENDIF ! Scale field cannot be a base field IF ( (ScalDct%DctType == HCO_DCTTYPE_BASE) ) THEN ERROR = 4 - EXIT + CYCLE ENDIF ! Skip this scale factor if no data defined. This is possible @@ -1625,23 +1814,22 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & MSG = TRIM(MSG) // '; mask: '//TRIM(MaskDct%cName) CALL HCO_ERROR( MSG, RC ) ERROR = 5 - EXIT + CYCLE ENDIF ! Get mask value CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, RC ) IF ( RC /= HCO_SUCCESS ) THEN ERROR = 6 - EXIT + CYCLE ENDIF ENDIF ! Get vertical extension of this scale factor array. - IF( (ScalDct%Dta%SpaceDim<=2) ) THEN - ScalLL = 1 - ELSE - ScalLL = SIZE(ScalDct%Dta%V3(1)%Val,3) + ScalLL = 1 + IF ( ScalDct%Dta%SpaceDim == 3 ) THEN + ScalLL = SIZE( ScalDct%Dta%V3(1)%Val, 3 ) ENDIF ! Get current time index @@ -1650,7 +1838,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & write(MSG,*) 'Cannot get time slice index at location ',I,J,& ': ', TRIM(ScalDct%cName) ERROR = 3 - EXIT + CYCLE ENDIF ! ------------------------------------------------------------ @@ -1692,14 +1880,12 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & ! Loop over all vertical levels of the base field DO L = LowLL,UppLL + ! If the vertical level exceeds the number of available ! scale factor levels, use the highest available level. - IF ( L > ScalLL ) THEN - TmpLL = ScalLL ! Otherwise use the same vertical level index. - ELSE - TmpLL = L - ENDIF + TmpLL = L + IF ( L > ScalLL ) TmpLL = ScalLL ! Get scale factor for this grid box. Use same uniform ! value if it's a scalar field @@ -1729,7 +1915,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & WRITE(*,*) 'Negative scale factor at ',I,J,TmpLL,tidx,& ': ', TRIM(ScalDct%cName), TMPVAL ERROR = 1 ! Will cause error - EXIT + CYCLE ENDIF ENDIF @@ -1757,7 +1943,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & MSG = 'Illegal data operator: ' // TRIM(ScalDct%cName) CALL HCO_ERROR( MSG, RC ) ERROR = 2 - EXIT + CYCLE ENDIF ENDDO !LL ENDDO ! N @@ -1777,7 +1963,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & ENDDO !I ENDDO !J -!$OMP END PARALLEL DO + !$OMP END PARALLEL DO ! Error check IF ( ERROR > 0 ) THEN @@ -2332,12 +2518,16 @@ SUBROUTINE GetVertIndx( HcoState, Dct, isLevDct1, & ! INTEGER :: EmisLUnit REAL(hp) :: EmisL - CHARACTER(LEN=255) :: LOC + CHARACTER(LEN=255) :: errMsg, thisLoc !======================================================================= ! GetVertIndx begins here !======================================================================= - LOC = 'GetVertIndx (HCO_CALC_MOD.F90)' + + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'GetVertIndx (src/Core/hco_calc_mod.F90)' !----------------------------------------------------------------------- ! Get vertical extension of base emission array. @@ -2347,9 +2537,9 @@ SUBROUTINE GetVertIndx( HcoState, Dct, isLevDct1, & ! the effectively filled vertical levels. For most inventories, ! this is only the first model level. !----------------------------------------------------------------------- - IF ( Dct%Dta%SpaceDim==3 ) THEN + IF ( Dct%Dta%SpaceDim == 3 ) THEN LowLL = 1 - UppLL = SIZE(Dct%Dta%V3(1)%Val,3) + UppLL = SIZE( Dct%Dta%V3(1)%Val, 3 ) RC = HCO_SUCCESS RETURN ENDIF @@ -2362,6 +2552,11 @@ SUBROUTINE GetVertIndx( HcoState, Dct, isLevDct1, & ! Lower level ! --> Check if scale factor is used to determine lower and/or ! upper level + ! + ! NOTE: Get rid of ELSE block for efficiency (bmy, 09 Mar 2023) + EmisL = Dct%Dta%EmisL1 + EmisLUnit = Dct%Dta%EmisL1Unit + IF ( isLevDct1 ) THEN EmisL = GetEmisL( HcoState, LevDct1, I, J ) IF ( EmisL < 0.0_hp ) THEN @@ -2369,17 +2564,20 @@ SUBROUTINE GetVertIndx( HcoState, Dct, isLevDct1, & RETURN ENDIF EmisLUnit = LevDct1_Unit - ELSE - EmisL = Dct%Dta%EmisL1 - EmisLUnit = Dct%Dta%EmisL1Unit ENDIF + CALL GetIdx( HcoState, I, J, EmisL, EmisLUnit, LowLL, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in rouitine "GetIdx" (for LevDct1)!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF ! Upper level + ! NOTE: Get rid of ELSE block for efficiency (bmy, 09 Mar 2023) + EmisL = Dct%Dta%EmisL2 + EmisLUnit = Dct%Dta%EmisL2Unit + IF ( isLevDct2 ) THEN EmisL = GetEmisL( HcoState, LevDct2, I, J ) IF ( EmisL < 0.0_hp ) THEN @@ -2387,14 +2585,13 @@ SUBROUTINE GetVertIndx( HcoState, Dct, isLevDct1, & RETURN ENDIF EmisLUnit = LevDct2_Unit - ELSE - EmisL = Dct%Dta%EmisL2 - EmisLUnit = Dct%Dta%EmisL2Unit ENDIF + CALL GetIdx( HcoState, I, J, EmisL, EmisLUnit, UppLL, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in rouitine "GetIdx" (for LevDct2)!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF ! Upper level must not be lower than lower level @@ -2560,6 +2757,10 @@ SUBROUTINE GetIdx( HcoState, I, J, alt, altu, lidx, RC ) REAL(hp), INTENT(INOUT) :: alt ! altitude INTEGER, INTENT(INOUT) :: RC ! +! !REMARKS: +! The code was refactored to avoid ELSE blocks (which are computationally +! expensive) following the "never-nesting" technique. (Bob Y., 10 Mar 2023) +! ! !REVISION HISTORY: ! 09 May 2016 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history @@ -2575,20 +2776,29 @@ SUBROUTINE GetIdx( HcoState, I, J, alt, altu, lidx, RC ) CHARACTER(LEN=255) :: LOC = 'GetIdx (hco_calc_mod.F90)' !================================================================= - ! HCO_GetVertIndx begins here + ! HCO_GetIdx begins here !================================================================= ! Init RC = HCO_SUCCESS - ! Simple case: data is already on level unit + ! Input data is in level coordinates; + ! Return the corresponding level index IF ( altu == HCO_EMISL_LEV ) THEN - lidx = INT(alt) + lidx = INT( alt ) + RETURN + ENDIF - ELSEIF ( altu == HCO_EMISL_TOP ) THEN + ! Input specifies the top-of-atmosphere; + ! Return the top-of-atmosphere level index + IF ( altu == HCO_EMISL_TOP ) THEN lidx = HCOState%NZ + RETURN + ENDIF - ELSEIF ( altu == HCO_EMISL_M .OR. altu == HCO_EMISL_PBL ) THEN + ! Input data is in meters or specifies the PBL top; + ! Find the corresponding level index + IF ( altu == HCO_EMISL_M .OR. altu == HCO_EMISL_PBL ) THEN ! Eventually get altitude from PBL height IF ( altu == HCO_EMISL_PBL ) THEN @@ -2618,19 +2828,18 @@ SUBROUTINE GetIdx( HcoState, I, J, alt, altu, lidx, RC ) ! If altitude is above maximum level IF ( lidx == -1 .AND. alt >= altt ) THEN lidx = HcoState%NZ - WRITE(MSG,*) 'Level is above max. grid box level - use top level ', alt + WRITE(MSG,*) & + 'Level is above max. grid box level - use top level ', alt CALL HCO_WARNING ( HcoState%Config%Err, MSG, RC, THISLOC=LOC ) RETURN ENDIF - ELSE - MSG = 'Illegal altitude unit' - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) RETURN ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ! Error if we drop down to here + MSG = 'Illegal altitude unit' + CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) END SUBROUTINE GetIdx !EOC From 778e4c2377b5e042aa0053d9bf31b61004c7c811 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 14 Mar 2023 09:37:40 -0400 Subject: [PATCH 24/63] Fix bugs preventing compilation from the prior commit 3e453a6 src/Core/hco_calc_mod.F90 - Fixed incorrect function calls to Get_Value_From_DataCont - Added missing commas to arguments in Get_Value_From_DataCont - Renamed return value to dataVal in Get_Value_From_DataCont - Fixed incorrect data container names (BaseDct -> Dct) in Get_Value_From_DataCont Signed-off-by: Bob Yantosca --- src/Core/hco_calc_mod.F90 | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index ebf3d1c6..964bad7a 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -1030,7 +1030,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & DO L = LowLL, UppLL ! Get base value. Use uniform value if scalar field. - tmpVal = Get_Data_From_DataCont( I, J, L, tIdx, BaseDct ) + tmpVal = Get_Value_From_DataCont( I, J, L, tIdx, BaseDct ) ! If it's a missing value, mask box as unused ! and set value to zero. @@ -1257,7 +1257,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Get scale factor for this grid box. Use same uniform ! value if it's a scalar field - tmpVal = Get_Data_From_DataCont( I, J, L, tIdX, ScalDct ) + tmpVal = Get_Value_From_DataCont( I, J, L, tIdX, ScalDct ) ! Set missing value to one IF ( TMPVAL == HCO_MISSVAL ) TMPVAL = 1.0_sp @@ -1369,30 +1369,30 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & END SUBROUTINE Get_Current_Emissions - FUNCTION Get_Value_From_DataCont( I, J, L, tIdx, Dct ) RESULT( val ) + FUNCTION Get_Value_From_DataCont( I, J, L, tIdx, Dct ) RESULT( dataVal ) - INTEGER INTENT(IN) :: I - INTEGER INTENT(IN) :: J - INTEGER INTENT(IN) :: L + INTEGER, INTENT(IN) :: I + INTEGER, INTENT(IN) :: J + INTEGER, INTENT(IN) :: L INTEGER, INTENT(IN) :: tIdx TYPE(DataCont), POINTER :: Dct - REAL(sp) :: val + REAL(sp) :: dataVal ! Data is a 1-D scaler: Return a uniform value IF ( Dct%Dta%SpaceDim == 1 ) THEN - val = BaseDct%Dta%V2(tIDx)%Val(1,1) + dataVal = Dct%Dta%V2(tIDx)%Val(1,1) RETURN ENDIF ! Data is a 2-D array: Return value at (I,J) IF ( Dct%Dta%SpaceDim == 2 ) THEN - val = BaseDct%Dta%V2(tIDx)%Val(I,J) + dataVal = Dct%Dta%V2(tIDx)%Val(I,J) RETURN ENDIF ! Data is a 3-D array: Return value at (I,J,L) - val = BaseDct%Dta%V3(tIDx)%Val(I,J,L) + dataVal = Dct%Dta%V3(tIDx)%Val(I,J,L) END FUNCTION Get_Value_From_DataCont !EOC From e5cf0113b410cc6de28bc435d355fa8ff347f54e Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 14 Mar 2023 11:52:08 -0400 Subject: [PATCH 25/63] Further code cleanup in hco_calc_mod.F90 src/Core/hco_calc_mod.F90 - In routine Get_Current_Emissions - Renamed LOC -> thisLoc - Added whitespace to function calls for better readability - Edited comments for clarity - Replaced placeholder error messages with actual error messages - Indented code to proper indentation levels - Trimmed trailing whitespace - In routine Get_Value_From_Datacont - Update comments and comment header - In routine Apply_Scale_Factor - Update comments and comment header - In routine Apply_Dilution_Factor - Update comments and comment header - Routine Get_Current_Emisisons_B - Now removed, this was not used --- src/Core/hco_calc_mod.F90 | 1174 ++++++++++++++----------------------- 1 file changed, 427 insertions(+), 747 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index 964bad7a..759931c2 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -839,7 +839,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & INTEGER :: I, J, L, N INTEGER :: LowLL, UppLL, ScalLL, TmpLL INTEGER :: EC, ERROR - CHARACTER(LEN=255) :: MSG, LOC + CHARACTER(LEN=255) :: MSG, thisLoc LOGICAL :: NegScalExist LOGICAL :: MaskFractions LOGICAL :: isLevDct1 @@ -860,16 +860,17 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Initialize ScalDct => NULL() MaskDct => NULL() - LOC = 'GET_CURRENT_EMISSIONS (hco_calc_mod.F90)' + msg = '' + thisLoc = 'GET_CURRENT_EMISSIONS (hco_calc_mod.F90)' ! Enter - CALL HCO_ENTER(HcoState%Config%Err, LOC, RC ) - IF(RC /= HCO_SUCCESS) RETURN + CALL HCO_Enter( HcoState%Config%Err, thisLoc, RC ) + IF ( RC /= HCO_SUCCESS ) RETURN ! Check if container contains data IF ( .NOT. FileData_ArrIsDefined(BaseDct%Dta) ) THEN - MSG = 'Array not defined: ' // TRIM(BaseDct%cName) - CALL HCO_ERROR( MSG, RC ) + msg = 'Array not defined: ' // TRIM(BaseDct%cName) + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF @@ -877,43 +878,35 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & MASK = 1.0_hp MaskFractions = HcoState%Options%MaskFractions - ! Verbose + ! Verbose output IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN - WRITE(MSG,*) 'Evaluate field ', TRIM(BaseDct%cName) - CALL HCO_MSG(HcoState%Config%Err,MSG,SEP1=' ') + WRITE(msg,*) 'Evaluate field ', TRIM(BaseDct%cName) + CALL HCO_Msg( HcoState%Config%Err, msg, sep1=' ' ) ENDIF - ! Put check for PBLHEIGHT here (bmy, 3/4/21) #if !defined ( ESMF_ ) - IF ( .NOT. ASSOCIATED(HcoState%Grid%PBLHEIGHT%Val) ) THEN - MSG = 'PBLHEIGHT (in meters) is missing in HEMCO state' - CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + ! Put check for PBLHEIGHT here, if not running in ESMF/MAPL + IF ( .NOT. ASSOCIATED( HcoState%Grid%PBLHEIGHT%Val ) ) THEN + msg = 'PBLHEIGHT (in meters) is missing in HEMCO state' + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF #endif - ! ---------------------------------------------------------------- + !======================================================================== ! Set base emissions - ! ---------------------------------------------------------------- - - ! Initialize ERROR. Will be set if error occurs below - ERROR = 0 - - ! Initialize variables to compute average vertical level index - totLL = 0.0 - nnLL = 0.0 + !======================================================================== - !----------------------------------------------------------------- ! Check for level index containers ! Move error checks here, outside of the parallel DO loop ! Remove ELSE blocks for efficiency - !----------------------------------------------------------------- LevDct1 => NULL() IF ( BaseDct%levScalID1 > 0 ) THEN CALL Pnt2DataCont( HcoState, BaseDct%levScalID1, LevDct1, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) - RETURN + msg = 'Could not get a pointer to LevDct1 from HcoState!' + CALL HCO_Error( msg, RC, thisLoc ) + RETURN ENDIF ENDIF @@ -921,8 +914,9 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & IF ( BaseDct%levScalID2 > 0 ) THEN CALL Pnt2DataCont( HcoState, BaseDct%levScalID2, LevDct2, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) - RETURN + msg = 'Could not get a pointer to LevDct2 in HcoState!' + CALL HCO_Error( msg, RC, thisLoc ) + RETURN ENDIF ENDIF @@ -936,8 +930,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & LevDct1_Unit = GetEmisLUnit( HcoState, LevDct1 ) IF ( LevDct1_Unit < 0 ) THEN MSG = 'LevDct1 units are not defined!' - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) - RC = HCO_FAIL + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF ENDIF @@ -948,7 +941,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & LevDct2_Unit = GetEmisLUnit( HcoState, LevDct2 ) IF ( LevDct2_Unit < 0 ) THEN MSG = 'LevDct2_Units are not defined!' - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF ENDIF @@ -956,9 +949,9 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Throw an error if boxheight is missing and the units are in meters IF ( LevDct1_Unit == HCO_EMISL_M .or. & LevDct2_Unit == HCO_EMISL_M ) THEN - IF ( .NOT. ASSOCIATED(HcoState%Grid%BXHEIGHT_M%Val) ) THEN + IF ( .not. ASSOCIATED( HcoState%Grid%BXHEIGHT_M%Val ) ) THEN MSG = 'Boxheight (in meters) is missing in HEMCO state' - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF ENDIF @@ -966,19 +959,19 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Throw an error if boxheight is missing and the units are in PBL frac IF ( LevDct1_Unit == HCO_EMISL_PBL .or. & LevDct2_Unit == HCO_EMISL_PBL ) THEN - IF ( .NOT. ASSOCIATED(HcoState%Grid%PBLHEIGHT%Val) ) THEN + IF ( .not. ASSOCIATED( HcoState%Grid%PBLHEIGHT%Val ) ) THEN MSG = 'Boundary layer height is missing in HEMCO state' - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF ENDIF - ! Reset the error flag before the loop - ERROR = 0 + ! Initialize non-private loop variables here + error = 0 + totLL = 0.0 + nnLL = 0.0 - !------------------------------------------------------------------------ ! Loop over all latitudes and longitudes - !------------------------------------------------------------------------ !$OMP PARALLEL DO & !$OMP DEFAULT( SHARED )& !$OMP PRIVATE( I, J, L, tIdx, tmpVal, LowLL, UppLL, EC )& @@ -991,37 +984,45 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Continue to end of loop if an error has occurred ! (we cannot exit from a parallel loop) - IF ( ERROR > 0 ) CYCLE + IF ( error > 0 ) CYCLE ! Zero private variables for safety's sake tmpVal = 0.0_hp lowLL = 0 uppLL = 0 EC = HCO_SUCCESS - + + !--------------------------------------------------------------------- ! Get current time index for this container and at this location + !--------------------------------------------------------------------- tIDx = tIDx_GetIndx( HcoState, BaseDct%Dta, I, J ) IF ( tIDx < 1 ) THEN - WRITE(MSG,*) 'Cannot get time slice index at location ',I,J,& - ': ', TRIM(BaseDct%cName), tIDx - ERROR = 1 + WRITE( msg, * ) 'Cannot get time slice index at location ',I,J, & + ': ', TRIM(BaseDct%cName), tIDx + error = 1 CYCLE ENDIF + !--------------------------------------------------------------------- ! Get lower and upper vertical index + !--------------------------------------------------------------------- CALL GetVertIndx( HcoState, BaseDct, isLevDct1, LevDct1, & LevDct1_Unit, isLevDct2, LevDct2, LevDct2_Unit, & I, J, LowLL, UppLL, & RC=EC ) - ! trap error + ! Trap error IF ( EC /= HCO_SUCCESS ) THEN WRITE(MSG,*) 'Error getting vertical index at location ',I,J,& ': ', TRIM(BaseDct%cName) - ERROR = 1 ! Will cause error + error = 1 CYCLE ENDIF + !--------------------------------------------------------------------- + ! Apply vertical dilution factor (if necessary) + !--------------------------------------------------------------------- + ! Update variables for computing the average level totLL = totLL + UppLL nnLL = nnLL + 1 @@ -1032,14 +1033,14 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Get base value. Use uniform value if scalar field. tmpVal = Get_Value_From_DataCont( I, J, L, tIdx, BaseDct ) - ! If it's a missing value, mask box as unused + ! If it's a missing value, mask box as unused ! and set value to zero. IF ( tmpVal == HCO_MISSVAL ) THEN mask(I,J,:) = 0.0_hp outArr_3D(I,J,L) = 0.0_hp CYCLE ENDIF - + ! Otherwise, apply the vertical dilution factor (if necessary) CALL Apply_Dilution_Factor( I = I, & J = J, & @@ -1052,8 +1053,11 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & outData = outArr_3D(I,J,L), & RC = EC ) + ! Trap errors IF ( EC /= HCO_SUCCESS ) THEN - ERROR = 1 + error = 1 + msg = 'Error encountered in routine "Apply_Dilution_Factor"!' + CYCLE ENDIF ENDDO !L @@ -1062,322 +1066,389 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ENDDO !J !$OMP END PARALLEL DO - ! Check for error - IF ( ERROR == 1 ) THEN - CALL HCO_ERROR( MSG, RC ) + !------------------------------------------------------------------------ + ! Return if an error occurred in the parallel loop above + !------------------------------------------------------------------------ + IF ( error == 1 ) THEN + CALL HCO_Error( msg, RC, thisLoc ) RETURN ENDIF - ! ---------------------------------------------------------------- - ! Apply scale factors + !======================================================================== + ! Apply scale factors to base emissions + ! ! The container IDs of all scale factors associated with this base ! container are stored in vector Scal_cID. - ! ---------------------------------------------------------------- - - ! Loop over scale factors + !======================================================================== IF ( BaseDct%nScalID > 0 ) THEN - DO N = 1, BaseDct%nScalID + ! Loop over all scale factors for this base emissions + DO N = 1, BaseDct%nScalID - ! Get the scale factor container ID for the current slot - IDX = BaseDct%Scal_cID(N) + !------------------------------------------------------------------ + ! Get a pointer to the data container holding this scale factor + !------------------------------------------------------------------ - ! Point to data container with the given container ID - CALL Pnt2DataCont( HcoState, IDX, ScalDct, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) - RETURN - ENDIF + ! Get the Nth scale factor container ID + IDX = BaseDct%Scal_cID(N) - ! Sanity check: scale field cannot be a base field - IF ( (ScalDct%DctType == HCO_DCTTYPE_BASE) ) THEN - MSG = 'Wrong scale field type: ' // TRIM(ScalDct%cName) - CALL HCO_ERROR( MSG, RC ) - RETURN - ENDIF + ! Point to data container with the given container ID + CALL Pnt2DataCont( HcoState, IDX, ScalDct, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not get scale factor for base emissions field ' // & + TRIM( BaseDct%cName ) + CALL HCO_Error( msg, RC, thisLoc ) + RETURN + ENDIF - ! Skip this scale factor if no data defined. This is possible - ! if scale factors are only defined for a given time range and - ! the simulation datetime is outside of this range. - IF ( .NOT. FileData_ArrIsDefined(ScalDct%Dta) ) THEN + ! Sanity check: scale field cannot be a base field + IF ( ScalDct%DctType == HCO_DCTTYPE_BASE ) THEN + msg = 'Wrong scale field type: ' // TRIM(ScalDct%cName) + CALL HCO_Error( msg, RC, thisLoc ) + RETURN + ENDIF + + !------------------------------------------------------------------ + ! Skip this scale factor if no data defined. This is possible + ! if scale factors are only defined for a given time range and + ! the simulation datetime is outside of this range. + !------------------------------------------------------------------ + IF ( .not. FileData_ArrIsDefined( ScalDct%Dta ) ) THEN + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + msg = 'Skip scale factor ' // TRIM( ScalDct%cName ) // & + ' because it is not defined for this datetime.' + CALL HCO_MSG( HcoState%Config%Err, msg ) + ENDIF + CYCLE + ENDIF + + ! Verbose printout IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN - MSG = 'Skip scale factor '//TRIM(ScalDct%cName)// & - ' because it is not defined for this datetime.' + MSG = 'Applying scale factor ' // TRIM(ScalDct%cName) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF - CYCLE - ENDIF - - ! Verbose mode - IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN - MSG = 'Applying scale factor ' // TRIM(ScalDct%cName) - CALL HCO_MSG(HcoState%Config%Err,MSG) - ENDIF - ! Get vertical extension of this scale factor array. - IF( (ScalDct%Dta%SpaceDim<=2) ) THEN + !------------------------------------------------------------------ + ! Get vertical extension of this scale factor array. + !------------------------------------------------------------------ ScalLL = 1 - ELSE - ScalLL = SIZE(ScalDct%Dta%V3(1)%Val,3) - ENDIF - - ! Check if there is a mask field associated with this scale - ! factor. In this case, get a pointer to the corresponding - ! mask field and evaluate scale factors only inside the mask - ! region. - IF ( ASSOCIATED(ScalDct%Scal_cID) ) THEN - CALL Pnt2DataCont( HcoState, ScalDct%Scal_cID(1), MaskDct, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) - RETURN + IF ( ScalDct%Dta%SpaceDim == 3 ) THEN + ScalLL = SIZE( ScalDct%Dta%V3(1)%Val, 3 ) ENDIF - ! Must be mask field - IF ( MaskDct%DctType /= HCO_DCTTYPE_MASK ) THEN - MSG = 'Invalid mask for scale factor: '//TRIM(ScalDct%cName) - MSG = TRIM(MSG) // '; mask: '//TRIM(MaskDct%cName) - CALL HCO_ERROR( MSG, RC ) - RETURN + !------------------------------------------------------------------ + ! Check if there is a mask field associated with this scale + ! factor. In this case, get a pointer to the corresponding + ! mask field and evaluate scale factors only inside the mask + ! region. + !------------------------------------------------------------------ + IF ( ASSOCIATED(ScalDct%Scal_cID) ) THEN + CALL Pnt2DataCont( HcoState, ScalDct%Scal_cID(1), MaskDct, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not get mask field for scale factor: ' // & + TRIM( ScalDct%cName ) + CALL HCO_Error( msg, RC, thisLoc ) + RETURN + ENDIF + + ! Sanity check: The data container MaskDct must be a mask! + IF ( MaskDct%DctType /= HCO_DCTTYPE_MASK ) THEN + MSG = 'Invalid mask for scale factor: ' // & + TRIM( ScalDct%cName ) // '; mask: ' // & + TRIM( MaskDct%cName ) + CALL HCO_Error( msg, RC, thisLoc ) + RETURN + ENDIF ENDIF - ENDIF - ! Set a flag to denote whether MaskDct is associated - ! This can be done outside of the parallel loops below - isMaskDct = ASSOCIATED( MaskDct ) + ! Set a flag to denote whether MaskDct is associated + ! This can be done outside of the parallel loops below + isMaskDct = ASSOCIATED( MaskDct ) + + !------------------------------------------------------------------ + ! Apply the mask to the scale factor + !------------------------------------------------------------------ + + ! Reinitialize error flag. Will be set to > 0 if error occurs, + ! and to -1 if negative scale factor is ignored. + error = 0 + + ! Loop over all latitudes and longitudes + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, tIdx, tmpVal, L )& + !$OMP PRIVATE( LowLL, UppLL, tmpLL, MaskScale, EC )& + !$OMP COLLAPSE( 2 )& + !$OMP SCHEDULE( DYNAMIC, 8 ) + DO J = 1, nJ + DO I = 1, nI + + ! Continue to end of loop if an error has occurred + ! (we cannot exit from a parallel loop) + IF ( error > 0 ) CYCLE + + !--------------------------------------------------------------- + ! If there is a mask associated with this scale factors, check + ! if this grid box is within or outside of the mask region. + ! Values that partially fall into the mask region are either + ! treated as binary (100% inside or outside), or partially + ! (using the real grid area fractions), depending on the + ! HEMCO options. + !--------------------------------------------------------------- + + ! Default mask scaling is 1.0 (no mask applied) + maskScale = 1.0_sp + + ! If there is a mask applied to this scale factor ... + IF ( isMaskDct ) THEN + CALL GetMaskVal ( MaskDct, I, J, & + MaskScale, MaskFractions, EC ) + IF ( EC /= HCO_SUCCESS ) THEN + error = 4 + CYCLE + ENDIF + ENDIF - ! Reinitialize error flag. Will be set to 1 or 2 if error occurs, - ! and to -1 if negative scale factor is ignored. - ERROR = 0 + ! We continue an skip this grid box if mask is completely zero + IF ( maskScale <= 0.0_sp ) CYCLE - !-------------------------------------------------------------------- - ! Loop over all latitudes and longitudes - !-------------------------------------------------------------------- - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED )& - !$OMP PRIVATE( I, J, tIdx, tmpVal, L )& - !$OMP PRIVATE( LowLL, UppLL, tmpLL, MaskScale, EC )& - !$OMP COLLAPSE( 2 )& - !$OMP SCHEDULE( DYNAMIC, 8 ) - DO J = 1, nJ - DO I = 1, nI + ! Get current time index for this container and at this location + tIDx = tIDx_GetIndx( HcoState, ScalDct%Dta, I, J ) + IF ( tIDx < 1 ) THEN + WRITE(*,*) 'Cannot get time slice index at location ',I,J, & + ': ', TRIM(ScalDct%cName), tIDx + error = 3 + CYCLE + ENDIF - ! Continue to end of loop if an error has occurred - ! (we cannot exit from a parallel loop) - IF ( ERROR > 0 ) CYCLE + !--------------------------------------------------------------- + ! Check if this is a mask. If so, add mask values to the MASK + ! array. For now, we assume masks to be binary, i.e. 0 or 1. + ! We may want to change that in future to also support values + ! in between. This is especially important when regridding + ! high resolution masks onto coarser grids! + !--------------------------------------------------------------- + IF ( ScalDct%DctType == HCO_DCTTYPE_MASK ) THEN + + ! Get mask value + CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, EC ) + IF ( EC /= HCO_SUCCESS ) THEN + error = 4 + CYCLE + ENDIF - ! ------------------------------------------------------------ - ! If there is a mask associated with this scale factors, check - ! if this grid box is within or outside of the mask region. - ! Values that partially fall into the mask region are either - ! treated as binary (100% inside or outside), or partially - ! (using the real grid area fractions), depending on the - ! HEMCO options. - ! ------------------------------------------------------------ + ! Pass to output mask + mask(I,J,:) = mask(I,J,:) * TMPVAL - ! Default mask scaling is 1.0 (no mask applied) - MaskScale = 1.0_sp + ! Verbose printout + IF ( HCO_IsVerb(HcoState%Config%Err) .and. & + I==1 .AND. J==1 ) THEN + msg = 'Mask field ' // TRIM( ScalDct%cName ) // & + ' found and added to temporary mask.' + CALL HCO_Msg( HcoState%Config%Err, msg ) + ENDIF - ! If there is a mask applied to this scale factor ... - IF ( isMaskDct ) THEN - CALL GetMaskVal ( MaskDct, I, J, MaskScale, MaskFractions, EC ) + ! Advance to next grid box + CYCLE + ENDIF + + !--------------------------------------------------------------- + ! For non-mask fields, apply scale factors to all levels + ! of the base field individually. If the scale factor + ! field has more than one vertical level, use the + ! vertical level closest to the corresponding vertical + ! level of the base emission field + !--------------------------------------------------------------- + + ! Get lower and upper vertical index + CALL GetVertIndx( HcoState, BaseDct, isLevDct1, & + LevDct1, LevDct1_Unit, isLevDct2, & + LevDct2, LevDct2_Unit, I, & + J, LowLL, UppLL, EC ) + + ! Trap errors IF ( EC /= HCO_SUCCESS ) THEN - ERROR = 4 + error = 1 CYCLE ENDIF - ENDIF - ! We can skip this grid box if mask is completely zero - IF ( MaskScale <= 0.0_sp ) CYCLE + ! Loop over all vertical levels of the base field + DO L = LowLL,UppLL - ! Get current time index for this container and at this location - tIDx = tIDx_GetIndx( HcoState, ScalDct%Dta, I, J ) - IF ( tIDx < 1 ) THEN - WRITE(*,*) 'Cannot get time slice index at location ',I,J,& - ': ', TRIM(ScalDct%cName), tIDx - ERROR = 3 - CYCLE - ENDIF + ! If the vertical level exceeds the number of available + ! scale factor levels, use the highest available level. + ! Otherwise use the same vertical level index. + TmpLL = L + IF ( L > ScalLL ) TmpLL = ScalLL - ! Check if this is a mask. If so, add mask values to the MASK - ! array. For now, we assume masks to be binary, i.e. 0 or 1. - ! We may want to change that in future to also support values - ! in between. This is especially important when regridding - ! high resolution masks onto coarser grids! - ! ------------------------------------------------------------ - IF ( ScalDct%DctType == HCO_DCTTYPE_MASK ) THEN + !------------------------------------------------------------ + ! Get scale factor for this grid box. Use same uniform + ! value if it's a scalar field. + !------------------------------------------------------------ + tmpVal = Get_Value_From_DataCont( I, J, L, tIdX, ScalDct ) - ! Get mask value - CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, EC ) - IF ( EC /= HCO_SUCCESS ) THEN - ERROR = 4 - CYCLE - ENDIF + ! Set missing value to one + IF ( tmpVal == HCO_MISSVAL ) tmpVal = 1.0_sp - ! Pass to output mask - MASK(I,J,:) = MASK(I,J,:) * TMPVAL + ! Eventually apply mask scaling + IF ( maskScale /= 1.0_sp ) THEN + tmpVal = tmpVal * MaskScale + ENDIF - ! testing only - IF ( HCO_IsVerb(HcoState%Config%Err) .AND. I==1 .AND. J==1 ) THEN - write(MSG,*) 'Mask field ', TRIM(ScalDct%cName), & - ' found and added to temporary mask.' + !------------------------------------------------------------ + ! Negative scale factors: proceed according to the "negative + ! value" setting specified in the HEMCO configuration file + ! NegFlag = 2: Use this value (i.e. pass thru this IF stmt) + ! NegFlag = 1: Ignore ands how warning + ! NegFlag = 0: Return with error + !------------------------------------------------------------ + IF ( tmpVal < 0.0_sp .and. HcoState%Options%NegFlag /= 2 ) THEN + + ! NegFlag = 1: ignore and show warning + ! Otherwise return with error + IF ( HcoState%Options%NegFlag == 1 ) THEN + error = -1 + CYCLE + ELSE + WRITE( 6, * ) 'Negative scale factor at ', & + I, J, TmpLL, tidx, ': ', & + TRIM(ScalDct%cName), TMPVAL + error = 1 + CYCLE + ENDIF + ENDIF + + !------------------------------------------------------------ + ! Apply scale factor in accordance to field operator + !------------------------------------------------------------ + CALL Apply_Scale_Factor( I = I, & + J = J, & + L = L, & + ScalDct = ScalDct, & + scalFac = tmpVal, & + dataVal = outArr_3D(I,J,L), & + RC = EC ) + + ! Trap errors + IF ( EC /= HCO_SUCCESS ) THEN + error = 2 + CYCLE + ENDIF + + ENDDO + + !--------------------------------------------------------------- + ! Verbose printout + !---------------------------------------------------------------- + IF ( HCO_IsVerb(HcoState%Config%Err) .and. & + I == ix .and. J == iy ) THEN + write(MSG,*) 'Scale field ', TRIM(ScalDct%cName) + CALL HCO_MSG(HcoState%Config%Err,MSG) + write(MSG,*) 'Time slice: ', tIdx + CALL HCO_MSG(HcoState%Config%Err,MSG) + write(MSG,*) 'IX, IY: ', IX, IY + CALL HCO_MSG(HcoState%Config%Err,MSG) + write(MSG,*) 'Scale factor (IX,IY,L1): ', TMPVAL + CALL HCO_MSG(HcoState%Config%Err,MSG) + write(MSG,*) 'Mathematical operation : ', ScalDct%Oper CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF - ! Advance to next grid box - CYCLE - ENDIF! DctType=MASK - - ! ------------------------------------------------------------ - ! For non-mask fields, apply scale factors to all levels - ! of the base field individually. If the scale factor - ! field has more than one vertical level, use the - ! vertical level closest to the corresponding vertical - ! level of the base emission field - ! ------------------------------------------------------------ + ENDDO !I + ENDDO !J + !$OMP END PARALLEL DO + + !------------------------------------------------------------------ + ! Return with error if an error was encountered in the loop above + !------------------------------------------------------------------ + IF ( error > 0 ) THEN + + ! Construct the appropriate error message + SELECT CASE( error ) + CASE( 1 ) + msg = 'Negative scale factor found (aborted): ' + CASE( 2 ) + msg = 'Illegal mathematical operator for scale factor: ' + CASE( 3 ) + msg = 'Encountered negative time index for scale factor: ' + CASE( 4 ) + msg = 'Error applying mask to scale factor: ' + CASE DEFAULT + msg = 'Error when applying scale factor: ' + END SELECT + + ! Append name of scale factor to error message + msg = TRIM( msg ) // TRIM( ScalDct%cName ) + + ! Exit with error message + ScalDct => NULL() + CALL HCO_Error( msg, RC, thisLoc ) + RETURN + ENDIF - ! Get lower and upper vertical index - CALL GetVertIndx( HcoState, BaseDct, isLevDct1, & - LevDct1, LevDct1_Unit, isLevDct2, & - LevDct2, LevDct2_Unit, I, & - J, LowLL, UppLL, & - RC=EC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 1 ! Will cause error - CYCLE + ! eventually prompt warning for negative values + IF ( ERROR == -1 ) THEN + msg = 'Negative scale factor found (ignored): ' // & + TRIM( ScalDct%cName ) + CALL HCO_WARNING( HcoState%Config%Err, msg, RC ) ENDIF - ! Loop over all vertical levels of the base field - DO L = LowLL,UppLL + ! Free pointer + MaskDct => NULL() - ! If the vertical level exceeds the number of available - ! scale factor levels, use the highest available level. - ! Otherwise use the same vertical level index. - TmpLL = L - IF ( L > ScalLL ) TmpLL = ScalLL + ENDDO ! N + ENDIF ! N > 0 - ! Get scale factor for this grid box. Use same uniform - ! value if it's a scalar field - tmpVal = Get_Value_From_DataCont( I, J, L, tIdX, ScalDct ) + !======================================================================== + ! Update optional variables + !======================================================================== + IF ( PRESENT( UseLL) ) THEN + UseLL = 1 + IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,4)/REAL(nnLL,4)) + ENDIF - ! Set missing value to one - IF ( TMPVAL == HCO_MISSVAL ) TMPVAL = 1.0_sp + ! Weight output emissions by mask + outArr_3D = outArr_3D * mask - ! Eventually apply mask scaling - IF ( MaskScale /= 1.0_sp ) THEN - TMPVAL = TMPVAL * MaskScale - ENDIF - - ! For negative scale factor, proceed according to the - ! negative value setting specified in the configuration - ! file (NegFlag = 2: use this value): - IF ( TMPVAL < 0.0_sp .AND. HcoState%Options%NegFlag /= 2 ) THEN - - ! NegFlag = 1: ignore and show warning - IF ( HcoState%Options%NegFlag == 1 ) THEN - ERROR = -1 ! Will prompt warning - CYCLE - - ! Return w/ error otherwise - ELSE - WRITE(*,*) 'Negative scale factor at ',I,J,TmpLL,tidx,& - ': ', TRIM(ScalDct%cName), TMPVAL - ERROR = 1 ! Will cause error - CYCLE - ENDIF - ENDIF - - ! ------------------------------------------------------- - ! Apply scale factor in accordance to field operator - ! ------------------------------------------------------- - CALL Apply_Scale_Factor( I = I, & - J = J, & - L = L, & - ScalDct = ScalDct, & - scalFac = tmpVal, & - dataVal = outArr_3D(I,J,L), & - RC = EC ) - - IF ( EC /= HCO_SUCCESS ) THEN - ERROR = 2 - CYCLE - ENDIF - - ENDDO - - ! Verbose mode - if ( HCO_IsVerb(HcoState%Config%Err) .and. i == ix .and. j == iy ) then - write(MSG,*) 'Scale field ', TRIM(ScalDct%cName) - CALL HCO_MSG(HcoState%Config%Err,MSG) - write(MSG,*) 'Time slice: ', tIdx - CALL HCO_MSG(HcoState%Config%Err,MSG) - write(MSG,*) 'IX, IY: ', IX, IY - CALL HCO_MSG(HcoState%Config%Err,MSG) - write(MSG,*) 'Scale factor (IX,IY,L1): ', TMPVAL - CALL HCO_MSG(HcoState%Config%Err,MSG) - write(MSG,*) 'Mathematical operation : ', ScalDct%Oper - CALL HCO_MSG(HcoState%Config%Err,MSG) -! write(lun,*) 'Updt (IX,IY,L1): ', OUTARR_3D(IX,IY,1) - endif - - ENDDO !I - ENDDO !J - !$OMP END PARALLEL DO - - ! error check - IF ( ERROR > 0 ) THEN - IF ( ERROR == 1 ) THEN - MSG = 'Negative scale factor found (aborted): ' // TRIM(ScalDct%cName) - ELSEIF ( ERROR == 2 ) THEN - MSG = 'Illegal mathematical operator for scale factor: ' // TRIM(ScalDct%cName) - ELSEIF ( ERROR == 3 ) THEN - MSG = 'Encountered negative time index for scale factor: ' // TRIM(ScalDct%cName) - ELSEIF ( ERROR == 3 ) THEN - MSG = 'Mask error in ' // TRIM(ScalDct%cName) - ELSE - MSG = 'Error when applying scale factor: ' // TRIM(ScalDct%cName) - ENDIF - ScalDct => NULL() - CALL HCO_ERROR( MSG, RC ) - RETURN - ENDIF - - ! eventually prompt warning for negative values - IF ( ERROR == -1 ) THEN - MSG = 'Negative scale factor found (ignored): ' // TRIM(ScalDct%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) - ENDIF - - ! Free pointer - MaskDct => NULL() - - ENDDO ! N - ENDIF ! N > 0 - - ! Update optional variables - IF ( PRESENT(UseLL) ) THEN - UseLL = 1 - IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,4)/REAL(nnLL,4)) - ENDIF - - ! Weight output emissions by mask - OUTARR_3D = OUTARR_3D * MASK - - ! Cleanup and leave w/ success - ScalDct => NULL() - CALL HCO_LEAVE ( HcoState%Config%Err, RC ) + ! Cleanup and leave w/ success + ScalDct => NULL() + CALL HCO_Leave( HcoState%Config%Err, RC ) END SUBROUTINE Get_Current_Emissions - - +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Get_Value_From_DataCont +! +! !DESCRIPTION: Returns a data value stored in a data container at a given +! grid box and time. +!\\ +!\\ +! !INTERFACE: +! FUNCTION Get_Value_From_DataCont( I, J, L, tIdx, Dct ) RESULT( dataVal ) - - INTEGER, INTENT(IN) :: I - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(IN) :: L - INTEGER, INTENT(IN) :: tIdx - TYPE(DataCont), POINTER :: Dct - - REAL(sp) :: dataVal +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: I ! Longitude (or X-dim) index + INTEGER, INTENT(IN) :: J ! Latitude (or Y-dim) index + INTEGER, INTENT(IN) :: L ! Vertical level index + INTEGER, INTENT(IN) :: tIdx ! Time index + TYPE(DataCont), POINTER :: Dct ! Data Container object +! +! !RETURN VALUE: +! + REAL(sp) :: dataVal ! Data at this grid box and time +! +! !REMARKS: +! This code was abstracted out of Get_Current_Emisssions for clarity. +! We have refactored the code to remove ELSE blocks for better efficiency. +!EOP +!------------------------------------------------------------------------------ +!BOC ! Data is a 1-D scaler: Return a uniform value IF ( Dct%Dta%SpaceDim == 1 ) THEN @@ -1390,10 +1461,10 @@ FUNCTION Get_Value_From_DataCont( I, J, L, tIdx, Dct ) RESULT( dataVal ) dataVal = Dct%Dta%V2(tIDx)%Val(I,J) RETURN ENDIF - + ! Data is a 3-D array: Return value at (I,J,L) dataVal = Dct%Dta%V3(tIDx)%Val(I,J,L) - + END FUNCTION Get_Value_From_DataCont !EOC !------------------------------------------------------------------------------ @@ -1419,7 +1490,7 @@ SUBROUTINE Apply_Dilution_Factor( I, J, L, LowLL, & USE HCO_Error_Mod USE HCO_State_Mod, ONLY : HCO_State ! -! !INPUT PARAMETERS: +! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: I ! Longitude (or X-dim) index INTEGER, INTENT(IN) :: J ! Latitude (or Y-dim) index @@ -1438,6 +1509,10 @@ SUBROUTINE Apply_Dilution_Factor( I, J, L, LowLL, & ! INTEGER, INTENT(OUT) :: RC ! Success or failure ! +! +! !REMARKS: +! This code was abstracted out of Get_Current_Emisssions for clarity. We +! have also refactored the code to remove ELSE blocks for better efficiency. !EOP !------------------------------------------------------------------------------ !BOC @@ -1525,7 +1600,7 @@ SUBROUTINE Apply_Scale_Factor( I, J, L, ScalDct, scalFac, dataVal, RC ) ! USE HCO_Error_Mod ! -! !INPUT PARAMETERS: +! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: I ! Longitude (or X-dim) index INTEGER, INTENT(IN) :: J ! Latitude (or Y-dim) index @@ -1533,34 +1608,46 @@ SUBROUTINE Apply_Scale_Factor( I, J, L, ScalDct, scalFac, dataVal, RC ) TYPE(DataCont), POINTER :: ScalDct ! Scale Factor data container REAL(sp), INTENT(IN) :: scalFac ! Scale factor ! -! !INPUT/OUTPUT PARAMETERS: +! !INPUT/OUTPUT PARAMETERS: ! REAL(hp), INTENT(INOUT) :: dataVal ! Data to be scaled ! -! !OUTPUT PARAMETERS: +! !OUTPUT PARAMETERS: ! INTEGER, INTENT(OUT) :: RC ! Success or failure ! +! !REMARKS: +! This code was abstracted out of Get_Current_Emisssions for clarity. We +! have also refactored the code to remove ELSE blocks for better efficiency. !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! - !======================================================================= + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc + + !======================================================================== ! Apply_Scale_Factor begins here! - !======================================================================= + !======================================================================== ! Initialize - RC = HCO_SUCCESS + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'Apply_Scale_Factor (src/Core/hco_calc_mod.F90)' - ! Oper 1: multiply + !------------------------------------------------------------------------ + ! Operation = 1: multiply + !------------------------------------------------------------------------ IF ( ScalDct%Oper == 1 ) THEN dataVal = dataVal * scalFac RETURN ENDIF - - ! Oper -1: divide + + !------------------------------------------------------------------------ + ! Operation = -1: divide + !------------------------------------------------------------------------ IF ( ScalDct%Oper == -1 ) THEN IF ( scalFac /= 0.0_sp ) THEN dataVal = dataVal / scalFac @@ -1568,430 +1655,23 @@ SUBROUTINE Apply_Scale_Factor( I, J, L, ScalDct, scalFac, dataVal, RC ) RETURN ENDIF - ! Oper 2: square + !------------------------------------------------------------------------ + ! Operation = 2: square + !------------------------------------------------------------------------ IF ( ScalDct%Oper == 2 ) THEN dataVal = dataVal * scalFac * scalFac RETURN ENDIF - - ! Return w/ error otherwise (Oper 3 is only allowed for masks!) - WRITE(*,*) 'Illegal operator for ', & - TRIM(ScalDct%cName), ScalDct%Oper - RC = 2 ! Will cause error - - END SUBROUTINE Apply_Scale_Factor -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Get_Current_Emissions_b (NOT USED!!) -! -! !DESCRIPTION: Subroutine Get\_Current\_Emissions\_B calculates the current -! emissions for the specified emission field and passes the result to -! OUTARR\_3D. -!\\ -!\\ -! This subroutine is only called by HCO\_CalcEmis and for fields with a valid -! species ID, i.e. for base emission fields. -! -! !!! WARNING: this routine is not actively developed any more and may lag -! !!! behind Get\_Current\_Emissions -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, & - nI, nJ, nL, OUTARR_3D, MASK, RC ) -! -! !USES: -! - USE HCO_STATE_MOD, ONLY : HCO_State - USE HCO_TIDX_MOD, ONLY : tIDx_GetIndx - USE HCO_FILEDATA_MOD, ONLY : FileData_ArrIsDefined -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: nI ! # of lons - INTEGER, INTENT(IN) :: nJ ! # of lats - INTEGER, INTENT(IN) :: nL ! # of levs -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object - TYPE(DataCont), POINTER :: BaseDct ! base emission - ! container - REAL(hp), INTENT(INOUT) :: OUTARR_3D(nI,nJ,nL) ! output array - REAL(hp), INTENT(INOUT) :: MASK (nI,nJ,nL) ! mask array - INTEGER, INTENT(INOUT) :: RC -! -! !REVISION HISTORY: -! 25 Aug 2012 - C. Keller - Initial Version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Pointers - TYPE(DataCont), POINTER :: ScalDct - TYPE(DataCont), POINTER :: MaskDct - REAL(sp) :: TMPVAL, MaskScale - INTEGER :: tIdx, IDX - INTEGER :: I, J, L, N - INTEGER :: LowLL, UppLL, ScalLL, TmpLL - INTEGER :: IJFILLED - INTEGER :: ERROR - CHARACTER(LEN=255) :: MSG, LOC - LOGICAL :: MaskFractions - - ! testing only - INTEGER :: IX, IY - LOGICAL :: verb - - !================================================================= - ! GET_CURRENT_EMISSIONS_B begins here - !================================================================= - - ! Initialize - ScalDct => NULL() - MaskDct => NULL() - LOC = 'GET_CURRENT_EMISSIONS_B (HCO_CALC_MOD.F90)' - - ! Enter - CALL HCO_ENTER(HcoState%Config%Err, LOC, RC ) - IF(RC /= HCO_SUCCESS) RETURN - - ! testing only - verb = HCO_IsVerb(HcoState%Config%Err) - IX = 60 !40 !19 43 61 - IY = 32 !36 !33 26 37 - - ! Check if field data is defined - IF ( .NOT. FileData_ArrIsDefined(BaseDct%Dta) ) THEN - MSG = 'Array not defined: ' // TRIM(BaseDct%cName) - CALL HCO_ERROR( MSG, RC ) - RETURN - ENDIF - - ! Testing only: - IF ( verb ) THEN - write(MSG,*) '--> GET EMISSIONS FOR ', TRIM(BaseDct%cName) - CALL HCO_MSG(HcoState%Config%Err,MSG) - ENDIF - - ! Initialize mask values - MASK(:,:,:) = 1.0_hp - MaskFractions = HcoState%Options%MaskFractions - - ! Initialize ERROR. Will be set to 1 if error occurs below - ERROR = 0 - - ! Loop over all grid boxes - !$OMP PARALLEL DO & - !$OMP DEFAULT( SHARED )& - !$OMP PRIVATE( I, J, LowLL, UppLL, tIdx, IJFILLED, L )& - !$OMP PRIVATE( TMPVAL, N, IDX, ScalDct, ScalLL, tmpLL, MaskScale )& - !$OMP COLLAPSE( 2 )& - !$OMP SCHEDULE( DYNAMIC, 8 ) - DO J = 1, nJ - DO I = 1, nI - - ! Continue to end of loop if an error has occurred - ! (we cannot exit from a parallel loop) - IF ( ERROR > 0 ) CYCLE - - ! ------------------------------------------------------------- - ! Set base emissions - ! ------------------------------------------------------------- - - ! Get vertical extension of base emission array. - ! Unlike the output array OUTARR_3D, the data containers do not - ! necessarily extent over the entire troposphere but only cover - ! the effectively filled vertical levels. For most inventories, - ! this is only the first model level. - LowLL = 1 - UppLL = 1 - IF ( BaseDct%Dta%SpaceDim == 3 ) THEN - UppLL = SIZE( BaseDct%Dta%V3(1)%Val, 3 ) - ENDIF - - ! Precalculate timeslice index. The data containers can - ! carry 2D/3D arrays for multiple time steps (i.e. for - ! every hour of the day), stored in a vector. - ! tIdxVec contains the vector index to be used at the current - ! datetime. This parameter may vary with longitude due to time - ! zone shifts! - tIDx = tIDx_GetIndx( HcoState, BaseDct%Dta, I, J ) - IF ( tIDx < 0 ) THEN - write(MSG,*) 'Cannot get time slice index at location ',I,J,& - ': ', TRIM(BaseDct%cName) - ERROR = 3 - CYCLE - ENDIF - - ! # of levels w/ defined emissions - IJFILLED = 0 - - ! Loop over all levels - DO L = LowLL, UppLL - - ! Get base value. Use uniform value if scalar field. - IF ( BaseDct%Dta%SpaceDim == 1 ) THEN - TMPVAL = BaseDct%Dta%V2(tIDx)%Val(1,1) - ELSEIF ( BaseDct%Dta%SpaceDim == 2 ) THEN - TMPVAL = BaseDct%Dta%V2(tIDx)%Val(I,J) - ELSE - TMPVAL = BaseDct%Dta%V3(tIDx)%Val(I,J,L) - ENDIF - - ! Check for missing value - IF ( TMPVAL == HCO_MISSVAL ) THEN - OUTARR_3D(I,J,L) = 0.0_hp - MASK(I,J,:) = 0.0_hp - - ! Pass base value to output array - ELSE - OUTARR_3D(I,J,L) = TMPVAL - ENDIF - - ! Update IJFILLED - IJFILLED = IJFILLED + 1 - - ENDDO !L - - ! ------------------------------------------------------------- - ! Apply scale factors - ! The container IDs of all scale factors associated with this base - ! container are stored in vector Scal_cID. - ! ------------------------------------------------------------- - - ! Loop over maximum number of scale factors - IF ( BaseDct%nScalID > 0 ) THEN - DO N = 1, BaseDct%nScalID - - ! Get the scale factor container ID for the current slot - IDX = BaseDct%Scal_cID(N) - - ! Point to emission container with the given container ID - CALL Pnt2DataCont( HcoState, IDX, ScalDct, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 4 - CYCLE - ENDIF - - ! Scale field cannot be a base field - IF ( (ScalDct%DctType == HCO_DCTTYPE_BASE) ) THEN - ERROR = 4 - CYCLE - ENDIF - - ! Skip this scale factor if no data defined. This is possible - ! if scale factors are only defined for a given time range and - ! the simulation datetime is outside of this range. - IF ( .NOT. FileData_ArrIsDefined(ScalDct%Dta) ) THEN - MSG = 'Array not defined: ' // TRIM(ScalDct%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) - CYCLE - ENDIF - - ! Check if there is a mask field associated with this scale - ! factor. In this case, get a pointer to the corresponding - ! mask field and evaluate scale factors only inside the mask - ! region. - IF ( ASSOCIATED(ScalDct%Scal_cID) ) THEN - CALL Pnt2DataCont( HcoState, ScalDct%Scal_cID(1), MaskDct, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 5 - EXIT - ENDIF - - ! Must be mask field - IF ( MaskDct%DctType /= HCO_DCTTYPE_MASK ) THEN - MSG = 'Invalid mask for scale factor: '//TRIM(ScalDct%cName) - MSG = TRIM(MSG) // '; mask: '//TRIM(MaskDct%cName) - CALL HCO_ERROR( MSG, RC ) - ERROR = 5 - CYCLE - ENDIF - - ! Get mask value - CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 6 - CYCLE - ENDIF - - ENDIF - - ! Get vertical extension of this scale factor array. - ScalLL = 1 - IF ( ScalDct%Dta%SpaceDim == 3 ) THEN - ScalLL = SIZE( ScalDct%Dta%V3(1)%Val, 3 ) - ENDIF - - ! Get current time index - tIDx = tIDx_GetIndx( HcoState, ScalDct%Dta, I, J ) - IF ( tIDx < 0 ) THEN - write(MSG,*) 'Cannot get time slice index at location ',I,J,& - ': ', TRIM(ScalDct%cName) - ERROR = 3 - CYCLE - ENDIF - - ! ------------------------------------------------------------ - ! Check if this is a mask. If so, add mask values to the MASK - ! array. For now, we assume masks to be binary, i.e. 0 or 1. - ! We may want to change that in future to also support values - ! in between. This is especially important when regridding - ! high resolution masks onto coarser grids! - ! ------------------------------------------------------------ - IF ( ScalDct%DctType == HCO_DCTTYPE_MASK ) THEN - - ! Get mask value - CALL GetMaskVal( ScalDct, I, J, TMPVAL, MaskFractions, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 6 - EXIT - ENDIF - - ! Pass to mask - MASK(I,J,:) = MASK(I,J,:) * TMPVAL - - ! testing only - if ( verb .and. i == ix .and. j == iy ) then - write(*,*) 'Mask field ', TRIM(ScalDct%cName), & - ' found and added to temporary mask.' - ENDIF - - ! Advance to next scale factor - CYCLE - ENDIF! DctType=MASK - - ! ------------------------------------------------------------ - ! For non-mask fields, apply scale factors to all levels - ! of the base field individually. If the scale factor - ! field has more than one vertical level, use the - ! vertical level closest to the corresponding vertical - ! level in the base emission field - ! ------------------------------------------------------------ - - ! Loop over all vertical levels of the base field - DO L = LowLL,UppLL - - ! If the vertical level exceeds the number of available - ! scale factor levels, use the highest available level. - ! Otherwise use the same vertical level index. - TmpLL = L - IF ( L > ScalLL ) TmpLL = ScalLL - - ! Get scale factor for this grid box. Use same uniform - ! value if it's a scalar field - IF ( ScalDct%Dta%SpaceDim == 1 ) THEN - TMPVAL = ScalDct%Dta%V2(tidx)%Val(1,1) - ELSEIF ( ScalDct%Dta%SpaceDim == 2 ) THEN - TMPVAL = ScalDct%Dta%V2(tidx)%Val(I,J) - ELSE - TMPVAL = ScalDct%Dta%V3(tidx)%Val(I,J,TmpLL) - ENDIF - - ! Check for missing value - IF ( TMPVAL == HCO_MISSVAL ) TMPVAL = 1.0_sp - - ! For negative scale factor, proceed according to the - ! negative value setting specified in the configuration - ! file (NegFlag = 2: use this value): - IF ( TMPVAL < 0.0_sp .AND. HcoState%Options%NegFlag /= 2 ) THEN - - ! NegFlag = 1: ignore and show warning - IF ( HcoState%Options%NegFlag == 1 ) THEN - ERROR = -1 ! Will prompt warning - CYCLE - - ! Return w/ error otherwise - ELSE - WRITE(*,*) 'Negative scale factor at ',I,J,TmpLL,tidx,& - ': ', TRIM(ScalDct%cName), TMPVAL - ERROR = 1 ! Will cause error - CYCLE - ENDIF - ENDIF - - ! ------------------------------------------------------- - ! Apply scale factor according to field operator - ! ------------------------------------------------------- - - ! Oper 1: multiply - IF ( ScalDct%Oper == 1 ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) * TMPVAL - - ! Oper -1: divide - ELSEIF ( ScalDct%Oper == -1 ) THEN - ! Ignore zeros to avoid NaN - IF ( TMPVAL /= 0.0_sp ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) / TMPVAL - ENDIF - - ! Oper 2: square - ELSEIF ( ScalDct%Oper == 2 ) THEN - OUTARR_3D(I,J,L) = OUTARR_3D(I,J,L) * TMPVAL * TMPVAL - - ! Return w/ error otherwise (Oper 3 only allowed for masks!) - ELSE - MSG = 'Illegal data operator: ' // TRIM(ScalDct%cName) - CALL HCO_ERROR( MSG, RC ) - ERROR = 2 - CYCLE - ENDIF - ENDDO !LL - ENDDO ! N - ENDIF ! N > 0 - - ! ---------------------------- - ! Masks - ! ---------------------------- - - ! Apply the mask. Make sure that emissions become negative - ! outside the mask region. This is to make sure that these - ! grid boxes will be ignored when calculating the final - ! emissions. - WHERE ( MASK(I,J,:) == 0 ) - OUTARR_3D(I,J,:) = 0.0_hp - ENDWHERE - - ENDDO !I - ENDDO !J - !$OMP END PARALLEL DO - - ! Error check - IF ( ERROR > 0 ) THEN - IF ( ERROR == 1 ) THEN - MSG = 'Negative scale factor found (aborted): ' // TRIM(ScalDct%cName) - ELSEIF ( ERROR == 2 ) THEN - MSG = 'Illegal mathematical operator for scale factor: ' // TRIM(ScalDct%cName) - ELSEIF ( ERROR == 3 ) THEN - MSG = 'Encountered negative time index for scale factor: ' // TRIM(ScalDct%cName) - ELSE - MSG = 'Error when applying scale factor: ' // TRIM(ScalDct%cName) - ENDIF - CALL HCO_ERROR( MSG, RC ) - ScalDct => NULL() - RETURN - ENDIF - ! eventually prompt warning for negative values - IF ( ERROR == -1 ) THEN - MSG = 'Negative scale factor found (ignored): ' // TRIM(ScalDct%cName) - CALL HCO_WARNING( HcoState%Config%Err, MSG, RC ) - ENDIF - - ! Leave - ScalDct => NULL() - CALL HCO_LEAVE ( HcoState%Config%Err, RC ) + !------------------------------------------------------------------------ + ! Return w/ error otherwise (Oper 3 is only allowed for masks!) + !------------------------------------------------------------------------ + WRITE( errMsg, * ) 'Illegal operator for: ', TRIM( ScalDct%cName ), & + ' operation: ', ScalDct%Oper + CALL HCO_Error( ErrMsg, RC, thisLoc ) + RC = 2 - END SUBROUTINE Get_Current_Emissions_B + END SUBROUTINE Apply_Scale_Factor !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! From abaff9a92d9f2ea9c960a985f128396c175acb5c Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 14 Mar 2023 15:47:30 -0400 Subject: [PATCH 26/63] Updated CHANGELOG.md to note removal of computational bottlenecks CHANGELOG.md - Added a sentence about the removal of computational bottlenecks from hco_calc_mod.F90 (PR #201) Signed-off-by: Bob Yantosca --- CHANGELOG.md | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2b0e2923..ffd023de 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,17 +7,18 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased 3.7.0] ### Added - - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. - - Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts +- HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. + - Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts ### Changed - - `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - - HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) +- `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` +- HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) +- Refactored `hco_calc_mod.F90` to avoid computational bottlenecks (PR #201) ### Removed - - Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - - Removed the `src/Shared/NcdfUtil/perl` folder - +- Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` +- Removed the `src/Shared/NcdfUtil/perl` folder + ## [3.6.2] - 2023-03-02 ### Added - Added `.github/config.yml` with settings for the issue chooser page From 698d1a5c097410249b176b148ba0654b855a48fa Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 22 Mar 2023 15:31:28 -0400 Subject: [PATCH 27/63] Write HEMCO restart file to the rundir Restarts folder src/Core/hcoio_diagn_mod.F90 - Replace placeholder error messages with actual error messages - Cosmetic changes src/Core/hcoio_write_std_mod.F90 - In HCOIO_Write, we now write restart files (COL==2) to the rundir Restarts/ folder. Signed-off-by: Bob Yantosca --- src/Core/hcoio_diagn_mod.F90 | 53 ++++++++++++++++++++------------ src/Core/hcoio_write_std_mod.F90 | 11 +++++-- 2 files changed, 41 insertions(+), 23 deletions(-) diff --git a/src/Core/hcoio_diagn_mod.F90 b/src/Core/hcoio_diagn_mod.F90 index f9943235..5ac2af2c 100644 --- a/src/Core/hcoio_diagn_mod.F90 +++ b/src/Core/hcoio_diagn_mod.F90 @@ -236,39 +236,52 @@ SUBROUTINE HCOIO_Diagn_WriteOut( HcoState, ForceWrite, & ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255), PARAMETER :: LOC = 'HCOIO_DIAGN_WRITEOUT (hcoio_diagn_mod.F90)' + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !================================================================= ! HCOIO_DIAGN_WRITEOUT begins here! !================================================================= + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCOIO_DIAGN_WRITEOUT (src/Core/hcoio_diagn_mod.F90)' + + #if defined(ESMF_) - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! ESMF environment: call ESMF output routines - !----------------------------------------------------------------- - CALL HCOIO_Write ( HcoState, & - RC, & - OnlyIfFirst=OnlyIfFirst, & - COL=COL ) + !------------------------------------------------------------------------ + CALL HCOIO_Write( HcoState, & + RC, & + OnlyIfFirst = OnlyIfFirst, & + COL = COL ) + + ! Trap errors IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in routine "HCOIO_Write"!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF #else - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! Standard environment: call default output routines - !----------------------------------------------------------------- - CALL HCOIO_Write ( HcoState, & - ForceWrite, & - RC, & - PREFIX =PREFIX, & - UsePrevTime =UsePrevTime, & - OnlyIfFirst =OnlyIfFirst, & - COL = COL ) + !------------------------------------------------------------------------ + CALL HCOIO_Write( HcoState, & + ForceWrite, & + RC, & + PREFIX = PREFIX, & + UsePrevTime = UsePrevTime, & + OnlyIfFirst = OnlyIfFirst, & + COL = COL ) + + ! Trap errors IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in routine "HCOIO_Write"!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF #endif diff --git a/src/Core/hcoio_write_std_mod.F90 b/src/Core/hcoio_write_std_mod.F90 index 071ba429..5119f8d0 100644 --- a/src/Core/hcoio_write_std_mod.F90 +++ b/src/Core/hcoio_write_std_mod.F90 @@ -82,9 +82,9 @@ MODULE HCOIO_Write_Mod !\\ ! !INTERFACE: ! - SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, & - RC, PREFIX, UsePrevTime, & - OnlyIfFirst, COL ) + SUBROUTINE HCOIO_Write( HcoState, ForceWrite, & + RC, PREFIX, UsePrevTime, & + OnlyIfFirst, COL ) ! ! !USES: ! @@ -321,6 +321,11 @@ SUBROUTINE HCOIO_Write ( HcoState, ForceWrite, & ENDIF ncFile = TRIM(Pfx)//'.'//Yrs//Mts//Dys//hrs//mns//'.nc' + ! Place HEMCO restart files in the Restarts folder of the run directory + IF ( PS == HcoState%Diagn%HcoDiagnIDRestart ) THEN + ncFile = 'Restarts/' // TRIM( ncFile ) + ENDIF + ! Multiple time slice update. Comment out for now since it causes ! timestamping the filename twice (ewl, 10/19/18) ! Add default time stamp if no time tokens are in the file template. From 582ff96076be181d77fe73eebe668ab13e676a8a Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 22 Mar 2023 15:47:32 -0400 Subject: [PATCH 28/63] Create "Restarts/" folder in HEMCO standalone rundirs run/createRunDir.sh - Create a Restarts folder in the rundir, where HEMCO restart files will be stored. CHANGELOG.md - Updated accordingly Signed-off-by: Bob Yantosca --- CHANGELOG.md | 2 ++ run/createRunDir.sh | 1 + 2 files changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4506291f..58f35701 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -15,6 +15,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` - HEMCO warnings are now only generated when `Verbose: true` is found in the HEMCO configuration file (no more numerical levels) - Updated GFED4 emission factors for VOCs to Andreae et al. (2019) + - Restart files are now written to the rundir `Restarts/` subdirectory + - Create a `Restarts/` subdirectory in HEMCO standalone run directories ### Removed - Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` diff --git a/run/createRunDir.sh b/run/createRunDir.sh index ff1793c5..692c358f 100755 --- a/run/createRunDir.sh +++ b/run/createRunDir.sh @@ -294,6 +294,7 @@ mkdir -p ${rundir} # Copy run directory files and subdirectories cp -r ./OutputDir ${rundir} +cp -r ./OutputDir ${rundir}/Restarts cp ./HEMCO_sa_Config.template ${rundir}/HEMCO_sa_Config.rc cp ./HEMCO_sa_Time.rc ${rundir} cp ./HEMCO_sa_Spec.rc ${rundir} From ff5adb9fa71274165c174b469f9c45d7442c0a68 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 31 Mar 2023 09:19:17 -0400 Subject: [PATCH 29/63] Use mkdir -p to create the HEMCO standalone rundir Restarts folder run/createRunDir.sh - Now use mkdir -p ${rundir}/Restarts to make the Restarts folder in the HEMCO standalone rundir. This is now consistent with the rundir script in GCClassic. Signed-off-by: Bob Yantosca --- run/createRunDir.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/run/createRunDir.sh b/run/createRunDir.sh index 692c358f..8035a1f9 100755 --- a/run/createRunDir.sh +++ b/run/createRunDir.sh @@ -294,7 +294,7 @@ mkdir -p ${rundir} # Copy run directory files and subdirectories cp -r ./OutputDir ${rundir} -cp -r ./OutputDir ${rundir}/Restarts +mkdir -p ${rundir}/Restarts cp ./HEMCO_sa_Config.template ${rundir}/HEMCO_sa_Config.rc cp ./HEMCO_sa_Time.rc ${rundir} cp ./HEMCO_sa_Spec.rc ${rundir} From 673ef2aab590559cea47edee70cfb35ecf8ef081 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 11 Apr 2023 12:46:34 -0400 Subject: [PATCH 30/63] Bug fix: Also allow ".$NC" in a mask file name not to throw an error src/Core/hco_config_mod.F90 - Update the IF statement so that we allow mask files ending in the token ".$NC" to be read from disk (and not marked a mask specification of a rectangular region with no associated file). This prevents an error when reading the ocean mask for Transport Tracers simulations. Signed-off-by: Bob Yantosca --- src/Core/hco_config_mod.F90 | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 09f37bef..42db1a15 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -2423,9 +2423,15 @@ SUBROUTINE RegisterPrepare( HcoState, RC ) ! IsLocTime flag to TRUE. This should fix Github issue ! https://github.com/geoschem/HEMCO/issues/153. ! -- Bob Yantosca (12 Jul 2022) - IF ( INDEX( Lct%Dct%Dta%ncFile, ".nc" ) == 0 ) THEN - Lct%Dct%Dta%ncRead = .FALSE. - Lct%Dct%Dta%IsLocTime = .TRUE. + ! + ! Also allow for the .$NC replaceable token, see: + ! https://github.com/geoschem/HEMCO/issues/204 + ! -- Melissa Sulprizio & Bob Yantosca (11 Apr 2023) + IF ( INDEX( Lct%Dct%Dta%ncFile, ".nc" ) == 0 ) THEN + IF ( INDEX( Lct%Dct%Dta%ncFile, ".$NC" ) == 0 ) THEN + Lct%Dct%Dta%ncRead = .FALSE. + Lct%Dct%Dta%IsLocTime = .TRUE. + ENDIF ENDIF ThisCover = CALC_COVERAGE( lon1, lon2, lat1, lat2, & From 80e898e7d7f55a71f85508307ff8c827cb0713a9 Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Thu, 13 Apr 2023 20:58:14 -0400 Subject: [PATCH 31/63] Increase the string length for reading lines from HEMCO standalone grid file In order to run the HEMCO standalone with the 0.25x0.3125 global grid (defined in run/HEMCO_sa_Grid.025x03125.rc), the line length for reading YEDGE and YMID must be increased. Previously, it was LEN=4095 when the length of YEDGE is 5341 and YMID is 4616. To prevent errors when reading the HEMCO standalone grid file and defining the grid in routine Set_Grid, the length of DUM has been increased to 5500. This addresses https://github.com/geoschem/HEMCO/issues/206. Signed-off-by: Melissa Sulprizio --- src/Core/hco_chartools_mod.F90 | 4 ++-- src/Interfaces/Standalone/hcoi_standalone_mod.F90 | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Core/hco_chartools_mod.F90 b/src/Core/hco_chartools_mod.F90 index 19909214..89a0fd71 100644 --- a/src/Core/hco_chartools_mod.F90 +++ b/src/Core/hco_chartools_mod.F90 @@ -870,7 +870,7 @@ SUBROUTINE GetNextLine( LUN, LINE, EOF, RC ) ! LOCAL VARIABLES: ! INTEGER :: IOS - CHARACTER(LEN=4095) :: DUM + CHARACTER(LEN=5500) :: DUM !================================================================= ! GetNextLine begins here @@ -952,7 +952,7 @@ SUBROUTINE HCO_ReadLine( LUN, LINE, EOF, RC ) ! INTEGER :: IOS, C CHARACTER(LEN=255) :: MSG - CHARACTER(LEN=4095) :: DUM + CHARACTER(LEN=5500) :: DUM !================================================================= ! HCO_ReadLine begins here! diff --git a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 index c1e3941b..1d5085fb 100644 --- a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 +++ b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 @@ -1057,7 +1057,8 @@ SUBROUTINE Set_Grid( HcoState, RC ) CHARACTER(LEN=255) :: LOC CHARACTER(LEN= 1) :: COL CHARACTER(LEN=255) :: MyGridFile, ThisLoc - CHARACTER(LEN=4095) :: DUM, ErrMsg, Msg + CHARACTER(LEN=5500) :: DUM + CHARACTER(LEN=255) :: ErrMsg, Msg !================================================================= ! SET_GRID begins here From 98adbe2c54577b8e6f064370646d187720df905f Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Fri, 14 Apr 2023 12:10:39 -0400 Subject: [PATCH 32/63] Update CHANGELOG.md Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4bc010a3..2bbc0e8a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -22,6 +22,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Do not read masks if the filename is `-` (non-ESMF environments only) - Always assume partial coverage when reading masks in an ESMF environment (#163) +- Increased the string length for reading lines from HEMCO grid file to fix error in global 0.25x0.3125 standalone simulations ### Removed - Warnings is now removed from `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` From 56977ec350e82dfa03dc6db57d71fba81df949eb Mon Sep 17 00:00:00 2001 From: Melissa Sulprizio Date: Thu, 25 May 2023 12:40:50 -0400 Subject: [PATCH 33/63] Update tracer names in RnPbBe extension The Be7Strat and Be10Strat tracers are renamed to Be7s and Be10s for consistency with GMAO's tracer gridded component (TR_GridComp). These changes are also made in GEOS-Chem in the feature/update-transport-tracers branch. Signed-off-by: Melissa Sulprizio --- CHANGELOG.md | 3 +- src/Extensions/hcox_gc_RnPbBe_mod.F90 | 82 +++++++++++++-------------- 2 files changed, 43 insertions(+), 42 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2bbc0e8a..aad28b7e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -17,7 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Updated GFED4 emission factors for VOCs to Andreae et al. (2019) - Refactored `hco_calc_mod.F90` to avoid computational bottlenecks (PR #201) - Restart files are now written to the rundir `Restarts/` subdirectory -- Create a `Restarts/` subdirectory in HEMCO standalone run directories +- Created a `Restarts/` subdirectory in HEMCO standalone run directories +- Renamed Be7Strat and Be10Strat to Be7s and Be10s for consistency with GMAO's TR_GridComp ### Fixed - Do not read masks if the filename is `-` (non-ESMF environments only) diff --git a/src/Extensions/hcox_gc_RnPbBe_mod.F90 b/src/Extensions/hcox_gc_RnPbBe_mod.F90 index 36cd5983..8e8c7af3 100644 --- a/src/Extensions/hcox_gc_RnPbBe_mod.F90 +++ b/src/Extensions/hcox_gc_RnPbBe_mod.F90 @@ -75,16 +75,16 @@ MODULE HCOX_GC_RnPbBe_Mod INTEGER :: ExtNrZhang ! ZHANG_Rn222 extension number INTEGER :: IDTRn222 ! Index # for Rn222 INTEGER :: IDTBe7 ! Index # for Be7 - INTEGER :: IDTBe7Strat ! Index # for Be7Strat + INTEGER :: IDTBe7s ! Index # for Be7s INTEGER :: IDTBe10 ! Index # for Be10 - INTEGER :: IDTBe10Strat ! Index # for Be10Strat + INTEGER :: IDTBe10s ! Index # for Be10s ! For tracking Rn222, Be7, and Be10 emissions - REAL(hp), POINTER :: EmissRn222 (:,: ) - REAL(hp), POINTER :: EmissBe7 (:,:,:) - REAL(hp), POINTER :: EmissBe7Strat (:,:,:) - REAL(hp), POINTER :: EmissBe10 (:,:,:) - REAL(hp), POINTER :: EmissBe10Strat(:,:,:) + REAL(hp), POINTER :: EmissRn222(:,: ) + REAL(hp), POINTER :: EmissBe7 (:,:,:) + REAL(hp), POINTER :: EmissBe7s (:,:,:) + REAL(hp), POINTER :: EmissBe10 (:,:,:) + REAL(hp), POINTER :: EmissBe10s(:,:,:) ! For Lal & Peters 7Be emissions input data REAL(hp), POINTER :: LATSOU(: ) ! Array for latitudes @@ -421,18 +421,18 @@ SUBROUTINE HCOX_Gc_RnPbBe_Run( ExtState, HcoState, RC ) Inst%EmissBe7 (I,J,L) = ADD_Be7 Inst%EmissBe10(I,J,L) = ADD_Be10 IF ( L > ExtState%TropLev%Arr%Val(I,J) ) THEN - IF ( Inst%IDTBe7Strat > 0 ) THEN - Inst%EmissBe7Strat (I,J,L) = Add_Be7 + IF ( Inst%IDTBe7s > 0 ) THEN + Inst%EmissBe7s (I,J,L) = Add_Be7 ENDIF - IF ( Inst%IDTBe10Strat > 0 ) THEN - Inst%EmissBe10Strat(I,J,L) = Add_Be10 + IF ( Inst%IDTBe10s > 0 ) THEN + Inst%EmissBe10s(I,J,L) = Add_Be10 ENDIF ELSE - IF ( Inst%IDTBe7Strat > 0 ) THEN - Inst%EmissBe7Strat (I,J,L) = 0d0 + IF ( Inst%IDTBe7s > 0 ) THEN + Inst%EmissBe7s (I,J,L) = 0d0 ENDIF - IF ( Inst%IDTBe10Strat > 0 ) THEN - Inst%EmissBe10Strat(I,J,L) = 0d0 + IF ( Inst%IDTBe10s > 0 ) THEN + Inst%EmissBe10s(I,J,L) = 0d0 ENDIF ENDIF @@ -459,14 +459,14 @@ SUBROUTINE HCOX_Gc_RnPbBe_Run( ExtState, HcoState, RC ) ENDIF ! Add emissions - IF ( Inst%IDTBe7Strat > 0 ) THEN - Arr3D => Inst%EmissBe7Strat(:,:,:) - CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe7Strat, & + IF ( Inst%IDTBe7s > 0 ) THEN + Arr3D => Inst%EmissBe7s(:,:,:) + CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe7s, & RC, ExtNr=Inst%ExtNr ) Arr3D => NULL() IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( & - 'HCO_EmisAdd error: EmissBe7Strat', RC ) + 'HCO_EmisAdd error: EmissBe7s', RC ) RETURN ENDIF ENDIF @@ -485,14 +485,14 @@ SUBROUTINE HCOX_Gc_RnPbBe_Run( ExtState, HcoState, RC ) ENDIF ! Add emissions - IF ( Inst%IDTBe10Strat > 0 ) THEN - Arr3D => Inst%EmissBe10Strat(:,:,:) - CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe10Strat, & + IF ( Inst%IDTBe10s > 0 ) THEN + Arr3D => Inst%EmissBe10s(:,:,:) + CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe10s, & RC, ExtNr=Inst%ExtNr ) Arr3D => NULL() IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( & - 'HCO_EmisAdd error: EmissBe10Strat', RC ) + 'HCO_EmisAdd error: EmissBe10s', RC ) RETURN ENDIF ENDIF @@ -626,12 +626,12 @@ SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC ) Inst%IDTRn222 = HcoIDs(N) CASE( 'Be', 'Be7', '7Be' ) Inst%IDTBe7 = HcoIDs(N) - CASE( 'Be7Strat', '7BeStrat' ) - Inst%IDTBe7Strat = HcoIDs(N) + CASE( 'Be7s', '7Bes' ) + Inst%IDTBe7s = HcoIDs(N) CASE( 'Be10', '10Be' ) Inst%IDTBe10 = HcoIDs(N) - CASE( 'Be10Strat', '10BeStrat' ) - Inst%IDTBe10Strat = HcoIDs(N) + CASE( 'Be10s', '10Bes' ) + Inst%IDTBe10s = HcoIDs(N) CASE DEFAULT ! Do nothing END SELECT @@ -718,15 +718,15 @@ SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC ) CALL Init_7Be_Emissions( Inst ) ENDIF - IF ( Inst%IDTBe7Strat > 0 ) THEN - ALLOCATE( Inst%EmissBe7Strat( HcoState%Nx, HcoState%NY, HcoState%NZ ), & + IF ( Inst%IDTBe7s > 0 ) THEN + ALLOCATE( Inst%EmissBe7s( HcoState%Nx, HcoState%NY, HcoState%NZ ), & STAT=RC ) IF ( RC /= 0 ) THEN CALL HCO_ERROR ( & - 'Cannot allocate EmissBe7Strat', RC ) + 'Cannot allocate EmissBe7s', RC ) RETURN ENDIF - Inst%EmissBe7Strat = 0.0_hp + Inst%EmissBe7s = 0.0_hp ENDIF IF ( Inst%IDTBe10 > 0 ) THEN @@ -739,15 +739,15 @@ SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC ) ENDIF ENDIF - IF ( Inst%IDTBe10Strat > 0 ) THEN - ALLOCATE( Inst%EmissBe10Strat( HcoState%Nx, HcoState%NY, HcoState%NZ ), & + IF ( Inst%IDTBe10s > 0 ) THEN + ALLOCATE( Inst%EmissBe10s( HcoState%Nx, HcoState%NY, HcoState%NZ ), & STAT=RC ) IF ( RC /= 0 ) THEN CALL HCO_ERROR ( & - 'Cannot allocate EmissBe10Strat', RC ) + 'Cannot allocate EmissBe10s', RC ) RETURN ENDIF - Inst%EmissBe10Strat = 0.0_hp + Inst%EmissBe10s = 0.0_hp ENDIF !======================================================================= @@ -1318,20 +1318,20 @@ SUBROUTINE InstRemove ( Instance ) ENDIF Inst%EmissBe7 => NULL() - IF ( ASSOCIATED( Inst%EmissBe7Strat ) ) THEN - DEALLOCATE( Inst%EmissBe7Strat ) + IF ( ASSOCIATED( Inst%EmissBe7s ) ) THEN + DEALLOCATE( Inst%EmissBe7s ) ENDIF - Inst%EmissBe7Strat => NULL() + Inst%EmissBe7s => NULL() IF ( ASSOCIATED( Inst%EmissBe10 ) ) THEN DEALLOCATE(Inst%EmissBe10 ) ENDIF Inst%EmissBe10 => NULL() - IF ( ASSOCIATED( Inst%EmissBe10Strat ) ) THEN - DEALLOCATE( Inst%EmissBe10Strat ) + IF ( ASSOCIATED( Inst%EmissBe10s ) ) THEN + DEALLOCATE( Inst%EmissBe10s ) ENDIF - Inst%EmissBe10Strat => NULL() + Inst%EmissBe10s => NULL() IF ( ASSOCIATED( Inst%LATSOU ) ) THEN DEALLOCATE( Inst%LATSOU ) From 8f28731ed3f4a268942e75d9e52e6bb221ac87b5 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Thu, 25 May 2023 11:47:47 -0600 Subject: [PATCH 34/63] changes to appease NAG compiler modified: src/Core/hco_calc_mod.F90 modified: src/Core/hco_chartools_mod.F90 modified: src/Core/hco_error_mod.F90 modified: src/Core/hco_unit_mod.F90 modified: src/Core/hcoio_util_mod.F90 modified: src/Extensions/drydep_toolbox_mod.F90 modified: src/Extensions/hcox_dustdead_mod.F modified: src/Extensions/hcox_tomas_dustdead_mod.F modified: src/Extensions/hcox_tomas_jeagle_mod.F90 modified: src/Extensions/ocean_toolbox_mod.F90 modified: src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 modified: src/Shared/Headers/hco_precision_mod.F90 modified: src/Shared/NcdfUtil/hco_ncdf_mod.F90 modified: src/Shared/NcdfUtil/m_do_err_out.F90 --- src/Core/hco_calc_mod.F90 | 4 ++-- src/Core/hco_chartools_mod.F90 | 10 ++++---- src/Core/hco_error_mod.F90 | 11 +++++---- src/Core/hco_unit_mod.F90 | 6 ++--- src/Core/hcoio_util_mod.F90 | 2 +- src/Extensions/drydep_toolbox_mod.F90 | 4 ++-- src/Extensions/hcox_dustdead_mod.F | 2 +- src/Extensions/hcox_tomas_dustdead_mod.F | 4 ++-- src/Extensions/hcox_tomas_jeagle_mod.F90 | 4 ++-- src/Extensions/ocean_toolbox_mod.F90 | 2 +- src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 | 11 +++++---- src/Shared/Headers/hco_precision_mod.F90 | 8 +++---- src/Shared/NcdfUtil/hco_ncdf_mod.F90 | 27 +++++++++++----------- src/Shared/NcdfUtil/m_do_err_out.F90 | 6 ++--- 14 files changed, 52 insertions(+), 49 deletions(-) diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index 018933b7..96b133d5 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -1385,7 +1385,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Update optional variables IF ( PRESENT(UseLL) ) THEN UseLL = 1 - IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,4)/REAL(nnLL,4)) + IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,kind=sp)/REAL(nnLL,kind=sp)) ENDIF ! Weight output emissions by mask @@ -3416,7 +3416,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & ! Update optional variables IF ( PRESENT(UseLL) ) THEN UseLL = 1 - IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,4)/REAL(nnLL,4)) + IF ( nnLL > 0 ) UseLL = NINT(REAL(TotLL,kind=sp)/REAL(nnLL,kind=sp)) ENDIF ! Weight output emissions by mask diff --git a/src/Core/hco_chartools_mod.F90 b/src/Core/hco_chartools_mod.F90 index 19909214..c7fcc81b 100644 --- a/src/Core/hco_chartools_mod.F90 +++ b/src/Core/hco_chartools_mod.F90 @@ -200,7 +200,7 @@ SUBROUTINE HCO_CharSplit_R4( CharStr, SEP, WC, Reals, N, RC ) LOC = 'HCO_CharSplit_R4 (HCO_CHARTOOLS_MOD.F90)' ! Init - Reals(:) = -999_sp + Reals(:) = -999._sp ! Extract strings to be translated into integers !CALL STRSPLIT( CharStr, TRIM(SEP), SUBSTR, N ) @@ -218,9 +218,9 @@ SUBROUTINE HCO_CharSplit_R4( CharStr, SEP, WC, Reals, N, RC ) ! character with -999! DO I = 1, N IF ( TRIM(SUBSTR(I)) == TRIM(WC) ) THEN - Reals(I) = -999_sp + Reals(I) = -999._sp ELSEIF ( TRIM(SUBSTR(I)) == '-' ) THEN - Reals(I) = -999_sp + Reals(I) = -999._sp ELSE READ( SUBSTR(I), * ) Reals(I) ENDIF @@ -338,10 +338,10 @@ SUBROUTINE HCO_CharMatch( vec1, n1, vec2, n2, matchidx, nnmatch ) ! ! !INPUT PARAMETERS: ! - CHARACTER(LEN=*), INTENT(IN ) :: vec1(n1) ! char. vector 1 INTEGER, INTENT(IN ) :: n1 ! len of vec1 - CHARACTER(LEN=*), INTENT(IN ) :: vec2(n2) ! char. vector 2 INTEGER, INTENT(IN ) :: n2 ! len of vec2 + CHARACTER(LEN=*), INTENT(IN ) :: vec1(n1) ! char. vector 1 + CHARACTER(LEN=*), INTENT(IN ) :: vec2(n2) ! char. vector 2 ! ! !OUTPUT PARAMETERS: ! diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 838a62e4..c95beef6 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -77,15 +77,15 @@ MODULE HCO_Error_Mod ! !MODULE VARIABLES: ! ! Double and single precision definitions - INTEGER, PARAMETER, PUBLIC :: dp = KIND( 0.0_8 ) ! Double (r8) - INTEGER, PARAMETER, PUBLIC :: sp = KIND( 0.0_4 ) ! Single (r4) + INTEGER, PARAMETER, PUBLIC :: dp = selected_real_kind(12) ! Double (r8) + INTEGER, PARAMETER, PUBLIC :: sp = selected_real_kind( 6) ! Single (r4) #ifdef USE_REAL8 INTEGER, PARAMETER, PUBLIC :: hp = dp ! HEMCO precision = r8 #else INTEGER, PARAMETER, PUBLIC :: hp = sp ! HEMCO precision = r4 #endif - INTEGER, PARAMETER, PUBLIC :: i4 = 4 ! FourByteInt - INTEGER, PARAMETER, PUBLIC :: i8 = 8 ! EightByteInt + INTEGER, PARAMETER, PUBLIC :: i4 = selected_int_kind ( 6) ! FourByteInt + INTEGER, PARAMETER, PUBLIC :: i8 = selected_int_kind (13) ! EightByteInt ! Error success/failure definitions INTEGER, PARAMETER, PUBLIC :: HCO_SUCCESS = 0 @@ -992,7 +992,8 @@ SUBROUTINE HCO_LogFile_Open( Err, RC ) ! Reopen otherwise ELSE OPEN ( UNIT=FREELUN, FILE=TRIM(Err%LogFile), STATUS='OLD', & - ACTION='WRITE', ACCESS='APPEND', FORM='FORMATTED', & +!!$ ACTION='WRITE', ACCESS='APPEND', FORM='FORMATTED', & + ACTION='WRITE', FORM='FORMATTED', & ! NAG did not like ACCESS='APPEND' -- don't know what to do here ?? IOSTAT=IOS ) IF ( IOS /= 0 ) THEN PRINT *, 'Cannot reopen logfile: ' // TRIM(Err%LogFile) diff --git a/src/Core/hco_unit_mod.F90 b/src/Core/hco_unit_mod.F90 index 981a5de7..640f00c5 100644 --- a/src/Core/hco_unit_mod.F90 +++ b/src/Core/hco_unit_mod.F90 @@ -46,9 +46,9 @@ MODULE HCO_Unit_Mod ! !DEFINED PARAMETERS: ! REAL(dp), PARAMETER :: N_0 = 6.022140857e+23_dp - REAL(hp), PARAMETER :: SEC_IN_DAY = 86400_hp - REAL(hp), PARAMETER :: SEC_IN_LEAPYEAR = SEC_IN_DAY * 366_hp - REAL(hp), PARAMETER :: SEC_IN_REGYEAR = SEC_IN_DAY * 365_hp + REAL(hp), PARAMETER :: SEC_IN_DAY = 86400._hp + REAL(hp), PARAMETER :: SEC_IN_LEAPYEAR = SEC_IN_DAY * 366._hp + REAL(hp), PARAMETER :: SEC_IN_REGYEAR = SEC_IN_DAY * 365._hp ! Accepted units for unitless data. No unit conversion is applied to ! data with any of these units. The first entry represents the diff --git a/src/Core/hcoio_util_mod.F90 b/src/Core/hcoio_util_mod.F90 index 8fe97cd3..b772c9c1 100644 --- a/src/Core/hcoio_util_mod.F90 +++ b/src/Core/hcoio_util_mod.F90 @@ -1000,9 +1000,9 @@ FUNCTION IsClosest ( prefYMDhm, availYMDhm, nTime, ctidx1 ) RESULT ( Closest ) ! ! !INPUT PARAMETERS: ! + INTEGER, INTENT(IN) :: nTime REAL(dp), INTENT(IN) :: prefYMDhm REAL(dp), INTENT(IN) :: availYMDhm(nTime) - INTEGER, INTENT(IN) :: nTime INTEGER, INTENT(IN) :: ctidx1 ! ! !OUTPUT PARAMETERS: diff --git a/src/Extensions/drydep_toolbox_mod.F90 b/src/Extensions/drydep_toolbox_mod.F90 index 62172a87..9f1a44db 100644 --- a/src/Extensions/drydep_toolbox_mod.F90 +++ b/src/Extensions/drydep_toolbox_mod.F90 @@ -60,11 +60,11 @@ FUNCTION BioFit_R4( COEFF1, XLAI1, SUNCOS1, CFRAC1, NPOLY ) RESULT( BIO_FIT ) ! ! !INPUT PARAMETERS: ! + INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients REAL*4, INTENT(IN) :: COEFF1(NPOLY) ! Baldocchi drydep coefficients REAL*4, INTENT(IN) :: XLAI1 ! Leaf area index [cm2/cm2] REAL*4, INTENT(IN) :: SUNCOS1 ! Cosine( Solar Zenith Angle ) REAL*4, INTENT(IN) :: CFRAC1 ! Cloud fraction [unitless] - INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients ! ! !RETURN VALUE: ! @@ -145,11 +145,11 @@ FUNCTION BioFit_R8( COEFF1, XLAI1, SUNCOS1, CFRAC1, NPOLY ) RESULT( BIO_FIT ) ! ! !INPUT PARAMETERS: ! + INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients REAL*8, INTENT(IN) :: COEFF1(NPOLY) ! Baldocchi drydep coefficients REAL*8, INTENT(IN) :: XLAI1 ! Leaf area index [cm2/cm2] REAL*8, INTENT(IN) :: SUNCOS1 ! Cosine( Solar Zenith Angle ) REAL*8, INTENT(IN) :: CFRAC1 ! Cloud fraction [unitless] - INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients ! ! !RETURN VALUE: ! diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F index ef00eb87..1077fc59 100644 --- a/src/Extensions/hcox_dustdead_mod.F +++ b/src/Extensions/hcox_dustdead_mod.F @@ -439,7 +439,7 @@ SUBROUTINE HCOX_DustDead_Run( ExtState, HcoState, RC ) ! Orography at surface ! Ocean is 0; land is 1; ice is 2 - ORO(I) = REAL(OROGRAPHY(I,J),KIND=8) + ORO(I) = REAL(OROGRAPHY(I,J),KIND=dp) ! Snow [m H2O]. SNOWHGT is in kg H2O/m2, which is equivalent to ! mm H2O. Convert to m H2O here. diff --git a/src/Extensions/hcox_tomas_dustdead_mod.F b/src/Extensions/hcox_tomas_dustdead_mod.F index cbd6e3e5..776db3f7 100644 --- a/src/Extensions/hcox_tomas_dustdead_mod.F +++ b/src/Extensions/hcox_tomas_dustdead_mod.F @@ -1,4 +1,3 @@ -#if defined( TOMAS ) !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ @@ -42,6 +41,7 @@ ! !INTERFACE: ! MODULE HCOX_TOMAS_DustDead_Mod +#if defined( TOMAS ) ! ! !USES: ! @@ -5934,6 +5934,6 @@ SUBROUTINE InstRemove ( Instance ) END SUBROUTINE InstRemove !EOC +#endif END MODULE HCOX_TOMAS_DustDead_Mod !EOM -#endif diff --git a/src/Extensions/hcox_tomas_jeagle_mod.F90 b/src/Extensions/hcox_tomas_jeagle_mod.F90 index f97d5c6a..6605511b 100644 --- a/src/Extensions/hcox_tomas_jeagle_mod.F90 +++ b/src/Extensions/hcox_tomas_jeagle_mod.F90 @@ -1,4 +1,3 @@ -#if defined( TOMAS ) !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ @@ -27,6 +26,7 @@ ! !INTERFACE: ! MODULE HCOX_TOMAS_Jeagle_Mod +#if defined( TOMAS ) ! ! !USES: ! @@ -833,5 +833,5 @@ SUBROUTINE InstRemove ( Instance ) END SUBROUTINE InstRemove !EOC -END MODULE HCOX_TOMAS_Jeagle_Mod #endif +END MODULE HCOX_TOMAS_Jeagle_Mod diff --git a/src/Extensions/ocean_toolbox_mod.F90 b/src/Extensions/ocean_toolbox_mod.F90 index bb007b9f..0cf7efd0 100644 --- a/src/Extensions/ocean_toolbox_mod.F90 +++ b/src/Extensions/ocean_toolbox_mod.F90 @@ -467,7 +467,7 @@ FUNCTION P_SW(T,S) RESULT(P) !A = 0.824493D0-(4.0899D-3*T)+(7.6438D-5*(T**2d0))-(8.2467D-7*(T**3d0))+(5.3875D-9*(T**4d0)) ! B = -5.72466D-3+(1.0277D-4*T)-(1.6546D-6*(T**2d0)) A = 0.824493d0 + T * (-4.0899d-3 + T * (7.6438d-5 + T * (-8.2467d-7 + T * 5.3875d-9))) - B = -5.72466D-3 + T * ( 1.0277D-4 + T * -1.6546D-6) + B = -5.72466D-3 + T * ( 1.0277D-4 + T *(-1.6546D-6)) C = 4.8314D-4 ! Density of pure water diff --git a/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 b/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 index 338cbde9..e3717bc2 100644 --- a/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 +++ b/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 @@ -16,6 +16,7 @@ MODULE HCO_Regrid_A2A_Mod ! !USES: ! USE HCO_PRECISION_MOD ! For GEOS-Chem Precision (fp) + USE HCO_ERROR_MOD, ONLY : SP, DP, I4, I8 IMPLICIT NONE PRIVATE @@ -427,8 +428,8 @@ SUBROUTINE Map_A2A_r4r8( im, jm, lon1, sin1, q1, & ! Init IF ( PRESENT(missval) ) THEN - qtmp = real(missval,8) - q2 = real(missval,8) + qtmp = real(missval,kind=dp) + q2 = real(missval,kind=dp) ELSE qtmp = miss_r8 q2 = miss_r8 @@ -560,8 +561,8 @@ SUBROUTINE Map_A2A_r8r4( im, jm, lon1, sin1, q1, & ! Init IF ( PRESENT(missval) ) THEN - qtmp = real(missval,4) - q2 = real(missval,4) + qtmp = real(missval,kind=sp) + q2 = real(missval,kind=sp) ELSE qtmp = miss_r4 q2 = miss_r4 @@ -617,7 +618,7 @@ SUBROUTINE Map_A2A_r8r4( im, jm, lon1, sin1, q1, & ! Otherwise, call YMAP to regrid in the N-S direction CALL ymap_r4r4(in, jm, sin1, qtmp(1,1+ig), jn, sin2, q2(1,1+ig), ig, iv, & - missval=real(missval,4)) + missval=real(missval,kind=sp)) ENDIF diff --git a/src/Shared/Headers/hco_precision_mod.F90 b/src/Shared/Headers/hco_precision_mod.F90 index a42faa00..d389fa4d 100644 --- a/src/Shared/Headers/hco_precision_mod.F90 +++ b/src/Shared/Headers/hco_precision_mod.F90 @@ -29,12 +29,12 @@ MODULE HCO_PRECISION_MOD #ifdef USE_REAL8 ! Use 8-byte floating point precision when asked. - INTEGER, PARAMETER, PUBLIC :: fp = KIND( REAL( 0.0, 8 ) ) + INTEGER, PARAMETER, PUBLIC :: fp = selected_real_kind(12) #else ! Use 4-byte floating point by default. - INTEGER, PARAMETER, PUBLIC :: fp = KIND( REAL( 0.0, 4 ) ) + INTEGER, PARAMETER, PUBLIC :: fp = selected_real_kind( 6) #endif @@ -47,10 +47,10 @@ MODULE HCO_PRECISION_MOD !================================================================= ! KIND parameter for 4-byte precision - INTEGER, PARAMETER, PUBLIC :: f4 = KIND( REAL( 0.0, 4 ) ) + INTEGER, PARAMETER, PUBLIC :: f4 = selected_real_kind( 6) ! KIND parameter for 8-byte precision - INTEGER, PARAMETER, PUBLIC :: f8 = KIND( REAL( 0.0, 8 ) ) + INTEGER, PARAMETER, PUBLIC :: f8 = selected_real_kind(12) ! ! !REMARKS: ! This module is designed to help avoid hard-coding precision. diff --git a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 index a5fcc31c..02b24d41 100644 --- a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 +++ b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 @@ -26,6 +26,7 @@ MODULE HCO_NCDF_MOD USE HCO_m_netcdf_io_define USE HCO_m_netcdf_io_write USE HCO_m_netcdf_io_checks + USE HCO_ERROR_MOD, ONLY : SP, DP, I4, I8 IMPLICIT NONE PRIVATE @@ -1996,8 +1997,8 @@ SUBROUTINE NC_GET_GRID_EDGES_SP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC ) ! INTEGER, INTENT(IN ) :: fID ! Ncdf File ID INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat - REAL*4, INTENT(IN ) :: MID(NMID) ! midpoints INTEGER, INTENT(IN ) :: NMID ! # of midpoints + REAL*4, INTENT(IN ) :: MID(NMID) ! midpoints ! ! !INPUT/OUTPUT PARAMETERS: ! @@ -2047,8 +2048,8 @@ SUBROUTINE NC_GET_GRID_EDGES_DP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC ) ! INTEGER, INTENT(IN ) :: fID ! Ncdf File ID INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat - REAL*8, INTENT(IN ) :: MID(NMID) ! midpoints INTEGER, INTENT(IN ) :: NMID ! # of midpoints + REAL*8, INTENT(IN ) :: MID(NMID) ! midpoints ! ! !INPUT/OUTPUT PARAMETERS: ! @@ -2095,9 +2096,9 @@ SUBROUTINE NC_GET_GRID_EDGES_C( fID, AXIS, NMID, NEDGE, RC, & ! INTEGER, INTENT(IN ) :: fID ! Ncdf File ID INTEGER, INTENT(IN ) :: AXIS ! 1=lon, 2=lat + INTEGER, INTENT(IN ) :: NMID ! # of midpoints REAL*4, OPTIONAL, INTENT(IN ) :: MID4(NMID) ! midpoints REAL*8, OPTIONAL, INTENT(IN ) :: MID8(NMID) ! midpoints - INTEGER, INTENT(IN ) :: NMID ! # of midpoints ! ! !INPUT/OUTPUT PARAMETERS: ! @@ -4038,7 +4039,7 @@ SUBROUTINE NC_VAR_WRITE_R8_0D( fId, VarName, Var ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=8) :: Var ! Variable to be written + REAL(kind=dp) :: Var ! Variable to be written ! ! !REMARKS: ! Assumes that you have: @@ -4085,7 +4086,7 @@ SUBROUTINE NC_VAR_WRITE_R8_1D( fId, VarName, Arr1D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=8), POINTER :: Arr1D(:) ! array to be written + REAL(kind=dp), POINTER :: Arr1D(:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4139,7 +4140,7 @@ SUBROUTINE NC_VAR_WRITE_R8_2D( fId, VarName, Arr2D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=8), POINTER :: Arr2D(:,:) ! array to be written + REAL(kind=dp), POINTER :: Arr2D(:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4199,7 +4200,7 @@ SUBROUTINE NC_VAR_WRITE_R8_3D( fId, VarName, Arr3D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=8), POINTER :: Arr3D(:,:,:) ! array to be written + REAL(kind=dp), POINTER :: Arr3D(:,:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4259,7 +4260,7 @@ SUBROUTINE NC_VAR_WRITE_R8_4D( fId, VarName, Arr4D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=8), POINTER :: Arr4D(:,:,:,:) ! array to be written + REAL(kind=dp), POINTER :: Arr4D(:,:,:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4319,7 +4320,7 @@ SUBROUTINE NC_VAR_WRITE_R4_0d( fId, VarName, Var ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=4) :: Var ! Variable to be written + REAL(kind=sp) :: Var ! Variable to be written ! ! !REMARKS: ! Assumes that you have: @@ -4366,7 +4367,7 @@ SUBROUTINE NC_VAR_WRITE_R4_1D( fId, VarName, Arr1D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=4), POINTER :: Arr1D(:) ! array to be written + REAL(kind=sp), POINTER :: Arr1D(:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4420,7 +4421,7 @@ SUBROUTINE NC_VAR_WRITE_R4_2D( fId, VarName, Arr2D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=4), POINTER :: Arr2D(:,:) ! array to be written + REAL(kind=sp), POINTER :: Arr2D(:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4480,7 +4481,7 @@ SUBROUTINE NC_VAR_WRITE_R4_3D( fId, VarName, Arr3D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=4), POINTER :: Arr3D(:,:,:) ! array to be written + REAL(kind=sp), POINTER :: Arr3D(:,:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: @@ -4540,7 +4541,7 @@ SUBROUTINE NC_VAR_WRITE_R4_4D( fId, VarName, Arr4D ) ! INTEGER, INTENT(IN) :: fId ! file ID CHARACTER(LEN=*), INTENT(IN) :: VarName ! variable name - REAL(kind=4), POINTER :: Arr4D(:,:,:,:) ! array to be written + REAL(kind=sp), POINTER :: Arr4D(:,:,:,:) ! array to be written ! ! !REMARKS: ! Assumes that you have: diff --git a/src/Shared/NcdfUtil/m_do_err_out.F90 b/src/Shared/NcdfUtil/m_do_err_out.F90 index 9c75c7de..7fa63f4b 100644 --- a/src/Shared/NcdfUtil/m_do_err_out.F90 +++ b/src/Shared/NcdfUtil/m_do_err_out.F90 @@ -101,7 +101,7 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush the buffer - CALL Flush( 6 ) + !CALL Flush( 6 ) ! Stop with error (if requested) ! NOTE: We should pass back the error code to the main routine @@ -117,11 +117,11 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush stdout buffer - CALL Flush( 6 ) + !CALL Flush( 6 ) ! NOTE: Should not exit but pass error code up ! work on this for a future version - CALL Exit( 999 ) + stop 999 ENDIF RETURN From d0f7594953bfd955d974ec88675e43bc49c831ff Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 25 May 2023 17:55:01 -0400 Subject: [PATCH 35/63] Fixes to nag fixes --- src/Core/hco_error_mod.F90 | 3 +-- src/Shared/NcdfUtil/hco_ncdf_mod.F90 | 2 +- src/Shared/NcdfUtil/m_do_err_out.F90 | 8 ++++++-- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index c95beef6..6b5c7375 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -992,8 +992,7 @@ SUBROUTINE HCO_LogFile_Open( Err, RC ) ! Reopen otherwise ELSE OPEN ( UNIT=FREELUN, FILE=TRIM(Err%LogFile), STATUS='OLD', & -!!$ ACTION='WRITE', ACCESS='APPEND', FORM='FORMATTED', & - ACTION='WRITE', FORM='FORMATTED', & ! NAG did not like ACCESS='APPEND' -- don't know what to do here ?? + ACTION='WRITE', POSITION='APPEND', FORM='FORMATTED', & ! NAG did not like ACCESS='APPEND' -- use standard-compliant position='append' IOSTAT=IOS ) IF ( IOS /= 0 ) THEN PRINT *, 'Cannot reopen logfile: ' // TRIM(Err%LogFile) diff --git a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 index 02b24d41..5037b119 100644 --- a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 +++ b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 @@ -26,7 +26,7 @@ MODULE HCO_NCDF_MOD USE HCO_m_netcdf_io_define USE HCO_m_netcdf_io_write USE HCO_m_netcdf_io_checks - USE HCO_ERROR_MOD, ONLY : SP, DP, I4, I8 + USE HCO_PRECISION_MOD, ONLY : SP => f4, DP => f8 IMPLICIT NONE PRIVATE diff --git a/src/Shared/NcdfUtil/m_do_err_out.F90 b/src/Shared/NcdfUtil/m_do_err_out.F90 index 7fa63f4b..11fd3c43 100644 --- a/src/Shared/NcdfUtil/m_do_err_out.F90 +++ b/src/Shared/NcdfUtil/m_do_err_out.F90 @@ -101,7 +101,9 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush the buffer - !CALL Flush( 6 ) +#ifndef MODEL_CESM + CALL Flush( 6 ) +#endif ! Stop with error (if requested) ! NOTE: We should pass back the error code to the main routine @@ -117,7 +119,9 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush stdout buffer - !CALL Flush( 6 ) +#ifndef MODEL_CESM + CALL Flush( 6 ) +#endif ! NOTE: Should not exit but pass error code up ! work on this for a future version From 3c25a66d71540b3bab131b1ff30fd53dd0110510 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Thu, 25 May 2023 18:13:01 -0400 Subject: [PATCH 36/63] Fixes to nag fixes (2): use f4, f8 in hco_regrid_a2a_mod and not HEMCO types --- src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 b/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 index e3717bc2..09e2b1ee 100644 --- a/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 +++ b/src/Shared/GeosUtil/hco_regrid_a2a_mod.F90 @@ -16,7 +16,6 @@ MODULE HCO_Regrid_A2A_Mod ! !USES: ! USE HCO_PRECISION_MOD ! For GEOS-Chem Precision (fp) - USE HCO_ERROR_MOD, ONLY : SP, DP, I4, I8 IMPLICIT NONE PRIVATE @@ -428,8 +427,8 @@ SUBROUTINE Map_A2A_r4r8( im, jm, lon1, sin1, q1, & ! Init IF ( PRESENT(missval) ) THEN - qtmp = real(missval,kind=dp) - q2 = real(missval,kind=dp) + qtmp = real(missval,kind=f8) + q2 = real(missval,kind=f8) ELSE qtmp = miss_r8 q2 = miss_r8 @@ -561,8 +560,8 @@ SUBROUTINE Map_A2A_r8r4( im, jm, lon1, sin1, q1, & ! Init IF ( PRESENT(missval) ) THEN - qtmp = real(missval,kind=sp) - q2 = real(missval,kind=sp) + qtmp = real(missval,kind=f4) + q2 = real(missval,kind=f4) ELSE qtmp = miss_r4 q2 = miss_r4 @@ -618,7 +617,7 @@ SUBROUTINE Map_A2A_r8r4( im, jm, lon1, sin1, q1, & ! Otherwise, call YMAP to regrid in the N-S direction CALL ymap_r4r4(in, jm, sin1, qtmp(1,1+ig), jn, sin2, q2(1,1+ig), ig, iv, & - missval=real(missval,kind=sp)) + missval=real(missval,kind=f4)) ENDIF From 1702dba4212f1328cf2fb2836b8fb4ff3b7510f9 Mon Sep 17 00:00:00 2001 From: Francis Vitt Date: Fri, 26 May 2023 08:33:19 -0600 Subject: [PATCH 37/63] use ISO fortran kinds --- src/Core/hco_error_mod.F90 | 9 +++++---- src/Shared/Headers/hco_precision_mod.F90 | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 6b5c7375..988deca1 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -56,6 +56,7 @@ MODULE HCO_Error_Mod #if defined( MAPL_ESMF ) USE MAPL_Base, ONLY: MAPL_UNDEF #endif + USE ISO_Fortran_Env, ONLY : INT32, INT64, REAL32, REAL64 IMPLICIT NONE PRIVATE @@ -77,15 +78,15 @@ MODULE HCO_Error_Mod ! !MODULE VARIABLES: ! ! Double and single precision definitions - INTEGER, PARAMETER, PUBLIC :: dp = selected_real_kind(12) ! Double (r8) - INTEGER, PARAMETER, PUBLIC :: sp = selected_real_kind( 6) ! Single (r4) + INTEGER, PARAMETER, PUBLIC :: dp = REAL64 ! Double (r8) + INTEGER, PARAMETER, PUBLIC :: sp = REAL32 ! Single (r4) #ifdef USE_REAL8 INTEGER, PARAMETER, PUBLIC :: hp = dp ! HEMCO precision = r8 #else INTEGER, PARAMETER, PUBLIC :: hp = sp ! HEMCO precision = r4 #endif - INTEGER, PARAMETER, PUBLIC :: i4 = selected_int_kind ( 6) ! FourByteInt - INTEGER, PARAMETER, PUBLIC :: i8 = selected_int_kind (13) ! EightByteInt + INTEGER, PARAMETER, PUBLIC :: i4 = INT32 ! FourByteInt + INTEGER, PARAMETER, PUBLIC :: i8 = INT64 ! EightByteInt ! Error success/failure definitions INTEGER, PARAMETER, PUBLIC :: HCO_SUCCESS = 0 diff --git a/src/Shared/Headers/hco_precision_mod.F90 b/src/Shared/Headers/hco_precision_mod.F90 index d389fa4d..17a6d62f 100644 --- a/src/Shared/Headers/hco_precision_mod.F90 +++ b/src/Shared/Headers/hco_precision_mod.F90 @@ -14,6 +14,7 @@ MODULE HCO_PRECISION_MOD ! ! !USES: + USE ISO_Fortran_Env, ONLY : REAL32, REAL64 ! IMPLICIT NONE PRIVATE @@ -29,12 +30,12 @@ MODULE HCO_PRECISION_MOD #ifdef USE_REAL8 ! Use 8-byte floating point precision when asked. - INTEGER, PARAMETER, PUBLIC :: fp = selected_real_kind(12) + INTEGER, PARAMETER, PUBLIC :: fp = REAL64 #else ! Use 4-byte floating point by default. - INTEGER, PARAMETER, PUBLIC :: fp = selected_real_kind( 6) + INTEGER, PARAMETER, PUBLIC :: fp = REAL32 #endif @@ -47,10 +48,10 @@ MODULE HCO_PRECISION_MOD !================================================================= ! KIND parameter for 4-byte precision - INTEGER, PARAMETER, PUBLIC :: f4 = selected_real_kind( 6) + INTEGER, PARAMETER, PUBLIC :: f4 = REAL32 ! KIND parameter for 8-byte precision - INTEGER, PARAMETER, PUBLIC :: f8 = selected_real_kind(12) + INTEGER, PARAMETER, PUBLIC :: f8 = REAL64 ! ! !REMARKS: ! This module is designed to help avoid hard-coding precision. From 5c4fca93af8a441ac7d721d56dc013743773a29a Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Fri, 26 May 2023 12:41:07 -0400 Subject: [PATCH 38/63] Use CPRNAG compiler flag from CESM build for blocking out unsupported Flush() command --- src/Shared/NcdfUtil/m_do_err_out.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Shared/NcdfUtil/m_do_err_out.F90 b/src/Shared/NcdfUtil/m_do_err_out.F90 index 11fd3c43..b6df11e5 100644 --- a/src/Shared/NcdfUtil/m_do_err_out.F90 +++ b/src/Shared/NcdfUtil/m_do_err_out.F90 @@ -101,7 +101,8 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush the buffer -#ifndef MODEL_CESM + ! Flush is unavailable on the NAG compiler (for CESM) and CPRNAG is defined if using it. +#ifndef CPRNAG CALL Flush( 6 ) #endif @@ -119,7 +120,8 @@ subroutine Do_Err_Out & WRITE( 6, '(/,a,/)' ) REPEAT( '!', 79 ) ! Flush stdout buffer -#ifndef MODEL_CESM + ! Flush is unavailable on the NAG compiler (for CESM) and CPRNAG is defined if using it. +#ifndef CPRNAG CALL Flush( 6 ) #endif From eed84ea49b0ad041e8995828321b60d95b30a020 Mon Sep 17 00:00:00 2001 From: Eric Roy <122998903+emroy00@users.noreply.github.com> Date: Fri, 2 Jun 2023 11:46:45 -0400 Subject: [PATCH 39/63] Update Hg0 Emission Factors in hcox_gfed_include_gfed4.H Updating emission factors to values consistent with Holmes et al. (2010) and emphasizing the assumed Hg0:CO scaling factor --- src/Extensions/hcox_gfed_include_gfed4.H | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Extensions/hcox_gfed_include_gfed4.H b/src/Extensions/hcox_gfed_include_gfed4.H index c139d22c..69d74fc8 100644 --- a/src/Extensions/hcox_gfed_include_gfed4.H +++ b/src/Extensions/hcox_gfed_include_gfed4.H @@ -327,12 +327,12 @@ Inst%GFED4_EMFAC(31,6)=Inst%GFED4_EMFAC(1,6) ! AGRI ! HG0 GFED4_SPEC_NAME(32)="Hg0" -Inst%GFED4_EMFAC(32,1)=7.23E-08_hp ! SAV -- SAVA -Inst%GFED4_EMFAC(32,2)=1.50E-07_hp ! FOR -- BORF -Inst%GFED4_EMFAC(32,3)=1.50E-07_hp ! FOR -- TEMP -Inst%GFED4_EMFAC(32,4)=5.85E-08_hp ! DEF -- DEFO -Inst%GFED4_EMFAC(32,5)=7.56E-08_hp ! PET -- PEAT -Inst%GFED4_EMFAC(32,6)=4.48E-08_hp ! AGW -- AGRI +Inst%GFED4_EMFAC(32,1)=7.17E-07_hp * Inst%GFED4_EMFAC(1,1) ! SAV -- SAVA +Inst%GFED4_EMFAC(32,2)=7.17E-07_hp * Inst%GFED4_EMFAC(1,2) ! FOR -- BORF +Inst%GFED4_EMFAC(32,3)=7.17E-07_hp * Inst%GFED4_EMFAC(1,3) ! FOR -- TEMP +Inst%GFED4_EMFAC(32,4)=7.17E-07_hp * Inst%GFED4_EMFAC(1,4) ! DEF -- DEFO +Inst%GFED4_EMFAC(32,5)=7.17E-07_hp * Inst%GFED4_EMFAC(1,5) ! PET -- PEAT +Inst%GFED4_EMFAC(32,6)=7.17E-07_hp * Inst%GFED4_EMFAC(1,6) ! AGW -- AGRI ! HAC - not traced per carbon - from Akagi et al, 2011 GFED4_SPEC_NAME(33)="HAC" From bf53c91ead4d6cd538f371fd42c217c3eaa732a1 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 20 Jun 2023 17:17:40 -0400 Subject: [PATCH 40/63] Remove extraneous routine GetExtSpcVal_Dr in hco_extlist_mod.F90 src/Core/hco_extlist_mod.F90 - Routine GetExtSpcVal_Dr has a DO loop over species where we test if the optional arguments for spcScal_sp, spcScal_int, spcScal_char are passed, and if so, then we populate them. - But this is redundant, as the code to handle spcScal_sp, spcScal_int, and spcScal_char can be moved to the overloaded module routines (GetExtSpcVal_sp, GetExtSpcVal_int, GetExtSpcVal_char). We have done this. - Removed GetExtSpcVal_Dr, as it is no longer needed. - Updated comments, cosmetic changes Signed-off-by: Bob Yantosca --- src/Core/hco_extlist_mod.F90 | 359 ++++++++++++++++++++--------------- 1 file changed, 210 insertions(+), 149 deletions(-) diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index 50cd26bf..6b58c554 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -639,21 +639,21 @@ END SUBROUTINE GetExtSpcStr !\\ ! !INTERFACE: ! - SUBROUTINE GetExtSpcVal_Sp( HcoConfig, ExtNr, NSPC, SpcNames, & - Prefix, DefValue, SpcScal, RC ) + SUBROUTINE GetExtSpcVal_sp( HcoConfig, extNr, NSPC, spcNames, & + prefix, defValue, spcScal, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(ConfigObj), POINTER :: HcoConfig - INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr. - INTEGER, INTENT(IN ) :: NSPC ! # of species - CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string - CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix - REAL(sp), INTENT(IN ) :: DefValue ! default value + TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config obj + INTEGER, INTENT(IN) :: extNr ! Extension Nr. + INTEGER, INTENT(IN) :: NSPC ! # of species + CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string + CHARACTER(LEN=*), INTENT(IN) :: prefix ! Search prefix + REAL(sp), INTENT(IN) :: defValue ! Default value ! ! !INPUT/OUTPUT PARAMETERS: ! - REAL(sp), ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors + REAL(sp), ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs INTEGER, INTENT(INOUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: @@ -663,17 +663,67 @@ SUBROUTINE GetExtSpcVal_Sp( HcoConfig, ExtNr, NSPC, SpcNames, & !------------------------------------------------------------------------------ !BOC - !====================================================================== - ! GetExtSpcVal_Sp begins here - !====================================================================== + ! Scalars + LOGICAL :: found + INTEGER :: I + REAL(sp) :: scaleFac + + ! Strings + CHARACTER(LEN= 61) :: name + CHARACTER(LEN=255) :: errMsg + CHARACTER(LEN=255) :: thisLoc + + !======================================================================== + ! GetExtSpcVal_sp begins here + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = & + ' -> at GetExtSpcVal_sp (in module src/Core/hco_extlist_mod.F90)' + + !======================================================================== + ! Make sure output array SpcScal is properly allocated + !======================================================================== + IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal ) + ALLOCATE( SpcScal(NSPC), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate SpcScal array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ! Initialize to default values + spcScal = defValue - ! Make sure output is properly allocated - IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal) - ALLOCATE(SpcScal(NSPC)) - SpcScal=DefValue + !======================================================================== + ! Look for species scale factors; save to spcScal array + !======================================================================== + DO I = 1, NSPC + + ! Species name + name = TRIM( prefix ) // '_' // TRIM( spcNames(I) ) + + ! Look for the scale factor + CALL GetExtOpt( & + HcoConfig = HcoConfig, & + extNr = extNr, & + optName = name, & + optValSp = scaleFac, & + found = found, & + RC = RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "GetExtOpt" routine!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN + ENDIF - CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, & - DefVal_SP=DefValue, SpcScal_SP=SpcScal ) + ! If scale factor was found, assign it to SpcScal + IF ( found ) spcScal(I) = scaleFac + ENDDO END SUBROUTINE GetExtSpcVal_sp !EOC @@ -694,22 +744,25 @@ END SUBROUTINE GetExtSpcVal_sp !\\ ! !INTERFACE: ! - SUBROUTINE GetExtSpcVal_Int( HcoConfig, ExtNr, NSPC, SpcNames, & - Prefix, DefValue, SpcScal, RC ) + SUBROUTINE GetExtSpcVal_int( HcoConfig, extNr, NSPC, spcNames, & + prefix, defValue, spcScal, RC ) ! ! !INPUT PARAMETERS: ! TYPE(ConfigObj), POINTER :: HcoConfig - INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr. - INTEGER, INTENT(IN ) :: NSPC ! # of species - CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string - CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix - INTEGER, INTENT(IN ) :: DefValue ! default value + INTEGER, INTENT(IN) :: extNr ! Extension Nr. + INTEGER, INTENT(IN) :: NSPC ! # of species + CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string + CHARACTER(LEN=*), INTENT(IN) :: prefix ! search prefix + INTEGER, INTENT(IN) :: defValue ! default value ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors - INTEGER, INTENT(INOUT) :: RC ! Success or failure? + INTEGER, ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs +! +! !OUTPUT PARAMETERS:: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 10 Jun 2015 - C. Keller - Initial version @@ -718,28 +771,78 @@ SUBROUTINE GetExtSpcVal_Int( HcoConfig, ExtNr, NSPC, SpcNames, & !------------------------------------------------------------------------------ !BOC - !====================================================================== - ! GetExtSpcVal_Int begins here - !====================================================================== + ! Scalars + LOGICAL :: found + INTEGER :: I + INTEGER :: scaleFac + + ! Strings + CHARACTER(LEN= 61) :: name + CHARACTER(LEN=255) :: errMsg + CHARACTER(LEN=255) :: thisLoc + + !======================================================================== + ! GetExtSpcVal_int begins here + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = & + ' -> at GetExtSpcVal_Int (in module src/Core/hco_extlist_mod.F90)' + + !======================================================================== + ! Make sure output array SpcScal is properly allocated + !======================================================================== + IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal ) + ALLOCATE( SpcScal(NSPC), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate SpcScal array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Make sure output is properly allocated - IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal) - ALLOCATE(SpcScal(NSPC)) - SpcScal=DefValue + ! Initialize to default values + spcScal = defValue - CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, & - DefVal_IN=DefValue, SpcScal_IN=SpcScal ) + !======================================================================== + ! Look for species scale factors; save to spcScal array + !======================================================================== + DO I = 1, NSPC + + ! Species name + name = TRIM( prefix ) // '_' // TRIM( spcNames(I) ) + + ! Look for the scale factor + CALL GetExtOpt( & + HcoConfig = HcoConfig, & + extNr = extNr, & + optName = name, & + optValInt = scaleFac, & + found = found, & + RC = RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "GetExtOpt" routine!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ! If scale factor was found, assign it to SpcScal + IF ( found ) spcScal(I) = scaleFac + ENDDO - END SUBROUTINE GetExtSpcVal_Int + END SUBROUTINE GetExtSpcVal_int !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! -! !ROUTINE: GetExtSpcVal_Char +! !ROUTINE: GetExtSpcVal_char ! -! !DESCRIPTION: Subroutine GetExtSpcVal\_Char returns character values +! !DESCRIPTION: Subroutine GetExtSpcVal\_char returns character values ! associated with the species for a given extension. Specifically, this routine ! searches for extension setting '\_SpecName' for every species passed ! through input argument SpcNames and writes those into output argument SpcScal. @@ -749,22 +852,26 @@ END SUBROUTINE GetExtSpcVal_Int !\\ ! !INTERFACE: ! - SUBROUTINE GetExtSpcVal_Char( HcoConfig, ExtNr, NSPC, SpcNames, & - Prefix, DefValue, SpcScal, RC ) + SUBROUTINE GetExtSpcVal_char( HcoConfig, extNr, NSPC, spcNames, & + prefix, defValue, spcScal, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(ConfigObj), POINTER :: HcoConfig - INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr. - INTEGER, INTENT(IN ) :: NSPC ! # of species - CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string - CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix - CHARACTER(LEN=*), INTENT(IN ) :: DefValue ! default value + TYPE(ConfigObj), POINTER :: HcoConfig ! HEMCO config object + INTEGER, INTENT(IN) :: extNr ! Extension Nr. + INTEGER, INTENT(IN) :: NSPC ! # of species + CHARACTER(LEN=*), INTENT(IN) :: spcNames(NSPC) ! Species string + CHARACTER(LEN=*), INTENT(IN) :: prefix ! search prefix + CHARACTER(LEN=*), INTENT(IN) :: defValue ! default value ! ! !INPUT/OUTPUT PARAMETERS: ! - CHARACTER(LEN=*), ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors - INTEGER, INTENT(INOUT) :: RC ! Success or failure? + CHARACTER(LEN=*), & + ALLOCATABLE, INTENT(INOUT) :: SpcScal(:) ! Species scale factors +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 10 Jun 2015 - C. Keller - Initial version @@ -773,115 +880,69 @@ SUBROUTINE GetExtSpcVal_Char( HcoConfig, ExtNr, NSPC, SpcNames, & !------------------------------------------------------------------------------ !BOC - !====================================================================== - ! GetExtSpcVal_Char begins here - !====================================================================== - - ! Make sure output is properly allocated - IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal) - ALLOCATE(SpcScal(NSPC)) - SpcScal=DefValue + ! Scalars + LOGICAL :: found + INTEGER :: I - CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, & - DefVal_Char=DefValue, SpcScal_Char=SpcScal ) + ! Strings + CHARACTER(LEN= 61) :: name + CHARACTER(LEN=255) :: scaleFac + CHARACTER(LEN=255) :: errMsg + CHARACTER(LEN=255) :: thisLoc - END SUBROUTINE GetExtSpcVal_char -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !ROUTINE: GetExtSpcVal_Dr -! -! !DESCRIPTION: Subroutine GetExtSpcVal\_Dr is the GetExtSpcVal driver routine. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE GetExtSpcVal_Dr( HcoConfig, ExtNr, NSPC, & - SpcNames, Prefix, RC, & - DefVal_SP, SpcScal_SP, & - DefVal_Char, SpcScal_Char, & - DefVal_IN, SpcScal_IN ) -! -! !INPUT PARAMETERS: -! - TYPE(ConfigObj), POINTER :: HcoConfig - INTEGER, INTENT(IN ) :: ExtNr ! Extension Nr. - INTEGER, INTENT(IN ) :: NSPC ! # of species - CHARACTER(LEN=*), INTENT(IN ) :: SpcNames(NSPC) ! Species string - CHARACTER(LEN=*), INTENT(IN ) :: Prefix ! search prefix - REAL(sp), INTENT(IN ), OPTIONAL :: DefVal_SP ! default value - INTEGER, INTENT(IN ), OPTIONAL :: DefVal_IN ! default value - CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: DefVal_Char ! default value -! -! !OUTPUT PARAMETERS: -! - REAL(sp), INTENT( OUT), OPTIONAL :: SpcScal_SP(NSPC) ! Species values - INTEGER, INTENT( OUT), OPTIONAL :: SpcScal_IN(NSPC) ! Species values - CHARACTER(LEN=*), INTENT( OUT), OPTIONAL :: SpcScal_Char(NSPC) ! Species values -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC ! Success or failure? -! -! !REVISION HISTORY: -! 10 Jun 2015 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL ARGUMENTS: -! - INTEGER :: I - LOGICAL :: FND - REAL(sp) :: iScal_sp - INTEGER :: iScal_in - CHARACTER(LEN=255) :: iScal_char - CHARACTER(LEN= 61) :: IOptName - CHARACTER(LEN=255) :: MSG - CHARACTER(LEN=255) :: LOC = 'GetExtSpcVal_Dr (hco_extlist_mod.F90)' + !======================================================================== + ! GetExtSpcVal_Char begins here + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = & + ' -> at GetExtSpcVal_Char (in module src/Core/hco_extlist_mod.F90)' + + !======================================================================== + ! Make sure output array SpcScal is properly allocated + !======================================================================== + IF ( ALLOCATED( spcScal ) ) DEALLOCATE( spcScal ) + ALLOCATE( SpcScal(NSPC), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate SpcScal array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN + ENDIF - !====================================================================== - ! GetExtSpcVal_Dr begins here - !====================================================================== + ! Initialize to default values + spcScal = defValue - ! Do for every species + !======================================================================== + ! Look for species scale factors; save to spcScal array + !======================================================================== DO I = 1, NSPC - IOptName = TRIM(Prefix)//'_'//TRIM(SpcNames(I)) - IF ( PRESENT(SpcScal_sp) ) THEN - CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValSp=iScal_sp, FOUND=FND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN - ENDIF - IF ( FND ) SpcScal_sp(I) = iScal_sp - ENDIF - IF ( PRESENT(SpcScal_in) ) THEN - CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValInt=iScal_in, FOUND=FND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN - ENDIF - IF ( FND ) SpcScal_in(I) = iScal_in - ENDIF - IF ( PRESENT(SpcScal_char) ) THEN - CALL GetExtOpt ( HcoConfig, ExtNr, IOptName, OptValChar=iScal_char, FOUND=FND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN - ENDIF - IF ( FND ) SpcScal_char(I) = iScal_char + ! Species name + name = TRIM( prefix ) // '_' // TRIM( spcNames(I) ) + + ! Look for the scale factor + CALL GetExtOpt( & + HcoConfig = HcoConfig, & + extNr = extNr, & + optName = name, & + optValChar = scaleFac, & + found = found, & + RC = RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "GetExtOpt" routine!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF - ENDDO - ! Return w/ success - RC = HCO_SUCCESS + ! If scale factor was found, assign it to SpcScal + IF ( found ) spcScal(I) = scaleFac + ENDDO - END SUBROUTINE GetExtSpcVal_Dr + END SUBROUTINE GetExtSpcVal_char !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! From a086424cdcb6e295dfcf9cad1e05e24220b40f28 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Wed, 21 Jun 2023 14:37:54 -0400 Subject: [PATCH 41/63] Additional formatting updates in hco_extlist_mod.F90 src/Core/hco_extlist_mod.F90 - In routine GetExtSpcVal_sp, RC is now INTENT(OUT) - Fixed indentation for END SUBROUTINE statements Signed-off-by: Bob Yantosca --- src/Core/hco_extlist_mod.F90 | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index 6b58c554..88d81026 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -654,7 +654,10 @@ SUBROUTINE GetExtSpcVal_sp( HcoConfig, extNr, NSPC, spcNames, & ! !INPUT/OUTPUT PARAMETERS: ! REAL(sp), ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs - INTEGER, INTENT(INOUT) :: RC ! Success or failure? +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 10 Jun 2015 - C. Keller - Initial version @@ -725,7 +728,7 @@ SUBROUTINE GetExtSpcVal_sp( HcoConfig, extNr, NSPC, spcNames, & IF ( found ) spcScal(I) = scaleFac ENDDO - END SUBROUTINE GetExtSpcVal_sp + END SUBROUTINE GetExtSpcVal_sp !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -833,7 +836,7 @@ SUBROUTINE GetExtSpcVal_int( HcoConfig, extNr, NSPC, spcNames, & IF ( found ) spcScal(I) = scaleFac ENDDO - END SUBROUTINE GetExtSpcVal_int + END SUBROUTINE GetExtSpcVal_int !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -942,7 +945,7 @@ SUBROUTINE GetExtSpcVal_char( HcoConfig, extNr, NSPC, spcNames, & IF ( found ) spcScal(I) = scaleFac ENDDO - END SUBROUTINE GetExtSpcVal_char + END SUBROUTINE GetExtSpcVal_char !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! From a0cef212fc5562d20796d5713ed85a53cbfbe2cc Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 21 Jun 2023 15:08:57 -0400 Subject: [PATCH 42/63] Update HCO_WARNING arguments in MODEL_GEOS block to avoid GEOS build error Signed-off-by: Lizzie Lundgren --- src/Extensions/hcox_dustdead_mod.F | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F index e2721553..928411e5 100644 --- a/src/Extensions/hcox_dustdead_mod.F +++ b/src/Extensions/hcox_dustdead_mod.F @@ -5868,7 +5868,7 @@ SUBROUTINE ReadTuningFactor(HcoState, TuningTable, FCT, RC ) FNDLABEL = TRIM(CSLABEL) IF ( .NOT. HcoState%Grid%AREA_M2%Alloc ) THEN MSG = 'Warning: AREA_M2 not found, will use default number' - CALL HCO_WARNING( MSG, RC, 1, LOC ) + CALL HCO_WARNING( MSG, RC, .TRUE., LOC ) ELSE AM2 = SUM(HcoState%Grid%AREA_M2%Val)/(HcoState%NX*HcoState%NY) RES = SQRT(AM2) From 0c8fc35ca5cfe65d3233798688edfe9a1fba426d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Mon, 26 Jun 2023 10:59:04 -0400 Subject: [PATCH 43/63] Enable GEOSIT as possible met directory in HEMCO_Config.yml This update facilitates development to include GEOS-IT as a standard GEOS-Chem meteorology option. It prevents a run error if GEOSIT is used in the HEMCO data path in HEMCO_Config.rc. Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 1 + src/Core/hco_extlist_mod.F90 | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0cc9e2a9..60846427 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,6 +10,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. - Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts - Added GFED4 biomass burning emissions for furans, PHEN, MVK, ISOP, ACTA, MGLY, MYLX, RCHO +- Add GEOSIT as an allowable meteorology directory name in HEMCO_Config.rc # Changed - `Verbose` is now a `true/false` variable in `run/HEMCO_sa_Config.rc` and `run/HEMCO_Config.rc.sample` diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index 50cd26bf..f0d4711e 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -1500,6 +1500,11 @@ SUBROUTINE HCO_SetDefaultToken( CF, RC ) DEF_MET_LC = 'merra2' DEF_CN_YR = '2015' ! Constant met fld year DEF_NC_VER = 'nc4' ! NetCDF extension + ELSE IF ( TRIM(CF%MetField) == 'GEOSIT' ) THEN + DEF_MET_UC = 'GEOSIT' + DEF_MET_LC = 'geosit' + DEF_CN_YR = '2011' ! Constant met fld year + DEF_NC_VER = 'nc' ! NetCDF extension ENDIF IF ( TRIM(CF%GridRes) == '4.0x5.0' ) THEN From 640f9070bf4657e36665b222644fd3106af73802 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Wed, 28 Jun 2023 15:47:45 -0400 Subject: [PATCH 44/63] Fixes to prevent writing basic status messages to log from every thread Signed-off-by: Lizzie Lundgren --- src/Core/hco_config_mod.F90 | 2 +- src/Extensions/hcox_volcano_mod.F90 | 23 +++++++++++++---------- 2 files changed, 14 insertions(+), 11 deletions(-) diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 42db1a15..91d4d503 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -2177,7 +2177,7 @@ SUBROUTINE ReadSettings( HcoConfig, IU_HCO, EOF, RC ) ELSE msg = NEW_LINE( 'A' ) // 'HEMCO verbose output is OFF' ENDIF - CALL HCO_Msg( msg, verb=.TRUE. ) + IF ( HcoConfig%amIRoot ) CALL HCO_Msg( msg, verb=.TRUE. ) ! Logfile to write into CALL GetExtOpt( HcoConfig, CoreNr, 'Logfile', & diff --git a/src/Extensions/hcox_volcano_mod.F90 b/src/Extensions/hcox_volcano_mod.F90 index 620f5d9c..2c6f8b59 100644 --- a/src/Extensions/hcox_volcano_mod.F90 +++ b/src/Extensions/hcox_volcano_mod.F90 @@ -355,18 +355,21 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) ! Extension Nr. ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) - IF ( ExtNr > 0 ) THEN - ! Write the name of the extension regardless of the verbose setting - msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' - IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator + ! Print to log + IF ( HcoState%amIRoot ) THEN + IF ( ExtNr > 0 ) THEN + ! Write the name of the extension regardless of the verbose setting + msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator + ELSE + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator + ENDIF ELSE - CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator + MSG = 'The Volcano extension is turned off.' + CALL HCO_MSG( HcoState%Config%Err, MSG ) + RETURN ENDIF - ELSE - MSG = 'The Volcano extension is turned off.' - CALL HCO_MSG( HcoState%Config%Err, MSG ) - RETURN ENDIF ! Enter From 24cf7e06a061e1f24cbed01b3b45f267f5310a66 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 6 Jul 2023 16:01:49 -0400 Subject: [PATCH 45/63] PR #215 post-merge fixes: Update CHANGELOG.md & version numbers CMakeLists.txt docs/source/conf.py src/Core/hco_error_mod.F90 - Updated version numbers from 3.7.0 to 3.7.1 CHANGELOG.md - Updated accordingly Signed-off-by: Bob Yantosca --- CHANGELOG.md | 7 ++++++- CMakeLists.txt | 2 +- docs/source/conf.py | 2 +- src/Core/hco_error_mod.F90 | 7 +++---- 4 files changed, 11 insertions(+), 7 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 60846427..a4f4fdde 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,12 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased 3.7.0] +## [Unreleased 3.7.1] - TBD +### Changed +- Updated version numbers to 3.7.1 +- Make Hg0 emission factors in `hcox_gfed_include_gfed4.H` multipliers of the CO emission factors + +## [Unreleased 3.7.0] - TBD ### Added - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. - Added 'src/Shared/NcdfUtil/README.md` file directing users to look for netCDF utility scripts at https://github.com/geoschem/netcdf-scripts diff --git a/CMakeLists.txt b/CMakeLists.txt index 77196450..ea235e01 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,7 +1,7 @@ # HEMCO/CMakeLists.txt cmake_minimum_required(VERSION 3.5) -project(HEMCO VERSION 3.7.0 LANGUAGES Fortran) +project(HEMCO VERSION 3.7.1 LANGUAGES Fortran) # Reminder: Make sure to also update version in src/Core/hco_error_mod.F90 #----------------------------------------------------------------------------- diff --git a/docs/source/conf.py b/docs/source/conf.py index 15755236..325803c6 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -23,7 +23,7 @@ author = 'GEOS-Chem Support Team' # The full version, including alpha/beta/rc tags -release = '3.7.0' +release = '3.7.1' # -- General configuration --------------------------------------------------- diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index e4d6bb3c..b242dc1c 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -105,7 +105,7 @@ MODULE HCO_Error_Mod #endif ! HEMCO version number. - CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.7.0' + CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.7.1' INTERFACE HCO_Error MODULE PROCEDURE HCO_ErrorNoErr @@ -707,7 +707,7 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & LOGICAL, INTENT(INOUT) :: doVerbose ! Verbose output T/F? LOGICAL, INTENT(INOUT) :: doVerboseOnRoot ! =T: Verbose on root ! =F: Verbose on all - INTEGER, INTENT(INOUT) :: RC + INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: ! 23 Sep 2013 - C. Keller - Initialization @@ -732,7 +732,7 @@ SUBROUTINE HCO_ERROR_SET( am_I_Root, Err, LogFile, & Err%Loc(:) = '' ! Pass values - Err%IsRoot = am_I_Root + Err%IsRoot = am_I_Root Err%LogFile = TRIM(LogFile) ! Specify if verbose will be printed on the root core, or all cores @@ -1059,4 +1059,3 @@ SUBROUTINE HCO_LogFile_Close( Err, ShowSummary ) END SUBROUTINE HCO_LogFile_Close !EOC END MODULE HCO_Error_Mod - From 46f62ed43cdb976d286ccc4f268a518bac0345ec Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 11 Jul 2023 11:22:45 -0400 Subject: [PATCH 46/63] Updated CHANGELOG.md w/ info about cleanup of hco_extlist_mod.F90 CHANGELOG.md - Added comment about the removal of superfluous routine GetExtSpcVal_Dr from src/Core/hco_extlist_mod.F90 Signed-off-by: Bob Yantosca --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0cc9e2a9..da9d6aa2 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased 3.7.1] +### Changed +- Removed superfluous routine `GetExtSpcVal_Dr` in `src/Core/hco_extlist_mod.F90` + ## [Unreleased 3.7.0] ### Added - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. From 3aa65839aecb6a794d19bc6d74b6eb55e4328b25 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Tue, 11 Jul 2023 12:58:16 -0400 Subject: [PATCH 47/63] GEOS-IT meteorology testing now requires year 2018 not 2011 for constants Signed-off-by: Lizzie Lundgren --- src/Core/hco_extlist_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index f0d4711e..173bc134 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -1503,7 +1503,7 @@ SUBROUTINE HCO_SetDefaultToken( CF, RC ) ELSE IF ( TRIM(CF%MetField) == 'GEOSIT' ) THEN DEF_MET_UC = 'GEOSIT' DEF_MET_LC = 'geosit' - DEF_CN_YR = '2011' ! Constant met fld year + DEF_CN_YR = '2018' ! Constant met fld year DEF_NC_VER = 'nc' ! NetCDF extension ENDIF From a032396596cbb0972bdedccb8e80f9ef9013b525 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 14 Jul 2023 18:17:43 -0400 Subject: [PATCH 48/63] HEMCO netCDF utilities now use netCDF-Fortran90 (aka NF90) interface src/Core/hcoio_write_std_mod.F90 - Set Compress=.FALSE. for the P0 variable. This prevents a netCDF error when netCDF tries to compress a zero-dimension variable. src/shared/NcdfUtil/hco_m_netcdf_*.F90 - Replaced"INCLUDE netcdf.inc" with "use netCDF" - Now use the NF90_ function and variables CHANGELOG.md - Updated accordingly Signed-off-by: Bob Yantosca --- CHANGELOG.md | 4 + src/Core/hcoio_write_std_mod.F90 | 2 +- .../NcdfUtil/hco_m_netcdf_io_checks.F90 | 73 +- src/Shared/NcdfUtil/hco_m_netcdf_io_close.F90 | 17 +- .../NcdfUtil/hco_m_netcdf_io_create.F90 | 44 +- .../NcdfUtil/hco_m_netcdf_io_define.F90 | 329 ++-- .../NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 | 49 +- .../NcdfUtil/hco_m_netcdf_io_handle_err.F90 | 7 +- src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 | 26 +- src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 | 1546 ++++++++--------- .../NcdfUtil/hco_m_netcdf_io_readattr.F90 | 187 +- src/Shared/NcdfUtil/hco_ncdf_mod.F90 | 52 +- src/Shared/NcdfUtil/m_do_err_out.F90 | 2 +- 13 files changed, 1111 insertions(+), 1227 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 5c76a252..b20f4b79 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased] +### Changed +- NetCDF routines in `src/Shared/NcdfUtil` now use the Fortran-90 API + ## [Unreleased 3.7.1] - TBD ### Changed - Updated version numbers to 3.7.1 diff --git a/src/Core/hcoio_write_std_mod.F90 b/src/Core/hcoio_write_std_mod.F90 index 5119f8d0..14b7688f 100644 --- a/src/Core/hcoio_write_std_mod.F90 +++ b/src/Core/hcoio_write_std_mod.F90 @@ -547,7 +547,7 @@ SUBROUTINE HCOIO_Write( HcoState, ForceWrite, & VarUnit = 'Pa', & DataType = dp, & VarCt = VarCt, & - Compress = .TRUE. ) + Compress = .FALSE. ) CALL NC_Var_Write( fId, 'P0', P0 ) ! Deallocate arrays diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 index b3fdb2ee..e8115926 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 @@ -1,5 +1,5 @@ !------------------------------------------------------------------------------ -! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group ! +! Ncdfutilities: by Harvard Atmospheric Chemistry Modeling Group ! ! and NASA/GSFC, SIVO, Code 610.3 ! !------------------------------------------------------------------------------ !BOP @@ -44,9 +44,7 @@ module HCO_m_netcdf_io_checks ! function Ncdoes_Udim_Exist (ncid) ! - implicit none -! - include "netcdf.inc" + use netCDF ! ! !INPUT PARAMETERS: !! ncid : netCDF file id to check @@ -69,19 +67,12 @@ function Ncdoes_Udim_Exist (ncid) !BOC ! ! !LOCAL VARIABLES: - integer :: ierr - integer :: udimid -! - ierr = Nf_Inq_Unlimdim (ncid, udimid) - - if (ierr == NF_NOERR) then - Ncdoes_Udim_Exist = .true. - else - Ncdoes_Udim_Exist = .false. - end if - - return + integer :: ierr, udim_id + Ncdoes_Udim_Exist = .false. + ierr = NF90_Inquire(ncid, unlimitedDimId=udim_id) + IF ( ierr /= NF90_NOERR ) Ncdoes_Udim_Exist = .true. + end function Ncdoes_Udim_Exist !EOC !------------------------------------------------------------------------------ @@ -96,9 +87,7 @@ end function Ncdoes_Udim_Exist ! function Ncdoes_Var_Exist (ncid, varname) ! - implicit none -! - include "netcdf.inc" + use netCDF ! ! !INPUT PARAMETERS: !! ncid : netCDF file id to check @@ -126,15 +115,9 @@ function Ncdoes_Var_Exist (ncid, varname) integer :: ierr integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr == NF_NOERR) then - Ncdoes_Var_Exist = .true. - else - Ncdoes_Var_Exist = .false. - end if - - return + ierr = NF90_Inq_Varid(ncid, varname, varid) + Ncdoes_Var_Exist = .false. + if (ierr == NF90_NOERR) Ncdoes_Var_Exist = .true. end function Ncdoes_Var_Exist !EOC @@ -148,11 +131,9 @@ end function Ncdoes_Var_Exist ! ! !INTERFACE: ! - function Ncdoes_Attr_Exist (ncid, varname, attname, attType) + function Ncdoes_Attr_Exist(ncid, varname, attname, attType) ! - implicit none -! - include "netcdf.inc" + use netCDF ! ! !INPUT PARAMETERS: !! ncid : netCDF file id to check @@ -185,27 +166,24 @@ function Ncdoes_Attr_Exist (ncid, varname, attname, attType) !BOC ! ! !LOCAL VARIABLES: - integer :: ierr - integer :: varid - INTEGER :: attLen + INTEGER :: ierr, varId, attLen, attNum ! Init Ncdoes_Attr_Exist = .false. attType = -1 ! First check the variable - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid (ncid, varname, varid) ! Check the attribute if variable was found - IF ( ierr == NF_NOERR ) THEN - ierr = Nf_Inq_Att( ncId, varId, attName, attType, attLen ) - IF ( ierr == NF_NOERR ) THEN + IF ( ierr == NF90_NOERR ) THEN + ierr = NF90_Inquire_Attribute( ncId, varId, attName, & + attType, attLen, attNum ) + IF ( ierr == NF90_NOERR ) THEN NcDoes_Attr_Exist = .TRUE. ENDIF ENDIF - return - end function Ncdoes_Attr_Exist !EOC !------------------------------------------------------------------------------ @@ -220,9 +198,7 @@ end function Ncdoes_Attr_Exist ! function Ncdoes_Dim_Exist (ncid, dimname ) ! - implicit none -! - include "netcdf.inc" + use netCDF ! ! !INPUT PARAMETERS: !! ncid : netCDF file id to check @@ -251,14 +227,11 @@ function Ncdoes_Dim_Exist (ncid, dimname ) integer :: dimid ! First check the variable - ierr = Nf_Inq_Dimid (ncid, dimname, dimid) + ierr = NF90_Inq_Dimid(ncid, dimname, dimid) ! Check the attribute if variable was found - if (ierr == NF_NOERR) then - Ncdoes_Dim_Exist = .true. - else - Ncdoes_Dim_Exist = .false. - end if + Ncdoes_Dim_Exist = .false. + if (ierr == NF90_NOERR) Ncdoes_Dim_Exist = .true. return diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_close.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_close.F90 index 81e2f9d3..4f593a8d 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_close.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_close.F90 @@ -44,11 +44,8 @@ subroutine Nccl (ncid) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -70,10 +67,10 @@ subroutine Nccl (ncid) character (len=512) :: err_msg integer :: ierr ! - ierr = Nf_Close (ncid) + ierr = Nf90_Close (ncid) - if (ierr /= NF_NOERR) then - err_msg = 'In Nccl: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + err_msg = 'In Nccl: ' // Nf90_Strerror (ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) end if @@ -93,9 +90,7 @@ end subroutine Nccl ! subroutine Nccl_Noerr (ncid) ! - implicit none -! - include "netcdf.inc" + use netCDF ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -117,7 +112,7 @@ subroutine Nccl_Noerr (ncid) ! !LOCAL VARIABLES: integer :: ierr ! - ierr = Nf_Close (ncid) + ierr = Nf90_Close (ncid) return diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 index ccf91853..024480e6 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 @@ -44,18 +44,15 @@ subroutine Nccr_Wr (ncid, filname, WRITE_NC4) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: ! ncid : opened netCDF file id ! filname : name of netCDF file to open for writing - integer , intent(in) :: ncid - character (len=*), intent(in) :: filname - LOGICAL, OPTIONAL, INTENT(IN) :: WRITE_NC4 + integer , intent(INOUT) :: ncid + character (len=*), intent(IN) :: filname + LOGICAL, OPTIONAL, INTENT(IN) :: WRITE_NC4 ! ! !DESCRIPTION: Creates a netCDF file for writing and does some error checking. !\\ @@ -64,10 +61,10 @@ subroutine Nccr_Wr (ncid, filname, WRITE_NC4) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REMARKS: -! If the netCDF4 library is used, then the NF_CLOBBER flag will write +! If the netCDF4 library is used, then the NF90_CLOBBER flag will write ! a classic (i.e. netCDF3) file. Use OR(NF_NETCDF4,NF_CLASSIC_MODEL) to -! create netCDF-4 file that supports compression and uses "classic" netcdf data model -! (no groups, no user-defined types) +! create netCDF-4 file that supports compression and uses "classic" +! netcdf data model (no groups, no user-defined types) ! ! !REVISION HISTORY: ! See https://github.com/geoschem/ncdfutil for complete history @@ -91,17 +88,17 @@ subroutine Nccr_Wr (ncid, filname, WRITE_NC4) IF ( TMP_NC4 ) THEN #if defined( NC_HAS_COMPRESSION ) - mode = IOR( NF_NETCDF4, NF_CLASSIC_MODEL ) ! netCDF4 file - ierr = Nf_Create (filname, mode, ncid) ! w/ compression + mode = IOR( NF90_NETCDF4, NF90_CLASSIC_MODEL ) ! netCDF4 file + ierr = NF90_Create(filname, mode, ncid) ! w/ compression #else - ierr = Nf_Create (filname, NF_64BIT_OFFSET, ncid) ! netCDF4 file - ! w/o compression + ierr = NF90_Create(filname, NF90_64BIT_OFFSET, ncid) ! netCDF4 file + ! w/o compression #endif ELSE - ierr = Nf_Create (filname, NF_CLOBBER, ncid) ! netCDF3 file + ierr = NF90_Create(filname, NF90_CLOBBER, ncid) ! netCDF3 file ENDIF - if (ierr /= NF_NOERR) then + if (ierr /= NF90_NOERR) then err_msg = 'In Nccr_Wr, cannot create: ' // Trim (filname) call Do_Err_Out (err_msg, .true., 0, 0, 0, 0 , 0.0d0, 0.0d0) end if @@ -120,15 +117,12 @@ end subroutine Nccr_Wr ! ! !INTERFACE: ! - subroutine Ncdo_Sync (ncid) + subroutine Ncdo_Sync(ncid) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -150,15 +144,13 @@ subroutine Ncdo_Sync (ncid) character (len=128) :: err_msg integer :: ierr ! - ierr = Nf_Sync (ncid) + ierr = Nf90_Sync (ncid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncdo_Sync: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncdo_Sync: ' // Nf90_Strerror (ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) end if - return - end subroutine Ncdo_Sync !EOC end module HCO_m_netcdf_io_create diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 index 02c399cf..97eb4ef1 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 @@ -89,11 +89,8 @@ SUBROUTINE NcDef_dimension(ncid,name,len,id,unlimited) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -130,14 +127,14 @@ SUBROUTINE NcDef_dimension(ncid,name,len,id,unlimited) len0 = len if (present(unlimited)) then if (unlimited) then - len0 = NF_UNLIMITED + len0 = NF90_UNLIMITED endif endif - ierr = Nf_Def_Dim (ncid, name, len0, id) + ierr = NF90_Def_Dim(ncid, name, len0, id) - IF (ierr.ne.NF_NOERR) then - err_msg = 'Nf_Def_Dim: can not define dimension : '// Trim (name) + IF (ierr.ne.NF90_NOERR) then + err_msg = 'NF90_Def_Dim: can not define dimension : '// Trim (name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) END IF @@ -153,33 +150,30 @@ END SUBROUTINE NcDef_dimension ! ! !INTERFACE: ! - SUBROUTINE NcDef_variable(ncid,name,type,ndims,dims,var_id,compress) + SUBROUTINE NcDef_variable(ncid, name, xtype, ndims, dims, var_id, compress) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: ! !! ncid : netCDF file id !! name : name of the variable !! type : type of the variable -!! (NF_FLOAT, NF_CHAR, NF_INT, NF_DOUBLE, NF_BYTE, NF_SHORT) +!! (NF90_FLOAT, NF90_CHAR, NF90_INT, NF90_DOUBLE, NF90_BYTE, NF90_SHORT) !! ndims : number of dimensions of the variable !! dims : netCDF dimension id of the variable CHARACTER (LEN=*), INTENT(IN) :: name INTEGER, INTENT(IN) :: ncid, ndims INTEGER, INTENT(IN) :: dims(ndims) - INTEGER, INTENT(IN) :: type + INTEGER, INTENT(IN) :: xtype LOGICAL, OPTIONAL, INTENT(IN) :: compress ! ! !OUTPUT PARAMETERS: ! -!! varid : netCDF variable id returned by NF_DEF_VAR +!! varid : netCDF variable id returned by NF90_DEF_VAR INTEGER, INTENT(OUT) :: var_id ! ! !DESCRIPTION: Defines a netCDF variable. @@ -195,58 +189,75 @@ SUBROUTINE NcDef_variable(ncid,name,type,ndims,dims,var_id,compress) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - logical :: doStop - ! Compression settings - ! choose deflate_level=1 for fast, minimal compression. - ! Informal testing suggests minimal benefit from higher compression level - integer, parameter :: shuffle=1, deflate=1, deflate_level=1 -! - ierr = Nf_Def_Var (ncid, name, type, ndims, dims, var_id) - - IF (ierr.ne.NF_NOERR) THEN - err_msg = 'Nf_Def_Var: can not define variable : '// Trim (name) - CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) - END IF + character(len=512) :: err_msg + integer :: ierr + logical :: doStop -#if defined( NC_HAS_COMPRESSION ) +#ifdef NC_HAS_COMPRESSION !===================================================================== ! If the optional "compress" variable is used and set to TRUE, ! then enable variable compression (cdh, 0/17/17) ! ! NOTE: We need to block this out with an #ifdef because some - ! netCDF installations might lack the nf_def_var_deflate function + ! netCDF installations might lack the NF90_def_var_deflate function ! which would cause a compile-time error. (bmy, 3/1/17) ! ! ALSO NOTE: Newer versions of netCDF balk when you try to compress ! a scalar variable. This generates an annoying warning message. ! To avoid this, only compress array variables. (bmy, 11/30/20) !===================================================================== - if (present(Compress) .and. ndims > 0) then + if ( PRESENT( Compress ) ) then - if (Compress) then + ! Skip compression for zero-dimension variables + IF ( Compress .and. ndims > 0 ) THEN - ! Set compression - ierr = nf_def_var_deflate( ncid, var_id, shuffle, & - deflate, deflate_level ) + ! Define variable with deflation (aka compression). + ! Choose deflate_level=1 for fast, minimal deflation. + ! Testing shows minimal benefit from higher deflation levels. + ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id, & + shuffle=.TRUE., deflate_level=1 ) ! Check for errors. ! No message will be generated if the error is simply that the ! file is not netCDF-4 ! (i.e. netCDF-3 don't support compression) - IF ( (ierr.ne.NF_NOERR) .and. (ierr.ne.NF_ENOTNC4)) THEN + IF ( (ierr.ne.NF90_NOERR) .and. (ierr.ne.NF90_ENOTNC4)) THEN ! Errors enabling compression will not halt the program doStop = .False. ! Print error - err_msg = 'Nf_Def_Var_Deflate: can not compress variable : '// Trim (name) + err_msg = 'NF90_Def_Var: can not create compressed variable : '//& + Trim(name) CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) END IF - endif - endif + ELSE + + ! Create uncompressed variable if COMPRESS = .FALSE. + ! or if the number of dimensions is zero + ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id ) + IF ( ierr /= NF90_NOERR ) THEN + err_msg = 'NF90_Def_Var_Deflate: can not create variable : '// & + Trim (name) + CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) + ENDIF + + ENDIF + ENDIF + +#else + !===================================================================== + ! Define variable without compression if HEMCO was compiled + ! with netCDF deflation turned off. + !===================================================================== + ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id ) + IF ( ierr /= NF90_NOERR ) THEN + err_msg = 'NF90_Def_Var_Deflate: can not create variable : '// & + Trim(name) + CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) + ENDIF + #endif END SUBROUTINE NcDef_variable @@ -261,14 +272,12 @@ END SUBROUTINE NcDef_variable ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_c(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_c(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -276,7 +285,7 @@ SUBROUTINE NcDef_var_attributes_c(ncid,var_id,att_name,att_val) !! att_name: attribute name !! att_val : attribute value CHARACTER (LEN=*), INTENT(IN) :: att_name, att_val - INTEGER, INTENT(IN) :: ncid, var_id + INTEGER, INTENT(IN) :: ncid, var_id ! ! !DESCRIPTION: Defines a netCDF variable attribute of type: CHARACTER. !\\ @@ -292,12 +301,11 @@ SUBROUTINE NcDef_var_attributes_c(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = LEN(att_val) - ierr = Nf_Put_Att_Text (ncid, var_id, att_name, mylen, att_val) + ierr = NF90_Put_Att(ncid, var_id, att_name, att_val) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr /= NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_c: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -315,10 +323,11 @@ END SUBROUTINE NcDef_var_attributes_c ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_i(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_i(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out ! IMPLICIT NONE @@ -350,11 +359,9 @@ SUBROUTINE NcDef_var_attributes_i(ncid,var_id,att_name,att_val) character (len=512) :: err_msg integer :: mylen, ierr ! - mylen = 1 - ierr = Nf_Put_Att_Int( ncid, var_id, att_name, & - NF_INT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_i: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -372,14 +379,12 @@ END SUBROUTINE NcDef_var_attributes_i ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_r4(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_r4(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out - - IMPLICIT NONE - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -405,13 +410,11 @@ SUBROUTINE NcDef_var_attributes_r4(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = 1 - ierr = Nf_Put_Att_Real( ncid, var_id, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_r4: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -429,14 +432,12 @@ END SUBROUTINE NcDef_var_attributes_r4 ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_r8(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_r8(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -462,13 +463,11 @@ SUBROUTINE NcDef_var_attributes_r8(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = 1 - ierr = Nf_Put_Att_Double( ncid, var_id, att_name, & - NF_DOUBLE, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_r8: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -486,14 +485,12 @@ END SUBROUTINE NcDef_var_attributes_r8 ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_i_arr(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_i_arr(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -519,13 +516,11 @@ SUBROUTINE NcDef_var_attributes_i_arr(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = SIZE( att_val ) - ierr = Nf_Put_Att_Int( ncid, var_id, att_name, & - NF_INT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - iF (ierr.ne.NF_NOERR) THEN + iF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_i_arr: can not define attribute : ' & // TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -543,14 +538,12 @@ END SUBROUTINE NcDef_var_attributes_i_arr ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_r4_arr(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_r4_arr(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -576,13 +569,11 @@ SUBROUTINE NcDef_var_attributes_r4_arr(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = SIZE( att_val ) - ierr = Nf_Put_Att_Real( ncid, var_id, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_r4_arr: can not define attribute : ' & // TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -600,14 +591,12 @@ END SUBROUTINE NcDef_var_attributes_r4_arr ! ! !INTERFACE: ! - SUBROUTINE NcDef_var_attributes_r8_arr(ncid,var_id,att_name,att_val) + SUBROUTINE NcDef_var_attributes_r8_arr(ncid, var_id, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -633,13 +622,11 @@ SUBROUTINE NcDef_var_attributes_r8_arr(ncid,var_id,att_name,att_val) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: ierr ! - mylen = size( att_val ) - ierr = Nf_Put_Att_Double( ncid, var_id, att_name, & - NF_DOUBLE, mylen, att_val ) + ierr = NF90_Put_Att( ncid, var_id, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_var_attributes_r4_arr: can not define attribute : '& // Trim (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -657,15 +644,12 @@ END SUBROUTINE NcDef_var_attributes_r8_arr ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_c(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_c(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -691,12 +675,11 @@ SUBROUTINE NcDef_glob_attributes_c(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = len(att_val) - ierr = Nf_Put_Att_Text (ncid, NF_GLOBAL, att_name, mylen, att_val) + ierr = NF90_Put_Att(ncid, NF90_GLOBAL, att_name, att_val) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_c: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -714,15 +697,12 @@ END SUBROUTINE NcDef_glob_attributes_c ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_i(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_i(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -748,13 +728,11 @@ SUBROUTINE NcDef_glob_attributes_i(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = 1 - ierr = Nf_Put_Att_Int( ncid, NF_GLOBAL, att_name, & - NF_INT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_i: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -772,15 +750,12 @@ END SUBROUTINE NcDef_glob_attributes_i ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_r4(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_r4(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -806,13 +781,11 @@ SUBROUTINE NcDef_glob_attributes_r4(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: ierr ! - mylen = 1 - ierr = Nf_Put_Att_Real( ncid, NF_GLOBAL, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_r4: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -830,15 +803,12 @@ END SUBROUTINE NcDef_glob_attributes_r4 ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_r8(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_r8(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -864,13 +834,11 @@ SUBROUTINE NcDef_glob_attributes_r8(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: ierr ! - mylen = 1 - ierr = Nf_Put_Att_Double( ncid, NF_GLOBAL, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_r8: can not define attribute : ' // & TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -888,15 +856,12 @@ END SUBROUTINE NcDef_glob_attributes_r8 ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_i_arr(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_i_arr(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -922,13 +887,11 @@ SUBROUTINE NcDef_glob_attributes_i_arr(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: CHARACTER (LEN=512) :: err_msg - INTEGER :: mylen, ierr + INTEGER :: ierr ! - mylen = SIZE( att_val ) - ierr = Nf_Put_Att_Int( ncid, NF_GLOBAL, att_name, & - NF_INT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_i_arr: can not define attribute : ' & // Trim (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -950,11 +913,8 @@ SUBROUTINE NcDef_glob_attributes_r4_arr(ncid,att_name,att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -980,13 +940,11 @@ SUBROUTINE NcDef_glob_attributes_r4_arr(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: ierr ! - mylen = SIZE( att_val ) - ierr = Nf_Put_Att_Real( ncid, NF_GLOBAL, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_r4_arr: can not define attribute : ' & // TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -1004,15 +962,12 @@ END SUBROUTINE NcDef_glob_attributes_r4_arr ! ! !INTERFACE: ! - SUBROUTINE NcDef_glob_attributes_r8_arr(ncid,att_name,att_val) + SUBROUTINE NcDef_glob_attributes_r8_arr(ncid, att_name, att_val) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -1038,13 +993,11 @@ SUBROUTINE NcDef_glob_attributes_r8_arr(ncid,att_name,att_val) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: ierr ! - mylen = SIZE( att_val ) - ierr = Nf_Put_Att_Double( ncid, NF_GLOBAL, att_name, & - NF_FLOAT, mylen, att_val ) + ierr = NF90_Put_Att( ncid, NF90_GLOBAL, att_name, att_val ) - IF (ierr.ne.NF_NOERR) THEN + IF (ierr.ne.NF90_NOERR) THEN err_msg = 'NcDef_glob_attributes_r8_arr: can not define attribute : ' & // TRIM (att_name) CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) @@ -1062,19 +1015,17 @@ END SUBROUTINE NcDef_glob_attributes_r8_arr ! ! !INTERFACE: ! - SUBROUTINE NcSetFill(ncid,ifill,omode) + SUBROUTINE NcSetFill(ncid, ifill, omode) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: ! - INTEGER, INTENT(in) :: ncid, ifill,omode + INTEGER, INTENT(IN ) :: ncid, ifill + INTEGER, INTENT(INOUT) :: omode ! ! !DESCRIPTION: Sets fill method. !\\ @@ -1090,12 +1041,12 @@ SUBROUTINE NcSetFill(ncid,ifill,omode) ! ! !LOCAL VARIABLES: character (len=512) :: err_msg - integer :: mylen, ierr + integer :: mylen, ierr ! - ierr = Nf_Set_Fill (ncid, NF_NOFILL, omode) + ierr = NF90_Set_Fill(ncid, NF90_NOFILL, omode) - IF (ierr.ne.NF_NOERR) THEN - err_msg = 'Nf_Set_FIll: Error in omode ' + IF (ierr.ne.NF90_NOERR) THEN + err_msg = 'NF90_Set_FIll: Error in omode ' CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) END IF @@ -1115,11 +1066,8 @@ SUBROUTINE NcEnd_Def(ncid) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT NONE -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: ! @@ -1141,10 +1089,10 @@ SUBROUTINE NcEnd_Def(ncid) CHARACTER (LEN=512) :: err_msg INTEGER :: ierr ! - ierr = Nf_Enddef (ncid) + ierr = NF90_Enddef(ncid) - IF (ierr.ne.NF_NOERR) THEN - err_msg = 'Nf_EndDef: Error in closing netCDF define mode!' + IF (ierr.ne.NF90_NOERR) THEN + err_msg = 'NF90_EndDef: Error in closing netCDF define mode!' CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) END IF @@ -1164,11 +1112,8 @@ SUBROUTINE NcBegin_Def(ncid) ! ! !USES: ! + USE netCDF USE m_do_err_out -! - IMPLICIT none -! - INCLUDE 'netcdf.inc' ! ! !INPUT PARAMETERS: ! @@ -1192,10 +1137,10 @@ SUBROUTINE NcBegin_Def(ncid) character (len=512) :: err_msg integer :: ierr ! - ierr = Nf_Redef (ncid) + ierr = NF90_Redef (ncid) - IF (ierr.ne.NF_NOERR) THEN - err_msg = 'Nf_ReDef: Error in opening netCDF define mode!' + IF (ierr.ne.NF90_NOERR) THEN + err_msg = 'NF90_ReDef: Error in opening netCDF define mode!' CALL Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) END IF diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 index 2e509746..9a86d189 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 @@ -40,15 +40,12 @@ module HCO_m_netcdf_io_get_dimlen ! ! !INTERFACE: ! - subroutine Ncget_Dimlen (ncid, dim_name, dim_len ) + subroutine Ncget_Dimlen(ncid, dim_name, dim_len) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include 'netcdf.inc' ! ! !INPUT PARAMETERS: !! dim_name : netCDF dimension name @@ -80,18 +77,18 @@ subroutine Ncget_Dimlen (ncid, dim_name, dim_len ) integer :: dimid integer :: ierr - ierr = Nf_Inq_Dimid (ncid, dim_name, dimid) + ierr = NF90_Inq_Dimid(ncid, dim_name, dimid) - if (ierr /= NF_NOERR ) then + if (ierr /= NF90_NOERR ) then err_msg = 'In Ncget_Dimlen #1: ' // Trim (dim_name) // & - ', ' // Nf_Strerror (ierr) + ', ' // NF90_Strerror (ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) end if - ierr = Nf_Inq_Dimlen (ncid, dimid, dim_len) + ierr = NF90_Inquire_Dimension(ncid, dimid, len=dim_len) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncget_Dimlen #2: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncget_Dimlen #2: ' // NF90_Strerror (ierr) call Do_Err_Out (err_msg, .true., 2, ncid, dimid, 0, 0.0d0, 0.0d0) end if @@ -112,11 +109,8 @@ subroutine Ncget_Unlim_Dimlen (ncid, udim_len) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include 'netcdf.inc' ! ! !INPUT PARAMETERS: !! ncid : netCDF file id @@ -139,25 +133,14 @@ subroutine Ncget_Unlim_Dimlen (ncid, udim_len) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: udimid -! - ierr = Nf_Inq_Unlimdim (ncid, udimid) + character(len=512) :: err_msg + integer :: ierr, udim_id - if (ierr /= NF_NOERR) then - err_msg = 'In Ncget_Unlim_Dimlen #1: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if - - ierr = Nf_Inq_Dimlen (ncid, udimid, udim_len) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncget_Unlim_Dimlen #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, udimid, 0, 0.0d0, 0.0d0) - end if - - return + udim_len = -1 + ierr = NF90_Inquire(ncid, unlimitedDimId=udim_id) + IF ( ierr /= NF90_NOERR ) THEN + ierr = NF90_Inquire_Dimension( ncid, udim_id, len=udim_len ) + ENDIF end subroutine Ncget_Unlim_Dimlen !EOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 index 86474497..64719b7d 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 @@ -43,11 +43,8 @@ subroutine Nchandle_Err (ierr) ! ! !USES: ! + use netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: ! ierr : netCDF error number @@ -68,7 +65,7 @@ subroutine Nchandle_Err (ierr) ! !LOCAL VARIABLES: character (len=512) :: err_msg ! - err_msg = 'In Nchandle_Err: ' // Nf_Strerror (ierr) + err_msg = 'In Nchandle_Err: ' // Nf90_Strerror (ierr) call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 index 31e8f65e..0d600b3b 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 @@ -40,15 +40,12 @@ module HCO_m_netcdf_io_open ! ! !INTERFACE: ! - subroutine Ncop_Rd (ncid, filname) + subroutine Ncop_Rd (ncid, filname, rc) ! ! !USES: ! + USE netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: !! filname : name of netCDF file to open for reading @@ -57,6 +54,7 @@ subroutine Ncop_Rd (ncid, filname) ! !OUTPUT PARAMETERS: !! ncid : opened netCDF file id integer , intent (out) :: ncid + integer, optional :: rc ! ! !DESCRIPTION: Opens a netCDF file for reading and does some error checking. !\\ @@ -71,14 +69,15 @@ subroutine Ncop_Rd (ncid, filname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr + character(len=512) :: err_msg + integer :: ierr ! - ierr = Nf_Open (filname, NF_NOWRITE, ncid) + ierr = Nf90_Open( filname, NF90_NOWRITE, ncid ) - if (ierr /= NF_NOERR) then + if (ierr /= NF90_NOERR) then err_msg = 'In Ncop_Rd, cannot open: ' // Trim (filname) call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + return end if return @@ -99,11 +98,8 @@ subroutine Ncop_Wr (ncid, filname) ! ! !USES: ! + USE netCDF use m_do_err_out -! - implicit none -! - include "netcdf.inc" ! ! !INPUT PARAMETERS: !! filname : name of netCDF file to open for reading @@ -130,9 +126,9 @@ subroutine Ncop_Wr (ncid, filname) character (len=512) :: err_msg integer :: ierr ! - ierr = Nf_Open (filname, NF_WRITE, ncid) + ierr = Nf90_Open (filname, NF90_WRITE, ncid) - if (ierr /= NF_NOERR) then + if (ierr /= NF90_NOERR) then err_msg = 'In Ncop_Rd, cannot open: ' // Trim (filname) call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) end if diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 index 73cf8e25..b7ed044e 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 @@ -8,44 +8,44 @@ ! ! !INTERFACE: ! - MODULE HCO_m_netcdf_io_read +MODULE HCO_m_netcdf_io_read ! ! !USES: ! - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: ! - ! Public interface - PUBLIC :: NcRd - - ! Private methods overloaded by public interface - ! (see below for info about these routines & the arguments they take) - INTERFACE NcRd - MODULE PROCEDURE Ncrd_Scal - MODULE PROCEDURE Ncrd_Scal_Int - MODULE PROCEDURE Ncrd_1d_R8 - MODULE PROCEDURE Ncrd_1d_R4 - MODULE PROCEDURE Ncrd_1d_Int - MODULE PROCEDURE Ncrd_1d_Char - MODULE PROCEDURE Ncrd_2d_R8 - MODULE PROCEDURE Ncrd_2d_R4 - MODULE PROCEDURE Ncrd_2d_Int - MODULE PROCEDURE Ncrd_2d_Char - MODULE PROCEDURE Ncrd_3d_R8 - MODULE PROCEDURE Ncrd_3d_R4 - MODULE PROCEDURE Ncrd_3d_Int - MODULE PROCEDURE Ncrd_4d_R8 - MODULE PROCEDURE Ncrd_4d_R4 - MODULE PROCEDURE Ncrd_4d_Int - MODULE PROCEDURE Ncrd_5d_R8 - MODULE PROCEDURE Ncrd_5d_R4 - MODULE PROCEDURE Ncrd_6d_R8 - MODULE PROCEDURE Ncrd_6d_R4 - MODULE PROCEDURE Ncrd_7d_R8 - MODULE PROCEDURE Ncrd_7d_R4 - END INTERFACE + ! Public interface + PUBLIC :: NcRd + + ! Private methods overloaded by public interface + ! (see below for info about these routines & the arguments they take) + INTERFACE NcRd + MODULE PROCEDURE Ncrd_Scal + MODULE PROCEDURE Ncrd_Scal_Int + MODULE PROCEDURE Ncrd_1d_R8 + MODULE PROCEDURE Ncrd_1d_R4 + MODULE PROCEDURE Ncrd_1d_Int + MODULE PROCEDURE Ncrd_1d_Char + MODULE PROCEDURE Ncrd_2d_R8 + MODULE PROCEDURE Ncrd_2d_R4 + MODULE PROCEDURE Ncrd_2d_Int + MODULE PROCEDURE Ncrd_2d_Char + MODULE PROCEDURE Ncrd_3d_R8 + MODULE PROCEDURE Ncrd_3d_R4 + MODULE PROCEDURE Ncrd_3d_Int + MODULE PROCEDURE Ncrd_4d_R8 + MODULE PROCEDURE Ncrd_4d_R4 + MODULE PROCEDURE Ncrd_4d_Int + MODULE PROCEDURE Ncrd_5d_R8 + MODULE PROCEDURE Ncrd_5d_R4 + MODULE PROCEDURE Ncrd_6d_R8 + MODULE PROCEDURE Ncrd_6d_R4 + MODULE PROCEDURE Ncrd_7d_R8 + MODULE PROCEDURE Ncrd_7d_R4 + END INTERFACE NcRd ! ! !DESCRIPTION: Routines for reading variables in a netCDF file. !\\ @@ -67,25 +67,22 @@ MODULE HCO_m_netcdf_io_read ! ! !INTERFACE: ! - subroutine Ncrd_Scal (varrd_scal, ncid, varname) + subroutine Ncrd_Scal(varrd_scal, ncid, varname) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read variable from -!! varname : netCDF variable name - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname +!! ncid : netCDF file id to read variable from +!! varname : netCDF variable name + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname ! ! !OUTPUT PARAMETERS: -!! varrd_scal : variable to fill - real*8 , intent(out) :: varrd_scal +!! varrd_scal : variable to fill + real*8 , intent(out) :: varrd_scal ! ! !DESCRIPTION: Reads in a netCDF scalar variable. !\\ @@ -100,31 +97,31 @@ subroutine Ncrd_Scal (varrd_scal, ncid, varname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid - real*4 :: varrd_scal_tmp + character (len=512) :: err_msg + integer :: ierr + integer :: varid + real*4 :: varrd_scal_tmp ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_Scal #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_VarId(ncid, varname, varid) - ierr = Nf_Get_Var_Real (ncid, varid, varrd_scal_tmp) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_Scal #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_Scal #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Get_Var(ncid, varid, varrd_scal_tmp) - varrd_scal = varrd_scal_tmp + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_Scal #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + varrd_scal = varrd_scal_tmp - return + return - end subroutine Ncrd_Scal + end subroutine Ncrd_Scal !EOC !------------------------------------------------------------------------- !BOP @@ -133,25 +130,22 @@ end subroutine Ncrd_Scal ! ! !INTERFACE: ! - subroutine Ncrd_Scal_Int (varrd_scali, ncid, varname) + subroutine Ncrd_Scal_Int(varrd_scali, ncid, varname) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read variable from -!! varname : netCDF variable name - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname +!! ncid : netCDF file id to read variable from +!! varname : netCDF variable name + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname ! ! !OUTPUT PARAMETERS: -!! varrd_scali : integer variable to fill - integer , intent(out) :: varrd_scali +!! varrd_scali : integer variable to fill + integer , intent(out) :: varrd_scali ! ! !DESCRIPTION: Reads in a netCDF integer scalar variable. !\\ @@ -166,28 +160,28 @@ subroutine Ncrd_Scal_Int (varrd_scali, ncid, varname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_Scal_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_Scal_Int #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = NF90_Get_Var(ncid, varid, varrd_scali) - ierr = Nf_Get_Var_Int (ncid, varid, varrd_scali) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_Scal_Int #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_Scal_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - return + return - end subroutine Ncrd_Scal_Int + end subroutine Ncrd_Scal_Int !EOC !------------------------------------------------------------------------- !BOP @@ -196,33 +190,29 @@ end subroutine Ncrd_Scal_Int ! ! !INTERFACE: ! - subroutine Ncrd_1d_R8 (varrd_1d, ncid, varname, strt1d, cnt1d, & - err_stop, stat) + subroutine Ncrd_1d_R8(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varrd_1d where -!! the first of the data values will be read -!! cnt1d : varrd_1d dimension - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - logical, optional, intent(in) :: err_stop +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1d where +!! the first of the data values will be read +!! cnt1d : varrd_1d dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + logical, optional, intent(in) :: err_stop ! ! !OUTPUT PARAMETERS: -!! varrd_1d : array to fill - real*8 , intent(out) :: varrd_1d(cnt1d(1)) - integer, optional, intent(out) :: stat +!! varrd_1d : array to fill + real*8 , intent(out) :: varrd_1d(cnt1d(1)) + integer, optional, intent(out) :: stat ! ! !DESCRIPTION: Reads in a 1D netCDF real array and does some error checking. !\\ @@ -238,49 +228,49 @@ subroutine Ncrd_1d_R8 (varrd_1d, ncid, varname, strt1d, cnt1d, & ! ! !LOCAL VARIABLES: ! - character (len=512) :: err_msg - integer :: ierr - integer :: varid - logical :: dostop + character (len=512) :: err_msg + integer :: ierr + integer :: varid + logical :: dostop - ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif + ! set dostop flag + if ( present ( err_stop ) ) then + dostop = err_stop + else + dostop = .true. + endif - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - if ( dostop ) then + if (ierr /= NF90_NOERR) then + if ( dostop ) then err_msg = 'In Ncrd_1d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) + ', ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - else + else varrd_1d(:) = -999d0 if ( present ( stat ) ) stat = 1 return - end if - end if - - ierr = Nf_Get_Vara_Double (ncid, varid, strt1d, cnt1d, varrd_1d) - - if (ierr /= NF_NOERR) then - if ( dostop ) then - err_msg = 'In Ncrd_1d_R8 #2: ' // Nf_Strerror (ierr) + end if + end if + + ierr = NF90_Get_Var(ncid, varid, varrd_1d, start=strt1d, count=cnt1d) + + if (ierr /= NF90_NOERR) then + if ( dostop ) then + err_msg = 'In Ncrd_1d_R8 #2: ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - else + else varrd_1d(:) = -999d0 if ( present ( stat ) ) stat = 2 return - endif - end if - - ! set stat to 0 (= success) - if ( present ( stat ) ) stat = 0 - - end subroutine Ncrd_1d_R8 + endif + end if + + ! set stat to 0 (= success) + if ( present ( stat ) ) stat = 0 + + end subroutine Ncrd_1d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -289,33 +279,29 @@ end subroutine Ncrd_1d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_1d_R4 (varrd_1d, ncid, varname, strt1d, cnt1d, & - err_stop, stat) + subroutine Ncrd_1d_R4(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varrd_1d where -!! the first of the data values will be read -!! cnt1d : varrd_1d dimension - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - logical, optional, intent(in) :: err_stop +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1d where +!! the first of the data values will be read +!! cnt1d : varrd_1d dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + logical, optional, intent(in) :: err_stop ! ! !OUTPUT PARAMETERS: -!! varrd_1d : array to fill - real*4 , intent(out) :: varrd_1d(cnt1d(1)) - integer, optional, intent(out) :: stat +!! varrd_1d : array to fill + real*4 , intent(out) :: varrd_1d(cnt1d(1)) + integer, optional, intent(out) :: stat ! ! !DESCRIPTION: Reads in a 1D netCDF real array and does some error checking. !\\ @@ -331,50 +317,50 @@ subroutine Ncrd_1d_R4 (varrd_1d, ncid, varname, strt1d, cnt1d, & ! ! !LOCAL VARIABLES: ! - character (len=512) :: err_msg - integer :: ierr - integer :: varid - logical :: dostop - - ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif - - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - if ( dostop ) then - err_msg = 'In Ncrd_1d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - else + character (len=512) :: err_msg + integer :: ierr + integer :: varid + logical :: dostop + + ! set dostop flag + if ( present ( err_stop ) ) then + dostop = err_stop + else + dostop = .true. + endif + + ierr = NF90_Inq_VarId(ncid, varname, varid) + + if (ierr /= NF90_NOERR) then + if ( dostop ) then + err_msg = 'In Ncrd_1d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + else varrd_1d(:) = -999.0 if ( present ( stat ) ) stat = 1 return - end if - end if + end if + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt1d, cnt1d, varrd_1d) + ierr = NF90_Get_Var(ncid, varid, varrd_1d, start=strt1d, count=cnt1d) - if (ierr /= NF_NOERR) then - if ( dostop ) then - err_msg = 'In Ncrd_1d_R4 #2: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + if ( dostop ) then + err_msg = 'In Ncrd_1d_R4 #2: ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - else + else varrd_1d(:) = -999.0 if ( present ( stat ) ) stat = 2 return - endif - end if + endif + end if - ! set stat to 0 (= success) - if ( present ( stat ) ) stat = 0 - return + ! set stat to 0 (= success) + if ( present ( stat ) ) stat = 0 + return - end subroutine Ncrd_1d_R4 + end subroutine Ncrd_1d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -383,34 +369,31 @@ end subroutine Ncrd_1d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_1d_Int (varrd_1di, ncid, varname, strt1d, cnt1d, & - err_stop, stat) + subroutine Ncrd_1d_Int(varrd_1di, ncid, varname, strt1d, & + cnt1d, err_stop, stat) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: ! -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varrd_1di where -!! the first of the data values will be read -!! cnt1d : varrd_1di dimension - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - logical, optional, intent(in) :: err_stop +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1di where +!! the first of the data values will be read +!! cnt1d : varrd_1di dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + logical, optional, intent(in) :: err_stop ! ! !OUTPUT PARAMETERS: -!! varrd_1di : intger array to fill - integer , intent(out) :: varrd_1di(cnt1d(1)) - integer, optional, intent(out) :: stat +!! varrd_1di : intger array to fill + integer , intent(out) :: varrd_1di(cnt1d(1)) + integer, optional, intent(out) :: stat ! ! !DESCRIPTION: Reads in a 1D netCDF integer array and does some error ! checking. @@ -427,51 +410,51 @@ subroutine Ncrd_1d_Int (varrd_1di, ncid, varname, strt1d, cnt1d, & ! ! !LOCAL VARIABLES: ! - character (len=512) :: err_msg - integer :: ierr - integer :: varid - logical :: dostop + character (len=512) :: err_msg + integer :: ierr + integer :: varid + logical :: dostop - ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif + ! set dostop flag + if ( present ( err_stop ) ) then + dostop = err_stop + else + dostop = .true. + endif - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - if ( dostop ) then + if (ierr /= NF90_NOERR) then + if ( dostop ) then err_msg = 'In Ncrd_1d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) + ', ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - else + else varrd_1di(:) = -999 if ( present ( stat ) ) stat = 1 return - end if - end if + end if + end if - ierr = Nf_Get_Vara_Int (ncid, varid, strt1d, cnt1d, varrd_1di) + ierr = NF90_Get_Var(ncid, varid, varrd_1di, start=strt1d, count=cnt1d) - if (ierr /= NF_NOERR) then - if ( dostop ) then - err_msg = 'In Ncrd_1d_Int #2: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + if ( dostop ) then + err_msg = 'In Ncrd_1d_Int #2: ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - else + else varrd_1di(:) = -999 if ( present ( stat ) ) stat = 2 return - endif - end if + endif + end if - ! set stat to 0 (= success) - if ( present ( stat ) ) stat = 0 + ! set stat to 0 (= success) + if ( present ( stat ) ) stat = 0 - return + return - end subroutine Ncrd_1d_Int + end subroutine Ncrd_1d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -480,30 +463,26 @@ end subroutine Ncrd_1d_Int ! ! !INTERFACE: ! - subroutine Ncrd_2d_R8 (varrd_2d, ncid, varname, strt2d, cnt2d) + subroutine Ncrd_2d_R8(varrd_2d, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" -! -! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varrd_2d where + use netCDF + use m_do_err_out + +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where !! the first of the data values will be read -!! cnt2d : varrd_2d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) +!! cnt2d : varrd_2d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) ! ! !OUTPUT PARAMETERS: -!! varrd_2d : array to fill - real*8 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) +!! varrd_2d : array to fill + real*8 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Reads in a 2D netCDF real array and does some error checking. !\\ @@ -518,26 +497,26 @@ subroutine Ncrd_2d_R8 (varrd_2d, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_R8 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt2d, cnt2d, varrd_2d) + ierr = NF90_Get_Var(ncid, varid, varrd_2d, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_2d_R8 + end subroutine Ncrd_2d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -546,30 +525,27 @@ end subroutine Ncrd_2d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_2d_R4 (varrd_2d, ncid, varname, strt2d, cnt2d) + subroutine Ncrd_2d_R4(varrd_2d, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varrd_2d where -!! the first of the data values will be read -!! cnt2d : varrd_2d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where +!! the first of the data values will be read +!! cnt2d : varrd_2d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) ! ! !OUTPUT PARAMETERS: -!! varrd_2d : array to fill - real*4 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) +!! varrd_2d : array to fill + real*4 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Reads in a 2D netCDF real array and does some error checking. !\\ @@ -584,26 +560,26 @@ subroutine Ncrd_2d_R4 (varrd_2d, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt2d, cnt2d, varrd_2d) + ierr = NF90_Get_Var(ncid, varid, varrd_2d, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_2d_R4 + end subroutine Ncrd_2d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -612,30 +588,27 @@ end subroutine Ncrd_2d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_2d_Int (varrd_2di, ncid, varname, strt2d, cnt2d) + subroutine Ncrd_2d_Int(varrd_2di, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varrd_2d where -!! the first of the data values will be read -!! cnt2d : varrd_2di dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where +!! the first of the data values will be read +!! cnt2d : varrd_2di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) ! ! !OUTPUT PARAMETERS: -!! varrd_2di : intger array to fill - integer , intent(out) :: varrd_2di(cnt2d(1), cnt2d(2)) +!! varrd_2di : intger array to fill + integer , intent(out) :: varrd_2di(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Reads in a 2D netCDF integer array and does some error ! checking. @@ -651,26 +624,26 @@ subroutine Ncrd_2d_Int (varrd_2di, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_Int #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Int (ncid, varid, strt2d, cnt2d, varrd_2di) + ierr = NF90_Get_Var(ncid, varid, varrd_2di, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_Int #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_2d_Int + end subroutine Ncrd_2d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -679,31 +652,28 @@ end subroutine Ncrd_2d_Int ! ! !INTERFACE: ! - subroutine Ncrd_3d_R8 (varrd_3d, ncid, varname, strt3d, cnt3d) + subroutine Ncrd_3d_R8(varrd_3d, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varrd_3d where +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where !! the first of the data values will be read -!! cnt3d : varrd_3d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) +!! cnt3d : varrd_3d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) ! ! !OUTPUT PARAMETERS: -!! varrd_3d : array to fill - real*8 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & - cnt3d(3)) +!! varrd_3d : array to fill + real*8 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & + cnt3d(3)) ! ! !DESCRIPTION: Reads in a 3D netCDF real array and does some error checking. !\\ @@ -718,26 +688,26 @@ subroutine Ncrd_3d_R8 (varrd_3d, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_R8 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt3d, cnt3d, varrd_3d) + ierr = NF90_Get_Var(ncid, varid, varrd_3d, start=strt3d, count=cnt3d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_3d_R8 + end subroutine Ncrd_3d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -746,31 +716,28 @@ end subroutine Ncrd_3d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_3d_R4 (varrd_3d, ncid, varname, strt3d, cnt3d) + subroutine Ncrd_3d_R4(varrd_3d, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varrd_3d where -!! the first of the data values will be read -!! cnt3d : varrd_3d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) ! ! !OUTPUT PARAMETERS: -!! varrd_3d : array to fill - real*4 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & - cnt3d(3)) +!! varrd_3d : array to fill + real*4 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & + cnt3d(3)) ! ! !DESCRIPTION: Reads in a 3D netCDF real array and does some error checking. !\\ @@ -785,26 +752,26 @@ subroutine Ncrd_3d_R4 (varrd_3d, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt3d, cnt3d, varrd_3d) + ierr = NF90_Get_Var(ncid, varid, varrd_3d, start=strt3d, count=cnt3d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_3d_R4 + end subroutine Ncrd_3d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -813,31 +780,28 @@ end subroutine Ncrd_3d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_3d_Int (varrd_3di, ncid, varname, strt3d, cnt3d) + subroutine Ncrd_3d_Int(varrd_3di, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varrd_3d where -!! the first of the data values will be read -!! cnt3d : varrd_3di dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) ! ! !OUTPUT PARAMETERS: -!! varrd_3di : intger array to fill - integer , intent(out) :: varrd_3di(cnt3d(1), cnt3d(2), & - cnt3d(3)) +!! varrd_3di : intger array to fill + integer , intent(out) :: varrd_3di(cnt3d(1), cnt3d(2), & + cnt3d(3)) ! ! !DESCRIPTION: Reads in a 3D netCDF integer array and does some error ! checking. @@ -853,26 +817,26 @@ subroutine Ncrd_3d_Int (varrd_3di, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Int (ncid, varid, strt3d, cnt3d, varrd_3di) + ierr = NF90_Get_Var(ncid, varid, varrd_3di, start=strt3d, count=cnt3d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_Int #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_3d_Int + end subroutine Ncrd_3d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -881,31 +845,30 @@ end subroutine Ncrd_3d_Int ! ! !INTERFACE: ! - subroutine Ncrd_4d_R8 (varrd_4d, ncid, varname, strt4d, cnt4d) + subroutine Ncrd_4d_R8(varrd_4d, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none + use netCDF + use m_do_err_out ! - include "netcdf.inc" + implicit none ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt4d : vector specifying the index in varrd_4d where -!! the first of the data values will be read -!! cnt4d : varrd_4d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varrd_4d where +!! the first of the data values will be read +!! cnt4d : varrd_4d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) ! ! !OUTPUT PARAMETERS: -!! varrd_4d : array to fill - real*8 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! varrd_4d : array to fill + real*8 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Reads in a 4D netCDF real array and does some error checking. !\\ @@ -920,27 +883,26 @@ subroutine Ncrd_4d_R8 (varrd_4d, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_4d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_VarId(ncid, varname, varid) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_4d_R8 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt4d, cnt4d, varrd_4d) + ierr = NF90_Get_Var(ncid, varid, varrd_4d, start=strt4d, count=cnt4d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_4d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_4d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_4d_R8 + end subroutine Ncrd_4d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -949,31 +911,28 @@ end subroutine Ncrd_4d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_4d_R4 (varrd_4d, ncid, varname, strt4d, cnt4d) + subroutine Ncrd_4d_R4(varrd_4d, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt4d : vector specifying the index in varrd_4d where -!! the first of the data values will be read -!! cnt4d : varrd_4d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varrd_4d where +!! the first of the data values will be read +!! cnt4d : varrd_4d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) ! ! !OUTPUT PARAMETERS: -!! varrd_4d : array to fill - real*4 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! varrd_4d : array to fill + real*4 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Reads in a 4D netCDF real array and does some error checking. !\\ @@ -988,26 +947,26 @@ subroutine Ncrd_4d_R4 (varrd_4d, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_4d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_4d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt4d, cnt4d, varrd_4d) + ierr = NF90_Get_Var(ncid, varid, varrd_4d, start=strt4d, count=cnt4d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_4d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_4d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_4d_R4 + end subroutine Ncrd_4d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1016,31 +975,28 @@ end subroutine Ncrd_4d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_4d_Int (varrd_4di, ncid, varname, strt4d, cnt4d) + subroutine Ncrd_4d_Int(varrd_4di, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varrd_3d where -!! the first of the data values will be read -!! cnt3d : varrd_3di dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) ! ! !OUTPUT PARAMETERS: -!! varrd_3di : intger array to fill - integer , intent(out) :: varrd_4di(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! varrd_3di : intger array to fill + integer , intent(out) :: varrd_4di(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Reads in a 3D netCDF integer array and does some error ! checking. @@ -1056,26 +1012,26 @@ subroutine Ncrd_4d_Int (varrd_4di, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Int (ncid, varid, strt4d, cnt4d, varrd_4di) + ierr = NF90_Get_Var(ncid, varid, varrd_4di, start=strt4d, count=cnt4d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_3d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_3d_Int #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_4d_Int + end subroutine Ncrd_4d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -1084,32 +1040,29 @@ end subroutine Ncrd_4d_Int ! ! !INTERFACE: ! - subroutine Ncrd_5d_R8 (varrd_5d, ncid, varname, strt5d, cnt5d) + subroutine Ncrd_5d_R8(varrd_5d, ncid, varname, strt5d, cnt5d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varrd_5d where -!! the first of the data values will be read -!! cnt5d : varrd_5d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt5d(5) - integer , intent(in) :: cnt5d (5) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) ! ! !OUTPUT PARAMETERS: -!! varrd_5d : array to fill - real*8 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & - cnt5d(3), cnt5d(4), & - cnt5d(5)) +!! varrd_5d : array to fill + real*8 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) ! ! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. !\\ @@ -1124,26 +1077,26 @@ subroutine Ncrd_5d_R8 (varrd_5d, ncid, varname, strt5d, cnt5d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then + if (ierr /= NF90_NOERR) then err_msg = 'In Ncrd_5d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) + ', ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt5d, cnt5d, varrd_5d) + ierr = NF90_Get_Var(ncid, varid, varrd_5d, start=strt5d, count=cnt5d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_5d_R8 #2: ' // Nf_Strerror (ierr) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_5d_R8 #2: ' // NF90_Strerror(ierr) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + end if - end subroutine Ncrd_5d_R8 + end subroutine Ncrd_5d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1152,30 +1105,27 @@ end subroutine Ncrd_5d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_5d_R4 (varrd_5d, ncid, varname, strt5d, cnt5d) + subroutine Ncrd_5d_R4(varrd_5d, ncid, varname, strt5d, cnt5d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varrd_5d where -!! the first of the data values will be read -!! cnt5d : varrd_5d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt5d(5) - integer , intent(in) :: cnt5d (5) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) ! ! !OUTPUT PARAMETERS: -!! varrd_5d : array to fill - real*4 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & +!! varrd_5d : array to fill + real*4 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & cnt5d(3), cnt5d(4), & cnt5d(5)) ! @@ -1192,26 +1142,26 @@ subroutine Ncrd_5d_R4 (varrd_5d, ncid, varname, strt5d, cnt5d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid -! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_5d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if - - ierr = Nf_Get_Vara_Real (ncid, varid, strt5d, cnt5d, varrd_5d) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_5d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncrd_5d_R4 + character (len=512) :: err_msg + integer :: ierr + integer :: varid +! + ierr = NF90_Inq_VarId(ncid, varname, varid) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_5d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = NF90_Get_Var(ncid, varid, varrd_5d, start=strt5d, count=cnt5d) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_5d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_5d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1220,32 +1170,29 @@ end subroutine Ncrd_5d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_6d_R8 (varrd_6d, ncid, varname, strt6d, cnt6d) + subroutine Ncrd_6d_R8(varrd_6d, ncid, varname, strt6d, cnt6d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varrd_5d where +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where !! the first of the data values will be read -!! cnt5d : varrd_5d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt6d(6) - integer , intent(in) :: cnt6d (6) +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) ! ! !OUTPUT PARAMETERS: -!! varrd_5d : array to fill - real*8 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & - cnt6d(3), cnt6d(4), & - cnt6d(5), cnt6d(6)) +!! varrd_5d : array to fill + real*8 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) ! ! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. !\\ @@ -1261,26 +1208,26 @@ subroutine Ncrd_6d_R8 (varrd_6d, ncid, varname, strt6d, cnt6d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_6d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_6d_R8 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt6d, cnt6d, varrd_6d) + ierr = NF90_Get_Var(ncid, varid, varrd_6d, start=strt6d, count=cnt6d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_6d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_6d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_6d_R8 + end subroutine Ncrd_6d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1289,32 +1236,29 @@ end subroutine Ncrd_6d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_6d_R4 (varrd_6d, ncid, varname, strt6d, cnt6d) + subroutine Ncrd_6d_R4(varrd_6d, ncid, varname, strt6d, cnt6d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varrd_5d where -!! the first of the data values will be read -!! cnt5d : varrd_5d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt6d(6) - integer , intent(in) :: cnt6d (6) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) ! ! !OUTPUT PARAMETERS: -!! varrd_5d : array to fill - real*4 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & - cnt6d(3), cnt6d(4), & - cnt6d(5), cnt6d(6)) +!! varrd_5d : array to fill + real*4 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) ! ! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. !\\ @@ -1329,26 +1273,26 @@ subroutine Ncrd_6d_R4 (varrd_6d, ncid, varname, strt6d, cnt6d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_6d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if ( ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_6d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt6d, cnt6d, varrd_6d) + ierr = NF90_Get_Var(ncid, varid, varrd_6d, start=strt6d, count=cnt6d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_6d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_6d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_6d_R4 + end subroutine Ncrd_6d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1357,33 +1301,30 @@ end subroutine Ncrd_6d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_7d_R8 (varrd_7d, ncid, varname, strt7d, cnt7d) + subroutine Ncrd_7d_R8(varrd_7d, ncid, varname, strt7d, cnt7d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt7d : vector specifying the index in varrd_7d where -!! the first of the data values will be read -!! cnt7d : varrd_7d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt7d(7) - integer , intent(in) :: cnt7d (7) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt7d : vector specifying the index in varrd_7d where +!! the first of the data values will be read +!! cnt7d : varrd_7d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt7d(7) + integer , intent(in) :: cnt7d (7) ! ! !OUTPUT PARAMETERS: -!! varrd_5d : array to fill - real*8 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & - cnt7d(3), cnt7d(4), & - cnt7d(5), cnt7d(6), & - cnt7d(7)) +!! varrd_5d : array to fill + real*8 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & + cnt7d(3), cnt7d(4), & + cnt7d(5), cnt7d(6), & + cnt7d(7)) ! ! !DESCRIPTION: Reads in a 7D netCDF real array and does some error checking. !\\ @@ -1399,26 +1340,26 @@ subroutine Ncrd_7d_R8 (varrd_7d, ncid, varname, strt7d, cnt7d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_7d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_7d_R8 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Double (ncid, varid, strt7d, cnt7d, varrd_7d) + ierr = NF90_Get_Var(ncid, varid, varrd_7d, start=strt7d, count=cnt7d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_7d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_7d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_7d_R8 + end subroutine Ncrd_7d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1427,33 +1368,30 @@ end subroutine Ncrd_7d_R8 ! ! !INTERFACE: ! - subroutine Ncrd_7d_R4 (varrd_7d, ncid, varname, strt7d, cnt7d) + subroutine Ncrd_7d_R4(varrd_7d, ncid, varname, strt7d, cnt7d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt7d : vector specifying the index in varrd_7d where -!! the first of the data values will be read -!! cnt7d : varrd_7d dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt7d(7) - integer , intent(in) :: cnt7d (7) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt7d : vector specifying the index in varrd_7d where +!! the first of the data values will be read +!! cnt7d : varrd_7d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt7d(7) + integer , intent(in) :: cnt7d (7) ! ! !OUTPUT PARAMETERS: -!! varrd_7d : array to fill - real*4 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & - cnt7d(3), cnt7d(4), & - cnt7d(5), cnt7d(6), & - cnt7d(7)) +!! varrd_7d : array to fill + real*4 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & + cnt7d(3), cnt7d(4), & + cnt7d(5), cnt7d(6), & + cnt7d(7)) ! ! !DESCRIPTION: Reads in a 7D netCDF real array and does some error checking. !\\ @@ -1469,26 +1407,26 @@ subroutine Ncrd_7d_R4 (varrd_7d, ncid, varname, strt7d, cnt7d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_7d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_7d_R4 #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Real (ncid, varid, strt7d, cnt7d, varrd_7d) + ierr = NF90_Get_Var(ncid, varid, varrd_7d, start=strt7d, count=cnt7d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_7d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_7d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_7d_R4 + end subroutine Ncrd_7d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1497,31 +1435,28 @@ end subroutine Ncrd_7d_R4 ! ! !INTERFACE: ! - subroutine Ncrd_1d_Char (varrd_1dc, ncid, varname, strt1d, cnt1d) + subroutine Ncrd_1d_Char(varrd_1dc, ncid, varname, strt1d, cnt1d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: ! -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varrd_1dc where -!! the first of the data values will be read -!! cnt1d : varrd_1dc dimension - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1dc where +!! the first of the data values will be read +!! cnt1d : varrd_1dc dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) ! ! !OUTPUT PARAMETERS: -!! varrd_1dc : intger array to fill - character (len=1), intent(out) :: varrd_1dc(cnt1d(1)) +!! varrd_1dc : intger array to fill + character (len=1), intent(out) :: varrd_1dc(cnt1d(1)) ! ! !DESCRIPTION: Reads in a 1D netCDF character array and does some error ! checking. @@ -1536,26 +1471,26 @@ subroutine Ncrd_1d_Char (varrd_1dc, ncid, varname, strt1d, cnt1d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_1d_Char #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_1d_Char #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Text (ncid, varid, strt1d, cnt1d, varrd_1dc) + ierr = NF90_Get_Var(ncid, varid, varrd_1dc, start=strt1d, count=cnt1d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_1d_Char #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_1d_Char #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_1d_Char + end subroutine Ncrd_1d_Char !EOC !------------------------------------------------------------------------- !BOP @@ -1564,30 +1499,27 @@ end subroutine Ncrd_1d_Char ! ! !INTERFACE: ! - subroutine Ncrd_2d_Char (varrd_2dc, ncid, varname, strt2d, cnt2d) + subroutine Ncrd_2d_Char(varrd_2dc, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to read array input data from -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varrd_2dc where -!! the first of the data values will be read -!! cnt2d : varrd_2dc dimensions - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2dc where +!! the first of the data values will be read +!! cnt2d : varrd_2dc dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) ! ! !OUTPUT PARAMETERS: -!! varrd_2dc : charcter array to fill - character , intent(out) :: varrd_2dc(cnt2d(1), cnt2d(2)) +!! varrd_2dc : charcter array to fill + character , intent(out) :: varrd_2dc(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Reads in a 2D netCDF character array and does some error ! checking. @@ -1603,26 +1535,26 @@ subroutine Ncrd_2d_Char (varrd_2dc, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character (len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_Char #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_Char #1: ' // Trim (varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Get_Vara_Text (ncid, varid, strt2d, cnt2d, varrd_2dc) + ierr = NF90_Get_Var(ncid, varid, varrd_2dc, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_2d_Char #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncrd_2d_Char #2: ' // NF90_Strerror(ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncrd_2d_Char + end subroutine Ncrd_2d_Char !EOC !------------------------------------------------------------------------ end module HCO_m_netcdf_io_read diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 index d08bd7da..fe32ef62 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 @@ -11,13 +11,9 @@ MODULE HCO_m_netcdf_io_readattr ! ! !USES: - - USE m_do_err_out - +! IMPLICIT NONE PRIVATE - - INCLUDE "netcdf.inc" ! ! !PUBLIC MEMBER FUNCTIONS: ! @@ -93,6 +89,11 @@ MODULE HCO_m_netcdf_io_readattr ! SUBROUTINE NcGet_Var_Attr_C( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -125,20 +126,20 @@ SUBROUTINE NcGet_Var_Attr_C( fid, varName, attName, attValue ) attValue = '' ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_C: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) ENDIF ! Get the attribute - status = Nf_Get_Att_Text( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_C: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -161,6 +162,11 @@ END SUBROUTINE NcGet_Var_Attr_C ! SUBROUTINE NcGet_Var_Attr_I4( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -193,20 +199,20 @@ SUBROUTINE NcGet_Var_Attr_I4( fid, varName, attName, attValue ) attValue = 0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_I4: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Int( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_I4: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -229,6 +235,11 @@ END SUBROUTINE NcGet_Var_Attr_I4 ! SUBROUTINE NcGet_Var_Attr_R4( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -261,20 +272,20 @@ SUBROUTINE NcGet_Var_Attr_R4( fid, varName, attName, attValue ) attValue = 0e0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R4: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Real( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R4: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -297,6 +308,11 @@ END SUBROUTINE NcGet_Var_Attr_R4 ! SUBROUTINE NcGet_Var_Attr_R8( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -329,20 +345,20 @@ SUBROUTINE NcGet_Var_Attr_R8( fid, varName, attName, attValue ) attValue = 0d0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R8: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Double( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R8: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -365,6 +381,11 @@ END SUBROUTINE NcGet_Var_Attr_R8 ! SUBROUTINE NcGet_Var_Attr_I4_arr( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -397,20 +418,20 @@ SUBROUTINE NcGet_Var_Attr_I4_arr( fid, varName, attName, attValue ) attValue = 0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_I4_arr: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Int( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_I4_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -433,6 +454,11 @@ END SUBROUTINE NcGet_Var_Attr_I4_arr ! SUBROUTINE NcGet_Var_Attr_R4_arr( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -465,20 +491,20 @@ SUBROUTINE NcGet_Var_Attr_R4_arr( fid, varName, attName, attValue ) attValue = 0e0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R4_arr: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Real( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R4_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -501,6 +527,11 @@ END SUBROUTINE NcGet_Var_Attr_R4_arr ! SUBROUTINE NcGet_Var_Attr_R8_arr( fid, varName, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -533,20 +564,20 @@ SUBROUTINE NcGet_Var_Attr_R8_arr( fid, varName, attName, attValue ) attValue = 0d0 ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R8_arr: ' // TRIM( varName ) // & - ', ' // Nf_Strerror( status ) + ', ' // NF90_Strerror( status ) CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) ENDIF ! Get the attribute - status = Nf_Get_Att_Double( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Var_Attr_R8_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -569,6 +600,11 @@ END SUBROUTINE NcGet_Var_Attr_R8_arr ! SUBROUTINE NcGet_Glob_Attr_C( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -600,10 +636,10 @@ SUBROUTINE NcGet_Glob_Attr_C( fid, attName, attValue ) attValue = '' ! Get the attribute - status = Nf_Get_Att_Text( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_C: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -626,6 +662,11 @@ END SUBROUTINE NcGet_Glob_Attr_C ! SUBROUTINE NcGet_Glob_Attr_I4( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -657,10 +698,10 @@ SUBROUTINE NcGet_Glob_Attr_I4( fid, attName, attValue ) attValue = 0 ! Get the attribute - status = Nf_Get_Att_Int( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_I4: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -683,6 +724,11 @@ END SUBROUTINE NcGet_Glob_Attr_I4 ! SUBROUTINE NcGet_Glob_Attr_R4( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -714,10 +760,10 @@ SUBROUTINE NcGet_Glob_Attr_R4( fid, attName, attValue ) attValue = 0e0 ! Get the attribute - status = Nf_Get_Att_Real( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_R4: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -740,6 +786,11 @@ END SUBROUTINE NcGet_Glob_Attr_R4 ! SUBROUTINE NcGet_Glob_Attr_R8( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -771,10 +822,10 @@ SUBROUTINE NcGet_Glob_Attr_R8( fid, attName, attValue ) attValue = 0d0 ! Get the attribute - status = Nf_Get_Att_Double( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_R8: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -797,6 +848,11 @@ END SUBROUTINE NcGet_Glob_Attr_R8 ! SUBROUTINE NcGet_Glob_Attr_I4_arr( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -828,10 +884,10 @@ SUBROUTINE NcGet_Glob_Attr_I4_arr( fid, attName, attValue ) attValue = 0 ! Get the attribute - status = Nf_Get_Att_Int( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_I4_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -854,6 +910,11 @@ END SUBROUTINE NcGet_Glob_Attr_I4_arr ! SUBROUTINE NcGet_Glob_Attr_R4_arr( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -885,10 +946,10 @@ SUBROUTINE NcGet_Glob_Attr_R4_arr( fid, attName, attValue ) attValue = 0e0 ! Get the attribute - status = Nf_Get_Att_Real( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_R4_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -911,6 +972,11 @@ END SUBROUTINE NcGet_Glob_Attr_R4_arr ! SUBROUTINE NcGet_Glob_Attr_R8_arr( fid, attName, attValue ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -942,10 +1008,10 @@ SUBROUTINE NcGet_Glob_Attr_R8_arr( fid, attName, attValue ) attValue = 0d0 ! Get the attribute - status = Nf_Get_Att_Double( fId, NF_GLOBAL, attName, attValue ) + status = NF90_Get_Att( fId, NF90_GLOBAL, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN errMsg = 'In NcGet_Glob_Attr_R8_arr: cannot read attribute : ' // & TRIM( attName ) CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) @@ -970,6 +1036,11 @@ END SUBROUTINE NcGet_Glob_Attr_R8_arr ! SUBROUTINE NcGet_Var_Attr_C_nostop( fId, varName, attName, attValue, RC ) ! +! USES: +! + USE netCDF + USE m_do_err_out +! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: fId ! netCDF file ID @@ -1003,19 +1074,19 @@ SUBROUTINE NcGet_Var_Attr_C_nostop( fId, varName, attName, attValue, RC ) attValue = '' ! Check if VARNAME is a valid variable - status = Nf_Inq_Varid ( fId, varName, vId ) + status = NF90_Inq_VarId( fId, varName, vId ) ! Exit w/ error message if VARNAME is not valid - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN RC = status RETURN ENDIF ! Get the attribute - status = Nf_Get_Att_Text( fId, vId, attName, attValue ) + status = NF90_Get_Att( fId, vId, attName, attValue ) ! Exit w/ error message if unsuccessful - IF ( status /= NF_NOERR ) THEN + IF ( status /= NF90_NOERR ) THEN RC = status RETURN ENDIF diff --git a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 index 5037b119..952dd9fe 100644 --- a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 +++ b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 @@ -17,6 +17,7 @@ MODULE HCO_NCDF_MOD ! !USES: ! ! Modules for netCDF read + USE netCDF USE HCO_m_netcdf_io_open USE HCO_m_netcdf_io_get_dimlen USE HCO_m_netcdf_io_read @@ -30,7 +31,6 @@ MODULE HCO_NCDF_MOD IMPLICIT NONE PRIVATE -# include "netcdf.inc" ! ! !PUBLIC MEMBER FUNCTIONS: ! @@ -217,11 +217,7 @@ SUBROUTINE NC_APPEND( FileName, fID, nTime ) ! Also return the number of time slices so that we can ! append to an existing file w/o clobbering any data IF ( PRESENT( nTime ) ) THEN - nTime = -1 - RC = Nf_Inq_DimId( fId, 'time', vId ) - IF ( RC == NF_NOERR ) THEN - RC = Nf_Inq_DimLen( fId, vId, nTime ) - ENDIF + CALL Ncget_Unlim_Dimlen( fId, nTime ) ENDIF END SUBROUTINE NC_APPEND @@ -1194,12 +1190,12 @@ SUBROUTINE NC_READ_ARR( fID, ncVar, lon1, lon2, lat1, & a_name = "missing_value" ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type ) IF ( ReadAtt ) THEN - IF ( a_type == NF_REAL ) THEN + IF ( a_type == NF90_REAL ) THEN CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss4 ) WHERE ( ncArr == miss4 ) ncArr = MissValue END WHERE - ELSE IF ( a_type == NF_DOUBLE ) THEN + ELSE IF ( a_type == NF90_DOUBLE ) THEN CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss8 ) miss4 = REAL( miss8 ) WHERE ( ncArr == miss4 ) @@ -1212,12 +1208,12 @@ SUBROUTINE NC_READ_ARR( fID, ncVar, lon1, lon2, lat1, & a_name = "_FillValue" ReadAtt = Ncdoes_Attr_Exist ( fId, TRIM(v_name), TRIM(a_name), a_type ) IF ( ReadAtt ) THEN - IF ( a_type == NF_REAL ) THEN + IF ( a_type == NF90_REAL ) THEN CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss4 ) WHERE ( ncArr == miss4 ) ncArr = MissValue END WHERE - ELSE IF ( a_type == NF_DOUBLE ) THEN + ELSE IF ( a_type == NF90_DOUBLE ) THEN CALL NcGet_Var_Attributes( fId, TRIM(v_name), TRIM(a_name), miss8 ) miss4 = REAL( miss8 ) WHERE ( ncArr == miss4 ) @@ -3115,7 +3111,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& CALL NcCr_Wr( fId, TRIM(ncFile) ) ! Turn filling off - CALL NcSetFill( fId, NF_NOFILL, omode ) + CALL NcSetFill( fId, NF90_NOFILL, omode ) !-------------------------------- ! GLOBAL ATTRIBUTES @@ -3170,7 +3166,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& ! Define the "lon" variable v_name = "lon" var1d = (/ id_lon /) - CALL NcDef_Variable( fId, TRIM(v_name), NF_FLOAT, 1, var1d, vId ) + CALL NcDef_Variable( fId, TRIM(v_name), NF90_FLOAT, 1, var1d, vId ) ! Define the "lon:long_name" attribute a_name = "long_name" @@ -3189,7 +3185,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& ! Define the "lat" variable v_name = "lat" var1d = (/ id_lat /) - CALL NcDef_Variable( fId, TRIM(v_name), NF_FLOAT, 1, var1d, vId ) + CALL NcDef_Variable( fId, TRIM(v_name), NF90_FLOAT, 1, var1d, vId ) ! Define the "lat:long_name" attribute a_name = "long_name" @@ -3210,7 +3206,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& ! Define the "levels" variable v_name = "lev" var1d = (/ id_lev /) - CALL NcDef_Variable( fId, TRIM(v_name), NF_INT, 1, var1d, vId ) + CALL NcDef_Variable( fId, TRIM(v_name), NF90_INT, 1, var1d, vId ) ! Define the "time:long_name" attribute a_name = "long_name" @@ -3230,7 +3226,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& ! Define the "time" variable v_name = "time" var1d = (/ id_time /) - CALL NcDef_Variable( fId, TRIM(v_name), NF_INT, 1, var1d, vId ) + CALL NcDef_Variable( fId, TRIM(v_name), NF90_INT, 1, var1d, vId ) ! Define the "time:long_name" attribute a_name = "long_name" @@ -3251,10 +3247,10 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& v_name = TRIM(ncVars(I)) IF ( PRESENT(nlev) ) THEN var4d = (/ id_lon, id_lat, id_lev, id_time /) - CALL NcDef_Variable(fId,TRIM(v_name),NF_DOUBLE,4,var4d,vId) + CALL NcDef_Variable(fId,TRIM(v_name),NF90_DOUBLE,4,var4d,vId) ELSE var3d = (/ id_lon, id_lat, id_time /) - CALL NcDef_Variable(fId,TRIM(v_name),NF_DOUBLE,3,var3d,vId) + CALL NcDef_Variable(fId,TRIM(v_name),NF90_DOUBLE,3,var3d,vId) ENDIF ! Define the long_name attribute @@ -3648,7 +3644,7 @@ SUBROUTINE Nc_Create( NcFile, Title, nLon, & CALL NcCr_Wr( fId, TRIM( ncFile ), Save_As_Nc4 ) ! Turn filling off - CALL NcSetFill( fId, NF_NOFILL, omode ) + CALL NcSetFill( fId, NF90_NOFILL, omode ) !======================================================================= ! Set global attributes @@ -3792,7 +3788,7 @@ SUBROUTINE NC_Var_Def( fId, lonId, latId, levId, & ! Scalars INTEGER :: nDim, Pos - INTEGER :: NF_TYPE, tmpIlevId + INTEGER :: NF90_TYPE, tmpIlevId LOGICAL :: isDefMode ! Strings @@ -3859,20 +3855,20 @@ SUBROUTINE NC_Var_Def( fId, lonId, latId, levId, & ! Set data type IF ( DataType == 1 ) THEN - NF_TYPE = NF_INT + NF90_TYPE = NF90_INT ELSEIF ( DataType == 4 ) THEN - NF_TYPE = NF_FLOAT + NF90_TYPE = NF90_FLOAT ELSEIF ( DataType == 8 ) THEN - NF_TYPE = NF_DOUBLE + NF90_TYPE = NF90_DOUBLE ELSE - NF_TYPE = NF_FLOAT + NF90_TYPE = NF90_FLOAT ENDIF !----------------------------------------------------------------------- ! Define variable !----------------------------------------------------------------------- - CALL NcDef_Variable( fId, TRIM(VarName), NF_TYPE, & - nDim, VarDims, VarCt, Compress ) + CALL NcDef_Variable( fId, TRIM(VarName), NF90_TYPE, & + nDim, VarDims, VarCt, Compress ) DEALLOCATE( VarDims ) !----------------------------------------------------------------------- @@ -3881,11 +3877,11 @@ SUBROUTINE NC_Var_Def( fId, lonId, latId, levId, & ! long_name (reuired) Att = 'long_name' - CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarLongName) ) + CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarLongName) ) ! units (requited) Att = 'units' - CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarUnit) ) + CALL NcDef_Var_Attributes( fId, VarCt, TRIM(Att), TRIM(VarUnit) ) ! add_offset (optional) IF ( PRESENT( AddOffset ) ) THEN @@ -4009,7 +4005,7 @@ SUBROUTINE Nc_Var_Chunk( fId, vId, ChunkSizes, RC ) ! Turn on chunking for this variable ! But only if the netCDF library supports it - RC = NF_Def_Var_Chunking( fId, vId, NF_CHUNKED, ChunkSizes ) + RC = NF90_Def_Var_Chunking( fId, vId, NF90_CHUNKED, ChunkSizes ) #else diff --git a/src/Shared/NcdfUtil/m_do_err_out.F90 b/src/Shared/NcdfUtil/m_do_err_out.F90 index b6df11e5..593fa835 100644 --- a/src/Shared/NcdfUtil/m_do_err_out.F90 +++ b/src/Shared/NcdfUtil/m_do_err_out.F90 @@ -127,7 +127,7 @@ subroutine Do_Err_Out & ! NOTE: Should not exit but pass error code up ! work on this for a future version - stop 999 + stop 999 ENDIF RETURN From a695de55ed28186c42915107c0284dc1764927c0 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Mon, 17 Jul 2023 10:17:47 -0400 Subject: [PATCH 49/63] Clean up logic in Ncdef_variable (in hco_m_netcdf_io_define.F90) src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 - Eliminate ELSE blocks by using never-nesting techniques - First execute the IF block in the #ifdef. If COMPRESS is not passed, or is false, or if ndims == 0, then do not create the variable with netCDF compression. Signed-off-by: Bob Yantosca --- .../NcdfUtil/hco_m_netcdf_io_define.F90 | 62 ++++++++----------- 1 file changed, 27 insertions(+), 35 deletions(-) diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 index 97eb4ef1..1812106e 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 @@ -162,7 +162,8 @@ SUBROUTINE NcDef_variable(ncid, name, xtype, ndims, dims, var_id, compress) !! ncid : netCDF file id !! name : name of the variable !! type : type of the variable -!! (NF90_FLOAT, NF90_CHAR, NF90_INT, NF90_DOUBLE, NF90_BYTE, NF90_SHORT) +!! (NF90_FLOAT, NF90_CHAR, NF90_INT, +!! NF90_DOUBLE, NF90_BYTE, NF90_SHORT) !! ndims : number of dimensions of the variable !! dims : netCDF dimension id of the variable CHARACTER (LEN=*), INTENT(IN) :: name @@ -195,32 +196,32 @@ SUBROUTINE NcDef_variable(ncid, name, xtype, ndims, dims, var_id, compress) #ifdef NC_HAS_COMPRESSION !===================================================================== - ! If the optional "compress" variable is used and set to TRUE, - ! then enable variable compression (cdh, 0/17/17) + ! Create a compressed (deflated) netCDF variable ! ! NOTE: We need to block this out with an #ifdef because some - ! netCDF installations might lack the NF90_def_var_deflate function + ! netCDF installations might lack the deflation capability, ! which would cause a compile-time error. (bmy, 3/1/17) - ! - ! ALSO NOTE: Newer versions of netCDF balk when you try to compress - ! a scalar variable. This generates an annoying warning message. - ! To avoid this, only compress array variables. (bmy, 11/30/20) - !===================================================================== - if ( PRESENT( Compress ) ) then + !======================================================================== + IF ( PRESENT( Compress ) ) then - ! Skip compression for zero-dimension variables + !------------------------------------------------------------------ + ! If COMPRESS is passed as an optional argument, and is TRUE, + ! then define the variable with deflate_level=1. Higher values + ! of deflate_level yield minimal additiional benefit. + ! + ! ALSO NOTE: Newer versions of netCDF balk when you try to compress + ! a scalar variable. This generates an annoying warning message. + ! To avoid this, only compress array variables. (bmy, 11/30/20) + !------------------------------------------------------------------- IF ( Compress .and. ndims > 0 ) THEN - ! Define variable with deflation (aka compression). - ! Choose deflate_level=1 for fast, minimal deflation. - ! Testing shows minimal benefit from higher deflation levels. + ! Create deflated variable ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id, & shuffle=.TRUE., deflate_level=1 ) ! Check for errors. ! No message will be generated if the error is simply that the - ! file is not netCDF-4 - ! (i.e. netCDF-3 don't support compression) + ! file is not netCDF-4 (as netCDF-3 doesn't support compression) IF ( (ierr.ne.NF90_NOERR) .and. (ierr.ne.NF90_ENOTNC4)) THEN ! Errors enabling compression will not halt the program @@ -232,33 +233,24 @@ SUBROUTINE NcDef_variable(ncid, name, xtype, ndims, dims, var_id, compress) CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) END IF - ELSE - - ! Create uncompressed variable if COMPRESS = .FALSE. - ! or if the number of dimensions is zero - ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id ) - IF ( ierr /= NF90_NOERR ) THEN - err_msg = 'NF90_Def_Var_Deflate: can not create variable : '// & - Trim (name) - CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) - ENDIF - + ! Return successfully + RETURN ENDIF ENDIF +#endif -#else - !===================================================================== - ! Define variable without compression if HEMCO was compiled - ! with netCDF deflation turned off. - !===================================================================== + !======================================================================== + ! Create an uncompressed netCDF variable if: + ! (1) COMPRESS is not passed as an optional argument + ! (2) COMPRESS is passed as an optional argument but is FALSE + ! (3) The variable is a scalar (ndims == 0) + !======================================================================== ierr = NF90_Def_Var( ncid, name, xtype, dims, var_id ) IF ( ierr /= NF90_NOERR ) THEN err_msg = 'NF90_Def_Var_Deflate: can not create variable : '// & - Trim(name) + Trim (name) CALL Do_Err_Out (err_msg, doStop, 0, 0, 0, 0, 0.0d0, 0.0d0) ENDIF - -#endif END SUBROUTINE NcDef_variable !EOC From 725972fa6ea0db8755a40eb997e62781ddc4182f Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Mon, 17 Jul 2023 10:53:45 -0400 Subject: [PATCH 50/63] PR #226 post-merge fixes: Update CHANGELOG.md CHANGELOG.md - Now list the PR #226 (Update HEMCO netCDF I/O code to use the netCDF-F90 interface) under version 3.7.1. Signed-off-by: Bob Yantosca --- CHANGELOG.md | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index b20f4b79..b4dc058a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,15 +5,12 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased] -### Changed -- NetCDF routines in `src/Shared/NcdfUtil` now use the Fortran-90 API - ## [Unreleased 3.7.1] - TBD ### Changed - Updated version numbers to 3.7.1 - Make Hg0 emission factors in `hcox_gfed_include_gfed4.H` multipliers of the CO emission factor - Removed superfluous routine `GetExtSpcVal_Dr` in `src/Core/hco_extlist_mod.F90` +- NetCDF routines in `src/Shared/NcdfUtil` now use the Fortran-90 API ## [Unreleased 3.7.0] - TBD ### Added From 3b70e2c1ed5ca52ecdf5955d1d054148b43550b7 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 18 Jul 2023 17:14:19 -0400 Subject: [PATCH 51/63] Bug fixes and comment updates in HEMCO netCDF I/O utilities src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 - Remove ELSE blocks in the IF ( dostop ) teset - Fix indentation - Change a leftover instance of NF_NOERR to NF90_NOERR - Update "Revision History" comments in subroutine headers src/Shared/NcdfUtil/hco_m_netcdf_io_write_mod.F90 - This file was not converted to use the netCDF-F90 interface, but this has now been resolved. - Use F90 indentation src/Shared/NcdfUtil/hco_ncdf_mod.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 - Update "Revision History" subroutine headers Signed-off-by: Bob Yantosca --- .../NcdfUtil/hco_m_netcdf_io_checks.F90 | 10 +- .../NcdfUtil/hco_m_netcdf_io_create.F90 | 6 +- .../NcdfUtil/hco_m_netcdf_io_define.F90 | 40 +- .../NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 | 6 +- .../NcdfUtil/hco_m_netcdf_io_handle_err.F90 | 4 +- src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 | 6 +- src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 | 85 +- .../NcdfUtil/hco_m_netcdf_io_readattr.F90 | 48 +- src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 | 1388 ++++++++--------- src/Shared/NcdfUtil/hco_ncdf_mod.F90 | 150 +- 10 files changed, 801 insertions(+), 942 deletions(-) diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 index e8115926..e51043bf 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_checks.F90 @@ -26,7 +26,7 @@ module HCO_m_netcdf_io_checks ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -61,7 +61,7 @@ function Ncdoes_Udim_Exist (ncid) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -106,7 +106,7 @@ function Ncdoes_Var_Exist (ncid, varname) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -160,7 +160,7 @@ function Ncdoes_Attr_Exist(ncid, varname, attname, attType) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -217,7 +217,7 @@ function Ncdoes_Dim_Exist (ncid, dimname ) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !----------------------------------------------------------------------------- !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 index 024480e6..a0ef592a 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_create.F90 @@ -24,7 +24,7 @@ module HCO_m_netcdf_io_create ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -67,7 +67,7 @@ subroutine Nccr_Wr (ncid, filname, WRITE_NC4) ! netcdf data model (no groups, no user-defined types) ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -135,7 +135,7 @@ subroutine Ncdo_Sync(ncid) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 index 1812106e..b97bd365 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_define.F90 @@ -69,7 +69,7 @@ MODULE HCO_m_netcdf_io_define ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -113,7 +113,7 @@ SUBROUTINE NcDef_dimension(ncid,name,len,id,unlimited) ! Jules Kouatchou and Maharaj Bhat ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -184,7 +184,7 @@ SUBROUTINE NcDef_variable(ncid, name, xtype, ndims, dims, var_id, compress) ! Jules Kouatchou and Maharaj Bhat ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -286,7 +286,7 @@ SUBROUTINE NcDef_var_attributes_c(ncid, var_id, att_name, att_val) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -342,7 +342,7 @@ SUBROUTINE NcDef_var_attributes_i(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -395,7 +395,7 @@ SUBROUTINE NcDef_var_attributes_r4(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -448,7 +448,7 @@ SUBROUTINE NcDef_var_attributes_r8(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 20 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -501,7 +501,7 @@ SUBROUTINE NcDef_var_attributes_i_arr(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -554,7 +554,7 @@ SUBROUTINE NcDef_var_attributes_r4_arr(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -607,7 +607,7 @@ SUBROUTINE NcDef_var_attributes_r8_arr(ncid, var_id, att_name, att_val) ! ! !REVISION HISTORY: ! 20 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -660,7 +660,7 @@ SUBROUTINE NcDef_glob_attributes_c(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -713,7 +713,7 @@ SUBROUTINE NcDef_glob_attributes_i(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -766,7 +766,7 @@ SUBROUTINE NcDef_glob_attributes_r4(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -819,7 +819,7 @@ SUBROUTINE NcDef_glob_attributes_r8(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -872,7 +872,7 @@ SUBROUTINE NcDef_glob_attributes_i_arr(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -925,7 +925,7 @@ SUBROUTINE NcDef_glob_attributes_r4_arr(ncid,att_name,att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -978,7 +978,7 @@ SUBROUTINE NcDef_glob_attributes_r8_arr(ncid, att_name, att_val) ! ! !REVISION HISTORY: ! 26 Sep 2013 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1026,7 +1026,7 @@ SUBROUTINE NcSetFill(ncid, ifill, omode) ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1072,7 +1072,7 @@ SUBROUTINE NcEnd_Def(ncid) ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1120,7 +1120,7 @@ SUBROUTINE NcBegin_Def(ncid) ! ! !REVISION HISTORY: ! 14 May 2014 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 index 9a86d189..2bde9a61 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_get_dimlen.F90 @@ -24,7 +24,7 @@ module HCO_m_netcdf_io_get_dimlen ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -67,7 +67,7 @@ subroutine Ncget_Dimlen(ncid, dim_name, dim_len) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -127,7 +127,7 @@ subroutine Ncget_Unlim_Dimlen (ncid, udim_len) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 index 64719b7d..b8c81d48 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_handle_err.F90 @@ -23,7 +23,7 @@ module HCO_m_netcdf_io_handle_err ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !----------------------------------------------------------------------------- !BOC @@ -57,7 +57,7 @@ subroutine Nchandle_Err (ierr) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 index 0d600b3b..449c3b8e 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_open.F90 @@ -24,7 +24,7 @@ module HCO_m_netcdf_io_open ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !----------------------------------------------------------------------------- !BOC @@ -63,7 +63,7 @@ subroutine Ncop_Rd (ncid, filname, rc) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -117,7 +117,7 @@ subroutine Ncop_Wr (ncid, filname) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 index b7ed044e..8bd9d77e 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 @@ -1,4 +1,3 @@ -! $Id: m_netcdf_io_read.F90,v 1.1 2009/08/04 14:52:05 bmy Exp $ !------------------------------------------------------------------------- ! NASA/GFSC, SIVO, Code 610.3 !------------------------------------------------------------------------- @@ -54,7 +53,7 @@ MODULE HCO_m_netcdf_io_read ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -91,7 +90,7 @@ subroutine Ncrd_Scal(varrd_scal, ncid, varname) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -154,7 +153,7 @@ subroutine Ncrd_Scal_Int(varrd_scali, ncid, varname) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -221,7 +220,7 @@ subroutine Ncrd_1d_R8(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -234,11 +233,8 @@ subroutine Ncrd_1d_R8(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) logical :: dostop ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif + dostop = .true. + if ( present ( err_stop ) ) dostop = err_stop ierr = NF90_Inq_VarId(ncid, varname, varid) @@ -310,7 +306,7 @@ subroutine Ncrd_1d_R4(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -323,11 +319,8 @@ subroutine Ncrd_1d_R4(varrd_1d, ncid, varname, strt1d, cnt1d, err_stop, stat) logical :: dostop ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif + dostop = .true. + if ( present ( err_stop ) ) dostop = err_stop ierr = NF90_Inq_VarId(ncid, varname, varid) @@ -403,7 +396,7 @@ subroutine Ncrd_1d_Int(varrd_1di, ncid, varname, strt1d, & ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -416,11 +409,8 @@ subroutine Ncrd_1d_Int(varrd_1di, ncid, varname, strt1d, & logical :: dostop ! set dostop flag - if ( present ( err_stop ) ) then - dostop = err_stop - else - dostop = .true. - endif + dostop = .true. + if ( present ( err_stop ) ) dostop = err_stop ierr = NF90_Inq_VarId(ncid, varname, varid) @@ -491,7 +481,7 @@ subroutine Ncrd_2d_R8(varrd_2d, ncid, varname, strt2d, cnt2d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -554,7 +544,7 @@ subroutine Ncrd_2d_R4(varrd_2d, ncid, varname, strt2d, cnt2d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -618,7 +608,7 @@ subroutine Ncrd_2d_Int(varrd_2di, ncid, varname, strt2d, cnt2d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -682,7 +672,7 @@ subroutine Ncrd_3d_R8(varrd_3d, ncid, varname, strt3d, cnt3d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -746,7 +736,7 @@ subroutine Ncrd_3d_R4(varrd_3d, ncid, varname, strt3d, cnt3d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -811,7 +801,7 @@ subroutine Ncrd_3d_Int(varrd_3di, ncid, varname, strt3d, cnt3d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -877,7 +867,7 @@ subroutine Ncrd_4d_R8(varrd_4d, ncid, varname, strt4d, cnt4d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -941,7 +931,7 @@ subroutine Ncrd_4d_R4(varrd_4d, ncid, varname, strt4d, cnt4d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1006,7 +996,7 @@ subroutine Ncrd_4d_Int(varrd_4di, ncid, varname, strt4d, cnt4d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1040,7 +1030,7 @@ end subroutine Ncrd_4d_Int ! ! !INTERFACE: ! - subroutine Ncrd_5d_R8(varrd_5d, ncid, varname, strt5d, cnt5d) + subroutine Ncrd_5d_R8 (varrd_5d, ncid, varname, strt5d, cnt5d) ! ! !USES: ! @@ -1071,7 +1061,7 @@ subroutine Ncrd_5d_R8(varrd_5d, ncid, varname, strt5d, cnt5d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1136,7 +1126,7 @@ subroutine Ncrd_5d_R4(varrd_5d, ncid, varname, strt5d, cnt5d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1202,7 +1192,7 @@ subroutine Ncrd_6d_R8(varrd_6d, ncid, varname, strt6d, cnt6d) ! ! !REVISION HISTORY: ! 20 Dec 2011 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1267,7 +1257,7 @@ subroutine Ncrd_6d_R4(varrd_6d, ncid, varname, strt6d, cnt6d) ! John Tannahill (LLNL) and Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1321,10 +1311,10 @@ subroutine Ncrd_7d_R8(varrd_7d, ncid, varname, strt7d, cnt7d) ! ! !OUTPUT PARAMETERS: !! varrd_5d : array to fill - real*8 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & - cnt7d(3), cnt7d(4), & - cnt7d(5), cnt7d(6), & - cnt7d(7)) + real*8 , intent(out) :: varrd_7d(cnt7d(1), cnt7d(2), & + cnt7d(3), cnt7d(4), & + cnt7d(5), cnt7d(6), & + cnt7d(7)) ! ! !DESCRIPTION: Reads in a 7D netCDF real array and does some error checking. !\\ @@ -1334,7 +1324,7 @@ subroutine Ncrd_7d_R8(varrd_7d, ncid, varname, strt7d, cnt7d) ! ! !REVISION HISTORY: ! 20 Dec 2011 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1359,7 +1349,12 @@ subroutine Ncrd_7d_R8(varrd_7d, ncid, varname, strt7d, cnt7d) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) end if - end subroutine Ncrd_7d_R8 + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_7d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_7d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1401,7 +1396,7 @@ subroutine Ncrd_7d_R4(varrd_7d, ncid, varname, strt7d, cnt7d) ! ! !REVISION HISTORY: ! 20 Dec 2011 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1465,7 +1460,7 @@ subroutine Ncrd_1d_Char(varrd_1dc, ncid, varname, strt1d, cnt1d) ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC @@ -1529,7 +1524,7 @@ subroutine Ncrd_2d_Char(varrd_2dc, ncid, varname, strt2d, cnt2d) ! Jules Kouatchou ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------- !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 index fe32ef62..58ce4600 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_readattr.F90 @@ -67,8 +67,7 @@ MODULE HCO_m_netcdf_io_readattr ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -111,8 +110,7 @@ SUBROUTINE NcGet_Var_Attr_C( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -184,8 +182,7 @@ SUBROUTINE NcGet_Var_Attr_I4( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -257,8 +254,7 @@ SUBROUTINE NcGet_Var_Attr_R4( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -330,8 +326,7 @@ SUBROUTINE NcGet_Var_Attr_R8( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -403,8 +398,7 @@ SUBROUTINE NcGet_Var_Attr_I4_arr( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -476,8 +470,7 @@ SUBROUTINE NcGet_Var_Attr_R4_arr( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -549,8 +542,7 @@ SUBROUTINE NcGet_Var_Attr_R8_arr( fid, varName, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -621,8 +613,7 @@ SUBROUTINE NcGet_Glob_Attr_C( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -683,8 +674,7 @@ SUBROUTINE NcGet_Glob_Attr_I4( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -745,8 +735,7 @@ SUBROUTINE NcGet_Glob_Attr_R4( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -807,8 +796,7 @@ SUBROUTINE NcGet_Glob_Attr_R8( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -869,8 +857,7 @@ SUBROUTINE NcGet_Glob_Attr_I4_arr( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -931,8 +918,7 @@ SUBROUTINE NcGet_Glob_Attr_R4_arr( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -993,8 +979,7 @@ SUBROUTINE NcGet_Glob_Attr_R8_arr( fid, attName, attValue ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -1059,8 +1044,7 @@ SUBROUTINE NcGet_Var_Attr_C_nostop( fId, varName, attName, attValue, RC ) ! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) ! ! !REVISION HISTORY: -! 25 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 index 3dbd9c53..567864dd 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 @@ -1,49 +1,47 @@ -! $Id: m_netcdf_io_write.F90,v 1.1 2009/08/04 14:52:05 bmy Exp $ !------------------------------------------------------------------------- ! NASA/GFSC, SIVO, Code 610.3 !------------------------------------------------------------------------- !BOP ! -! !MODULE: HCO_m_netcdf_io_write +! !MODULE: HCO_m_netcdf_io_write ! ! !INTERFACE: ! - module HCO_m_netcdf_io_write +MODULE HCO_m_netcdf_io_write ! - IMPLICIT NONE - PRIVATE + IMPLICIT NONE + PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: ! - ! Public interface - PUBLIC :: NcWr - - ! Private methods overloaded by public interface - ! (see below for info about these routines & the arguments they take) - INTERFACE NcWr - MODULE PROCEDURE Ncwr_Scal_R4 - MODULE PROCEDURE Ncwr_Scal_R8 - MODULE PROCEDURE Ncwr_Scal_Int - MODULE PROCEDURE Ncwr_1d_R8 - MODULE PROCEDURE Ncwr_1d_R4 - MODULE PROCEDURE Ncwr_1d_Int - MODULE PROCEDURE Ncwr_1d_Char - MODULE PROCEDURE Ncwr_2d_R8 - MODULE PROCEDURE Ncwr_2d_R4 - MODULE PROCEDURE Ncwr_2d_Int - MODULE PROCEDURE Ncwr_2d_Char - MODULE PROCEDURE Ncwr_3d_R8 - MODULE PROCEDURE Ncwr_3d_R4 - MODULE PROCEDURE Ncwr_3d_Int - MODULE PROCEDURE Ncwr_4d_R8 - MODULE PROCEDURE Ncwr_4d_R4 - MODULE PROCEDURE Ncwr_4d_Int - MODULE PROCEDURE Ncwr_5d_R8 - MODULE PROCEDURE Ncwr_5d_R4 - MODULE PROCEDURE Ncwr_6d_R8 - MODULE PROCEDURE Ncwr_6d_R4 - - END INTERFACE + ! Public interface + PUBLIC :: NcWr + + ! Private methods overloaded by public interface + ! (see below for info about these routines & the arguments they take) + INTERFACE NcWr + MODULE PROCEDURE Ncwr_Scal_R4 + MODULE PROCEDURE Ncwr_Scal_R8 + MODULE PROCEDURE Ncwr_Scal_Int + MODULE PROCEDURE Ncwr_1d_R8 + MODULE PROCEDURE Ncwr_1d_R4 + MODULE PROCEDURE Ncwr_1d_Int + MODULE PROCEDURE Ncwr_1d_Char + MODULE PROCEDURE Ncwr_2d_R8 + MODULE PROCEDURE Ncwr_2d_R4 + MODULE PROCEDURE Ncwr_2d_Int + MODULE PROCEDURE Ncwr_2d_Char + MODULE PROCEDURE Ncwr_3d_R8 + MODULE PROCEDURE Ncwr_3d_R4 + MODULE PROCEDURE Ncwr_3d_Int + MODULE PROCEDURE Ncwr_4d_R8 + MODULE PROCEDURE Ncwr_4d_R4 + MODULE PROCEDURE Ncwr_4d_Int + MODULE PROCEDURE Ncwr_5d_R8 + MODULE PROCEDURE Ncwr_5d_R4 + MODULE PROCEDURE Ncwr_6d_R8 + MODULE PROCEDURE Ncwr_6d_R4 + END INTERFACE NcWr ! ! !DESCRIPTION: Routines for writing variables in a netCDF file. !\\ @@ -51,14 +49,16 @@ module HCO_m_netcdf_io_write ! !AUTHOR: ! Jules Kouatchou ! +! !REMARKS: +! This file is based on code from NASA/GSFC, SIVO, Code 610.3 +! ! !REVISION HISTORY: ! See https://github.com/geoschem/ncdfutil for complete history !EOP !------------------------------------------------------------------------- - +!BOC CONTAINS - - +!EOC !------------------------------------------------------------------------- !BOP ! @@ -66,24 +66,20 @@ module HCO_m_netcdf_io_write ! ! !INTERFACE: ! - subroutine Ncwr_Scal_R4(varwr_scal, ncid, varname) + subroutine NcWr_Scal_R4(varwr_scal, ncid, varname) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write variable to -!! varname : netCDF variable name -!! varwr_scal : variable to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - real*4 , intent(in) :: varwr_scal - +!! ncid : netCDF file id to write variable to +!! varname : netCDF variable name +!! varwr_scal : variable to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + real*4 , intent(in) :: varwr_scal ! ! !DESCRIPTION: Writes out a netCDF real scalar variable. !\\ @@ -98,26 +94,27 @@ subroutine Ncwr_Scal_R4(varwr_scal, ncid, varname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_VarId(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal_R4 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Var_Real (ncid, varid, varwr_scal) + ierr = Nf90_Put_Var(ncid, varid, varwr_scal) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal+R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal+R4 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_Scal_R4 - end subroutine Ncwr_Scal_R4 !------------------------------------------------------------------------- !BOP ! @@ -125,23 +122,20 @@ end subroutine Ncwr_Scal_R4 ! ! !INTERFACE: ! - subroutine Ncwr_Scal_R8 (varwr_scal, ncid, varname) + subroutine Ncwr_Scal_R8(varwr_scal, ncid, varname) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write variable to -!! varname : netCDF variable name -!! varwr_scal : variable to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - real*8 , intent(in) :: varwr_scal +!! ncid : netCDF file id to write variable to +!! varname : netCDF variable name +!! varwr_scal : variable to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + real*8 , intent(in) :: varwr_scal ! ! !DESCRIPTION: Writes out a netCDF real scalar variable. !\\ @@ -156,26 +150,26 @@ subroutine Ncwr_Scal_R8 (varwr_scal, ncid, varname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Var_Double(ncid, varid, varwr_scal) + ierr = NF90_Put_Var_Double(ncid, varid, varwr_scal) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_Scal_R8 + end subroutine Ncwr_Scal_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -184,23 +178,20 @@ end subroutine Ncwr_Scal_R8 ! ! !INTERFACE: ! - subroutine Ncwr_Scal_Int (varwr_scali, ncid, varname) + subroutine Ncwr_Scal_Int(varwr_scali, ncid, varname) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write variable to -!! varname : netCDF variable name -!! varwr_scali : integer variable to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: varwr_scali +!! ncid : netCDF file id to write variable to +!! varname : netCDF variable name +!! varwr_scali : integer variable to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: varwr_scali ! ! !DESCRIPTION: Writes out a netCDF integer scalar variable. !\\ @@ -215,26 +206,26 @@ subroutine Ncwr_Scal_Int (varwr_scali, ncid, varname) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal_Int #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Var_Int (ncid, varid, varwr_scali) + ierr = NF90_Put_Var(ncid, varid, varwr_scali) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_Scal_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_Scal_Int #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_Scal_Int + end subroutine Ncwr_Scal_Int !EOC !------------------------------------------------------------------------- !BOP @@ -243,28 +234,25 @@ end subroutine Ncwr_Scal_Int ! ! !INTERFACE: ! - subroutine Ncwr_1d_R8 (varwr_1d, ncid, varname, strt1d, cnt1d) + subroutine Ncwr_1d_R8(varwr_1d, ncid, varname, strt1d, cnt1d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varwr_1d where -!! the first of the data values will be written -!! cnt1d : varwr_1d dimension -!! varwr_1d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - real*8 , intent(in) :: varwr_1d(cnt1d(1)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1d where +!! the first of the data values will be written +!! cnt1d : varwr_1d dimension +!! varwr_1d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + real*8 , intent(in) :: varwr_1d(cnt1d(1)) ! ! !DESCRIPTION: Writes out a 1D netCDF real array and does some error ! checking. @@ -280,26 +268,26 @@ subroutine Ncwr_1d_R8 (varwr_1d, ncid, varname, strt1d, cnt1d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid -! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if - - ierr = Nf_Put_Vara_Double (ncid, varid, strt1d, cnt1d, varwr_1d) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncwr_1d_R8 + character(len=512) :: err_msg + integer :: ierr + integer :: varid +! + ierr = NF90_Inq_Varid(ncid, varname, varid) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = NF90_Put_Var(ncid, varid, varwr_1d, start=strt1d, count=cnt1d) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -308,28 +296,25 @@ end subroutine Ncwr_1d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_1d_R4 (varwr_1d, ncid, varname, strt1d, cnt1d) + subroutine Ncwr_1d_R4(varwr_1d, ncid, varname, strt1d, cnt1d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varwr_1d where -!! the first of the data values will be written -!! cnt1d : varwr_1d dimension -!! varwr_1d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - real*4 , intent(in) :: varwr_1d(cnt1d(1)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1d where +!! the first of the data values will be written +!! cnt1d : varwr_1d dimension +!! varwr_1d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + real*4 , intent(in) :: varwr_1d(cnt1d(1)) ! ! !DESCRIPTION: Writes out a 1D netCDF real array and does some error ! checking. @@ -345,26 +330,26 @@ subroutine Ncwr_1d_R4 (varwr_1d, ncid, varname, strt1d, cnt1d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Real (ncid, varid, strt1d, cnt1d, varwr_1d) + ierr = NF90_Put_Var(ncid, varid, varwr_1d, start=strt1d, count=cnt1d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_R4 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_1d_R4 + end subroutine Ncwr_1d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -373,28 +358,25 @@ end subroutine Ncwr_1d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_1d_Int (varwr_1di, ncid, varname, strt1d, cnt1d) + subroutine Ncwr_1d_Int(varwr_1di, ncid, varname, strt1d, cnt1d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varwr_1di where -!! the first of the data values will be written -!! cnt1d : varwr_1di dimension -!! varwr_1di : intger array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - integer , intent(in) :: varwr_1di(cnt1d(1)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1di where +!! the first of the data values will be written +!! cnt1d : varwr_1di dimension +!! varwr_1di : intger array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + integer , intent(in) :: varwr_1di(cnt1d(1)) ! ! !DESCRIPTION: Writes out a 1D netCDF integer array and does some error ! checking. @@ -410,26 +392,26 @@ subroutine Ncwr_1d_Int (varwr_1di, ncid, varname, strt1d, cnt1d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_Int #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Int (ncid, varid, strt1d, cnt1d, varwr_1di) + ierr = NF90_Put_Var(ncid, varid, varwr_1di, start=strt1d, count=cnt1d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_Int #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_1d_Int + end subroutine Ncwr_1d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -438,28 +420,25 @@ end subroutine Ncwr_1d_Int ! ! !INTERFACE: ! - subroutine Ncwr_2d_R8 (varwr_2d, ncid, varname, strt2d, cnt2d) + subroutine Ncwr_2d_R8(varwr_2d, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varwr_2d where -!! the first of the data values will be written -!! cnt2d : varwr_2d dimensions -!! varwr_2d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) - real*8 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2d where +!! the first of the data values will be written +!! cnt2d : varwr_2d dimensions +!! varwr_2d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + real*8 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Writes out a 2D netCDF real array and does some error checking. !\\ @@ -474,26 +453,26 @@ subroutine Ncwr_2d_R8 (varwr_2d, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid (ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Double (ncid, varid, strt2d, cnt2d, varwr_2d) + ierr = NF90_Put_Var(ncid, varid, varwr_2d, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_2d_R8 + end subroutine Ncwr_2d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -502,28 +481,25 @@ end subroutine Ncwr_2d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_2d_R4 (varwr_2d, ncid, varname, strt2d, cnt2d) + subroutine Ncwr_2d_R4(varwr_2d, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varwr_2d where -!! the first of the data values will be written -!! cnt2d : varwr_2d dimensions -!! varwr_2d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) - real*4 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2d where +!! the first of the data values will be written +!! cnt2d : varwr_2d dimensions +!! varwr_2d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + real*4 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Writes out a 2D netCDF real array and does some error checking. !\\ @@ -538,26 +514,26 @@ subroutine Ncwr_2d_R4 (varwr_2d, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Real (ncid, varid, strt2d, cnt2d, varwr_2d) + ierr = NF90_Put_Var(ncid, varid, varwr_2d, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_R4 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_2d_R4 + end subroutine Ncwr_2d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -566,28 +542,25 @@ end subroutine Ncwr_2d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_2d_Int (varwr_2di, ncid, varname, strt2d, cnt2d) + subroutine Ncwr_2d_Int(varwr_2di, ncid, varname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt2d : vector specifying the index in varwr_2di where -!! the first of the data values will be written -!! cnt2d : varwr_2di dimensions -!! varwr_2di : intger array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) - integer , intent(in) :: varwr_2di(cnt2d(1), cnt2d(2)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2di where +!! the first of the data values will be written +!! cnt2d : varwr_2di dimensions +!! varwr_2di : intger array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + integer , intent(in) :: varwr_2di(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Writes out a 2D netCDF integer array and does some error ! checking. @@ -603,26 +576,26 @@ subroutine Ncwr_2d_Int (varwr_2di, ncid, varname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_Int #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Int (ncid, varid, strt2d, cnt2d, varwr_2di) + ierr = NF90_Put_Var(ncid, varid, varwr_2di, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_Int #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_2d_Int + end subroutine Ncwr_2d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -631,28 +604,25 @@ end subroutine Ncwr_2d_Int ! ! !INTERFACE: ! - subroutine Ncwr_3d_R8 (varwr_3d, ncid, varname, strt3d, cnt3d) + subroutine Ncwr_3d_R8(varwr_3d, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varwr_3d where -!! the first of the data values will be written -!! cnt3d : varwr_3d dimensions -!! varwr_3d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) - real*8 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3d where +!! the first of the data values will be written +!! cnt3d : varwr_3d dimensions +!! varwr_3d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + real*8 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) ! ! !DESCRIPTION: Writes out a 3D netCDF real array and does some error checking. !\\ @@ -667,26 +637,26 @@ subroutine Ncwr_3d_R8 (varwr_3d, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Double (ncid, varid, strt3d, cnt3d, varwr_3d) + ierr = NF90_Put_Var(ncid, varid, varwr_3d, start=strt3d, count=cnt3d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_3d_R8 + end subroutine Ncwr_3d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -695,28 +665,25 @@ end subroutine Ncwr_3d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_3d_R4 (varwr_3d, ncid, varname, strt3d, cnt3d) + subroutine Ncwr_3d_R4(varwr_3d, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varwr_3d where -!! the first of the data values will be written -!! cnt3d : varwr_3d dimensions -!! varwr_3d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) - real*4 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3d where +!! the first of the data values will be written +!! cnt3d : varwr_3d dimensions +!! varwr_3d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + real*4 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) ! ! !DESCRIPTION: Writes out a 3D netCDF real array and does some error checking. !\\ @@ -731,28 +698,26 @@ subroutine Ncwr_3d_R4 (varwr_3d, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_Varid(ncid, varname, varid) - ierr = Nf_Put_Vara_Real (ncid, varid, strt3d, cnt3d, varwr_3d) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Put_Var(ncid, varid, varwr_3d, start=strt3d, count=cnt3d) - return + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_3d_R4 + end subroutine Ncwr_3d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -761,28 +726,25 @@ end subroutine Ncwr_3d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_3d_Int (varwr_3di, ncid, varname, strt3d, cnt3d) + subroutine Ncwr_3d_Int(varwr_3di, ncid, varname, strt3d, cnt3d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varwr_3di where -!! the first of the data values will be written -!! cnt3d : varwr_3di dimensions -!! varwr_3di : intger array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt3d(3) - integer , intent(in) :: cnt3d (3) - integer , intent(in) :: varwr_3di(cnt3d(1), cnt3d(2), cnt3d(3)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3di where +!! the first of the data values will be written +!! cnt3d : varwr_3di dimensions +!! varwr_3di : intger array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + integer , intent(in) :: varwr_3di(cnt3d(1), cnt3d(2), cnt3d(3)) ! ! !DESCRIPTION: Writes out a 3D netCDF integer array and does some error ! checking. @@ -798,29 +760,26 @@ subroutine Ncwr_3d_Int (varwr_3di, ncid, varname, strt3d, cnt3d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_Varid(ncid, varname, varid) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_Int #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Int (ncid, varid, strt3d, cnt3d, varwr_3di) + ierr = NF90_Put_Var(ncid, varid, varwr_3di, start=strt3d, count=cnt3d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_3d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_3d_Int #2: ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - return - - end subroutine Ncwr_3d_Int + end subroutine Ncwr_3d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -829,29 +788,26 @@ end subroutine Ncwr_3d_Int ! ! !INTERFACE: ! - subroutine Ncwr_4d_R8 (varwr_4d, ncid, varname, strt4d, cnt4d) + subroutine Ncwr_4d_R8(varwr_4d, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt4d : vector specifying the index in varwr_4d where -!! the first of the data values will be written -!! cnt4d : varwr_4d dimensions -!! varwr_4d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) - real*8 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varwr_4d where +!! the first of the data values will be written +!! cnt4d : varwr_4d dimensions +!! varwr_4d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + real*8 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Writes out a 4D netCDF real array and does some error checking. !\\ @@ -866,27 +822,26 @@ subroutine Ncwr_4d_R8 (varwr_4d, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_Varid(ncid, varname, varid) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Double (ncid, varid, strt4d, cnt4d, varwr_4d) + ierr = NF90_Put_Var(ncid, varid, varwr_4d, start=strt4d, count=cnt4d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_4d_R8 + end subroutine Ncwr_4d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -895,29 +850,26 @@ end subroutine Ncwr_4d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_4d_R4 (varwr_4d, ncid, varname, strt4d, cnt4d) + subroutine Ncwr_4d_R4(varwr_4d, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt4d : vector specifying the index in varwr_4d where -!! the first of the data values will be written -!! cnt4d : varwr_4d dimensions -!! varwr_4d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) - real*4 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varwr_4d where +!! the first of the data values will be written +!! cnt4d : varwr_4d dimensions +!! varwr_4d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + real*4 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Writes out a 4D netCDF real array and does some error checking. !\\ @@ -932,27 +884,26 @@ subroutine Ncwr_4d_R4 (varwr_4d, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + ierr = NF90_Put_Var(ncid, varid, varwr_4d, start=strt4d, count=cnt4d) - ierr = Nf_Put_Vara_Real (ncid, varid, strt4d, cnt4d, varwr_4d) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_R4 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncwr_4d_R4 + end subroutine Ncwr_4d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -961,29 +912,26 @@ end subroutine Ncwr_4d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_4d_Int (varwr_4di, ncid, varname, strt4d, cnt4d) + subroutine Ncwr_4d_Int(varwr_4di, ncid, varname, strt4d, cnt4d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt3d : vector specifying the index in varwr_3di where -!! the first of the data values will be written -!! cnt3d : varwr_3di dimensions -!! varwr_3di : intger array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt4d(4) - integer , intent(in) :: cnt4d (4) - integer , intent(in) :: varwr_4di(cnt4d(1), cnt4d(2), & - cnt4d(3), cnt4d(4)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3di where +!! the first of the data values will be written +!! cnt3d : varwr_3di dimensions +!! varwr_3di : intger array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + integer , intent(in) :: varwr_4di(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) ! ! !DESCRIPTION: Writes out a 3D netCDF integer array and does some error ! checking. @@ -999,27 +947,26 @@ subroutine Ncwr_4d_Int (varwr_4di, ncid, varname, strt4d, cnt4d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid -! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_Int #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if - - - ierr = Nf_Put_Vara_Int (ncid, varid, strt4d, cnt4d, varwr_4di) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_4d_Int #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncwr_4d_Int + character(len=512) :: err_msg + integer :: ierr + integer :: varid +! + ierr = NF90_Inq_Varid(ncid, varname, varid) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_Int #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = NF90_Put_Var(ncid, varid, varwr_4di, start=strt4d, count=cnt4d) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_4d_Int #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_4d_Int !EOC !------------------------------------------------------------------------- !BOP @@ -1028,30 +975,27 @@ end subroutine Ncwr_4d_Int ! ! !INTERFACE: ! - subroutine Ncwr_5d_R8 (varwr_5d, ncid, varname, strt5d, cnt5d) + subroutine Ncwr_5d_R8(varwr_5d, ncid, varname, strt5d, cnt5d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varwr_5d where -!! the first of the data values will be written -!! cnt5d : varwr_5d dimensions -!! varwr_5d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt5d(5) - integer , intent(in) :: cnt5d (5) - real*8 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & - cnt5d(3), cnt5d(4), & - cnt5d(5)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varwr_5d where +!! the first of the data values will be written +!! cnt5d : varwr_5d dimensions +!! varwr_5d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) + real*8 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) ! ! !DESCRIPTION: Writes out a 5D netCDF real array and does some error checking. !\\ @@ -1066,26 +1010,26 @@ subroutine Ncwr_5d_R8 (varwr_5d, ncid, varname, strt5d, cnt5d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_5d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_5d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Double (ncid, varid, strt5d, cnt5d, varwr_5d) + ierr = NF90_Put_Var(ncid, varid, varwr_5d, start=strt5d, count=cnt5d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_5d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_5d_R8 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_5d_R8 + end subroutine Ncwr_5d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1094,30 +1038,27 @@ end subroutine Ncwr_5d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_5d_R4 (varwr_5d, ncid, varname, strt5d, cnt5d) + subroutine Ncwr_5d_R4(varwr_5d, ncid, varname, strt5d, cnt5d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt5d : vector specifying the index in varwr_5d where -!! the first of the data values will be written -!! cnt5d : varwr_5d dimensions -!! varwr_5d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt5d(5) - integer , intent(in) :: cnt5d (5) - real*4 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & - cnt5d(3), cnt5d(4), & - cnt5d(5)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varwr_5d where +!! the first of the data values will be written +!! cnt5d : varwr_5d dimensions +!! varwr_5d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) + real*4 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) ! ! !DESCRIPTION: Writes out a 5D netCDF real array and does some error checking. !\\ @@ -1132,26 +1073,26 @@ subroutine Ncwr_5d_R4 (varwr_5d, ncid, varname, strt5d, cnt5d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid (ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_5d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_5d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Real (ncid, varid, strt5d, cnt5d, varwr_5d) + ierr = NF90_Put_Var(ncid, varid, varwr_5d, start=strt5d, count=cnt5d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_5d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_5d_R4 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_5d_R4 + end subroutine Ncwr_5d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1160,30 +1101,27 @@ end subroutine Ncwr_5d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_6d_R8 (varwr_6d, ncid, varname, strt6d, cnt6d) + subroutine Ncwr_6d_R8(varwr_6d, ncid, varname, strt6d, cnt6d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt6d : vector specifying the index in varwr_6d where -!! the first of the data values will be written -!! cnt6d : varwr_6d dimensions -!! varwr_6d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt6d(6) - integer , intent(in) :: cnt6d (6) - real*8 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & - cnt6d(3), cnt6d(4), & - cnt6d(5), cnt6d(6)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt6d : vector specifying the index in varwr_6d where +!! the first of the data values will be written +!! cnt6d : varwr_6d dimensions +!! varwr_6d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) + real*8 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) ! ! !DESCRIPTION: Writes out a 6D netCDF real array and does some error checking. !\\ @@ -1198,26 +1136,26 @@ subroutine Ncwr_6d_R8 (varwr_6d, ncid, varname, strt6d, cnt6d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_6d_R8 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_6d_R8 #1: ' // Trim(varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Double (ncid, varid, strt6d, cnt6d, varwr_6d) + ierr = NF90_Put_Var(ncid, varid, varwr_6d, start=strt6d, count=cnt6d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_6d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_6d_R8 #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_6d_R8 + end subroutine Ncwr_6d_R8 !EOC !------------------------------------------------------------------------- !BOP @@ -1226,30 +1164,27 @@ end subroutine Ncwr_6d_R8 ! ! !INTERFACE: ! - subroutine Ncwr_6d_R4 (varwr_6d, ncid, varname, strt6d, cnt6d) + subroutine Ncwr_6d_R4(varwr_6d, ncid, varname, strt6d, cnt6d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt6d : vector specifying the index in varwr_6d where -!! the first of the data values will be written -!! cnt6d : varwr_6d dimensions -!! varwr_6d : array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt6d(6) - integer , intent(in) :: cnt6d (6) - real*4 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & - cnt6d(3), cnt6d(4), & - cnt6d(5), cnt6d(6)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt6d : vector specifying the index in varwr_6d where +!! the first of the data values will be written +!! cnt6d : varwr_6d dimensions +!! varwr_6d : array to write out + integer , intent(in) :: ncid + character(len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) + real*4 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) ! ! !DESCRIPTION: Writes out a 6D netCDF real array and does some error checking. !\\ @@ -1264,26 +1199,26 @@ subroutine Ncwr_6d_R4 (varwr_6d, ncid, varname, strt6d, cnt6d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid + character(len=512) :: err_msg + integer :: ierr + integer :: varid ! - ierr = Nf_Inq_Varid (ncid, varname, varid) + ierr = NF90_Inq_Varid(ncid, varname, varid) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_6d_R4 #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_6d_R4 #1: ' // Trim(varname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Real (ncid, varid, strt6d, cnt6d, varwr_6d) + ierr = NF90_Put_Var(ncid, varid, varwr_6d, start=strt6d, count=cnt6d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_6d_R4 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_6d_R4 #2: ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_6d_R4 + end subroutine Ncwr_6d_R4 !EOC !------------------------------------------------------------------------- !BOP @@ -1292,28 +1227,25 @@ end subroutine Ncwr_6d_R4 ! ! !INTERFACE: ! - subroutine Ncwr_1d_Char (varwr_1dc, ncid, varname, strt1d, cnt1d) + subroutine Ncwr_1d_Char(varwr_1dc, ncid, varname, strt1d, cnt1d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write array output data to -!! varname : netCDF variable name for array -!! strt1d : vector specifying the index in varwr_1dc where -!! the first of the data values will be written -!! cnt1d : varwr_1dc dimension -!! varwr_1dc : intger array to write out - integer , intent(in) :: ncid - character (len=*), intent(in) :: varname - integer , intent(in) :: strt1d(1) - integer , intent(in) :: cnt1d (1) - character (len=1), intent(in) :: varwr_1dc(cnt1d(1)) +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1dc where +!! the first of the data values will be written +!! cnt1d : varwr_1dc dimension +!! varwr_1dc : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + character (len=1), intent(in) :: varwr_1dc(cnt1d(1)) ! ! !DESCRIPTION: Writes out a 1D netCDF character array and does some error ! checking. @@ -1329,26 +1261,26 @@ subroutine Ncwr_1d_Char (varwr_1dc, ncid, varname, strt1d, cnt1d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: varid -! - ierr = Nf_Inq_Varid (ncid, varname, varid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_Char #1: ' // Trim (varname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if - - ierr = Nf_Put_Vara_Text (ncid, varid, strt1d, cnt1d, varwr_1dc) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_1d_Char #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncwr_1d_Char + character(len=512) :: err_msg + integer :: ierr + integer :: varid +! + ierr = NF90_Inq_Varid(ncid, varname, varid) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_Char #1: ' // Trim(varname) // & + ', ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = NF90_Put_Vara(ncid, varid, varwr_1dc, start=strt1d, count=cnt1d) + + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_1d_Char #2: ' // NF90_strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_Char !EOC !------------------------------------------------------------------------- !BOP @@ -1357,28 +1289,25 @@ end subroutine Ncwr_1d_Char ! ! !INTERFACE: ! - subroutine Ncwr_2d_Char (char_2d, ncid, tvarname, strt2d, cnt2d) + subroutine Ncwr_2d_Char(char_2d, ncid, tvarname, strt2d, cnt2d) ! ! !USES: ! - use m_do_err_out -! - implicit none -! - include "netcdf.inc" + use netCDF + use m_do_err_out ! ! !INPUT PARAMETERS: -!! ncid : netCDF file id to write text to -!! tvarname : netCDF variable name for text -!! strt2d : vector specifying the index in char_2d where -!! the first of the data values will be written -!! cnt2d : char_2d dimensions -!! char_2d : text to write - integer , intent(in) :: ncid - character (len=*), intent(in) :: tvarname - integer , intent(in) :: strt2d(2) - integer , intent(in) :: cnt2d (2) - character (len=1), intent(in) :: char_2d(cnt2d(1), cnt2d(2)) +!! ncid : netCDF file id to write text to +!! tvarname : netCDF variable name for text +!! strt2d : vector specifying the index in char_2d where +!! the first of the data values will be written +!! cnt2d : char_2d dimensions +!! char_2d : text to write + integer , intent(in) :: ncid + character(len=*), intent(in) :: tvarname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + character(len=1), intent(in) :: char_2d(cnt2d(1), cnt2d(2)) ! ! !DESCRIPTION: Writes out a 2D netCDF character array and does some error ! checking. @@ -1394,27 +1323,26 @@ subroutine Ncwr_2d_Char (char_2d, ncid, tvarname, strt2d, cnt2d) !BOC ! ! !LOCAL VARIABLES: - character (len=512) :: err_msg - integer :: ierr - integer :: tvarid + character(len=512) :: err_msg + integer :: ierr + integer :: tvarid ! - ierr = Nf_Inq_Varid (ncid, tvarname, tvarid) - - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_Char #1: ' // Trim (tvarname) // & - ', ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) - end if + ierr = NF90_Inq_Varid(ncid, tvarname, tvarid) + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_Char #1: ' // Trim(tvarname) // & + ', ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if - ierr = Nf_Put_Vara_Text (ncid, tvarid, strt2d, cnt2d, char_2d) + ierr = NF90_Put_Var(ncid, tvarid, char_2d, start=strt2d, count=cnt2d) - if (ierr /= NF_NOERR) then - err_msg = 'In Ncwr_2d_Char #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, tvarid, 0, 0.0d0, 0.0d0) - end if + if (ierr /= NF90_NOERR) then + err_msg = 'In Ncwr_2d_Char #2: ' // NF90_Strerror(ierr) + call Do_Err_Out(err_msg, .true., 2, ncid, tvarid, 0, 0.0d0, 0.0d0) + end if - end subroutine Ncwr_2d_Char + end subroutine Ncwr_2d_Char !EOC !------------------------------------------------------------------------ end module HCO_m_netcdf_io_write diff --git a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 index 952dd9fe..dc58ec3f 100644 --- a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 +++ b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 @@ -85,8 +85,7 @@ MODULE HCO_NCDF_MOD PRIVATE :: NC_READ_VAR_CORE ! ! !REVISION HISTORY: -! 27 Jul 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -157,8 +156,7 @@ SUBROUTINE NC_OPEN( FileName, fID ) INTEGER, INTENT(OUT) :: fID ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -197,8 +195,7 @@ SUBROUTINE NC_APPEND( FileName, fID, nTime ) INTEGER, OPTIONAL :: nTime ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -242,8 +239,7 @@ SUBROUTINE NC_CLOSE( fID ) INTEGER, INTENT(IN ) :: fID ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -281,8 +277,7 @@ SUBROUTINE Nc_Set_DefMode( fId, On, Off ) ! NcdfUtil module m_netcdf_define_mod.F90. ! ! !REVISION HISTORY: -! 06 Jan 2015 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -345,8 +340,7 @@ SUBROUTINE NC_READ_TIME( fID, nTime, timeUnit, & INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -432,11 +426,11 @@ SUBROUTINE NC_READ_TIME( fID, nTime, timeUnit, & ! Do nothing END SELECT ENDIF - + ! Reset RC so that we won't halt execution elsewhere RC = 0 ENDIF - + END SUBROUTINE NC_READ_TIME !EOC !------------------------------------------------------------------------------ @@ -471,8 +465,7 @@ SUBROUTINE NC_READ_VAR_SP( fID, Var, nVar, varUnit, varVec, RC ) INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -513,8 +506,7 @@ SUBROUTINE NC_READ_VAR_DP( fID, Var, nVar, varUnit, varVec, RC ) INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -556,8 +548,7 @@ SUBROUTINE NC_READ_VAR_CORE( fID, Var, nVar, varUnit, varVecDp, varVecSp, RC ) INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -708,8 +699,7 @@ SUBROUTINE NC_READ_ARR( fID, ncVar, lon1, lon2, lat1, & INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 27 Jul 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -1298,8 +1288,7 @@ SUBROUTINE NC_READ_TIME_YYYYMMDDhhmm( fID, nTime, & INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: -! 27 Jul 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -1434,8 +1423,7 @@ SUBROUTINE NC_GET_REFDATETIME( tUnit, tYr, tMt, tDy, tHr, tMn, tSc, RC ) ! !REMARKS: ! ! !REVISION HISTORY: -! 18 Jan 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -1652,8 +1640,7 @@ SUBROUTINE GET_TIDX( TDIM, TIMEVEC, TTYPE, TOFFSET, & ! !REMARKS: ! ! !REVISION HISTORY: -! 04 Nov 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -1816,8 +1803,7 @@ SUBROUTINE TIMEUNIT_CHECK( TIMEUNIT, TIMETYPE, TOFFSET, FILENAME, RC ) ! !REMARKS: ! ! !REVISION HISTORY: -! 18 Jan 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2003,8 +1989,7 @@ SUBROUTINE NC_GET_GRID_EDGES_SP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC ) INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 16 Jul 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2054,8 +2039,7 @@ SUBROUTINE NC_GET_GRID_EDGES_DP( fID, AXIS, MID, NMID, EDGE, NEDGE, RC ) INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 16 Jul 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2104,8 +2088,7 @@ SUBROUTINE NC_GET_GRID_EDGES_C( fID, AXIS, NMID, NEDGE, RC, & INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 16 Jul 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2308,8 +2291,7 @@ SUBROUTINE NC_GET_SIGMA_LEVELS_SP( fID, ncFile, levName, lon1, lon2, lat1, & INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 03 Oct 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2356,8 +2338,7 @@ SUBROUTINE NC_GET_SIGMA_LEVELS_DP( fID, ncFile, levName, lon1, lon2, lat1, & INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 03 Oct 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2415,8 +2396,7 @@ SUBROUTINE NC_GET_SIGMA_LEVELS_C( fID, ncFile, levName, lon1, lon2, lat1, & REAL*8, OPTIONAL, POINTER :: SigLev8(:,:,:) ! specified boundaries ! ! !REVISION HISTORY: -! 03 Oct 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2597,8 +2577,7 @@ SUBROUTINE NC_GET_SIG_FROM_HYBRID ( fID, levName, lon1, lon2, lat1, & INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 03 Oct 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2838,8 +2817,7 @@ SUBROUTINE GetVarFromFormula ( formula, inname, outname, RC ) INTEGER, INTENT(INOUT) :: RC ! Return code ! ! !REVISION HISTORY: -! 03 Oct 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2919,8 +2897,7 @@ SUBROUTINE NC_WRITE_3D( ncFile, I, J, T, N, lon, lat, & ! with subsequent hand-editing. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -2993,8 +2970,7 @@ SUBROUTINE NC_WRITE_4D (ncFile, I, J, L, T, N, lon, lat, lev, & ! with subsequent hand-editing. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3068,8 +3044,7 @@ SUBROUTINE NC_DEFINE ( ncFile, nLon, nLat, nLev, nTime,& ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3311,8 +3286,7 @@ SUBROUTINE NC_WRITE_DIMS( fID, lon, lat, time, lev ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 30 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3395,8 +3369,7 @@ SUBROUTINE NC_WRITE_DATA_3D ( fID, ncVar, Array ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 30 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3449,8 +3422,7 @@ SUBROUTINE NC_WRITE_DATA_4D ( fID, ncVar, Array ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 30 Jan 2012 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3537,8 +3509,7 @@ SUBROUTINE Nc_Create( NcFile, Title, nLon, & ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3775,8 +3746,7 @@ SUBROUTINE NC_Var_Def( fId, lonId, latId, levId, & ! (2) The NcdfUtilities package (from Bob Yantosca) source code ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -3993,8 +3963,7 @@ SUBROUTINE Nc_Var_Chunk( fId, vId, ChunkSizes, RC ) ! an error code of -111. ! ! !REVISION HISTORY: -! 28 Aug 2017 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4046,8 +4015,7 @@ SUBROUTINE NC_VAR_WRITE_R8_0D( fId, VarName, Var ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 25 Aug 2017 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4093,8 +4061,7 @@ SUBROUTINE NC_VAR_WRITE_R8_1D( fId, VarName, Arr1D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4147,8 +4114,7 @@ SUBROUTINE NC_VAR_WRITE_R8_2D( fId, VarName, Arr2D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4207,8 +4173,7 @@ SUBROUTINE NC_VAR_WRITE_R8_3D( fId, VarName, Arr3D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4267,8 +4232,7 @@ SUBROUTINE NC_VAR_WRITE_R8_4D( fId, VarName, Arr4D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4327,8 +4291,7 @@ SUBROUTINE NC_VAR_WRITE_R4_0d( fId, VarName, Var ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 25 Aug 2017 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4374,8 +4337,7 @@ SUBROUTINE NC_VAR_WRITE_R4_1D( fId, VarName, Arr1D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4428,8 +4390,7 @@ SUBROUTINE NC_VAR_WRITE_R4_2D( fId, VarName, Arr2D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4488,8 +4449,7 @@ SUBROUTINE NC_VAR_WRITE_R4_3D( fId, VarName, Arr3D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4548,8 +4508,7 @@ SUBROUTINE NC_VAR_WRITE_R4_4D( fId, VarName, Arr4D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4607,8 +4566,7 @@ SUBROUTINE NC_VAR_WRITE_INT_0d( fId, VarName, Var ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 25 Aug 2017 - R. Yantosca - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4654,8 +4612,7 @@ SUBROUTINE NC_VAR_WRITE_INT_1D( fId, VarName, Arr1D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4708,8 +4665,7 @@ SUBROUTINE NC_VAR_WRITE_INT_2D( fId, VarName, Arr2D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4768,8 +4724,7 @@ SUBROUTINE NC_VAR_WRITE_INT_3D( fId, VarName, Arr3D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4828,8 +4783,7 @@ SUBROUTINE NC_VAR_WRITE_INT_4D( fId, VarName, Arr4D ) ! hand-editing may be required. ! ! !REVISION HISTORY: -! 15 Jun 2012 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4904,7 +4858,7 @@ FUNCTION GET_TAU0( MONTH, DAY, YEAR, HOUR, MIN, SEC ) RESULT( THIS_TAU0 ) ! TAU0 is hours elapsed since 00:00 GMT on 01 Jan 1985. ! ! !REVISION HISTORY: -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -4993,8 +4947,7 @@ FUNCTION NC_IsModelLevel( fID, lev_name ) RESULT ( IsModelLevel ) LOGICAL :: IsModelLevel ! ! !REVISION HISTORY: -! 12 Dec 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC @@ -5060,8 +5013,7 @@ FUNCTION NC_IsSigmaLevel( fID, lev_name ) RESULT ( IsSigmaLevel ) LOGICAL :: IsSigmaLevel ! ! !REVISION HISTORY: -! 12 Dec 2014 - C. Keller - Initial version -! See https://github.com/geoschem/ncdfutil for complete history +! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC From 187f483ea382cf6e695d0de168c256a2978e1275 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 18 Jul 2023 17:22:11 -0400 Subject: [PATCH 52/63] Remove extraneous code in hco_m_netcdf_read.F90 src/Shared/hco_m_netcdf_io_read.F90 - Extraneous code was introduced into this module. This has now been removed. Signed-off-by: Bob Yantosca --- src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 index 8bd9d77e..7c1a8339 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_read.F90 @@ -1349,12 +1349,7 @@ subroutine Ncrd_7d_R8(varrd_7d, ncid, varname, strt7d, cnt7d) call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) end if - if (ierr /= NF_NOERR) then - err_msg = 'In Ncrd_7d_R8 #2: ' // Nf_Strerror (ierr) - call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) - end if - - end subroutine Ncrd_7d_R8 + end subroutine Ncrd_7d_R8 !EOC !------------------------------------------------------------------------- !BOP From bf4c627e967f13a306c9325580fa8be5792875fd Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 18 Jul 2023 17:28:19 -0400 Subject: [PATCH 53/63] Fix typo in hco_m_netcdf_write_mod.F90 src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 - Replaced "NF90_Put_Var_Double" (which is not a netCDF-F90 function) with the proper function call "NF90_Put_Var". This was leftover when we were replacing text. Signed-off-by: Bob Yantosca --- src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 b/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 index 567864dd..f13b431b 100644 --- a/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 +++ b/src/Shared/NcdfUtil/hco_m_netcdf_io_write.F90 @@ -162,7 +162,7 @@ subroutine Ncwr_Scal_R8(varwr_scal, ncid, varname) call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) end if - ierr = NF90_Put_Var_Double(ncid, varid, varwr_scal) + ierr = NF90_Put_Var(ncid, varid, varwr_scal) if (ierr /= NF90_NOERR) then err_msg = 'In Ncwr_Scal_R8 #2: ' // NF90_strerror(ierr) @@ -1273,7 +1273,7 @@ subroutine Ncwr_1d_Char(varwr_1dc, ncid, varname, strt1d, cnt1d) call Do_Err_Out(err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) end if - ierr = NF90_Put_Vara(ncid, varid, varwr_1dc, start=strt1d, count=cnt1d) + ierr = NF90_Put_Var(ncid, varid, varwr_1dc, start=strt1d, count=cnt1d) if (ierr /= NF90_NOERR) then err_msg = 'In Ncwr_1d_Char #2: ' // NF90_strerror(ierr) From 69f93d28bfb20e71527aacfd765aceed20b97afc Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 20 Jul 2023 11:47:08 -0400 Subject: [PATCH 54/63] Fix incorrect HEMCO_sa_Grid definitions for 0.5, 0.25 degree grids This commit applies the fixes suggested by @nicholasbalasus in issue geoschem/hemco #228. run/HEMCO_sa_Grid.025x03125.rc - Change XMIN from -180.125 to -180.15625 (Western longitude edge) - Change YMID from 179.875 to 179.84375 (Eastern longitude edge) - Add explanatory comments run/HEMCO_sa_Grid.05x0625.rc - Change XMIN from -180.25 to -180.3125 (Western longitude edge) - Change YMIN from 179.75 to 179.6875 (Eastern longitude edge) - Add explanatory comments run/HEMCO_sa_Grid.2x25 run/HEMCO_sa_Grid.4x5 - Add explanatory comments Signed-off-by: Bob Yantosca --- run/HEMCO_sa_Grid.025x03125.rc | 14 +++++++------- run/HEMCO_sa_Grid.05x0625.rc | 14 +++++++------- run/HEMCO_sa_Grid.2x25.rc | 14 +++++++------- run/HEMCO_sa_Grid.4x5.rc | 14 +++++++------- 4 files changed, 28 insertions(+), 28 deletions(-) diff --git a/run/HEMCO_sa_Grid.025x03125.rc b/run/HEMCO_sa_Grid.025x03125.rc index 4da8a0c2..612e5fbe 100644 --- a/run/HEMCO_sa_Grid.025x03125.rc +++ b/run/HEMCO_sa_Grid.025x03125.rc @@ -1,10 +1,10 @@ # Emission grid specifications: -XMIN: -180.125 -XMAX: 179.875 -YMIN: -90.0 -YMAX: 90.0 -NX: 1152 -NY: 721 -NZ: 47 +XMIN: -180.15625 # Westernmost longitude edge +XMAX: 179.84375 # Easternmost longitude edge +YMIN: -90.0 # Southernmost latitude edge +YMAX: 90.0 # Northernmost latititude edge +NX: 1152 # Number of longitudes in grid +NY: 721 # Number of latitudes in grid +NZ: 47 # Number of levels in grid YEDGE: -90.000 -89.875 -89.625 -89.375 -89.125 -88.875 -88.625 -88.375 -88.125 -87.875 -87.625 -87.375 -87.125 -86.875 -86.625 -86.375 -86.125 -85.875 -85.625 -85.375 -85.125 -84.875 -84.625 -84.375 -84.125 -83.875 -83.625 -83.375 -83.125 -82.875 -82.625 -82.375 -82.125 -81.875 -81.625 -81.375 -81.125 -80.875 -80.625 -80.375 -80.125 -79.875 -79.625 -79.375 -79.125 -78.875 -78.625 -78.375 -78.125 -77.875 -77.625 -77.375 -77.125 -76.875 -76.625 -76.375 -76.125 -75.875 -75.625 -75.375 -75.125 -74.875 -74.625 -74.375 -74.125 -73.875 -73.625 -73.375 -73.125 -72.875 -72.625 -72.375 -72.125 -71.875 -71.625 -71.375 -71.125 -70.875 -70.625 -70.375 -70.125 -69.875 -69.625 -69.375 -69.125 -68.875 -68.625 -68.375 -68.125 -67.875 -67.625 -67.375 -67.125 -66.875 -66.625 -66.375 -66.125 -65.875 -65.625 -65.375 -65.125 -64.875 -64.625 -64.375 -64.125 -63.875 -63.625 -63.375 -63.125 -62.875 -62.625 -62.375 -62.125 -61.875 -61.625 -61.375 -61.125 -60.875 -60.625 -60.375 -60.125 -59.875 -59.625 -59.375 -59.125 -58.875 -58.625 -58.375 -58.125 -57.875 -57.625 -57.375 -57.125 -56.875 -56.625 -56.375 -56.125 -55.875 -55.625 -55.375 -55.125 -54.875 -54.625 -54.375 -54.125 -53.875 -53.625 -53.375 -53.125 -52.875 -52.625 -52.375 -52.125 -51.875 -51.625 -51.375 -51.125 -50.875 -50.625 -50.375 -50.125 -49.875 -49.625 -49.375 -49.125 -48.875 -48.625 -48.375 -48.125 -47.875 -47.625 -47.375 -47.125 -46.875 -46.625 -46.375 -46.125 -45.875 -45.625 -45.375 -45.125 -44.875 -44.625 -44.375 -44.125 -43.875 -43.625 -43.375 -43.125 -42.875 -42.625 -42.375 -42.125 -41.875 -41.625 -41.375 -41.125 -40.875 -40.625 -40.375 -40.125 -39.875 -39.625 -39.375 -39.125 -38.875 -38.625 -38.375 -38.125 -37.875 -37.625 -37.375 -37.125 -36.875 -36.625 -36.375 -36.125 -35.875 -35.625 -35.375 -35.125 -34.875 -34.625 -34.375 -34.125 -33.875 -33.625 -33.375 -33.125 -32.875 -32.625 -32.375 -32.125 -31.875 -31.625 -31.375 -31.125 -30.875 -30.625 -30.375 -30.125 -29.875 -29.625 -29.375 -29.125 -28.875 -28.625 -28.375 -28.125 -27.875 -27.625 -27.375 -27.125 -26.875 -26.625 -26.375 -26.125 -25.875 -25.625 -25.375 -25.125 -24.875 -24.625 -24.375 -24.125 -23.875 -23.625 -23.375 -23.125 -22.875 -22.625 -22.375 -22.125 -21.875 -21.625 -21.375 -21.125 -20.875 -20.625 -20.375 -20.125 -19.875 -19.625 -19.375 -19.125 -18.875 -18.625 -18.375 -18.125 -17.875 -17.625 -17.375 -17.125 -16.875 -16.625 -16.375 -16.125 -15.875 -15.625 -15.375 -15.125 -14.875 -14.625 -14.375 -14.125 -13.875 -13.625 -13.375 -13.125 -12.875 -12.625 -12.375 -12.125 -11.875 -11.625 -11.375 -11.125 -10.875 -10.625 -10.375 -10.125 -9.875 -9.625 -9.375 -9.125 -8.875 -8.625 -8.375 -8.125 -7.875 -7.625 -7.375 -7.125 -6.875 -6.625 -6.375 -6.125 -5.875 -5.625 -5.375 -5.125 -4.875 -4.625 -4.375 -4.125 -3.875 -3.625 -3.375 -3.125 -2.875 -2.625 -2.375 -2.125 -1.875 -1.625 -1.375 -1.125 -0.875 -0.625 -0.375 -0.125 0.125 0.375 0.625 0.875 1.125 1.375 1.625 1.875 2.125 2.375 2.625 2.875 3.125 3.375 3.625 3.875 4.125 4.375 4.625 4.875 5.125 5.375 5.625 5.875 6.125 6.375 6.625 6.875 7.125 7.375 7.625 7.875 8.125 8.375 8.625 8.875 9.125 9.375 9.625 9.875 10.125 10.375 10.625 10.875 11.125 11.375 11.625 11.875 12.125 12.375 12.625 12.875 13.125 13.375 13.625 13.875 14.125 14.375 14.625 14.875 15.125 15.375 15.625 15.875 16.125 16.375 16.625 16.875 17.125 17.375 17.625 17.875 18.125 18.375 18.625 18.875 19.125 19.375 19.625 19.875 20.125 20.375 20.625 20.875 21.125 21.375 21.625 21.875 22.125 22.375 22.625 22.875 23.125 23.375 23.625 23.875 24.125 24.375 24.625 24.875 25.125 25.375 25.625 25.875 26.125 26.375 26.625 26.875 27.125 27.375 27.625 27.875 28.125 28.375 28.625 28.875 29.125 29.375 29.625 29.875 30.125 30.375 30.625 30.875 31.125 31.375 31.625 31.875 32.125 32.375 32.625 32.875 33.125 33.375 33.625 33.875 34.125 34.375 34.625 34.875 35.125 35.375 35.625 35.875 36.125 36.375 36.625 36.875 37.125 37.375 37.625 37.875 38.125 38.375 38.625 38.875 39.125 39.375 39.625 39.875 40.125 40.375 40.625 40.875 41.125 41.375 41.625 41.875 42.125 42.375 42.625 42.875 43.125 43.375 43.625 43.875 44.125 44.375 44.625 44.875 45.125 45.375 45.625 45.875 46.125 46.375 46.625 46.875 47.125 47.375 47.625 47.875 48.125 48.375 48.625 48.875 49.125 49.375 49.625 49.875 50.125 50.375 50.625 50.875 51.125 51.375 51.625 51.875 52.125 52.375 52.625 52.875 53.125 53.375 53.625 53.875 54.125 54.375 54.625 54.875 55.125 55.375 55.625 55.875 56.125 56.375 56.625 56.875 57.125 57.375 57.625 57.875 58.125 58.375 58.625 58.875 59.125 59.375 59.625 59.875 60.125 60.375 60.625 60.875 61.125 61.375 61.625 61.875 62.125 62.375 62.625 62.875 63.125 63.375 63.625 63.875 64.125 64.375 64.625 64.875 65.125 65.375 65.625 65.875 66.125 66.375 66.625 66.875 67.125 67.375 67.625 67.875 68.125 68.375 68.625 68.875 69.125 69.375 69.625 69.875 70.125 70.375 70.625 70.875 71.125 71.375 71.625 71.875 72.125 72.375 72.625 72.875 73.125 73.375 73.625 73.875 74.125 74.375 74.625 74.875 75.125 75.375 75.625 75.875 76.125 76.375 76.625 76.875 77.125 77.375 77.625 77.875 78.125 78.375 78.625 78.875 79.125 79.375 79.625 79.875 80.125 80.375 80.625 80.875 81.125 81.375 81.625 81.875 82.125 82.375 82.625 82.875 83.125 83.375 83.625 83.875 84.125 84.375 84.625 84.875 85.125 85.375 85.625 85.875 86.125 86.375 86.625 86.875 87.125 87.375 87.625 87.875 88.125 88.375 88.625 88.875 89.125 89.375 89.625 89.875 90.000 YMID: -89.9375 -89.75 -89.50 -89.25 -89.00 -88.75 -88.50 -88.25 -88.00 -87.75 -87.50 -87.25 -87.00 -86.75 -86.50 -86.25 -86.00 -85.75 -85.50 -85.25 -85.00 -84.75 -84.50 -84.25 -84.00 -83.75 -83.50 -83.25 -83.00 -82.75 -82.50 -82.25 -82.00 -81.75 -81.50 -81.25 -81.00 -80.75 -80.50 -80.25 -80.00 -79.75 -79.50 -79.25 -79.00 -78.75 -78.50 -78.25 -78.00 -77.75 -77.50 -77.25 -77.00 -76.75 -76.50 -76.25 -76.00 -75.75 -75.50 -75.25 -75.00 -74.75 -74.50 -74.25 -74.00 -73.75 -73.50 -73.25 -73.00 -72.75 -72.50 -72.25 -72.00 -71.75 -71.50 -71.25 -71.00 -70.75 -70.50 -70.25 -70.00 -69.75 -69.50 -69.25 -69.00 -68.75 -68.50 -68.25 -68.00 -67.75 -67.50 -67.25 -67.00 -66.75 -66.50 -66.25 -66.00 -65.75 -65.50 -65.25 -65.00 -64.75 -64.50 -64.25 -64.00 -63.75 -63.50 -63.25 -63.00 -62.75 -62.50 -62.25 -62.00 -61.75 -61.50 -61.25 -61.00 -60.75 -60.50 -60.25 -60.00 -59.75 -59.50 -59.25 -59.00 -58.75 -58.50 -58.25 -58.00 -57.75 -57.50 -57.25 -57.00 -56.75 -56.50 -56.25 -56.00 -55.75 -55.50 -55.25 -55.00 -54.75 -54.50 -54.25 -54.00 -53.75 -53.50 -53.25 -53.00 -52.75 -52.50 -52.25 -52.00 -51.75 -51.50 -51.25 -51.00 -50.75 -50.50 -50.25 -50.00 -49.75 -49.50 -49.25 -49.00 -48.75 -48.50 -48.25 -48.00 -47.75 -47.50 -47.25 -47.00 -46.75 -46.50 -46.25 -46.00 -45.75 -45.50 -45.25 -45.00 -44.75 -44.50 -44.25 -44.00 -43.75 -43.50 -43.25 -43.00 -42.75 -42.50 -42.25 -42.00 -41.75 -41.50 -41.25 -41.00 -40.75 -40.50 -40.25 -40.00 -39.75 -39.50 -39.25 -39.00 -38.75 -38.50 -38.25 -38.00 -37.75 -37.50 -37.25 -37.00 -36.75 -36.50 -36.25 -36.00 -35.75 -35.50 -35.25 -35.00 -34.75 -34.50 -34.25 -34.00 -33.75 -33.50 -33.25 -33.00 -32.75 -32.50 -32.25 -32.00 -31.75 -31.50 -31.25 -31.00 -30.75 -30.50 -30.25 -30.00 -29.75 -29.50 -29.25 -29.00 -28.75 -28.50 -28.25 -28.00 -27.75 -27.50 -27.25 -27.00 -26.75 -26.50 -26.25 -26.00 -25.75 -25.50 -25.25 -25.00 -24.75 -24.50 -24.25 -24.00 -23.75 -23.50 -23.25 -23.00 -22.75 -22.50 -22.25 -22.00 -21.75 -21.50 -21.25 -21.00 -20.75 -20.50 -20.25 -20.00 -19.75 -19.50 -19.25 -19.00 -18.75 -18.50 -18.25 -18.00 -17.75 -17.50 -17.25 -17.00 -16.75 -16.50 -16.25 -16.00 -15.75 -15.50 -15.25 -15.00 -14.75 -14.50 -14.25 -14.00 -13.75 -13.50 -13.25 -13.00 -12.75 -12.50 -12.25 -12.00 -11.75 -11.50 -11.25 -11.00 -10.75 -10.50 -10.25 -10.00 -9.75 -9.50 -9.25 -9.00 -8.75 -8.50 -8.25 -8.00 -7.75 -7.50 -7.25 -7.00 -6.75 -6.50 -6.25 -6.00 -5.75 -5.50 -5.25 -5.00 -4.75 -4.50 -4.25 -4.00 -3.75 -3.50 -3.25 -3.00 -2.75 -2.50 -2.25 -2.00 -1.75 -1.50 -1.25 -1.00 -0.75 -0.50 -0.25 0.00 0.25 0.50 0.75 1.00 1.25 1.50 1.75 2.00 2.25 2.50 2.75 3.00 3.25 3.50 3.75 4.00 4.25 4.50 4.75 5.00 5.25 5.50 5.75 6.00 6.25 6.50 6.75 7.00 7.25 7.50 7.75 8.00 8.25 8.50 8.75 9.00 9.25 9.50 9.75 10.00 10.25 10.50 10.75 11.00 11.25 11.50 11.75 12.00 12.25 12.50 12.75 13.00 13.25 13.50 13.75 14.00 14.25 14.50 14.75 15.00 15.25 15.50 15.75 16.00 16.25 16.50 16.75 17.00 17.25 17.50 17.75 18.00 18.25 18.50 18.75 19.00 19.25 19.50 19.75 20.00 20.25 20.50 20.75 21.00 21.25 21.50 21.75 22.00 22.25 22.50 22.75 23.00 23.25 23.50 23.75 24.00 24.25 24.50 24.75 25.00 25.25 25.50 25.75 26.00 26.25 26.50 26.75 27.00 27.25 27.50 27.75 28.00 28.25 28.50 28.75 29.00 29.25 29.50 29.75 30.00 30.25 30.50 30.75 31.00 31.25 31.50 31.75 32.00 32.25 32.50 32.75 33.00 33.25 33.50 33.75 34.00 34.25 34.50 34.75 35.00 35.25 35.50 35.75 36.00 36.25 36.50 36.75 37.00 37.25 37.50 37.75 38.00 38.25 38.50 38.75 39.00 39.25 39.50 39.75 40.00 40.25 40.50 40.75 41.00 41.25 41.50 41.75 42.00 42.25 42.50 42.75 43.00 43.25 43.50 43.75 44.00 44.25 44.50 44.75 45.00 45.25 45.50 45.75 46.00 46.25 46.50 46.75 47.00 47.25 47.50 47.75 48.00 48.25 48.50 48.75 49.00 49.25 49.50 49.75 50.00 50.25 50.50 50.75 51.00 51.25 51.50 51.75 52.00 52.25 52.50 52.75 53.00 53.25 53.50 53.75 54.00 54.25 54.50 54.75 55.00 55.25 55.50 55.75 56.00 56.25 56.50 56.75 57.00 57.25 57.50 57.75 58.00 58.25 58.50 58.75 59.00 59.25 59.50 59.75 60.00 60.25 60.50 60.75 61.00 61.25 61.50 61.75 62.00 62.25 62.50 62.75 63.00 63.25 63.50 63.75 64.00 64.25 64.50 64.75 65.00 65.25 65.50 65.75 66.00 66.25 66.50 66.75 67.00 67.25 67.50 67.75 68.00 68.25 68.50 68.75 69.00 69.25 69.50 69.75 70.00 70.25 70.50 70.75 71.00 71.25 71.50 71.75 72.00 72.25 72.50 72.75 73.00 73.25 73.50 73.75 74.00 74.25 74.50 74.75 75.00 75.25 75.50 75.75 76.00 76.25 76.50 76.75 77.00 77.25 77.50 77.75 78.00 78.25 78.50 78.75 79.00 79.25 79.50 79.75 80.00 80.25 80.50 80.75 81.00 81.25 81.50 81.75 82.00 82.25 82.50 82.75 83.00 83.25 83.50 83.75 84.00 84.25 84.50 84.75 85.00 85.25 85.50 85.75 86.00 86.25 86.50 86.75 87.00 87.25 87.50 87.75 88.00 88.25 88.50 88.75 89.00 89.25 89.50 89.75 89.9375 \ No newline at end of file diff --git a/run/HEMCO_sa_Grid.05x0625.rc b/run/HEMCO_sa_Grid.05x0625.rc index 5e55f256..185caac3 100644 --- a/run/HEMCO_sa_Grid.05x0625.rc +++ b/run/HEMCO_sa_Grid.05x0625.rc @@ -1,11 +1,11 @@ # Emission grid specifications: -XMIN: -180.25 -XMAX: 179.75 -YMIN: -90.0 -YMAX: 90.0 -NX: 576 -NY: 361 -NZ: 47 +XMIN: -180.3125 # Westernmost longitude edge +XMAX: 179.6875 # Easternmost longitude edge +YMIN: -90.0 # Southernmost latitude edge +YMAX: 90.0 # Northernmost latititude edge +NX: 576 # Number of longitudes in grid +NY: 361 # Number of latitudes in grid +NZ: 47 # Number of levels in grid YEDGE: -90.00 -89.75 -89.25 -88.75 -88.25 -87.75 -87.25 -86.75 -86.25 -85.75 -85.25 -84.75 -84.25 -83.75 -83.25 -82.75 -82.25 -81.75 -81.25 -80.75 -80.25 -79.75 -79.25 -78.75 -78.25 -77.75 -77.25 -76.75 -76.25 -75.75 -75.25 -74.75 -74.25 -73.75 -73.25 -72.75 -72.25 -71.75 -71.25 -70.75 -70.25 -69.75 -69.25 -68.75 -68.25 -67.75 -67.25 -66.75 -66.25 -65.75 -65.25 -64.75 -64.25 -63.75 -63.25 -62.75 -62.25 -61.75 -61.25 -60.75 -60.25 -59.75 -59.25 -58.75 -58.25 -57.75 -57.25 -56.75 -56.25 -55.75 -55.25 -54.75 -54.25 -53.75 -53.25 -52.75 -52.25 -51.75 -51.25 -50.75 -50.25 -49.75 -49.25 -48.75 -48.25 -47.75 -47.25 -46.75 -46.25 -45.75 -45.25 -44.75 -44.25 -43.75 -43.25 -42.75 -42.25 -41.75 -41.25 -40.75 -40.25 -39.75 -39.25 -38.75 -38.25 -37.75 -37.25 -36.75 -36.25 -35.75 -35.25 -34.75 -34.25 -33.75 -33.25 -32.75 -32.25 -31.75 -31.25 -30.75 -30.25 -29.75 -29.25 -28.75 -28.25 -27.75 -27.25 -26.75 -26.25 -25.75 -25.25 -24.75 -24.25 -23.75 -23.25 -22.75 -22.25 -21.75 -21.25 -20.75 -20.25 -19.75 -19.25 -18.75 -18.25 -17.75 -17.25 -16.75 -16.25 -15.75 -15.25 -14.75 -14.25 -13.75 -13.25 -12.75 -12.25 -11.75 -11.25 -10.75 -10.25 -9.75 -9.25 -8.75 -8.25 -7.75 -7.25 -6.75 -6.25 -5.75 -5.25 -4.75 -4.25 -3.75 -3.25 -2.75 -2.25 -1.75 -1.25 -0.75 -0.25 0.25 0.75 1.25 1.75 2.25 2.75 3.25 3.75 4.25 4.75 5.25 5.75 6.25 6.75 7.25 7.75 8.25 8.75 9.25 9.75 10.25 10.75 11.25 11.75 12.25 12.75 13.25 13.75 14.25 14.75 15.25 15.75 16.25 16.75 17.25 17.75 18.25 18.75 19.25 19.75 20.25 20.75 21.25 21.75 22.25 22.75 23.25 23.75 24.25 24.75 25.25 25.75 26.25 26.75 27.25 27.75 28.25 28.75 29.25 29.75 30.25 30.75 31.25 31.75 32.25 32.75 33.25 33.75 34.25 34.75 35.25 35.75 36.25 36.75 37.25 37.75 38.25 38.75 39.25 39.75 40.25 40.75 41.25 41.75 42.25 42.75 43.25 43.75 44.25 44.75 45.25 45.75 46.25 46.75 47.25 47.75 48.25 48.75 49.25 49.75 50.25 50.75 51.25 51.75 52.25 52.75 53.25 53.75 54.25 54.75 55.25 55.75 56.25 56.75 57.25 57.75 58.25 58.75 59.25 59.75 60.25 60.75 61.25 61.75 62.25 62.75 63.25 63.75 64.25 64.75 65.25 65.75 66.25 66.75 67.25 67.75 68.25 68.75 69.25 69.75 70.25 70.75 71.25 71.75 72.25 72.75 73.25 73.75 74.25 74.75 75.25 75.75 76.25 76.75 77.25 77.75 78.25 78.75 79.25 79.75 80.25 80.75 81.25 81.75 82.25 82.75 83.25 83.75 84.25 84.75 85.25 85.75 86.25 86.75 87.25 87.75 88.25 88.75 89.25 89.75 90.00 YMID: -89.875 -89.50 -89.00 -88.50 -88.00 -87.50 -87.00 -86.50 -86.00 -85.50 -85.00 -84.50 -84.00 -83.50 -83.00 -82.50 -82.00 -81.50 -81.00 -80.50 -80.00 -79.50 -79.00 -78.50 -78.00 -77.50 -77.00 -76.50 -76.00 -75.50 -75.00 -74.50 -74.00 -73.50 -73.00 -72.50 -72.00 -71.50 -71.00 -70.50 -70.00 -69.50 -69.00 -68.50 -68.00 -67.50 -67.00 -66.50 -66.00 -65.50 -65.00 -64.50 -64.00 -63.50 -63.00 -62.50 -62.00 -61.50 -61.00 -60.50 -60.00 -59.50 -59.00 -58.50 -58.00 -57.50 -57.00 -56.50 -56.00 -55.50 -55.00 -54.50 -54.00 -53.50 -53.00 -52.50 -52.00 -51.50 -51.00 -50.50 -50.00 -49.50 -49.00 -48.50 -48.00 -47.50 -47.00 -46.50 -46.00 -45.50 -45.00 -44.50 -44.00 -43.50 -43.00 -42.50 -42.00 -41.50 -41.00 -40.50 -40.00 -39.50 -39.00 -38.50 -38.00 -37.50 -37.00 -36.50 -36.00 -35.50 -35.00 -34.50 -34.00 -33.50 -33.00 -32.50 -32.00 -31.50 -31.00 -30.50 -30.00 -29.50 -29.00 -28.50 -28.00 -27.50 -27.00 -26.50 -26.00 -25.50 -25.00 -24.50 -24.00 -23.50 -23.00 -22.50 -22.00 -21.50 -21.00 -20.50 -20.00 -19.50 -19.00 -18.50 -18.00 -17.50 -17.00 -16.50 -16.00 -15.50 -15.00 -14.50 -14.00 -13.50 -13.00 -12.50 -12.00 -11.50 -11.00 -10.50 -10.00 -9.50 -9.00 -8.50 -8.00 -7.50 -7.00 -6.50 -6.00 -5.50 -5.00 -4.50 -4.00 -3.50 -3.00 -2.50 -2.00 -1.50 -1.00 -0.50 0.00 0.50 1.00 1.50 2.00 2.50 3.00 3.50 4.00 4.50 5.00 5.50 6.00 6.50 7.00 7.50 8.00 8.50 9.00 9.50 10.00 10.50 11.00 11.50 12.00 12.50 13.00 13.50 14.00 14.50 15.00 15.50 16.00 16.50 17.00 17.50 18.00 18.50 19.00 19.50 20.00 20.50 21.00 21.50 22.00 22.50 23.00 23.50 24.00 24.50 25.00 25.50 26.00 26.50 27.00 27.50 28.00 28.50 29.00 29.50 30.00 30.50 31.00 31.50 32.00 32.50 33.00 33.50 34.00 34.50 35.00 35.50 36.00 36.50 37.00 37.50 38.00 38.50 39.00 39.50 40.00 40.50 41.00 41.50 42.00 42.50 43.00 43.50 44.00 44.50 45.00 45.50 46.00 46.50 47.00 47.50 48.00 48.50 49.00 49.50 50.00 50.50 51.00 51.50 52.00 52.50 53.00 53.50 54.00 54.50 55.00 55.50 56.00 56.50 57.00 57.50 58.00 58.50 59.00 59.50 60.00 60.50 61.00 61.50 62.00 62.50 63.00 63.50 64.00 64.50 65.00 65.50 66.00 66.50 67.00 67.50 68.00 68.50 69.00 69.50 70.00 70.50 71.00 71.50 72.00 72.50 73.00 73.50 74.00 74.50 75.00 75.50 76.00 76.50 77.00 77.50 78.00 78.50 79.00 79.50 80.00 80.50 81.00 81.50 82.00 82.50 83.00 83.50 84.00 84.50 85.00 85.50 86.00 86.50 87.00 87.50 88.00 88.50 89.00 89.50 89.875 diff --git a/run/HEMCO_sa_Grid.2x25.rc b/run/HEMCO_sa_Grid.2x25.rc index 2390c4eb..b282c9d0 100644 --- a/run/HEMCO_sa_Grid.2x25.rc +++ b/run/HEMCO_sa_Grid.2x25.rc @@ -1,11 +1,11 @@ # Emission grid specifications: -XMIN: -181.25 -XMAX: 178.75 -YMIN: -90.0 -YMAX: 90.0 -NX: 144 -NY: 91 -NZ: 47 +XMIN: -181.25 # Westernmost longitude edge +XMAX: 178.75 # Easternmost longitude edge +YMIN: -90.0 # Southernmost latitude edge +YMAX: 90.0 # Northernmost latititude edge +NX: 144 # Number of longitudes in grid +NY: 91 # Number of latitudes in grid +NZ: 47 # Number of levels in grid YMID: -89.5 -88.0 -86.0 -84.0 -82.0 -80.0 -78.0 -76.0 -74.0 -72.0 -70.0 -68.0 -66.0 -64.0 -62.0 -60.0 -58.0 -56.0 -54.0 -52.0 -50.0 -48.0 -46.0 -44.0 -42.0 -40.0 -38.0 -36.0 -34.0 -32.0 -30.0 -28.0 -26.0 -24.0 -22.0 -20.0 -18.0 -16.0 -14.0 -12.0 -10.0 -8.0 -6.0 -4.0 -2.0 0.0 2.0 4.0 6.0 8.0 10.0 12.0 14.0 16.0 18.0 20.0 22.0 24.0 26.0 28.0 30.0 32.0 34.0 36.0 38.0 40.0 42.0 44.0 46.0 48.0 50.0 52.0 54.0 56.0 58.0 60.0 62.0 64.0 66.0 68.0 70.0 72.0 74.0 76.0 78.0 80.0 82.0 84.0 86.0 88.0 89.5 diff --git a/run/HEMCO_sa_Grid.4x5.rc b/run/HEMCO_sa_Grid.4x5.rc index aaab0d73..53740647 100644 --- a/run/HEMCO_sa_Grid.4x5.rc +++ b/run/HEMCO_sa_Grid.4x5.rc @@ -1,11 +1,11 @@ # Emission grid specifications: -XMIN: -182.5 -XMAX: 177.5 -YMIN: -90.0 -YMAX: 90.0 -NX: 72 -NY: 46 -NZ: 47 +XMIN: -182.5 # Westernmost longitude edge +XMAX: 177.5 # Easternmost longitude edge +YMIN: -90.0 # Southernmost latitude edge +YMAX: 90.0 # Northernmost latititude edge +NX: 72 # Number of longitudes in grid +NY: 46 # Number of latitudes in grid +NZ: 47 # Number of levels in grid YMID: -89.0 -86.0 -82.0 -78.0 -74.0 -70.0 -66.0 -62.0 -58.0 -54.0 -50.0 -46.0 -42.0 -38.0 -34.0 -30.0 -26.0 -22.0 -18.0 -14.0 -10.0 -6.0 -2.0 2.0 6.0 10.0 14.0 18.0 22.0 26.0 30.0 34.0 38.0 42.0 46.0 50.0 54.0 58.0 62.0 66.0 70.0 74.0 78.0 82.0 86.0 89.0 YEDGE: -90.0 -88.0 -84.0 -80.0 -76.0 -72.0 -68.0 -64.0 -60.0 -56.0 -52.0 -48.0 -44.0 -40.0 -36.0 -32.0 -28.0 -24.0 -20.0 -16.0 -12.0 -8.0 -4.0 0.0 4.0 8.0 12.0 16.0 20.0 24.0 28.0 32.0 36.0 40.0 44.0 48.0 52.0 56.0 60.0 64.0 68.0 72.0 76.0 80.0 84.0 88.0 90.0 From 8ec9e47fe1df15cab596de3ec848d9b2bad46bac Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Thu, 20 Jul 2023 12:02:38 -0400 Subject: [PATCH 55/63] Updated CHANGELOG.md for PR #229 (Fixes in HEMCO_sa_Grid files) CHANGELOG.md - Updated with a sentence about the fix for XMIN and XMAX values in HEMCO_sa_Grid.05x0625.rc and HEMCO_sa_Grid.025x0625.rc. Signed-off-by: Bob Yantosca --- CHANGELOG.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index b4dc058a..25fb838f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,6 +12,9 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Removed superfluous routine `GetExtSpcVal_Dr` in `src/Core/hco_extlist_mod.F90` - NetCDF routines in `src/Shared/NcdfUtil` now use the Fortran-90 API +### Fixed +- Fixed incorrect `XMIN`, `XMAX` values in `HEMCO_sa_Grid.025x03125.rc` and `HEMCO_sa_Grid.05x0625.rc` + ## [Unreleased 3.7.0] - TBD ### Added - HEMCO extensions now display a first-time message, whether `Verbose` is `true` or `false`. From 35365b5a888e6781d125faaefd20538cb8bd846d Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 21 Jul 2023 16:35:52 -0400 Subject: [PATCH 56/63] Fix bug introduced by prior commit of blocking prints to root thread only This update fixes a problem where the simulation will crash in the volcano extension init subroutine on non-root threads if the volcano extension is turned off, such as in the transport tracer simulation. The fix moves the return if extension number is zero to directly after the call to retrieve extension number. This is the same handling as all other HEMCO extension initialization routines. Signed-off-by: Lizzie Lundgren --- src/Extensions/hcox_volcano_mod.F90 | 36 +++++++++++------------------ 1 file changed, 13 insertions(+), 23 deletions(-) diff --git a/src/Extensions/hcox_volcano_mod.F90 b/src/Extensions/hcox_volcano_mod.F90 index 2c6f8b59..1dc9841a 100644 --- a/src/Extensions/hcox_volcano_mod.F90 +++ b/src/Extensions/hcox_volcano_mod.F90 @@ -354,23 +354,7 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) ! Extension Nr. ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) - - ! Print to log - IF ( HcoState%amIRoot ) THEN - IF ( ExtNr > 0 ) THEN - ! Write the name of the extension regardless of the verbose setting - msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' - IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator - ELSE - CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator - ENDIF - ELSE - MSG = 'The Volcano extension is turned off.' - CALL HCO_MSG( HcoState%Config%Err, MSG ) - RETURN - ENDIF - ENDIF + IF ( ExtNr <= 0 ) RETURN ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) @@ -379,15 +363,24 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) RETURN ENDIF - ! Create Volcano instance for this simulation + ! Create instance for this simulation Inst => NULL() CALL InstCreate( ExtNr, ExtState%Volcano, Inst, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_Error( & - 'Cannot create Volcano instance', RC ) + CALL HCO_Error( 'Cannot create Volcano instance', RC ) RETURN ENDIF + ! Write the name of the extension regardless of the verbose settings + IF ( HcoState%amIRoot ) THEN + msg = 'Using HEMCO extension: Volcano (volcanic SO2 emissions)' + IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN + CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator + ELSE + CALL HCO_Msg( msg, verb=.TRUE. ) ! w/o separator + ENDIF + ENDIF + ! Get species IDs. CALL HCO_GetExtHcoID( HcoState, ExtNr, Inst%SpcIDs, & SpcNames, Inst%nSpc, RC ) @@ -483,9 +476,6 @@ SUBROUTINE HCOX_Volcano_Init( HcoState, ExtName,ExtState, RC ) ! Verbose mode IF ( HcoState%amIRoot ) THEN - MSG = 'Use emissions extension `Volcano`:' - CALL HCO_MSG( HcoState%Config%Err, MSG ) - MSG = ' - use the following species (Name, HcoID, Scaling relative to kgS):' CALL HCO_MSG( HcoState%Config%Err, MSG) DO N = 1, Inst%nSpc From 48181ad69873e85d9694ef8807b15e04e249e857 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 8 Aug 2023 13:27:44 -0400 Subject: [PATCH 57/63] Limit GC_72_EDGE_SIGMA variable to 135 columns per Fortran-90 spec. This will make compile compatible with the nvhpc compiler. This was reported downstream from ESCOMP/CAM#871 and at HEMCO#233. Reported-by: Jian Sun @sjsprecious Signed-off-by: Haipeng Lin --- src/Core/hcoio_read_std_mod.F90 | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 9a3c03af..fab7a07e 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -62,7 +62,20 @@ MODULE HCOIO_Read_Mod REAL(dp), PRIVATE, PARAMETER :: EPSILON = 1.0e-5_dp #if defined( MODEL_CESM ) || defined( MODEL_WRF ) - REAL(hp), PRIVATE :: GC_72_EDGE_SIGMA(73) = (/1.000000E+00, 9.849998E-01, 9.699136E-01, 9.548285E-01, 9.397434E-01, 9.246593E-01, 9.095741E-01, 8.944900E-01, 8.794069E-01, 8.643237E-01, 8.492406E-01, 8.341584E-01, 8.190762E-01, 7.989697E-01, 7.738347E-01, 7.487007E-01, 7.235727E-01, 6.984446E-01, 6.733175E-01, 6.356319E-01, 5.979571E-01, 5.602823E-01, 5.226252E-01, 4.849751E-01, 4.473417E-01, 4.097261E-01, 3.721392E-01, 3.345719E-01, 2.851488E-01, 2.420390E-01, 2.055208E-01, 1.746163E-01, 1.484264E-01, 1.261653E-01, 1.072420E-01, 9.115815E-02, 7.748532E-02, 6.573205E-02, 5.565063E-02, 4.702097E-02, 3.964964E-02, 3.336788E-02, 2.799704E-02, 2.341969E-02, 1.953319E-02, 1.624180E-02, 1.346459E-02, 1.112953E-02, 9.171478E-03, 7.520355E-03, 6.135702E-03, 4.981002E-03, 4.023686E-03, 3.233161E-03, 2.585739E-03, 2.057735E-03, 1.629410E-03, 1.283987E-03, 1.005675E-03, 7.846040E-04, 6.089317E-04, 4.697755E-04, 3.602270E-04, 2.753516E-04, 2.082408E-04, 1.569208E-04, 1.184308E-04, 8.783617E-05, 6.513694E-05, 4.737232E-05, 3.256847E-05, 1.973847E-05, 9.869233E-06/) + REAL(hp), PRIVATE :: GC_72_EDGE_SIGMA(73) = (/ & + 1.000000E+00, 9.849998E-01, 9.699136E-01, 9.548285E-01, 9.397434E-01, 9.246593E-01, & + 9.095741E-01, 8.944900E-01, 8.794069E-01, 8.643237E-01, 8.492406E-01, 8.341584E-01, & + 8.190762E-01, 7.989697E-01, 7.738347E-01, 7.487007E-01, 7.235727E-01, 6.984446E-01, & + 6.733175E-01, 6.356319E-01, 5.979571E-01, 5.602823E-01, 5.226252E-01, 4.849751E-01, & + 4.473417E-01, 4.097261E-01, 3.721392E-01, 3.345719E-01, 2.851488E-01, 2.420390E-01, & + 2.055208E-01, 1.746163E-01, 1.484264E-01, 1.261653E-01, 1.072420E-01, 9.115815E-02, & + 7.748532E-02, 6.573205E-02, 5.565063E-02, 4.702097E-02, 3.964964E-02, 3.336788E-02, & + 2.799704E-02, 2.341969E-02, 1.953319E-02, 1.624180E-02, 1.346459E-02, 1.112953E-02, & + 9.171478E-03, 7.520355E-03, 6.135702E-03, 4.981002E-03, 4.023686E-03, 3.233161E-03, & + 2.585739E-03, 2.057735E-03, 1.629410E-03, 1.283987E-03, 1.005675E-03, 7.846040E-04, & + 6.089317E-04, 4.697755E-04, 3.602270E-04, 2.753516E-04, 2.082408E-04, 1.569208E-04, & + 1.184308E-04, 8.783617E-05, 6.513694E-05, 4.737232E-05, 3.256847E-05, 1.973847E-05, & + 9.869233E-06/) #endif CONTAINS From c874025763d4b14971ba018a7a8ff6a692d8ecc8 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 8 Aug 2023 13:34:57 -0400 Subject: [PATCH 58/63] Add corresponding CHANGELOG.md update --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 25fb838f..1368cfea 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -14,6 +14,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ### Fixed - Fixed incorrect `XMIN`, `XMAX` values in `HEMCO_sa_Grid.025x03125.rc` and `HEMCO_sa_Grid.05x0625.rc` +- Fixed line length too long for the `GC_72_EDGE_SIGMA` variable in `src/Core/hcoio_read_std_mod.F90` ## [Unreleased 3.7.0] - TBD ### Added From 1f71788560ae7afee79e46de8916405513a89863 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Tue, 29 Aug 2023 09:27:44 -0400 Subject: [PATCH 59/63] PR #235 (bugfix/vertical-regridding): Squashed commit of: commit 718d342574a97a56675f1089fed07dccab61264e Author: nicholasbalasus Date: Tue Aug 29 07:50:26 2023 -0400 syntax fix commit 83a8f009a579d9f9bde443b3d5053d28ad9e9a11 Author: nicholasbalasus Date: Tue Aug 29 07:44:16 2023 -0400 handle AEIC files commit 3b99a63359b435d19f4242de80b70278ea20dd2a Author: nicholasbalasus Date: Mon Aug 28 13:24:31 2023 -0400 update CHANGELOG.md and address Bob's comments commit d1ddd10d79762d594f9ebf62bbf760d7eb793d2f Author: nicholasbalasus Date: Fri Aug 25 09:15:42 2023 -0400 add some messages when HEMCO is verbose commit e3200848925509e5ecde03c4fa8506bb9070c539 Author: nicholasbalasus Date: Thu Aug 24 16:54:31 2023 -0400 further ENDIF fixes commit 2a58a42e084c5e2f94d6e6362e4fc2391a35465c Author: nicholasbalasus Date: Thu Aug 24 16:40:09 2023 -0400 declare I commit 29e4efa8c4f7f332b44b89e92ff88620eb9cddc1 Author: nicholasbalasus Date: Thu Aug 24 16:38:04 2023 -0400 another forgotten ENDIF commit 420cabc6a369d5677fbc935cbb34e8f79420027a Author: nicholasbalasus Date: Thu Aug 24 16:33:44 2023 -0400 move ENDIF commit f1307ad30b40f3b1138fa1bf650c3cf966b7fd18 Author: nicholasbalasus Date: Thu Aug 24 13:41:05 2023 -0400 add INFLATE behavior back in commit c9cce090e8d6942c4947f33ad143288e33d39134 Author: nicholasbalasus Date: Thu Aug 24 08:02:03 2023 -0400 bugfix in DO loop from Todd's comment commit a0638762cb0b90ec15afddd2858409b68440938f Author: nicholasbalasus Date: Sat Aug 12 07:32:48 2023 -0400 more RC fixes commit c0a771b9000595f07f5ce9143afc4851f7a944f1 Author: nicholasbalasus Date: Sat Aug 12 07:28:10 2023 -0400 error handling in hco_interp_mod.F90 commit 80c56ff038c0cd54584ad862f0c8b593b56b802f Author: nicholasbalasus Date: Sat Aug 12 07:18:46 2023 -0400 fix for error writing commit bfbcd0379a9e64c84899a80b2d5ce5fd4e531dd0 Author: nicholasbalasus Date: Sat Aug 12 07:12:36 2023 -0400 update comments, only handle 22 and 5 met commit 786a9520fed6ab313614b6ce5cef496adb69535f Author: nicholasbalasus Date: Thu Aug 10 19:59:41 2023 -0400 add nout back in commit fa8b18150358289e7731959b7df434618f8d4a9b Author: nicholasbalasus Date: Thu Aug 10 17:25:49 2023 -0400 finally fixed out ALLOCATE error commit 86a3c4aca7f6d5be57ac1199f1c6b7ca3c960ca6 Author: nicholasbalasus Date: Thu Aug 10 16:36:03 2023 -0400 another try at printing commit 1cf516cc3d9039ce0f7cdfb2782293e9075b9cac Author: nicholasbalasus Date: Thu Aug 10 16:26:40 2023 -0400 try to print again commit a63210fe4620bda7d7835d9835622bdcdf982c71 Author: nicholasbalasus Date: Thu Aug 10 16:23:20 2023 -0400 print to debuug commit af45fa5ff8b44aa48ada31cfc0487b00a563b8cb Author: nicholasbalasus Date: Thu Aug 10 15:58:16 2023 -0400 trying another fix for IsModelLevel commit c371cb3d4c1167184d7c2ba2cdb51c0d54150fb8 Author: nicholasbalasus Date: Thu Aug 10 15:19:28 2023 -0400 default False IsModelLevel commit 31cfa897ffc2ecdb0118d3469c6fe6548ac3b46c Author: nicholasbalasus Date: Thu Aug 10 11:11:52 2023 -0400 another minor fix commit d1cf1a7daf32bd15128025c4c59e85642e8d5d36 Author: nicholasbalasus Date: Thu Aug 10 11:09:19 2023 -0400 syntax fix commit cf847353091e7d3f73d09ce8a5a3bd1ebbff51a4 Author: nicholasbalasus Date: Thu Aug 10 11:05:00 2023 -0400 remove INFLATE commit 56b0a3f7c3606546a888db79647d3b1b4b98b101 Author: nicholasbalasus Date: Thu Aug 10 10:59:07 2023 -0400 add ENDIF commit 29a228484bfa0a42adbe5be150c268015057093b Author: nicholasbalasus Date: Thu Aug 10 09:58:56 2023 -0400 add check that ModelLev_Interpolate should have been called commit 9832a3d04444341bde2d3984cce8940669f7de7e Author: nicholasbalasus Date: Thu Aug 10 09:51:45 2023 -0400 remove NC calls commit 8b170071efc66598177fe139b6cd9dcc0960f3d2 Author: nicholasbalasus Date: Thu Aug 10 09:50:59 2023 -0400 only us COLLAPSE if going from 72->47 or 102->74 commit 8415b03fffc1c69b0263d0ef98cbeb44af7b6215 Author: nicholasbalasus Date: Thu Aug 10 09:40:36 2023 -0400 fix COLLAPSE, change ModelLev_Check, remove INFLATE and GEOS4 Signed-off-by: Bob Yantosca --- CHANGELOG.md | 6 + src/Core/hco_interp_mod.F90 | 812 +++++++++------------------ src/Core/hcoio_read_std_mod.F90 | 37 +- src/Shared/NcdfUtil/hco_ncdf_mod.F90 | 151 ----- 4 files changed, 271 insertions(+), 735 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 1368cfea..da98dcfc 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,12 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 - Make Hg0 emission factors in `hcox_gfed_include_gfed4.H` multipliers of the CO emission factor - Removed superfluous routine `GetExtSpcVal_Dr` in `src/Core/hco_extlist_mod.F90` - NetCDF routines in `src/Shared/NcdfUtil` now use the Fortran-90 API +- Overhauled vertical regridding `src/Core/hco_interp_mod.F90` + - Removed `INFLATE` (but retained its behavior only for 47L -> 72L vertical regridding, warning users that this isn't recommended) + - `ModelLev_Interpolate` is only called when the input is 47/48, 72/73, or 102/103 levels (otherwise, MESSy is used). + - A bug that averaged the wrong number of levels in `COLLAPSE` is fixed (and edges are now sampled instead of averaged). + - Removed the now superfluous `NC_ISMODELLEVEL` and `NC_SISIGMALEVEL` from `src/Shared/NcdfUtil/hco_ncdf_mod.F90` + - Removed old code and references to `GEOS-4`. ### Fixed - Fixed incorrect `XMIN`, `XMAX` values in `HEMCO_sa_Grid.025x03125.rc` and `HEMCO_sa_Grid.05x0625.rc` diff --git a/src/Core/hco_interp_mod.F90 b/src/Core/hco_interp_mod.F90 index e6c87391..60c3d9bf 100644 --- a/src/Core/hco_interp_mod.F90 +++ b/src/Core/hco_interp_mod.F90 @@ -36,11 +36,9 @@ MODULE HCO_Interp_Mod PUBLIC :: ModelLev_Interpolate PUBLIC :: REGRID_MAPA2A ! -! !PUBLIC MEMBER FUNCTIONS: +! !PRIVATE MEMBER FUNCTIONS: ! - PRIVATE :: GEOS5_TO_GEOS4_LOWLEV PRIVATE :: COLLAPSE - PRIVATE :: INFLATE ! ! !REVISION HISTORY: ! 30 Dec 2014 - C. Keller - Initialization @@ -74,29 +72,6 @@ MODULE HCO_Interp_Mod 6.600001e-02_hp, 4.758501e-02_hp, 3.270000e-02_hp, 2.000000e-02_hp, & 1.000000e-02_hp /) - ! AP parameter of native GEOS-4 grid. Needed to remap GEOS-4 data from native - ! onto the reduced vertical grid. - REAL(hp), TARGET :: G4_EDGE_NATIVE(56) = (/ & - 0.000000_hp, 0.000000_hp, 12.704939_hp, & - 35.465965_hp, 66.098427_hp, 101.671654_hp, & - 138.744400_hp, 173.403183_hp, 198.737839_hp, & - 215.417526_hp, 223.884689_hp, 224.362869_hp, & - 216.864929_hp, 201.192093_hp, 176.929993_hp, & - 150.393005_hp, 127.837006_hp, 108.663429_hp, & - 92.365662_hp, 78.512299_hp, 66.603378_hp, & - 56.387939_hp, 47.643932_hp, 40.175419_hp, & - 33.809956_hp, 28.367815_hp, 23.730362_hp, & - 19.791553_hp, 16.457071_hp, 13.643393_hp, & - 11.276889_hp, 9.292943_hp, 7.619839_hp, & - 6.216800_hp, 5.046805_hp, 4.076567_hp, & - 3.276433_hp, 2.620212_hp, 2.084972_hp, & - 1.650792_hp, 1.300508_hp, 1.019442_hp, & - 0.795134_hp, 0.616779_hp, 0.475806_hp, & - 0.365041_hp, 0.278526_hp, 0.211349_hp, & - 0.159495_hp, 0.119703_hp, 0.089345_hp, & - 0.066000_hp, 0.047585_hp, 0.032700_hp, & - 0.020000_hp, 0.010000_hp /) - ! AP parameter of native 102-layer GISS grid REAL(hp), TARGET :: E102_EDGE_NATIVE(103) = (/ & 0.0000000, 2.7871507, 5.5743014, 8.3614521, 11.1486028, 13.9357536, & @@ -385,7 +360,7 @@ SUBROUTINE REGRID_MAPA2A( HcoState, NcArr, LonE, LatE, Lct, RC ) ENDDO !L ENDDO !T - ! Eventually inflate/collapse levels onto simulation levels. + ! Eventually collapse levels onto simulation levels. IF ( Lct%Dct%Dta%SpaceDim == 3 ) THEN CALL ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) IF ( RC /= HCO_SUCCESS ) THEN @@ -517,9 +492,6 @@ SUBROUTINE ModelLev_Check( HcoState, nLev, IsModelLev, RC ) ! Assume success until otherwise RC = HCO_SUCCESS - ! If IsModelLev is already TRUE, nothing to do - IF ( IsModelLev ) RETURN - ! Shadow number of vertical levels on grid nz = HcoState%NZ @@ -527,43 +499,21 @@ SUBROUTINE ModelLev_Check( HcoState, nLev, IsModelLev, RC ) ! levels or levels + 1 (edges) IF ( nlev == nz .OR. nlev == nz + 1 ) THEN IsModelLev = .TRUE. - RETURN - ENDIF - - ! Other supported levels that depend on compiler flags - ! Full grid - IF ( nz == 72 ) THEN - IF ( nlev <= 73 ) THEN - IsModelLev = .TRUE. - ENDIF - ! Reduced grid + ! If input is 72 layer (or 36 layer) and output is 47 layer ELSEIF ( nz == 47 ) THEN - IF ( nlev == 72 .OR. & - nlev == 73 .OR. & - nlev <= 47 ) THEN - IsModelLev = .TRUE. - ENDIF + IsModelLev = ( nlev == 72 .OR. nlev == 73 .OR. nlev == 36) - ! Full GISS 102-layer grid - ELSEIF ( nz == 102 ) THEN - IF ( nlev <= 103 ) THEN - IsModelLev = .TRUE. - ENDIF + ! If input is 102 layer and output is 74 layer + ELSEIF ( nz == 74 ) THEN + IsModelLev = ( nlev == 102 .OR. nlev == 103 ) - ! Full GISS 40-layer grid - ELSEIF ( nz == 40 ) THEN - IF ( nlev <= 41 ) THEN - IsModelLev = .TRUE. - ENDIF + ! If input is 47 layer (or 36 layer) and output is 72 layer + ELSEIF ( nz == 72 ) THEN + IsModelLev = ( nlev == 47 .OR. nlev == 48 .OR. nlev == 36) - ! Reduced GISS 74-layer grid - ELSEIF ( nz == 74 ) THEN - IF ( nlev == 102 .OR. & - nlev == 103 .OR. & - nlev <= 74 ) THEN - IsModelLev = .TRUE. - ENDIF + ELSE + IsModelLev = .FALSE. ENDIF END SUBROUTINE ModelLev_Check @@ -578,46 +528,34 @@ END SUBROUTINE ModelLev_Check ! !DESCRIPTION: Subroutine ModelLev\_Interpolate puts 3D data from an ! arbitrary number of model levels onto the vertical levels of the simulation ! grid. Since the input data is already on model levels, this is only to -! inflate/collapse fields between native/reduced vertical levels, e.g. from -! 72 native GEOS-5 levels onto the reduced 47 levels. The vertical -! interpolation scheme depends on compiler switches. If none of the compiler -! switches listed below is used, no vertical interpolation is performed, -! e.g. the vertical levels of the input grid are retained. -!\\ -!\\ +! collapse fields between native/reduced vertical levels, e.g. from +! 72 native GEOS-5 levels onto the reduced 47 levels. +! +! ! The input data (REGR\_4D) is expected to be already regridded horizontally. ! The 4th dimension of REGR\_4D denotes time. -!\\ -!\\ +! +! ! The 3rd dimension of REGR\_3D holds the vertical levels. It is assumed that ! these are model levels, starting at the surface (level 1). If the input -! data holds 72 input levels, this is interpreted as native data and will -! be collapsed onto the reduced grid. If the input data holds X <=47 levels, -! these levels are interpreted as levels 1-X of the reduced grid. In other -! words, input data with 33 levels will be interpreted as 33 levels on the -! reduced grid, and the data is accordingly mapped onto the simulation grid. -! If data becomes inflated or collapsed, the output data will always extent -! over all vertical levels of the simulation grid. If necessary, the unused -! upper levels will be filled with zeros. If no data interpolation is needed, -! the vertical extent of the output data is limited to the number of used -! levels. For instance, if the input data has 5 vertical levels, the output -! array will only extent over those 5 (bottom) levels. -!\\ -!\\ +! data holds 72/73 input levels, this is interpreted as native data and will +! be collapsed onto the reduced GEOS-5 grid. If the input holds 102/103 input +! levels, this is interpreted as native data and will be collapsed onto the +! reduced GISS grid. If the input holds 47/48 input levels, this is interpreted +! as reduced GEOS-5 data and it will be inflated to the native GEOS-5 grid +! (with a warning, as this is not recommended). If the input holds 36 input levels, +! this is assumed to be the first 36 levels of the GEOS-5 grid, meaning they will be +! written as levels 1-36 of a 47 or 72 level output grid (with the remaining values +! left to be zero) (nbalasus, 8/29/2023). +! +! ! Currently, this routine can remap the following combinations: -!\begin{itemize} -! \item Native GEOS-5 onto reduced GEOS-5 (72 --> 47 levels) -! \item Reduced GEOS-5 onto native GEOS-5 (47 --> 72 levels) -! \item Native GEOS-4 onto reduced GEOS-4 (55 --> 30 levels) -! \item Reduced GEOS-4 onto native GEOS-4 (30 --> 55 levels) -! \item Native GEOS-5 onto native GEOS-4 (72 --> 55 levels) -! \item Reduced GEOS-5 onto native GEOS-4 (47 --> 55 levels) -! \item Native GEOS-5 onto reduced GEOS-4 (72 --> 30 levels) -! \item Reduced GEOS-5 onto reduced GEOS-4 (47 --> 30 levels) -!\end{itemize} -! Interpolation from GEOS-5 onto GEOS-4 levels is currently not supported. -!\\ -!\\ +! +! * Native GEOS-5 onto reduced GEOS-5 (72 --> 47 levels, 73 --> 48 edges) +! * Native GISS onto reduced GISS (102 --> 74 levels, 103 --> 75 edges) +! * Reduced GEOS-5 onto native GEOS-5 (47 --> 72 levels, 48 --> 73 edges) +! * 36 levels onto native/reduced GEOS-5 (36 --> levels 1-36 levels of 47/72 level grid, rest are 0) +! ! !INTERFACE: ! SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) @@ -646,10 +584,10 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ! !LOCAL VARIABLES: ! INTEGER :: nx, ny, nz, nt + INTEGER :: fineIDX, coarseIDX INTEGER :: minlev, nlev, nout - INTEGER :: L, T, NL + INTEGER :: L, T, NL, I INTEGER :: OS - INTEGER :: G5T4 LOGICAL :: verb, infl, clps LOGICAL :: DONE CHARACTER(LEN=255) :: MSG, LOC @@ -678,10 +616,6 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ny = HcoState%NY nz = HcoState%NZ - ! Variable G5T4 is the # of GEOS-5 levels that need to be mapped - ! onto GEOS-4 levels. - G5T4 = 0 - ! Input data must be on horizontal HEMCO grid IF ( SIZE(REGR_4D,1) /= nx ) THEN WRITE(MSG,*) 'x dimension mismatch ', TRIM(Lct%Dct%cName), & @@ -700,6 +634,19 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) nlev = SIZE(REGR_4D,3) nt = SIZE(REGR_4D,4) + ! Check to make sure ModelLev_Interpolate should have been called + IF ( ( ( nlev == nz ) .OR. ( nlev == nz+1 ) ) .OR. & ! write data without doing anything + ( ( nz == 47 ) .AND. ( ( nlev == 72 ) .OR. ( nlev == 73 ) ) ) .OR. & ! collapse native to reduced GEOS-5 + ( ( nz == 74 ) .AND. ( ( nlev == 102 ) .OR. ( nlev == 103 ) ) ) .OR. & ! collapse native to reduced GISS + ( ( nz == 72 ) .AND. ( ( nlev == 47 ) .OR. ( nlev == 48 ) ) ) .OR. & ! inflate reduced to native GEOS-5 + ( ( ( nz == 72 ) .OR. ( nz == 47 ) ) .AND. ( nlev == 36 ) ) ) THEN ! write 36 levels to reduced/native GEOS-5 + ! do nothing + ELSE + WRITE(MSG,*) 'ModelLev_Interpolate was called but MESSy should have been used: ',TRIM(Lct%Dct%cName) + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF + ! Vertical interpolation done? DONE = .FALSE. @@ -736,28 +683,26 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) IF ( .NOT. DONE ) THEN !---------------------------------------------------------------- - ! Native levels + ! Native to reduced GEOS-5 levels !---------------------------------------------------------------- - IF ( nz == 72 ) THEN - - ! Determine number of output levels. If the input data has - ! 47 or less levels, it is assumed to represent reduced - ! GEOS-5 levels and data is mapped accordingly. If input data - ! has more than 47 levels, it cannot be on the reduced grid - ! and mapping is done 1:1 - IF ( nlev > 36 .AND. nlev <= 48 ) THEN - IF ( nlev == 48 ) THEN - nz = nz + 1 - nout = nz - NL = 37 - ELSE - nout = nz - NL = 36 - ENDIF + IF ( nz == 47 ) THEN + + ! Determine if the variable is on model levels or edges + IF ( nlev == 72 ) THEN + NL = 36 + nout = 47 + ELSEIF ( nlev == 73 ) THEN + NL = 37 + nout = 48 + ELSEIF ( nlev == 36 ) THEN + NL = 36 + nout = 47 ELSE - nout = nlev - NL = nout - ENDIF + MSG = 'Can only remap from native onto reduced GEOS-5 if '// & + 'input data has exactly 72, 73, or 36 levels: '//TRIM(Lct%Dct%cName) + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF ! nlev == (72,73,36,ELSE) ! Make sure output array is allocated CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC ) @@ -770,60 +715,76 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T) ENDDO !L - ! If needed, inflate from reduced GEOS-5 grid onto native GEOS-5 - IF ( ( NL == 36 .AND. nz == 72 ) .OR. & - ( NL == 37 .AND. nz == 73 ) ) THEN - ! Distribute over 2 levels (e.g. level 38 into 39-40): - CALL INFLATE( Lct, REGR_4D, NL+1 , NL+1, 2, T ) - CALL INFLATE( Lct, REGR_4D, NL+2 , NL+3, 2, T ) - CALL INFLATE( Lct, REGR_4D, NL+3 , NL+5, 2, T ) - CALL INFLATE( Lct, REGR_4D, NL+4 , NL+7, 2, T ) - ! Distribute over 4 levels: - CALL INFLATE( Lct, REGR_4D, NL+5 , NL+9, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+6 , NL+13, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+7 , NL+17, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+8 , NL+21, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+9 , NL+25, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+10, NL+29, 4, T ) - CALL INFLATE( Lct, REGR_4D, NL+11, NL+33, 4, T ) - ENDIF + ! If remapping model grid layers, collapse layers + IF ( nlev == 72 ) THEN + ! Collapse two levels (e.g. levels 37-38 into level 37): + CALL COLLAPSE( Lct, REGR_4D, 37, 37, 2, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 38, 39, 2, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 39, 41, 2, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 40, 43, 2, T, 5, RC ) + ! Collapse four levels: + CALL COLLAPSE( Lct, REGR_4D, 41, 45, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 42, 49, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 43, 53, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 44, 57, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 45, 61, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 46, 65, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 47, 69, 4, T, 5, RC ) + ! If remapping model grid edges, sample at edges + ELSEIF ( nlev == 73 ) THEN + Lct%Dct%Dta%V3(T)%Val(:,:,38) = REGR_4D(:,:,39,T) + Lct%Dct%Dta%V3(T)%Val(:,:,39) = REGR_4D(:,:,41,T) + Lct%Dct%Dta%V3(T)%Val(:,:,40) = REGR_4D(:,:,43,T) + Lct%Dct%Dta%V3(T)%Val(:,:,41) = REGR_4D(:,:,45,T) + Lct%Dct%Dta%V3(T)%Val(:,:,42) = REGR_4D(:,:,49,T) + Lct%Dct%Dta%V3(T)%Val(:,:,43) = REGR_4D(:,:,53,T) + Lct%Dct%Dta%V3(T)%Val(:,:,44) = REGR_4D(:,:,57,T) + Lct%Dct%Dta%V3(T)%Val(:,:,45) = REGR_4D(:,:,61,T) + Lct%Dct%Dta%V3(T)%Val(:,:,46) = REGR_4D(:,:,65,T) + Lct%Dct%Dta%V3(T)%Val(:,:,47) = REGR_4D(:,:,69,T) + Lct%Dct%Dta%V3(T)%Val(:,:,48) = REGR_4D(:,:,73,T) + ! If the input is 36 levels, levels 37-47 are set to 0 + ELSEIF ( nlev == 36 ) THEN + DO L = 37,47 + Lct%Dct%Dta%V3(T)%Val(:,:,L) = 0.0_hp + ENDDO !L + ENDIF ! nlev == (72,73,36) ENDDO ! T ! Verbose IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - WRITE(MSG,*) 'Mapped ', nlev, ' levels onto native GEOS-5 levels.' + WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GEOS-5 levels.' CALL HCO_MSG(HcoState%Config%Err,MSG) + IF ( nlev == 36 ) THEN + WRITE(MSG,*) 'The input variable has 36 L, which were written to be L 1-36 on the output 47 L grid (remaining values set to 0).' + ELSE + WRITE(MSG,*) 'Pressure-weighted vertical regridding was done - consider if this is appropriate for the variable units.' + CALL HCO_MSG(HcoState%Config%Err,MSG) + ENDIF ENDIF ! Done! DONE = .TRUE. !---------------------------------------------------------------- - ! Reduced levels + ! Native to reduced GISS levels !---------------------------------------------------------------- - ELSEIF ( nz == 47 ) THEN + ELSEIF ( nz == 74 ) THEN - ! Determine number of output levels. If input data is on the - ! native grid, we collapse them onto the reduced GEOS-5 grid. - ! In all other cases, we assume the input data is already on - ! the reduced levels and mappings occurs 1:1. - IF ( nlev == 72 ) THEN - nout = nz - NL = 36 - ELSEIF ( nlev == 73 ) THEN - nz = nz + 1 - nout = nz - NL = 37 - ELSEIF ( nlev > 47 ) THEN - MSG = 'Can only remap from native onto reduced GEOS-5 if '// & - 'input data has exactly 72 or 73 levels: '//TRIM(Lct%Dct%cName) + ! Determine if the variable is on model levels or edges + IF ( nlev == 102 ) THEN + NL = 60 + nout = 74 + ELSEIF ( nlev == 103 ) THEN + NL = 61 + nout = 75 + ELSE + MSG = 'Can only remap from native onto reduced GISS if '// & + 'input data has exactly 102 or 103 levels: '//TRIM(Lct%Dct%cName) CALL HCO_ERROR( MSG, RC ) RETURN - ELSE - nout = nlev - NL = nout - ENDIF + ENDIF ! nlev == (102,103,ELSE) ! Make sure output array is allocated CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC ) @@ -836,36 +797,48 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T) ENDDO !L - ! If needed, collapse from native GEOS-5 onto reduced GEOS-5 - IF ( nlev == 72 .OR. nlev == 73 ) THEN - - ! Add one level offset if these are edges - IF ( nlev == 73 ) THEN - OS = 1 - ELSE - OS = 0 - ENDIF - - ! Collapse two levels (e.g. levels 39-40 into level 38): - CALL COLLAPSE( Lct, REGR_4D, 37+OS, 37+OS, 2, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 38+OS, 39+OS, 2, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 39+OS, 41+OS, 2, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 40+OS, 43+OS, 2, T, 5 ) + ! If remapping model grid layers, collapse layers + IF ( nlev == 102 ) THEN + ! Collapse two levels (e.g. levels 61-62 into level 61): + CALL COLLAPSE( Lct, REGR_4D, 61, 61, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 62, 63, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 63, 65, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 64, 67, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 65, 69, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 66, 71, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 67, 73, 2, T, 22, RC ) ! Collapse four levels: - CALL COLLAPSE( Lct, REGR_4D, 41+OS, 45+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 42+OS, 49+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 43+OS, 53+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 44+OS, 57+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 45+OS, 61+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 46+OS, 65+OS, 4, T, 5 ) - CALL COLLAPSE( Lct, REGR_4D, 47+OS, 69+OS, 4, T, 5 ) - - ENDIF + CALL COLLAPSE( Lct, REGR_4D, 68, 75, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 69, 79, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 70, 83, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 71, 87, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 72, 91, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 73, 95, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 74, 99, 4, T, 22, RC ) + ! If remapping model grid edges, sample at the edges + ELSE + Lct%Dct%Dta%V3(T)%Val(:,:,62) = REGR_4D(:,:,63,T) + Lct%Dct%Dta%V3(T)%Val(:,:,63) = REGR_4D(:,:,65,T) + Lct%Dct%Dta%V3(T)%Val(:,:,64) = REGR_4D(:,:,67,T) + Lct%Dct%Dta%V3(T)%Val(:,:,65) = REGR_4D(:,:,69,T) + Lct%Dct%Dta%V3(T)%Val(:,:,66) = REGR_4D(:,:,71,T) + Lct%Dct%Dta%V3(T)%Val(:,:,67) = REGR_4D(:,:,73,T) + Lct%Dct%Dta%V3(T)%Val(:,:,68) = REGR_4D(:,:,75,T) + Lct%Dct%Dta%V3(T)%Val(:,:,69) = REGR_4D(:,:,79,T) + Lct%Dct%Dta%V3(T)%Val(:,:,70) = REGR_4D(:,:,83,T) + Lct%Dct%Dta%V3(T)%Val(:,:,71) = REGR_4D(:,:,87,T) + Lct%Dct%Dta%V3(T)%Val(:,:,72) = REGR_4D(:,:,91,T) + Lct%Dct%Dta%V3(T)%Val(:,:,73) = REGR_4D(:,:,95,T) + Lct%Dct%Dta%V3(T)%Val(:,:,74) = REGR_4D(:,:,99,T) + Lct%Dct%Dta%V3(T)%Val(:,:,75) = REGR_4D(:,:,103,T) + ENDIF ! nlev == (102,ELSE) ENDDO ! T ! Verbose - IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GEOS-5 levels.' + IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN + WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GISS levels.' + CALL HCO_MSG(HcoState%Config%Err,MSG) + WRITE(MSG,*) 'Pressure-weighted vertical regridding was done - consider if this is appropriate for the variable units.' CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF @@ -873,25 +846,26 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) DONE = .TRUE. !---------------------------------------------------------------- - ! Reduced GISS levels + ! Reduced to native GEOS-5 levels !---------------------------------------------------------------- - ELSEIF ( nz == 74 ) THEN + ELSEIF ( nz == 72 ) THEN - ! Determine number of output levels. If input data is on the - ! native grid, we collapse them onto the reduced GISS grid. - ! In all other cases, we assume the input data is already on - ! the reduced levels and mappings occurs 1:1. - IF ( nlev == 102 ) THEN - nout = nz - NL = 60 - ELSEIF ( nlev == 103 ) THEN - nz = nz + 1 - nout = nz - NL = 61 + ! Determine if the variable is on model levels or edges + IF ( nlev == 47 ) THEN + NL = 36 + nout = 72 + ELSEIF ( nlev == 48 ) THEN + NL = 37 + nout = 73 + ELSEIF ( nlev == 36 ) THEN + NL = 36 + nout = 72 ELSE - nout = nlev - NL = nout - ENDIF + MSG = 'Can only remap from reduced onto native GEOS-5 if '// & + 'input data has exactly 47, 48, or 36 levels: '//TRIM(Lct%Dct%cName) + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF ! nlev == (48,48,36,ELSE) ! Make sure output array is allocated CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nout, nt, RC ) @@ -904,74 +878,79 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) Lct%Dct%Dta%V3(T)%Val(:,:,L) = REGR_4D(:,:,L,T) ENDDO !L - ! If needed, collapse from native GEOS-5 onto reduced GEOS-5 - IF ( nlev == 102 .OR. nlev == 103 ) THEN - - ! Add one level offset if these are edges - IF ( nlev == 103 ) THEN - OS = 1 - ELSE - OS = 0 - ENDIF - - ! Collapse two levels (e.g. levels 61-62 into level 61): - CALL COLLAPSE( Lct, REGR_4D, 61+OS, 61+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 62+OS, 63+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 63+OS, 65+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 64+OS, 67+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 65+OS, 69+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 66+OS, 71+OS, 2, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 67+OS, 73+OS, 2, T, 22 ) - ! Collapse four levels: - CALL COLLAPSE( Lct, REGR_4D, 68+OS, 75+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 69+OS, 79+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 70+OS, 83+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 71+OS, 87+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 72+OS, 91+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 73+OS, 95+OS, 4, T, 22 ) - CALL COLLAPSE( Lct, REGR_4D, 74+OS, 99+OS, 4, T, 22 ) - - ENDIF + ! If remapping model grid layers, inflate layers + IF ( nlev == 47 ) THEN + + ! Inflate two levels (e.g. levels 37-38 on the fine grid are copies of level 37 on the coarse grid): + coarseIDX = 36 + DO I = 1,8 + fineIDX = 36 + I + IF ( MOD(I,2) /= 0 ) THEN + coarseIDX = coarseIDX + 1 + ENDIF + Lct%Dct%Dta%V3(T)%Val(:,:,fineIDX) = REGR_4D(:,:,coarseIDX,T) + ENDDO ! I + + ! Inflate four levels (e.g. levels 45-48 on the fine grid are copies of level 41 on the coarse grid) + coarseIDX = 40 + DO I = 1,28 + fineIDX = 44 + i + IF ( MOD(I-1,4) == 0 ) THEN + coarseIDX = coarseIDX + 1 + ENDIF + Lct%Dct%Dta%V3(T)%Val(:,:,fineIDX) = REGR_4D(:,:,coarseIDX,T) + ENDDO ! I + + ! If remapping model grid edges, inflate edges + ELSEIF ( nlev == 48 ) THEN + + ! Sample every two edges (e.g. edges 38-39 on the fine grid are copies of edge 38 on the coarse grid) + coarseIDX = 37 + DO I = 1,8 + fineIDX = 37 + I + IF ( MOD(I,2) /= 0 ) THEN + coarseIDX = coarseIDX + 1 + ENDIF + Lct%Dct%Dta%V3(T)%Val(:,:,fineIDX) = REGR_4D(:,:,coarseIDX,T) + ENDDO ! I + + ! Sample every four edges (e.g. edges 46-49 on the fine grid are copies of edge 42 on the coarse grid) + coarseIDX = 40 + DO I = 1,28 + fineIDX = 44 + i + IF ( MOD(I-1,4) == 0 ) THEN + coarseIDX = coarseIDX + 1 + ENDIF + Lct%Dct%Dta%V3(T)%Val(:,:,fineIDX) = REGR_4D(:,:,coarseIDX,T) + ENDDO ! I + + ELSEIF ( nlev == 36 ) THEN + DO L = 37,72 + Lct%Dct%Dta%V3(T)%Val(:,:,L) = 0.0_hp + ENDDO !L + + ENDIF ! nlev == (47,48,36) ENDDO ! T ! Verbose IF ( HCO_IsVerb(HcoState%Config%Err ) ) THEN - WRITE(MSG,*) 'Mapped ', nlev, ' levels onto reduced GISS levels.' + WRITE(MSG,*) 'Mapped ', nlev, ' levels onto native GEOS-5 levels.' + CALL HCO_MSG(HcoState%Config%Err,MSG) + IF ( nlev == 36 ) THEN + WRITE(MSG,*) 'The input variable has 36 L, which were written to be L 1-36 on the output 72 L grid (remaining values set to 0).' + ELSE + WRITE(MSG,*) 'Inflating from 47/48 to 72/73 levels is not recommended and is likely not mass-conserving.' + ENDIF CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF ! Done! DONE = .TRUE. - ENDIF + ENDIF ! nz == (47,74,72) ENDIF ! Vertical regridding required - !=================================================================== - ! For all other cases, do not do any vertical regridding - !=================================================================== - IF ( .NOT. DONE ) THEN - CALL FileData_ArrCheck( HcoState%Config, Lct%Dct%Dta, nx, ny, nlev, nt, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN - ENDIF - - DO T = 1, nt - Lct%Dct%Dta%V3(T)%Val(:,:,:) = REGR_4D(:,:,:,T) - ENDDO - - ! Verbose - IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN - WRITE(MSG,*) 'Could not find vertical interpolation key - ', & - 'kept the original ', nlev, ' levels.' - CALL HCO_MSG(HcoState%Config%Err,MSG) - ENDIF - - ! Done! - DONE = .TRUE. - ENDIF - !=================================================================== ! Error check / verbose mode !=================================================================== @@ -1000,240 +979,17 @@ END SUBROUTINE ModelLev_Interpolate !------------------------------------------------------------------------------ !BOP ! -! !IROUTINE: GEOS5_TO_GEOS4_LOWLEV -! -! !DESCRIPTION: Helper routine to map the lowest 28 GEOS-5 levels onto the -! lowest 11 GEOS-4 levels. The individual level weights were calculated -! offline and are hard-coded here. -! These are the edge pressure values on the lowest 28 GEOS-5 levels: -! 1013.25, 998.05, 982.76, 967.47, 952.19, 936.91 -! 921.62, 906.34, 891.05, 875.77, 860.49, 845.21, -! 829.92, 809.55, 784.08, 758.62, 733.15, 707.69, -! 682.23, 644.05, 605.87, 567.70, 529.54, 491.40, -! 453.26, 415.15, 377.07, 339.00, 288.92 -! -! And these are the edge pressure values on the lowest 12 GEOS-4 levels: -! 1013.25, 998.16, 968.49, 914.79, 841.15, 752.89, -! 655.96, 556.85, 472.64, 401.14, 340.43, 288.92 -! -! The value at every given GEOS-4 level is determined from the GEOS-5 values -! by multiplying the (GEOS-5) input data by the normalized level weights. For -! instance, the first GEOS-5 level is the only level contributing to the 1st -! GEOS-4 level. For the 2nd GEOS-4 level, contributions from GEOS-5 levels -! 1-3 are used. Of GEOS-5 level 1, only 0.7% lies in level 2 of GEOS-4 (99.3% -! is in GEOS-4 level 1), whereas 100% of GEOS-5 level 2 and 93.3% of GEOS-5 -! level 3 contribute to GEOS-4 level 2. The corresponding normalized weights -! become 0.00378,0.515, and 0.481, respectively. -!\\ -!\\ -! The weights don't always add up to exactly 1.00 due to rounding errors. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE GEOS5_TO_GEOS4_LOWLEV( HcoState, Lct, REGR_4D, NZ, T, RC ) -! -! !INPUT PARAMETERS: -! - TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object - REAL(sp), POINTER :: REGR_4D(:,:,:,:) ! 4D input data - INTEGER, INTENT(IN) :: T ! Time index - INTEGER, INTENT(IN) :: NZ ! # of vertical levels to remap. Must be 28 or 29 -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(ListCont), POINTER :: Lct ! HEMCO list container - INTEGER, INTENT(INOUT) :: RC ! Return code -! -! !REVISION HISTORY: -! 07 Jan 2015 - C. Keller - Initial version. -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - REAL(hp) :: WGHT - CHARACTER(LEN=255) :: MSG - CHARACTER(LEN=255) :: LOC = 'GEOS5_TO_GEOS4_LOWLEV (hco_interp_mod.F90)' - - !================================================================= - ! GEOS5_TO_GEOS4_LOWLEV begins here - !================================================================= - - ! Check number of levels to be used - IF ( NZ /= 28 .AND. NZ /= 29 ) THEN - MSG = 'Cannot map GEOS-5 onto GEOS-4 data, number of levels must be 28 or 29: '//TRIM(Lct%Dct%cName) - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Error check: make sure array REGR_4D has at least NZ levels - IF ( SIZE(REGR_4D,3) < NZ ) THEN - WRITE(MSG,*) 'Cannot map GEOS-5 onto GEOS-4 data, original data has not enough levels: ', & - TRIM(Lct%Dct%cName), ' --> ', SIZE(REGR_4D,3), ' smaller than ', NZ - CALL HCO_ERROR ( MSG, RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Map 28 GEOS-5 levels onto 11 GEOS-4 levels (grid midpoints): - IF ( NZ == 28 ) THEN - - ! Reset - Lct%Dct%Dta%V3(T)%Val(:,:,1:11) = 0.0_sp - - ! Level 1: - Lct%Dct%Dta%V3(T)%Val(:,:, 1) = REGR_4D(:,:,1,T) - - ! Level 2: - Lct%Dct%Dta%V3(T)%Val(:,:, 2) = 3.78e-3_sp * REGR_4D(:,:, 1,T) & - + 0.515_sp * REGR_4D(:,:, 2,T) & - + 0.481_sp * REGR_4D(:,:, 3,T) - - ! Level 3: - Lct%Dct%Dta%V3(T)%Val(:,:, 3) = 1.88e-2_sp * REGR_4D(:,:, 3,T) & - + 0.285_sp * REGR_4D(:,:, 4,T) & - + 0.285_sp * REGR_4D(:,:, 5,T) & - + 0.285_sp * REGR_4D(:,:, 6,T) & - + 0.127_sp * REGR_4D(:,:, 7,T) - - ! Level 4: - Lct%Dct%Dta%V3(T)%Val(:,:, 4) = 0.115_sp * REGR_4D(:,:, 7,T) & - + 0.208_sp * REGR_4D(:,:, 8,T) & - + 0.208_sp * REGR_4D(:,:, 9,T) & - + 0.208_sp * REGR_4D(:,:,10,T) & - + 0.208_sp * REGR_4D(:,:,11,T) & - + 5.51e-2_sp * REGR_4D(:,:,12,T) - - ! Level 5: - Lct%Dct%Dta%V3(T)%Val(:,:, 5) = 0.189_sp * REGR_4D(:,:,12,T) & - + 0.253_sp * REGR_4D(:,:,13,T) & - + 0.253_sp * REGR_4D(:,:,14,T) & - + 0.253_sp * REGR_4D(:,:,15,T) & - + 5.68e-2_sp * REGR_4D(:,:,16,T) - - ! Level 6: - Lct%Dct%Dta%V3(T)%Val(:,:, 6) = 0.224_sp * REGR_4D(:,:,16,T) & - + 0.289_sp * REGR_4D(:,:,17,T) & - + 0.289_sp * REGR_4D(:,:,18,T) & - + 0.199_sp * REGR_4D(:,:,19,T) - - ! Level 7: - Lct%Dct%Dta%V3(T)%Val(:,:, 7) = 0.120_sp * REGR_4D(:,:,19,T) & - + 0.385_sp * REGR_4D(:,:,20,T) & - + 0.385_sp * REGR_4D(:,:,21,T) & - + 0.110_sp * REGR_4D(:,:,22,T) - - ! Level 8: - Lct%Dct%Dta%V3(T)%Val(:,:, 8) = 0.324_sp * REGR_4D(:,:,22,T) & - + 0.453_sp * REGR_4D(:,:,23,T) & - + 0.223_sp * REGR_4D(:,:,24,T) - - ! Level 9: - Lct%Dct%Dta%V3(T)%Val(:,:, 9) = 0.271_sp * REGR_4D(:,:,24,T) & - + 0.533_sp * REGR_4D(:,:,25,T) & - + 0.196_sp * REGR_4D(:,:,26,T) - - ! Level 10: - Lct%Dct%Dta%V3(T)%Val(:,:,10) = 0.396_sp * REGR_4D(:,:,26,T) & - + 0.604_sp * REGR_4D(:,:,27,T) - - ! Level 11: - Lct%Dct%Dta%V3(T)%Val(:,:,11) = 3.63e-2_sp * REGR_4D(:,:,27,T) & - + 0.964_sp * REGR_4D(:,:,28,T) - - ! Map 29 GEOS-5 levels onto 12 GEOS-4 levels (grid edges): - ELSEIF ( NZ == 29 ) THEN - - ! Reset - Lct%Dct%Dta%V3(T)%Val(:,:,1:12) = 0.0_sp - - ! Level 1 - Lct%Dct%Dta%V3(T)%Val(:,:, 1) = REGR_4D(:,:,1,T) - - ! Level 2: - Lct%Dct%Dta%V3(T)%Val(:,:, 2) = 5.01e-3_sp * REGR_4D(:,:, 1,T) & - + 0.680_sp * REGR_4D(:,:, 2,T) & - + 0.314_sp * REGR_4D(:,:, 3,T) - - ! Level 3: - Lct%Dct%Dta%V3(T)%Val(:,:, 3) = 0.197_sp * REGR_4D(:,:, 3,T) & - + 0.366_sp * REGR_4D(:,:, 4,T) & - + 0.366_sp * REGR_4D(:,:, 5,T) & - + 6.98e-2_sp * REGR_4D(:,:, 6,T) - - ! Level 4: - Lct%Dct%Dta%V3(T)%Val(:,:, 4) = 0.194_sp * REGR_4D(:,:, 6,T) & - + 0.240_sp * REGR_4D(:,:, 7,T) & - + 0.240_sp * REGR_4D(:,:, 8,T) & - + 0.240_sp * REGR_4D(:,:, 9,T) & - + 8.55e-2_sp * REGR_4D(:,:,10,T) - - ! Level 5: - Lct%Dct%Dta%V3(T)%Val(:,:, 5) = 0.139_sp * REGR_4D(:,:,10,T) & - + 0.216_sp * REGR_4D(:,:,11,T) & - + 0.216_sp * REGR_4D(:,:,12,T) & - + 0.216_sp * REGR_4D(:,:,13,T) & - + 0.214_sp * REGR_4D(:,:,14,T) - - ! Level 6: - Lct%Dct%Dta%V3(T)%Val(:,:, 6) = 2.20e-2_sp * REGR_4D(:,:,14,T) & - + 0.275_sp * REGR_4D(:,:,15,T) & - + 0.275_sp * REGR_4D(:,:,16,T) & - + 0.275_sp * REGR_4D(:,:,17,T) & - + 0.173_sp * REGR_4D(:,:,18,T) - - ! Level 7: - Lct%Dct%Dta%V3(T)%Val(:,:, 7) = 0.130_sp * REGR_4D(:,:,18,T) & - + 0.345_sp * REGR_4D(:,:,19,T) & - + 0.345_sp * REGR_4D(:,:,20,T) & - + 0.170_sp * REGR_4D(:,:,21,T) - - ! Level 8: - Lct%Dct%Dta%V3(T)%Val(:,:, 8) = 0.214_sp * REGR_4D(:,:,21,T) & - + 0.416_sp * REGR_4D(:,:,22,T) & - + 0.370_sp * REGR_4D(:,:,23,T) - - ! Level 9: - Lct%Dct%Dta%V3(T)%Val(:,:, 9) = 5.49e-2_sp * REGR_4D(:,:,23,T) & - + 0.490_sp * REGR_4D(:,:,24,T) & - + 0.455_sp * REGR_4D(:,:,25,T) - - ! Level 10: - Lct%Dct%Dta%V3(T)%Val(:,:,10) = 4.06e-2_sp * REGR_4D(:,:,25,T) & - + 0.576_sp * REGR_4D(:,:,26,T) & - + 0.383_sp * REGR_4D(:,:,27,T) - - ! Level 11: - Lct%Dct%Dta%V3(T)%Val(:,:,11) = 0.254_sp * REGR_4D(:,:,27,T) & - + 0.746_sp * REGR_4D(:,:,28,T) - - ! Level 12: - Lct%Dct%Dta%V3(T)%Val(:,:,12) = 1.60e-2_sp * REGR_4D(:,:,28,T) & - + 0.984_sp * REGR_4D(:,:,29,T) - - ENDIF - - ! Return with success - RC = HCO_SUCCESS - - END SUBROUTINE GEOS5_TO_GEOS4_LOWLEV -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! ! !IROUTINE: COLLAPSE ! ! !DESCRIPTION: Helper routine to collapse input levels onto the output grid. ! The input data is weighted by the grid box thicknesses defined on top of ! this module. The input parameter T determines the time slice to be considered, -! and MET denotes the met field type of the input data (4 = GEOS-4 levels, GEOS-5 -! otherwise). +! and MET denotes the met field type of the input data (22 = GISS, 5= GEOS-5). !\\ !\\ ! !INTERFACE: ! - SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET ) + SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET, RC ) ! ! !INPUT PARAMETERS: ! @@ -1242,11 +998,12 @@ SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET ) INTEGER, INTENT(IN) :: InLev1 INTEGER, INTENT(IN) :: NLEV INTEGER, INTENT(IN) :: T - INTEGER, INTENT(IN) :: MET ! 4=GEOS-4, 22=GISS E2.2, else GEOS-5 + INTEGER, INTENT(IN) :: MET ! 22=GISS E2.2, else GEOS-5 ! ! !INPUT/OUTPUT PARAMETERS: ! TYPE(ListCont), POINTER :: Lct ! HEMCO list container + INTEGER, INTENT(INOUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 30 Dec 2014 - C. Keller - Initial version @@ -1258,6 +1015,8 @@ SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET ) REAL(hp) :: THICK REAL(hp), POINTER :: EDG(:) REAL(hp), ALLOCATABLE :: WGT(:) + CHARACTER(LEN=255) :: MSG + CHARACTER(LEN=255) :: LOC = 'ModelLev_Interpolate (hco_interp_mod.F90)' !================================================================= ! COLLAPSE begins here @@ -1274,24 +1033,26 @@ SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET ) IF ( NZ < InLev1 ) RETURN ! Get maximum level to be used for pressure thickness calculations. - TOPLEV = InLev1 + ( NLEV-1 ) + TOPLEV = InLev1 + NLEV ! Get pointer to grid edges on the native input grid - IF ( Met == 4 ) THEN - EDG => G4_EDGE_NATIVE(InLev1:TOPLEV) - ELSE IF ( Met == 22 ) THEN + IF ( Met == 22 ) THEN EDG => E102_EDGE_NATIVE(InLev1:TOPLEV) - ELSE + ELSEIF ( Met == 5 ) THEN EDG => G5_EDGE_NATIVE(InLev1:TOPLEV) + ELSE + WRITE(MSG,*) 'The Met value given was not valid: ', Met + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Thickness of output level - THICK = EDG(1) - EDG(NLEV) + THICK = EDG(1) - EDG(NLEV+1) ! Get level weights ALLOCATE(WGT(NLEV)) WGT = 0.0 - DO I = 1, NLEV-1 + DO I = 1, NLEV WGT(I) = ( EDG(I) - EDG(I+1) ) / THICK ENDDO @@ -1310,73 +1071,4 @@ SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET ) END SUBROUTINE COLLAPSE !EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: INFLATE -! -! !DESCRIPTION: Helper routine to inflate input levels onto the output grid. -! The values on the input data are evenly distributed amongst all output -! levels. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE INFLATE ( Lct, REGR_4D, InLev, OutLev1, NLEV, T ) -! -! !INPUT PARAMETERS: -! - REAL(sp), POINTER :: REGR_4D(:,:,:,:) ! 4D input data - INTEGER, INTENT(IN) :: InLev - INTEGER, INTENT(IN) :: OutLev1 - INTEGER, INTENT(IN) :: NLEV - INTEGER, INTENT(IN) :: T -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(ListCont), POINTER :: Lct ! HEMCO list container -! -! !REVISION HISTORY: -! 30 Dec 2014 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - INTEGER :: I, DZ, NZ, ILEV - - !================================================================= - ! INFLATE begins here - !================================================================= - - ! Get input data array - NZ = SIZE( REGR_4D, 3 ) - - ! Get size of data array in the HEMCO state (bmy, 22 Mar 2022) - DZ = SIZE( Lct%Dct%Dta%V3(T)%Val, 3 ) - - ! Do for every output level - DO I = 1, NLEV - - ! Current output level - ILEV = OutLev1 + I - 1 - - ! Avoid out-of-bounds errors if ILEV is greater than the - ! number of levels in Lct%Dct%Dta%V3(T)%Val (bmy, 22 Mar 2022) - IF ( ILEV > DZ ) EXIT - - ! If input level is beyond vert. extent of input data, set output - ! data to zero. - IF ( InLev > NZ ) THEN - Lct%Dct%Dta%V3(T)%Val(:,:,ILEV) = 0.0_hp - - ! Otherwise, evenly distribute input data - ELSE - Lct%Dct%Dta%V3(T)%Val(:,:,ILEV) = REGR_4D(:,:,InLev,T) - ENDIF - ENDDO - - END SUBROUTINE INFLATE -!EOC END MODULE HCO_Interp_Mod diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index fab7a07e..02eb44b9 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -125,8 +125,6 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) USE HCO_Ncdf_Mod, ONLY : NC_Read_Arr USE HCO_Ncdf_Mod, ONLY : NC_Get_Grid_Edges USE HCO_Ncdf_Mod, ONLY : NC_Get_Sigma_Levels - USE HCO_Ncdf_Mod, ONLY : NC_IsModelLevel - USE HCO_Ncdf_Mod, ONLY : NC_IsSigmaLevel USE HCO_CHARPAK_MOD, ONLY : TRANLC USE HCO_Unit_Mod, ONLY : HCO_Unit_Change USE HCO_Unit_Mod, ONLY : HCO_Unit_ScalCheck @@ -690,32 +688,19 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) RETURN ENDIF - ! Are these model levels? This will only return true if the long - ! name of the level variable contains "GEOS-Chem level". - ! For now, we assume levels are already on model levels if the - ! number of levels to be read is explicitly set in the configuration - ! file (ckeller, 5/20/15). + ! Are these model levels? This will only return true if + ! (1) the variable is on 72/73 levels and you are going to 47 + ! levels, (2) if you are on 102/103 levels and you are going + ! to 74 levels, (3) if you are on 47/48 levels and you are + ! going to 72 levels. Otherwise, use MESSy (nbalasus, 8/24/2023). IF ( Lct%Dct%Dta%Levels == 0 ) THEN - ! Check if vertical coordinate is GEOS-Chem levels - IsModelLevel = NC_IsModelLevel( ncLun, LevName ) - - ! Further check if the given number of vertical levels should be - ! treated as model levels. This is the case if e.g. the nuber of - ! levels found on the file exactly matches the number of vertical - ! levels of the grid. Some of these assumptions are rather arbitrary. - ! IsModelLev will stay True if is was set so in NC_ISMODELLEVEL - ! above. (ckeller, 9/29/15) CALL ModelLev_Check( HcoState, nlev, IsModelLevel, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) RETURN ENDIF - ! Override IsModelLevel if the long_name contains - ! "atmospheric_hybrid_sigma_pressure_coordinate" - IsModelLevel = ( .not. NC_IsSigmaLevel( ncLun, LevName ) ) - ! Set level indeces to be read lev1 = 1 lev2 = nlev @@ -723,10 +708,6 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! If levels are explicitly given: ELSE - ! If long_name is "atmospheric_hybrid_sigma_pressure_coordinate", - ! then treat it as sigma levels; otherwise assume model levels. - IsModelLevel = ( .not. NC_IsSigmaLevel( ncLun, LevName ) ) - ! Number of levels to be read must be smaller or equal to total ! number of available levels IF ( ABS(Lct%Dct%Dta%Levels) > nlev ) THEN @@ -747,6 +728,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) lev2 = nlev + Lct%Dct%Dta%Levels + 1 ENDIF + ! Use MESSy regridding + IsModelLevel = .FALSE. + ENDIF ! Verbose @@ -755,6 +739,11 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF + IF ( HCO_IsVerb( HcoState%Config%Err ) .AND. IsModelLevel ) THEN + WRITE(MSG,*) 'Data is assumed to already be on the model level grid' + CALL HCO_MSG(HcoState%Config%Err,MSG) + ENDIF + ! For 2D data, set lev1 and lev2 to zero. This will ignore ! the level dimension in the netCDF reading call that follows. ELSE diff --git a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 index dc58ec3f..c8690fe7 100644 --- a/src/Shared/NcdfUtil/hco_ncdf_mod.F90 +++ b/src/Shared/NcdfUtil/hco_ncdf_mod.F90 @@ -50,8 +50,6 @@ MODULE HCO_NCDF_MOD PUBLIC :: NC_GET_GRID_EDGES PUBLIC :: NC_GET_SIGMA_LEVELS PUBLIC :: NC_WRITE - PUBLIC :: NC_ISMODELLEVEL - PUBLIC :: NC_ISSIGMALEVEL PUBLIC :: GET_TAU0 ! ! !PRIVATE MEMBER FUNCTIONS: @@ -4916,153 +4914,4 @@ FUNCTION GET_TAU0( MONTH, DAY, YEAR, HOUR, MIN, SEC ) RESULT( THIS_TAU0 ) ( TMP_MIN / 60d0 ) + ( TMP_SEC / 3600d0 ) END FUNCTION GET_TAU0 -!------------------------------------------------------------------------------ -! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group ! -! and NASA/GFSC, SIVO, Code 610.3 ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Nc_IsModelLevel -! -! !DESCRIPTION: Function NC\_IsModelLevel returns true if (and only if) the -! long name of the level variable name of the given file ID contains the -! character "GEOS-Chem level". -!\\ -!\\ -! !INTERFACE: -! - FUNCTION NC_IsModelLevel( fID, lev_name ) RESULT ( IsModelLevel ) -! -! !USES: -! -# include "netcdf.inc" -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: fID ! file ID - CHARACTER(LEN=*), INTENT(IN) :: lev_name ! level variable name -! -! !RETURN VALUE: -! - LOGICAL :: IsModelLevel -! -! !REVISION HISTORY: -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - LOGICAL :: HasLngN - CHARACTER(LEN=255) :: a_name, LngName - INTEGER :: a_type - - !======================================================================= - ! NC_IsModelLevel begins here! - !======================================================================= - - ! Init - IsModelLevel = .FALSE. - - ! Check if there is a long_name attribute - a_name = "long_name" - HasLngN = Ncdoes_Attr_Exist ( fId, TRIM(lev_name), TRIM(a_name), a_type ) - - ! Only if attribute exists... - IF ( HasLngN ) THEN - ! Read attribute - CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), LngName ) - - ! See if this is a GEOS-Chem model level - IF ( INDEX( TRIM(LngName), "GEOS-Chem level" ) > 0 ) THEN - IsModelLevel = .TRUE. - ENDIF - ENDIF - - END FUNCTION NC_IsModelLevel -!EOC -!------------------------------------------------------------------------------ -! NcdfUtilities: by Harvard Atmospheric Chemistry Modeling Group ! -! and NASA/GFSC, SIVO, Code 610.3 ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: Nc_IsSigmaLevel -! -! !DESCRIPTION: Function NC\_IsSigmaLevels returns true if (and only if) the -! long name of the level variable name of the given file ID contains the -! character "atmospheric_hybrid_sigma_pressure_coordinate". -!\\ -!\\ -! !INTERFACE: -! - FUNCTION NC_IsSigmaLevel( fID, lev_name ) RESULT ( IsSigmaLevel ) -! -! !USES: -! -# include "netcdf.inc" -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: fID ! file ID - CHARACTER(LEN=*), INTENT(IN) :: lev_name ! level variable name -! -! !RETURN VALUE: -! - LOGICAL :: IsSigmaLevel -! -! !REVISION HISTORY: -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Scalars - LOGICAL :: found - INTEGER :: a_type - - ! Strings - CHARACTER(LEN=255) :: a_name - CHARACTER(LEN=255) :: a_val - - !======================================================================= - ! NC_IsSigmaLevel begins here! - !======================================================================= - - ! Initialize - IsSigmaLevel = .FALSE. - - ! Check if there is a long_name attribute - a_name = "standard_name" - found = Ncdoes_Attr_Exist( fId, TRIM(lev_name), TRIM(a_name), a_type ) - - ! First check if the "standard_name" attribute exists - IF ( found ) THEN - - ! Read "standard_name" attribute - CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), a_val ) - - ELSE - - ! If the "standard_name" attribute isn't found, try "long_name" - a_name = "long_name" - found = Ncdoes_Attr_Exist( fId, TRIM(lev_name), TRIM(a_name), a_type ) - - ! Read "long_name" attribute - IF ( found ) THEN - CALL NcGet_Var_Attributes( fID, TRIM(lev_name), TRIM(a_name), a_val ) - ENDIF - ENDIF - - ! Test if the attribute value indicates a hybrid sigma-pressure grid - IF ( INDEX( TRIM( a_val ), & - "atmospheric_hybrid_sigma_pressure_coordinate" ) > 0 ) THEN - IsSigmaLevel = .TRUE. - ENDIF - - END FUNCTION NC_IsSigmaLevel -!EOC END MODULE HCO_NCDF_MOD From 752fdfabbb57f71a0ad5bcdcc12379e012fd6137 Mon Sep 17 00:00:00 2001 From: Haipeng Lin Date: Tue, 8 Aug 2023 13:27:44 -0400 Subject: [PATCH 60/63] Limit GC_72_EDGE_SIGMA variable to 135 columns per Fortran-90 spec. This will make compile compatible with the nvhpc compiler. This was reported downstream from ESCOMP/CAM#871 and at HEMCO#233. Reported-by: Jian Sun @sjsprecious Signed-off-by: Haipeng Lin --- src/Core/hcoio_read_std_mod.F90 | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 7bfb6b5a..e5b79efe 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -62,7 +62,20 @@ MODULE HCOIO_Read_Mod REAL(dp), PRIVATE, PARAMETER :: EPSILON = 1.0e-5_dp #if defined( MODEL_CESM ) || defined( MODEL_WRF ) - REAL(hp), PRIVATE :: GC_72_EDGE_SIGMA(73) = (/1.000000E+00, 9.849998E-01, 9.699136E-01, 9.548285E-01, 9.397434E-01, 9.246593E-01, 9.095741E-01, 8.944900E-01, 8.794069E-01, 8.643237E-01, 8.492406E-01, 8.341584E-01, 8.190762E-01, 7.989697E-01, 7.738347E-01, 7.487007E-01, 7.235727E-01, 6.984446E-01, 6.733175E-01, 6.356319E-01, 5.979571E-01, 5.602823E-01, 5.226252E-01, 4.849751E-01, 4.473417E-01, 4.097261E-01, 3.721392E-01, 3.345719E-01, 2.851488E-01, 2.420390E-01, 2.055208E-01, 1.746163E-01, 1.484264E-01, 1.261653E-01, 1.072420E-01, 9.115815E-02, 7.748532E-02, 6.573205E-02, 5.565063E-02, 4.702097E-02, 3.964964E-02, 3.336788E-02, 2.799704E-02, 2.341969E-02, 1.953319E-02, 1.624180E-02, 1.346459E-02, 1.112953E-02, 9.171478E-03, 7.520355E-03, 6.135702E-03, 4.981002E-03, 4.023686E-03, 3.233161E-03, 2.585739E-03, 2.057735E-03, 1.629410E-03, 1.283987E-03, 1.005675E-03, 7.846040E-04, 6.089317E-04, 4.697755E-04, 3.602270E-04, 2.753516E-04, 2.082408E-04, 1.569208E-04, 1.184308E-04, 8.783617E-05, 6.513694E-05, 4.737232E-05, 3.256847E-05, 1.973847E-05, 9.869233E-06/) + REAL(hp), PRIVATE :: GC_72_EDGE_SIGMA(73) = (/ & + 1.000000E+00, 9.849998E-01, 9.699136E-01, 9.548285E-01, 9.397434E-01, 9.246593E-01, & + 9.095741E-01, 8.944900E-01, 8.794069E-01, 8.643237E-01, 8.492406E-01, 8.341584E-01, & + 8.190762E-01, 7.989697E-01, 7.738347E-01, 7.487007E-01, 7.235727E-01, 6.984446E-01, & + 6.733175E-01, 6.356319E-01, 5.979571E-01, 5.602823E-01, 5.226252E-01, 4.849751E-01, & + 4.473417E-01, 4.097261E-01, 3.721392E-01, 3.345719E-01, 2.851488E-01, 2.420390E-01, & + 2.055208E-01, 1.746163E-01, 1.484264E-01, 1.261653E-01, 1.072420E-01, 9.115815E-02, & + 7.748532E-02, 6.573205E-02, 5.565063E-02, 4.702097E-02, 3.964964E-02, 3.336788E-02, & + 2.799704E-02, 2.341969E-02, 1.953319E-02, 1.624180E-02, 1.346459E-02, 1.112953E-02, & + 9.171478E-03, 7.520355E-03, 6.135702E-03, 4.981002E-03, 4.023686E-03, 3.233161E-03, & + 2.585739E-03, 2.057735E-03, 1.629410E-03, 1.283987E-03, 1.005675E-03, 7.846040E-04, & + 6.089317E-04, 4.697755E-04, 3.602270E-04, 2.753516E-04, 2.082408E-04, 1.569208E-04, & + 1.184308E-04, 8.783617E-05, 6.513694E-05, 4.737232E-05, 3.256847E-05, 1.973847E-05, & + 9.869233E-06/) #endif CONTAINS From 068e0671d92a831e2ef22921ce91b632cb447eb0 Mon Sep 17 00:00:00 2001 From: Lizzie Lundgren Date: Fri, 15 Sep 2023 14:06:56 -0400 Subject: [PATCH 61/63] Update changelog Signed-off-by: Lizzie Lundgren --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 85d6abca..8846ccae 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,10 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [Unreleased 3.6.3] - TBD +### Fixed +- Fixed nvhpc compiler error in CESM by reducing line length of `GC_72_EDGE_SIGMA` assignment + ## [3.6.2] - 2023-03-02 ### Added - Added `.github/config.yml` with settings for the issue chooser page From 7b7e3883a11084573c36e34206e0213c2a4466d8 Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 15 Sep 2023 15:04:39 -0400 Subject: [PATCH 62/63] Update CHANGELOG.md and version numbers for 3.6.3 release CHANGELOG.md - Added 3.6.3 release date CMakeLists.txt docs/source/conf.py src/Core/hco_error_mod.F90 - Updated version numbers from 3.6.2 to 3.6.3 Signed-off-by: Bob Yantosca --- CHANGELOG.md | 2 +- CMakeLists.txt | 2 +- docs/source/conf.py | 2 +- src/Core/hco_error_mod.F90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8846ccae..067d3ecf 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased 3.6.3] - TBD +## [Unreleased 3.6.3] - 2023-09-15 ### Fixed - Fixed nvhpc compiler error in CESM by reducing line length of `GC_72_EDGE_SIGMA` assignment diff --git a/CMakeLists.txt b/CMakeLists.txt index adcce7b9..bab5d514 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,7 +1,7 @@ # HEMCO/CMakeLists.txt cmake_minimum_required(VERSION 3.5) -project(HEMCO VERSION 3.6.2 LANGUAGES Fortran) +project(HEMCO VERSION 3.6.3 LANGUAGES Fortran) # Reminder: Make sure to also update version in src/Core/hco_error_mod.F90 #----------------------------------------------------------------------------- diff --git a/docs/source/conf.py b/docs/source/conf.py index 41606aba..b184e242 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -23,7 +23,7 @@ author = 'GEOS-Chem Support Team' # The full version, including alpha/beta/rc tags -release = '3.6.2' +release = '3.6.3' # -- General configuration --------------------------------------------------- diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 838a62e4..c3c1b116 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -105,7 +105,7 @@ MODULE HCO_Error_Mod #endif ! HEMCO version number. - CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.6.2' + CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.6.3' INTERFACE HCO_Error MODULE PROCEDURE HCO_ErrorNoErr From 8b4f4c848ebaabbc4499641a4459017bfdb4735b Mon Sep 17 00:00:00 2001 From: Bob Yantosca Date: Fri, 15 Sep 2023 15:11:39 -0400 Subject: [PATCH 63/63] Final edit to CHANGELOG.md for 3.6.3 release CHANGELOG.md - Change "[Unreleased 3.6.3]" to "[3.6.3]" Signed-off-by: Bob Yantosca --- CHANGELOG.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 067d3ecf..4d0119ba 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,7 +5,7 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). -## [Unreleased 3.6.3] - 2023-09-15 +## [3.6.3] - 2023-09-15 ### Fixed - Fixed nvhpc compiler error in CESM by reducing line length of `GC_72_EDGE_SIGMA` assignment