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`. diff --git a/src/Core/hco_extlist_mod.F90 b/src/Core/hco_extlist_mod.F90 index 50cd26bf..88d81026 100644 --- a/src/Core/hco_extlist_mod.F90 +++ b/src/Core/hco_extlist_mod.F90 @@ -639,22 +639,25 @@ 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 - INTEGER, INTENT(INOUT) :: RC ! Success or failure? + REAL(sp), ALLOCATABLE, INTENT(INOUT) :: spcScal(:) ! Species scalefacs +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 10 Jun 2015 - C. Keller - Initial version @@ -663,19 +666,69 @@ 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 - CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, & - DefVal_SP=DefValue, SpcScal_SP=SpcScal ) + ! 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 + + ! If scale factor was found, assign it to SpcScal + IF ( found ) spcScal(I) = scaleFac + ENDDO - END SUBROUTINE GetExtSpcVal_sp + END SUBROUTINE GetExtSpcVal_sp !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! @@ -694,22 +747,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 +774,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 + + ! Initialize to default values + spcScal = defValue + + !======================================================================== + ! Look for species scale factors; save to spcScal array + !======================================================================== + DO I = 1, NSPC - ! Make sure output is properly allocated - IF ( ALLOCATED(SpcScal) ) DEALLOCATE(SpcScal) - ALLOCATE(SpcScal(NSPC)) - SpcScal=DefValue + ! 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 - CALL GetExtSpcVal_Dr ( HcoConfig, ExtNr, NSPC, SpcNames, Prefix, RC, & - DefVal_IN=DefValue, SpcScal_IN=SpcScal ) + ! 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 +855,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 +883,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) !