diff --git a/CHANGELOG.md b/CHANGELOG.md index 6566daaf..8d0293af 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [Unreleased 3.6.1] ### Added - GEOS-only updates + - Removed several memory leaks in HEMCO Core and Standalone routines ## [3.6.0] - 2023-02-01 ### Added diff --git a/src/Core/hco_arr_mod.F90 b/src/Core/hco_arr_mod.F90 index ed490697..c26de23b 100644 --- a/src/Core/hco_arr_mod.F90 +++ b/src/Core/hco_arr_mod.F90 @@ -192,13 +192,16 @@ SUBROUTINE HCO_ArrInit_2D_Hp( Arr, nx, ny, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Hp), POINTER :: Arr ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim ! -! !INPUT/OUTPUT PARAMETERS: +! INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr2D_Hp), POINTER :: Arr ! Array ! - INTEGER, INTENT(INOUT) :: RC ! Return code +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -209,24 +212,41 @@ SUBROUTINE HCO_ArrInit_2D_Hp( Arr, nx, ny, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrInit_2D_Hp begins here ! ================================================================ - LOC = 'HCO_ArrInit_2D_Hp (HCO_ARR_MOD.F90)' - NULLIFY (Arr) - ALLOCATE(Arr) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrInit_2D_Hp (HCO_ARR_MOD.F90)' + + ! NOTE: This may cause a memory leak + Arr => NULL() + + ! Initialize the Arr object + !IF ( .not. ASSOCIATED( Arr ) ) THEN + ALLOCATE( Arr, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate the "Arr" object!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Arr%Val => NULL() + Arr%Alloc = .FALSE. + !ENDIF + + ! Initialize the Arr%Val array CALL HCO_ValInit( Arr%Val, nx, ny, Arr%Alloc, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN + errMsg = 'Could not allocate the "Arr%Val" array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS - END SUBROUTINE HCO_ArrInit_2D_Hp !EOC !------------------------------------------------------------------------------ @@ -248,13 +268,16 @@ SUBROUTINE HCO_ArrInit_2D_Sp( Arr, nx, ny, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Sp), POINTER :: Arr ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim ! -! !INPUT/OUTPUT PARAMETERS: +! INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr2D_Sp), POINTER :: Arr ! Array +! +! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -265,24 +288,41 @@ SUBROUTINE HCO_ArrInit_2D_Sp( Arr, nx, ny, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrInit_2D_Sp begins here ! ================================================================ - LOC = 'HCO_ArrInit_2D_Sp (HCO_ARR_MOD.F90)' - NULLIFY (Arr) - ALLOCATE(Arr) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrInit_2D_Sp (HCO_ARR_MOD.F90)' + + ! NOTE: This may cause a memory leak + Arr => NULL() + + ! Initialize the Arr object + !IF ( .not. ASSOCIATED( Arr ) ) THEN + ALLOCATE( Arr, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate the "Arr" object!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Arr%Val => NULL() + Arr%Alloc = .FALSE. + !ENDIF + + ! Initialize the Arr%Val array CALL HCO_ValInit( Arr%Val, nx, ny, Arr%Alloc, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN + errMsg = 'Could not allocate the "Arr%Val" array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS - END SUBROUTINE HCO_ArrInit_2D_Sp !EOC !------------------------------------------------------------------------------ @@ -304,13 +344,16 @@ SUBROUTINE HCO_ArrInit_2D_I( Arr, nx, ny, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_I), POINTER :: Arr ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim ! -! !INPUT/OUTPUT PARAMETERS: +! INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr2D_I), POINTER :: Arr ! Array ! - INTEGER, INTENT(INOUT) :: RC ! Return code +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -321,24 +364,41 @@ SUBROUTINE HCO_ArrInit_2D_I( Arr, nx, ny, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrInit_2D_I begins here ! ================================================================ - LOC = 'HCO_ArrInit_2D_I (HCO_ARR_MOD.F90)' - NULLIFY (Arr) - ALLOCATE(Arr) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrInit_2D_I (hco_arr_mod.F90)' + + ! NOTE: This may cause a memory leak + Arr => NULL() + + ! Initialize the Arr object + !IF ( .not. ASSOCIATED( Arr ) ) THEN + ALLOCATE( Arr, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate the "Arr" object!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Arr%Val => NULL() + Arr%Alloc = .FALSE. + !ENDIF + + ! Initialize the Arr%Val array CALL HCO_ValInit( Arr%Val, nx, ny, Arr%Alloc, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN + errMsg = 'Could not allocate the "Arr%Val" array!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS - END SUBROUTINE HCO_ArrInit_2D_I !EOC !------------------------------------------------------------------------------ @@ -360,14 +420,17 @@ SUBROUTINE HCO_ArrInit_3D_Hp( Arr, nx, ny, nz, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Hp), POINTER :: Arr ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim ! -! !INPUT/OUTPUT PARAMETERS: +! INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr3D_Hp), POINTER :: Arr ! Array +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -378,23 +441,40 @@ SUBROUTINE HCO_ArrInit_3D_Hp( Arr, nx, ny, nz, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + CHARACTER(LEN=255) :: errMsg, thisLoc + ! ================================================================ ! HCO_ArrInit_3D_Hp begins here ! ================================================================ - LOC = 'HCO_ArrInit_3D_Hp (HCO_ARR_MOD.F90)' - NULLIFY (Arr) - ALLOCATE(Arr) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrInit_3D_Hp (hco_arr_mod.F90)' + + ! NOTE: This may cause a memory leak + Arr => NULL() + + ! Initialize the Arr object + !IF ( .not. ASSOCIATED( Arr ) ) THEN + ALLOCATE( Arr, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate the Arr object!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Arr%Val => NULL() + Arr%Alloc = .FALSE. + !ENDIF + + ! Initialize the Arr%Val array CALL HCO_ValInit( Arr%Val, nx, ny, nz, Arr%Alloc, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN + errMsg = 'Could not allocate the "Arr%Val" array!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS - END SUBROUTINE HCO_ArrInit_3D_Hp !EOC !------------------------------------------------------------------------------ @@ -416,14 +496,17 @@ SUBROUTINE HCO_ArrInit_3D_Sp( Arr, nx, ny, nz, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Sp), POINTER :: Arr ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim ! -! !INPUT/OUTPUT PARAMETERS: +! INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr3D_Sp), POINTER :: Arr ! Array +! +! !OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -434,23 +517,44 @@ SUBROUTINE HCO_ArrInit_3D_Sp( Arr, nx, ny, nz, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + ! Scalars + INTEGER :: I + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc + ! ================================================================ - ! HCO_ArrInit_3D_Hp begins here + ! HCO_ArrInit_3D_Sp begins here ! ================================================================ - LOC = 'HCO_ArrInit_3D_Hp (HCO_ARR_MOD.F90)' - NULLIFY (Arr) - ALLOCATE(Arr) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrInit_3D_Sp (hco_arr_mod.F90)' + + ! NOTE: This may cause a memory leak + Arr => NULL() + + ! Initialize the Arr object + !IF ( .not. ASSOCIATED( Arr ) ) THEN + ALLOCATE( Arr, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate the Arr object!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Arr%Val => NULL() + Arr%Alloc = .FALSE. + !ENDIF + + ! Initialize the Arr%Val array CALL HCO_ValInit( Arr%Val, nx, ny, nz, Arr%Alloc, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN + errMsg = 'Could not allocate the "Arr%Val" array!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS - END SUBROUTINE HCO_ArrInit_3D_Sp !EOC !------------------------------------------------------------------------------ @@ -472,14 +576,17 @@ SUBROUTINE HCO_ArrVecInit_2D_Hp( ArrVec, nn, nx, ny, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Hp), POINTER :: ArrVec(:) ! Array vector - INTEGER, INTENT(IN) :: nn ! vector length - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nn ! vector length + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr2D_Hp), POINTER :: ArrVec(:) ! Array vector ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -490,25 +597,46 @@ SUBROUTINE HCO_ArrVecInit_2D_Hp( ArrVec, nn, nx, ny, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: I + ! Scalars + INTEGER :: I + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrVecInit_2D_Hp begins here ! ================================================================ - ! Init - NULLIFY(ArrVec) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrVecInit_2D_Hp (hco_arr_mod.F90)' - IF ( nn > 0 ) THEN - IF ( .NOT. ASSOCIATED(ArrVec) ) ALLOCATE(ArrVec(nn)) - DO I = 1, nn - CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, ArrVec(I)%Alloc, RC ) - IF ( RC/=HCO_SUCCESS ) RETURN - ENDDO + ! If dimension is zero, return a null pointer + IF ( nn < 1 ) THEN + ArrVec => NULL() + RETURN + ENDIF + + ! Allocate ArrVec if necessary + IF ( .not. ASSOCIATED( ArrVec ) ) THEN + ALLOCATE( ArrVec( nn ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate "ArrVec"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF ENDIF - ! Leave - RC = HCO_SUCCESS + ! Reset values in ArrVec + DO I = 1, nn + CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, ArrVec(I)%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDDO END SUBROUTINE HCO_ArrVecInit_2D_Hp !EOC @@ -531,14 +659,17 @@ SUBROUTINE HCO_ArrVecInit_2D_Sp( ArrVec, nn, nx, ny, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Sp), POINTER :: ArrVec(:) ! Array vector - INTEGER, INTENT(IN) :: nn ! vector length - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nn ! vector length + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr2D_Sp), POINTER :: ArrVec(:) ! Array vector ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -549,25 +680,46 @@ SUBROUTINE HCO_ArrVecInit_2D_Sp( ArrVec, nn, nx, ny, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: I + ! Scalars + INTEGER :: I + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrVecInit_2D_Sp begins here ! ================================================================ - ! Init - NULLIFY(ArrVec) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrVecInit_2D_Sp (hco_arr_mod.F90)' - IF ( nn > 0 ) THEN - IF ( .NOT. ASSOCIATED(ArrVec) ) ALLOCATE(ArrVec(nn)) - DO I = 1, nn - CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, ArrVec(I)%Alloc, RC ) - IF ( RC/=HCO_SUCCESS ) RETURN - ENDDO + ! If dimension is zero, return a null pointer + IF ( nn < 1 ) THEN + ArrVec => NULL() + RETURN + ENDIF + + ! Allocate ArrVec if necessary + IF ( .not. ASSOCIATED( ArrVec ) ) THEN + ALLOCATE( ArrVec( nn ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate "ArrVec"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF ENDIF - ! Leave - RC = HCO_SUCCESS + ! Reset values in ArrVec + DO I = 1, nn + CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, ArrVec(I)%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDDO END SUBROUTINE HCO_ArrVecInit_2D_Sp !EOC @@ -590,15 +742,18 @@ SUBROUTINE HCO_ArrVecInit_3D_Hp( ArrVec, nn, nx, ny, nz, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Hp), POINTER :: ArrVec(:) ! Array vector - INTEGER, INTENT(IN) :: nn ! vector length - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nn ! vector length + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr3D_Hp), POINTER :: ArrVec(:) ! Array vector ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -609,25 +764,46 @@ SUBROUTINE HCO_ArrVecInit_3D_Hp( ArrVec, nn, nx, ny, nz, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: I + ! Scalars + INTEGER :: I + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrVecInit_3D_Hp begins here ! ================================================================ - ! Init - NULLIFY( ArrVec ) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrVecInit_3D_Hp (hco_arr_mod.F90)' - IF ( nn > 0 ) THEN - IF ( .NOT. ASSOCIATED(ArrVec) ) ALLOCATE(ArrVec(nn)) - DO I = 1, nn - CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, nz, ArrVec(I)%Alloc, RC ) - IF ( RC/=HCO_SUCCESS ) RETURN - ENDDO + ! If dimension is zero, return a null pointer + IF ( nn < 1 ) THEN + ArrVec => NULL() + RETURN + ENDIF + + ! Allocate ArrVec if necessary + IF ( .not. ASSOCIATED( ArrVec ) ) THEN + ALLOCATE( ArrVec( nn ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate "ArrVec"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF ENDIF - ! Leave - RC = HCO_SUCCESS + ! Reset values of ArrVec + DO I = 1, nn + CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, nz, ArrVec(I)%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDDO END SUBROUTINE HCO_ArrVecInit_3D_Hp !EOC @@ -650,15 +826,18 @@ SUBROUTINE HCO_ArrVecInit_3D_Sp( ArrVec, nn, nx, ny, nz, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Sp), POINTER :: ArrVec(:) ! Array vector - INTEGER, INTENT(IN) :: nn ! vector length - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nn ! vector length + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(Arr3D_Sp), POINTER :: ArrVec(:) ! Array vector ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -669,25 +848,46 @@ SUBROUTINE HCO_ArrVecInit_3D_Sp( ArrVec, nn, nx, ny, nz, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: I + ! Scalars + INTEGER :: I + + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ArrVecInit_3D_Sp begins here ! ================================================================ - ! Init - NULLIFY( ArrVec ) + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrVecInit_3D_Sp (hco_arr_mod.F90)' - IF ( nn > 0 ) THEN - IF ( .NOT. ASSOCIATED(ArrVec) ) ALLOCATE(ArrVec(nn)) - DO I = 1, nn - CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, nz, ArrVec(I)%Alloc, RC ) - IF ( RC/=HCO_SUCCESS ) RETURN - ENDDO + ! If dimension is zero, return a null pointer + IF ( nn < 1 ) THEN + ArrVec => NULL() + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Allocate ArrVec if necessary + IF ( .not. ASSOCIATED( ArrVec ) ) THEN + ALLOCATE( ArrVec( nn ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate "ArrVec"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDIF + + ! Reset values of ArrVec + DO I = 1, nn + CALL HCO_ValInit( ArrVec(I)%Val, nx, ny, nz, ArrVec(I)%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + ENDDO END SUBROUTINE HCO_ArrVecInit_3D_Sp !EOC @@ -710,14 +910,17 @@ SUBROUTINE HCO_ValInit_2D_Sp( Val, nx, ny, Alloc, RC ) ! ! !INPUT PARAMETERS: ! - REAL(sp), POINTER :: Val(:,:) ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(sp), POINTER :: Val(:,:) ! Array ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT( OUT) :: Alloc ! allocated? - INTEGER, INTENT(INOUT) :: RC ! Return code + LOGICAL, INTENT(OUT) :: Alloc ! allocated? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -728,28 +931,34 @@ SUBROUTINE HCO_ValInit_2D_Sp( Val, nx, ny, Alloc, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: AS + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ValInit_2D_Sp begins here ! ================================================================ - Val => NULL() - ALLOC = .FALSE. + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ValInit_2D_Sp (hco_arr_mod.F90)' - IF ( nx>0 ) THEN - ALLOCATE(Val(nx,ny),STAT=AS) - IF(AS/=0) THEN - WRITE(*,*) 'Arr2D value allocation error' - RC = HCO_FAIL - RETURN - ENDIF - Val(:,:) = 0.0_sp - ALLOC = .TRUE. + ! If dimensions are zero, just return a null pointer to Val + IF ( nx == 0 .or. ny == 0 ) THEN + Val => NULL() + Alloc = .FALSE. + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Initialize Val if dimensions are nonzero + ALLOCATE( Val( nx, ny ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate Val!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Val = 0.0_sp + alloc = .TRUE. END SUBROUTINE HCO_ValInit_2D_Sp !EOC @@ -772,14 +981,17 @@ SUBROUTINE HCO_ValInit_2D_Dp( Val, nx, ny, Alloc, RC ) ! ! !INPUT PARAMETERS: ! - REAL(dp), POINTER :: Val(:,:) ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT( OUT) :: Alloc ! allocated? - INTEGER, INTENT(INOUT) :: RC ! Return code + REAL(dp), POINTER :: Val(:,:) ! Array +! +! !INPUT/OUTPUT PARAMETERS: +! + LOGICAL, INTENT(OUT) :: Alloc ! allocated? + INTEGER, INTENT(OUT) :: RC ! Success or failure?! ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -790,27 +1002,34 @@ SUBROUTINE HCO_ValInit_2D_Dp( Val, nx, ny, Alloc, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: AS + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ValInit_2D_Dp begins here ! ================================================================ - Val => NULL() - Alloc = .FALSE. - IF ( nx>0 ) THEN - ALLOCATE(Val(nx,ny),STAT=AS) - IF(AS/=0) THEN - WRITE(*,*) 'Arr2D value allocation error' - RC = HCO_FAIL - RETURN - ENDIF - Val(:,:) = 0.0_dp - Alloc = .TRUE. + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ValInit_2D_Dp (hco_arr_mod.F90)' + + ! If dimensions are zero, just return a null pointer to Val + IF ( nx == 0 .or. ny == 0 ) THEN + Val => NULL() + Alloc = .FALSE. + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Initialize Val if dimensions are nonzero + ALLOCATE( Val( nx, ny ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate Val!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Val = 0.0_dp + alloc = .TRUE. END SUBROUTINE HCO_ValInit_2D_Dp !EOC @@ -829,18 +1048,21 @@ END SUBROUTINE HCO_ValInit_2D_Dp !\\ ! !INTERFACE: ! - SUBROUTINE HCO_ValInit_2D_I( Val, nx, ny, Alloc, RC ) + SUBROUTINE HCO_ValInit_2D_I( Val, nx, ny, alloc, RC ) ! ! !INPUT PARAMETERS: ! - INTEGER, POINTER :: Val(:,:) ! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, POINTER :: Val(:,:) ! Array ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT( OUT) :: Alloc ! allocated? - INTEGER, INTENT(INOUT) :: RC ! Return code + LOGICAL, INTENT(OUT) :: Alloc ! allocated? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -851,27 +1073,34 @@ SUBROUTINE HCO_ValInit_2D_I( Val, nx, ny, Alloc, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: AS + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ValInit_2D_I begins here ! ================================================================ - Val => NULL() - Alloc = .FALSE. - IF ( nx > 0 ) THEN - ALLOCATE(Val(nx,ny),STAT=AS) - IF(AS/=0) THEN - WRITE(*,*) 'Arr2D value allocation error' - RC = HCO_FAIL - RETURN - ENDIF - Val(:,:) = 0 - Alloc = .TRUE. + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ValInit_2D_I (hco_arr_mod.F90)' + + ! If dimensions are zero, just return a null pointer to Val + IF ( nx == 0 .or. ny == 0 ) THEN + Val => NULL() + Alloc = .FALSE. + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Initialize Val if dimensions are nonzero + ALLOCATE( Val( nx, ny ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate Val!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Val = 0 + alloc = .TRUE. END SUBROUTINE HCO_ValInit_2D_I !EOC @@ -894,15 +1123,18 @@ SUBROUTINE HCO_ValInit_3D_Dp( Val, nx, ny, nz, Alloc, RC ) ! ! !INPUT PARAMETERS: ! - REAL(dp), POINTER :: Val(:,:,:)! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT( OUT) :: Alloc ! allocated? - INTEGER, INTENT(INOUT) :: RC ! Return code + REAL(dp), POINTER :: Val(:,:,:) ! Array +! +! !INPUT/OUTPUT PARAMETERS: +! + LOGICAL, INTENT(OUT) :: Alloc ! allocated? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -913,27 +1145,34 @@ SUBROUTINE HCO_ValInit_3D_Dp( Val, nx, ny, nz, Alloc, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: AS + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ValInit_3D_Dp begins here ! ================================================================ - Val => NULL() - Alloc = .FALSE. - IF ( nx>0 ) THEN - ALLOCATE(Val(nx,ny,nz),STAT=AS) - IF(AS/=0) THEN - WRITE(*,*) 'Arr3D value allocation error' - RC = HCO_FAIL - RETURN - ENDIF - Val(:,:,:) = 0.0_dp - Alloc = .TRUE. + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ValInit_3D_Dp (hco_arr_mod.F90)' + + ! If dimensions are zero, return a null pointer + IF ( nx == 0 .or. ny == 0 .or. nz == 0 ) THEN + Val => NULL() + Alloc = .FALSE. + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Initialize Val if dimensions are nonzero + ALLOCATE( Val( nx, ny, nz ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate Val!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Val = 0.0_dp + alloc = .TRUE. END SUBROUTINE HCO_ValInit_3D_Dp !EOC @@ -956,15 +1195,18 @@ SUBROUTINE HCO_ValInit_3D_Sp( Val, nx, ny, nz, Alloc, RC ) ! ! !INPUT PARAMETERS: ! - REAL(sp), POINTER :: Val(:,:,:)! Array - INTEGER, INTENT(IN) :: nx ! x-dim - INTEGER, INTENT(IN) :: ny ! y-dim - INTEGER, INTENT(IN) :: nz ! z-dim + INTEGER, INTENT(IN) :: nx ! x-dim + INTEGER, INTENT(IN) :: ny ! y-dim + INTEGER, INTENT(IN) :: nz ! z-dim ! ! !INPUT/OUTPUT PARAMETERS: ! - LOGICAL, INTENT( OUT) :: Alloc ! allocated? - INTEGER, INTENT(INOUT) :: RC ! Return code + REAL(sp), POINTER :: Val(:,:,:) ! Array +! +! !INPUT/OUTPUT PARAMETERS: +! + LOGICAL, INTENT(OUT) :: Alloc ! allocated? + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -975,27 +1217,34 @@ SUBROUTINE HCO_ValInit_3D_Sp( Val, nx, ny, nz, Alloc, RC ) ! ! !LOCAL VARIABLES: ! - INTEGER :: AS + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc ! ================================================================ ! HCO_ValInit_3D_Sp begins here ! ================================================================ - Val => NULL() - Alloc = .FALSE. - IF ( nx>0 ) THEN - ALLOCATE(Val(nx,ny,nz),STAT=AS) - IF(AS/=0) THEN - WRITE(*,*) 'Arr3D value allocation error' - RC = HCO_FAIL - RETURN - ENDIF - Val(:,:,:) = 0.0_sp - Alloc = .TRUE. + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ValInit_3D_Sp (hco_arr_mod.F90)' + + ! If dimensions are zero, return a null pointer + IF ( nx == 0 .or. ny == 0 .or. nz == 0 ) THEN + Val => NULL() + Alloc = .FALSE. + RETURN ENDIF - ! Leave - RC = HCO_SUCCESS + ! Initialize Val if dimensions are nonzero + ALLOCATE( Val( nx, ny, nz ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate Val!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Val = 0.0_sp + alloc = .TRUE. END SUBROUTINE HCO_ValInit_3D_Sp !EOC @@ -1016,15 +1265,15 @@ SUBROUTINE HCO_ArrAssert_3D_Hp( ThisArr3D, I, J, L, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Hp), POINTER :: ThisArr3D ! 3D array - INTEGER, INTENT(IN ) :: I, J, L ! Array dims + INTEGER, INTENT(IN) :: I, J, L ! Array dims ! ! !INPUT/OUTPUT PARAMETERS: ! - - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr3D_Hp), POINTER :: ThisArr3D ! 3D array ! -! !REMARKS: +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 01 May 2013 - C. Keller - Initial version @@ -1032,22 +1281,39 @@ SUBROUTINE HCO_ArrAssert_3D_Hp( ThisArr3D, I, J, L, RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !===================================================================== ! HCO_ArrAssert_3D_Hp begins here! !===================================================================== + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrAssert_3D_Hp (hco_arr_mod.F90)' + ! Check flux array - IF ( .NOT. ASSOCIATED ( ThisArr3D ) ) THEN + IF ( .not. ASSOCIATED ( ThisArr3D ) ) THEN CALL HCO_ArrInit( ThisArr3D, I, J, L, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ELSEIF ( .NOT. ASSOCIATED ( ThisArr3D%Val ) ) THEN - CALL HCO_ValInit ( ThisArr3D%Val, I, J, L, ThisArr3D%Alloc, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ENDIF + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ArrInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ELSE IF ( .not. ASSOCIATED ( ThisArr3D%Val ) ) THEN + CALL HCO_ValInit( ThisArr3D%Val, I, J, L, ThisArr3D%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ENDIF END SUBROUTINE HCO_ArrAssert_3D_Hp !EOC @@ -1068,15 +1334,15 @@ SUBROUTINE HCO_ArrAssert_3D_Sp( ThisArr3D, I, J, L, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr3D_Sp), POINTER :: ThisArr3D ! 3D array - INTEGER, INTENT(IN ) :: I, J, L ! Array dims + INTEGER, INTENT(IN) :: I, J, L ! Array dims ! ! !INPUT/OUTPUT PARAMETERS: ! - - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr3D_Sp), POINTER :: ThisArr3D ! 3D array ! -! !REMARKS: +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 01 May 2013 - C. Keller - Initial version @@ -1084,22 +1350,39 @@ SUBROUTINE HCO_ArrAssert_3D_Sp( ThisArr3D, I, J, L, RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !===================================================================== ! HCO_ArrAssert_3D_Sp begins here! !===================================================================== + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrAssert_3D_Sp (hco_arr_mod.F90)' + ! Check flux array - IF ( .NOT. ASSOCIATED ( ThisArr3D ) ) THEN + IF ( .not. ASSOCIATED ( ThisArr3D ) ) THEN CALL HCO_ArrInit( ThisArr3D, I, J, L, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ELSEIF ( .NOT. ASSOCIATED ( ThisArr3D%Val ) ) THEN + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ArrInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ELSE IF ( .not. ASSOCIATED ( ThisArr3D%Val ) ) THEN CALL HCO_ValInit ( ThisArr3D%Val, I, J, L, ThisArr3D%Alloc, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ENDIF + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ENDIF END SUBROUTINE HCO_ArrAssert_3D_Sp !EOC @@ -1120,14 +1403,15 @@ SUBROUTINE HCO_ArrAssert_2D_Hp( ThisArr2D, I, J, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Hp), POINTER :: ThisArr2D ! 2D array - INTEGER, INTENT(IN ) :: I, J ! Array dims + INTEGER, INTENT(IN) :: I, J ! Array dims ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr2D_Hp), POINTER :: ThisArr2D ! 2D array ! -! !REMARKS: +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 01 May 2013 - C. Keller - Initial version @@ -1135,22 +1419,39 @@ SUBROUTINE HCO_ArrAssert_2D_Hp( ThisArr2D, I, J, RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !===================================================================== ! HCO_ArrAssert_2D_Hp begins here! !===================================================================== + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrAssert_2D_Hp (hco_arr_mod.F90)' + ! Check flux array - IF ( .NOT. ASSOCIATED ( ThisArr2D ) ) THEN + IF ( .not. ASSOCIATED ( ThisArr2D ) ) THEN CALL HCO_ArrInit( ThisArr2D, I, J, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ELSEIF ( .NOT. ASSOCIATED ( ThisArr2D%Val ) ) THEN - CALL HCO_ValInit ( ThisArr2D%Val, I, J, ThisArr2D%Alloc, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ENDIF + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ArrInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ELSE IF ( .not. ASSOCIATED ( ThisArr2D%Val ) ) THEN + CALL HCO_ValInit( ThisArr2D%Val, I, J, ThisArr2D%Alloc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ENDIF END SUBROUTINE HCO_ArrAssert_2D_Hp !EOC @@ -1171,14 +1472,15 @@ SUBROUTINE HCO_ArrAssert_2D_Sp( ThisArr2D, I, J, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_Sp), POINTER :: ThisArr2D ! 2D array - INTEGER, INTENT(IN ) :: I, J ! Array dims + INTEGER, INTENT(IN) :: I, J ! Array dims ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr2D_Sp), POINTER :: ThisArr2D ! 2D array +! +! !OUTPUT PARAMETERS: ! -! !REMARKS: + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 01 May 2013 - C. Keller - Initial version @@ -1186,22 +1488,39 @@ SUBROUTINE HCO_ArrAssert_2D_Sp( ThisArr2D, I, J, RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !===================================================================== ! HCO_ArrAssert_2D_Sp begins here! !===================================================================== + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrAssert_2D_Sp (hco_arr_mod.F90)' + ! Check flux array - IF ( .NOT. ASSOCIATED ( ThisArr2D ) ) THEN + IF ( .not. ASSOCIATED ( ThisArr2D ) ) THEN CALL HCO_ArrInit( ThisArr2D, I, J, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ELSEIF ( .NOT. ASSOCIATED ( ThisArr2D%Val ) ) THEN + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ArrInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ELSE IF ( .not. ASSOCIATED ( ThisArr2D%Val ) ) THEN CALL HCO_ValInit ( ThisArr2D%Val, I, J, ThisArr2D%Alloc, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ENDIF + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ENDIF END SUBROUTINE HCO_ArrAssert_2D_Sp !EOC @@ -1222,14 +1541,15 @@ SUBROUTINE HCO_ArrAssert_2D_I( ThisArr2D, I, J, RC ) ! ! !INPUT PARAMETERS: ! - TYPE(Arr2D_I), POINTER :: ThisArr2D ! 2D array - INTEGER, INTENT(IN ) :: I, J ! Array dims + INTEGER, INTENT(IN) :: I, J ! Array dims ! ! !INPUT/OUTPUT PARAMETERS: ! - INTEGER, INTENT(INOUT) :: RC ! Return code + TYPE(Arr2D_I), POINTER :: ThisArr2D ! 2D array +! +! !OUTPUT PARAMETERS: ! -! !REMARKS: + INTEGER, INTENT(OUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 01 May 2013 - C. Keller - Initial version @@ -1237,22 +1557,39 @@ SUBROUTINE HCO_ArrAssert_2D_I( ThisArr2D, I, J, RC ) !EOP !------------------------------------------------------------------------------ !BOC +! +! !LOCAL VARIABLES: +! + ! Strings + CHARACTER(LEN=255) :: errMsg, thisLoc !===================================================================== ! HCO_ArrAssert_2D_I begins here! !===================================================================== + ! Initialize + RC = HCO_SUCCESS + errMsg = '' + thisLoc = 'HCO_ArrAssert_2D_I (hco_arr_mod.F90)' + ! Check flux array - IF ( .NOT. ASSOCIATED ( ThisArr2D ) ) THEN + IF ( .not. ASSOCIATED ( ThisArr2D ) ) THEN CALL HCO_ArrInit( ThisArr2D, I, J, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ELSEIF ( .NOT. ASSOCIATED ( ThisArr2D%Val ) ) THEN + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ArrInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ELSE IF ( .not. ASSOCIATED ( ThisArr2D%Val ) ) THEN CALL HCO_ValInit ( ThisArr2D%Val, I, J, ThisArr2D%Alloc, RC ) - IF ( RC/= HCO_SUCCESS ) RETURN - ENDIF + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Error encountered in "HCO_ValInit"!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ! Return w/ success - RC = HCO_SUCCESS + ENDIF END SUBROUTINE HCO_ArrAssert_2D_I !EOC @@ -1290,16 +1627,15 @@ SUBROUTINE HCO_ArrCleanup_2D_Hp( Arr, DeepClean ) ! ================================================================ ! HCO_ArrCleanup_2D_Hp begins here ! ================================================================ + IF ( ASSOCIATED( Arr ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean ) ) DC = DeepClean - IF ( ASSOCIATED(Arr) ) THEN - CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DC ) - DEALLOCATE ( Arr ) + ! Finalize Arr%Val and Arr + CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DeepClean=DC ) + DEALLOCATE( Arr ) ENDIF END SUBROUTINE HCO_ArrCleanup_2D_Hp @@ -1338,16 +1674,15 @@ SUBROUTINE HCO_ArrCleanup_2D_Sp( Arr, DeepClean ) ! ================================================================ ! HCO_ArrCleanup_2D_Sp begins here ! ================================================================ + IF ( ASSOCIATED( Arr ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean ) ) DC = DeepClean - IF ( ASSOCIATED(Arr) ) THEN - CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DC ) - DEALLOCATE ( Arr ) + ! Finalize Arr%Val and Arr + CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DeepClean=DC ) + DEALLOCATE( Arr ) ENDIF END SUBROUTINE HCO_ArrCleanup_2D_Sp @@ -1386,16 +1721,15 @@ SUBROUTINE HCO_ArrCleanup_2D_I( Arr, DeepClean ) ! ================================================================ ! HCO_ArrCleanup_2D_I begins here ! ================================================================ + IF ( ASSOCIATED( Arr ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean ) ) DC = DeepClean - IF ( ASSOCIATED(Arr) ) THEN - CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DC ) - DEALLOCATE ( Arr ) + ! Finalize Arr%Val and Arr + CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DeepClean=DC ) + DEALLOCATE( Arr ) ENDIF END SUBROUTINE HCO_ArrCleanup_2D_I @@ -1434,18 +1768,16 @@ SUBROUTINE HCO_ArrCleanup_3D_Hp( Arr, DeepClean ) ! ================================================================ ! HCO_ArrCleanup_3D_Hp begins here ! ================================================================ + IF ( ASSOCIATED( Arr ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean ) ) DC = DeepClean - IF ( ASSOCIATED(Arr) ) THEN - CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DC ) - DEALLOCATE ( Arr ) + ! Finalize Arr%Val and Arr + CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DeepClean=DC ) + DEALLOCATE( Arr ) ENDIF - END SUBROUTINE HCO_ArrCleanup_3D_Hp !EOC !------------------------------------------------------------------------------ @@ -1482,16 +1814,15 @@ SUBROUTINE HCO_ArrCleanup_3D_Sp( Arr, DeepClean ) ! ================================================================ ! HCO_ArrCleanup_3D_Sp begins here ! ================================================================ + IF ( ASSOCIATED( Arr ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean ) ) DC = DeepClean - IF ( ASSOCIATED(Arr) ) THEN - CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DC ) - DEALLOCATE ( Arr ) + ! Finalize Arr%Val and Arr + CALL HCO_ValCleanup( Arr%Val, Arr%Alloc, DeepClean=DC ) + DEALLOCATE( Arr ) ENDIF END SUBROUTINE HCO_ArrCleanup_3D_Sp @@ -1531,19 +1862,18 @@ SUBROUTINE HCO_ArrVecCleanup_2D_Hp( ArrVec, DeepClean ) ! ================================================================ ! HCO_ArrVecCleanup_2D_Hp begins here ! ================================================================ + IF ( ASSOCIATED( ArrVec ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT(DeepClean) ) DC = DeepClean - IF ( ASSOCIATED(ArrVec) ) THEN + ! Finalize ArrVec DO I = 1, SIZE(ArrVec,1) CALL HCO_ValCleanup( ArrVec(I)%Val, ArrVec(I)%Alloc, DC ) ENDDO + DEALLOCATE( ArrVec ) - DEALLOCATE ( ArrVec ) ENDIF END SUBROUTINE HCO_ArrVecCleanup_2D_Hp @@ -1583,19 +1913,18 @@ SUBROUTINE HCO_ArrVecCleanup_2D_Sp( ArrVec, DeepClean ) ! ================================================================ ! HCO_ArrVecCleanup_2D_Sp begins here ! ================================================================ + IF ( ASSOCIATED(ArrVec) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT( DeepClean) ) DC = DeepClean - IF ( ASSOCIATED(ArrVec) ) THEN + ! Finalize ArrVec DO I = 1, SIZE(ArrVec,1) CALL HCO_ValCleanup( ArrVec(I)%Val, ArrVec(I)%Alloc, DC ) ENDDO - DEALLOCATE ( ArrVec ) + ENDIF END SUBROUTINE HCO_ArrVecCleanup_2D_Sp @@ -1635,19 +1964,18 @@ SUBROUTINE HCO_ArrVecCleanup_3D_Hp( ArrVec, DeepClean ) ! ================================================================ ! HCO_ArrVecCleanup_3D_Hp begins here ! ================================================================ + IF ( ASSOCIATED( ArrVec ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT(DeepClean) ) DC = DeepClean - IF ( ASSOCIATED(ArrVec) ) THEN + ! Finalize ArrVec DO I = 1, SIZE(ArrVec,1) CALL HCO_ValCleanup( ArrVec(I)%Val, ArrVec(I)%Alloc, DC ) ENDDO - DEALLOCATE ( ArrVec ) + ENDIF END SUBROUTINE HCO_ArrVecCleanup_3D_Hp @@ -1687,19 +2015,18 @@ SUBROUTINE HCO_ArrVecCleanup_3D_Sp( ArrVec, DeepClean ) ! ================================================================ ! HCO_ArrVecCleanup_3D_Sp begins here ! ================================================================ + IF ( ASSOCIATED( ArrVec ) ) THEN - IF ( PRESENT(DeepClean) ) THEN - DC = DeepClean - ELSE + ! Optional argument handling DC = .TRUE. - ENDIF + IF ( PRESENT(DeepClean) ) DC = DeepClean - IF ( ASSOCIATED(ArrVec) ) THEN + ! Finalize ArrVec DO I = 1, SIZE(ArrVec,1) CALL HCO_ValCleanup( ArrVec(I)%Val, ArrVec(I)%Alloc, DC ) ENDDO - DEALLOCATE ( ArrVec ) + ENDIF END SUBROUTINE HCO_ArrVecCleanup_3D_Sp @@ -1723,9 +2050,12 @@ SUBROUTINE HCO_ValCleanup_2D_Dp( Val, Alloc, DeepClean ) ! ! !INPUT PARAMETERS: ! - REAL(dp), POINTER :: Val(:,:) ! Array - LOGICAL, INTENT(IN) :: Alloc ! Allocated? - LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? + LOGICAL, INTENT(IN) :: Alloc ! Allocated? + LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? +! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(dp), POINTER :: Val(:,:) ! Array ! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version @@ -1759,10 +2089,13 @@ SUBROUTINE HCO_ValCleanup_2D_Sp( Val, Alloc, DeepClean ) ! ! !INPUT PARAMETERS: ! - REAL(sp), POINTER :: Val(:,:) ! Array LOGICAL, INTENT(IN) :: Alloc ! Allocated? LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? ! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(sp), POINTER :: Val(:,:) ! Array +! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history @@ -1795,19 +2128,19 @@ SUBROUTINE HCO_ValCleanup_2D_I( Val, Alloc, DeepClean ) ! ! !INPUT PARAMETERS: ! - INTEGER, POINTER :: Val(:,:) ! Array LOGICAL, INTENT(IN) :: Alloc ! Allocated? LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? ! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, POINTER :: Val(:,:) ! Array +! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC -! -! !LOCAL VARIABLES: -! IF ( DeepClean .AND. ASSOCIATED(Val) .AND. Alloc ) THEN DEALLOCATE( Val ) ENDIF @@ -1834,10 +2167,13 @@ SUBROUTINE HCO_ValCleanup_3D_Dp( Val, Alloc, DeepClean ) ! ! !INPUT PARAMETERS: ! - REAL(dp), POINTER :: Val(:,:,:) ! Array LOGICAL, INTENT(IN) :: Alloc ! Allocated? LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? ! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(dp), POINTER :: Val(:,:,:) ! Array +! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history @@ -1870,10 +2206,13 @@ SUBROUTINE HCO_ValCleanup_3D_Sp( Val, Alloc, DeepClean ) ! ! !INPUT PARAMETERS: ! - REAL(sp), POINTER :: Val(:,:,:) ! Array LOGICAL, INTENT(IN) :: Alloc ! Allocated? LOGICAL, INTENT(IN) :: DeepClean ! Deallocate array? ! +! !INPUT/OUTPUT PARAMETERS: +! + REAL(sp), POINTER :: Val(:,:,:) ! Array +! ! !REVISION HISTORY: ! 20 Apr 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index 689b165a..67ac1cd7 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -1,3 +1,6 @@ +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ !BOP ! ! !MODULE: hco_config_mod.F90 @@ -862,8 +865,8 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! Fill data container ! ------------------------------------------------------------- - ! Add blank list container to ConfigList list. The container - ! is placed at the beginning of the list. + ! Add blank list container (ListCont object) to ConfigList. + ! The container is placed at the beginning of the list. CALL ConfigList_AddCont ( Lct, HcoConfig%ConfigList ) ! Check if name exists already @@ -876,14 +879,14 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! Attributes used by all data types: data type number and ! container name. - Lct%Dct%DctType = DctType - Lct%Dct%cName = ADJUSTL(tagcName) + Lct%Dct%DctType = DctType + Lct%Dct%cName = ADJUSTL( tagcName ) ! Set species name, extension number, emission category, ! hierarchy - Lct%Dct%SpcName = ADJUSTL(SpcName) - Lct%Dct%Hier = Int2 - Lct%Dct%ExtNr = Int3 + Lct%Dct%SpcName = ADJUSTL( SpcName ) + Lct%Dct%Hier = Int2 + Lct%Dct%ExtNr = Int3 ! Extract category from character 2. This can be up to ! CatMax integers, or empty. @@ -939,32 +942,46 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! default value of -999 to be able to identify data objects ! used by multiple containers. ! ------------------------------------------------------------- - IF ( TRIM(srcFile) == '-' ) THEN - IF ( .NOT. ASSOCIATED(Dta) ) THEN + IF ( TRIM( srcFile ) == '-' ) THEN + + ! The current entry of the configuration file specifies that + ! we will get data from the file listed immediately above it. + ! Thus we have to reuse a previously-defined FileData object + ! (aka Dta). Stop if Dta is not initialized. + IF ( .not. ASSOCIATED( Dta ) ) THEN MSG = 'Cannot use previous data container: '//TRIM(tagcName) CALL HCO_Error( msg, RC, thisLoc=loc ) RETURN ENDIF + + ! Reuse the file metadata specified in PrevDta for + ! this entry of the HEMCO configuration file. Lct%Dct%DtaHome = Lct%Dct%DtaHome - 1 + ELSE - ! NOTE: FileData_Init now nullifies the Dta object - ! befire allocation. -- Bob Yantosca (22 Aug 2022) + + ! The current entry of the configuration file specifies that + ! we will read data from a file. We thus need to initialize + ! a new FileData object to keep track of the file metadata. + ! + ! >>> NOTE: This seems to cause a memory leak! <<< + ! >>> We will look into this at a later date. <<< CALL FileData_Init( Dta ) ! Set source file name. Check if the read file name starts ! with the configuration file token '$CFDIR', in which case ! we replace this value with the passed CFDIR value. - STRLEN = LEN(srcFile) + STRLEN = LEN( srcFile ) IF ( STRLEN > 6 ) THEN IF ( srcFile(1:6) == '$CFDIR' ) THEN - srcFile = TRIM(CFDIR) // TRIM(srcFile(7:STRLEN)) + srcFile = TRIM( CFDIR ) // TRIM( srcFile(7:STRLEN) ) ENDIF ENDIF - Dta%ncFile = srcFile + Dta%ncFile = srcFile ! Set source variable and original data unit. - Dta%ncPara = ADJUSTL(srcVar) - Dta%OrigUnit = ADJUStL(srcUnit) + Dta%ncPara = ADJUSTL( srcVar ) + Dta%OrigUnit = ADJUSTL( srcUnit ) ! If the parameter ncPara is not defined, attempt to read data ! directly from configuration file instead of netCDF. @@ -973,7 +990,7 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! data that is treated in local time. The corresponding ! IsLocTime flag is updated when reading the data (see ! hcoio_dataread_mod.F90). - IF ( TRIM(Dta%ncPara) == '-' ) THEN + IF ( TRIM( Dta%ncPara ) == '-' ) THEN Dta%ncRead = .FALSE. Dta%IsLocTime = .TRUE. ENDIF @@ -990,12 +1007,12 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ENDIF ENDIF +#if defined(ESMF_) ! In an ESMF environment, the source data will be imported ! through ExtData by name, hence need to set ncFile equal to ! container name! -#if defined(ESMF_) IF ( Dta%ncRead ) THEN - Dta%ncFile = ADJUSTL(tagcName) + Dta%ncFile = ADJUSTL( tagcName ) ENDIF #endif @@ -1026,7 +1043,7 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ENDIF - ! Connect file data object of this data container. + ! Connect this FileData object to the HcoState%HcoConfigList. Lct%Dct%Dta => Dta ! Free list container for next cycle @@ -1041,8 +1058,8 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! Fill data container ! ------------------------------------------------------------- - ! Add blank list container to ConfigList list. The container - ! is placed at the beginning of the list. + ! Add blank list container (ListCont object) to ConfigList. + ! The container is placed at the beginning of the list. CALL ConfigList_AddCont ( Lct, HcoConfig%ConfigList ) ! Check if name exists already @@ -1063,9 +1080,9 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! Set species name, extension number, emission category, ! hierarchy - Lct%Dct%SpcName = ADJUSTL(SpcName) - Lct%Dct%Hier = Int2 - Lct%Dct%ExtNr = Int3 + Lct%Dct%SpcName = ADJUSTL( SpcName ) + Lct%Dct%Hier = Int2 + Lct%Dct%ExtNr = Int3 ! Extract category from character 2. This can be up to ! CatMax integers, or empty. @@ -1145,32 +1162,46 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! default value of -999 to be able to identify data objects ! used by multiple containers. ! ------------------------------------------------------------- - IF ( TRIM(srcFile) == '-' ) THEN + IF ( TRIM( srcFile ) == '-' ) THEN + + ! The current entry of the configuration file specifies that + ! we will get data from the file listed immediately above it. + ! Thus we have to reuse a previously-defined FileData object + ! (aka Dta). Stop if Dta is not initialized. IF ( .NOT. ASSOCIATED(Dta) ) THEN MSG = 'Cannot use previous data container: '//TRIM(cName) CALL HCO_Error( msg, RC, thisLoc=loc) RETURN ENDIF + + ! Reuse the file metadata specified in Dta for + ! this entry of the HEMCO configuration file. Lct%Dct%DtaHome = Lct%Dct%DtaHome - 1 + ELSE - ! NOTE: FileData_Init now nullifies the Dta object - ! before allocation. -- Bob Yantosca (22 Aug 2022) + + ! The current entry of the configuration file specifies that + ! we will read data from a file. We thus need to initialize + ! a new FileData object to keep track of the file metadata. + ! + ! >>> NOTE: This seems to cause a memory leak; <<< + ! >>> We will look into this at a later date <<< CALL FileData_Init( Dta ) ! Set source file name. Check if the read file name starts ! with the configuration file token '$CFDIR', in which case ! we replace this value with the passed CFDIR value. - STRLEN = LEN(srcFile) + STRLEN = LEN( srcFile ) IF ( STRLEN > 6 ) THEN IF ( srcFile(1:6) == '$CFDIR' ) THEN - srcFile = TRIM(CFDIR) // TRIM(srcFile(7:STRLEN)) + srcFile = TRIM( CFDIR ) // TRIM( srcFile(7:STRLEN) ) ENDIF ENDIF - Dta%ncFile = srcFile + Dta%ncFile = srcFile ! Set source variable and original data unit. - Dta%ncPara = ADJUSTL(srcVar) - Dta%OrigUnit = ADJUStL(srcUnit) + Dta%ncPara = ADJUSTL( srcVar ) + Dta%OrigUnit = ADJUSTL( srcUnit ) ! If the parameter ncPara is not defined, attempt to read data ! directly from configuration file instead of netCDF. @@ -1179,7 +1210,7 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ! data that is treated in local time. The corresponding ! IsLocTime flag is updated when reading the data (see ! hcoio_dataread_mod.F90). - IF ( TRIM(Dta%ncPara) == '-' ) THEN + IF ( TRIM( Dta%ncPara ) == '-' ) THEN Dta%ncRead = .FALSE. Dta%IsLocTime = .TRUE. ENDIF @@ -1196,12 +1227,12 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ENDIF ENDIF +#if defined(ESMF_) ! In an ESMF environment, the source data will be imported ! through ExtData by name, hence need to set ncFile equal to ! container name! -#if defined(ESMF_) IF ( Dta%ncRead ) THEN - Dta%ncFile = ADJUSTL(cName) + Dta%ncFile = ADJUSTL( cName ) ENDIF #endif @@ -1232,7 +1263,7 @@ SUBROUTINE Config_ReadCont( HcoConfig, IU_HCO, CFDIR, & ENDIF - ! Connect file data object of this data container. + ! Connect FileData object to the HcoState%HcoConfigList Lct%Dct%Dta => Dta ! If a base emission field covers multiple emission categories, @@ -1614,7 +1645,7 @@ SUBROUTINE AddShadowFields( HcoConfig, Lct, Cats, nCat, RC ) ! Add scale factor zero to it, so that emissions will all be zero. DO I = 2, nCat - ! Create new data container + ! Create new data container (ListCont object) CALL ConfigList_AddCont ( Shd, HcoConfig%ConfigList ) ! Character of category diff --git a/src/Core/hco_datacont_mod.F90 b/src/Core/hco_datacont_mod.F90 index a8a9b743..4969ece8 100644 --- a/src/Core/hco_datacont_mod.F90 +++ b/src/Core/hco_datacont_mod.F90 @@ -156,6 +156,10 @@ MODULE HCO_DataCont_Mod ! SUBROUTINE DataCont_Init( Dct, cID ) ! +! !USES: +! + USE HCO_FileData_Mod, ONLY : FileData_Init +! ! !INPUT PARAMETERS: ! TYPE(DataCont), POINTER :: Dct @@ -176,8 +180,8 @@ SUBROUTINE DataCont_Init( Dct, cID ) IF ( .NOT. ASSOCIATED( Dct) ) ALLOCATE( Dct ) ! Nullify pointers - Dct%Dta => NULL() Dct%Scal_cID => NULL() + Dct%Dta => NULL() ! Set default values Dct%DtaHome = -999 @@ -242,28 +246,24 @@ SUBROUTINE DataCont_Cleanup( Dct, ArrOnly ) !====================================================================== ! DataCont_Cleanup begins here! !====================================================================== + IF ( ASSOCIATED( Dct ) ) THEN - IF ( PRESENT(ArrOnly) ) THEN - DeepClean = .NOT. ArrOnly - ELSE + ! Optional argument handling DeepClean = .TRUE. - ENDIF - - ! Only if associated... - IF ( ASSOCIATED( Dct ) ) THEN + IF ( PRESENT( ArrOnly ) ) DeepClean = ( .not. ArrOnly ) ! Clean up FileData object. If DeepClean is true, this - ! will entirely erase the file data object. Otherwise, only the - ! data arrays will be removed. - ! Note: do only if this is the home container of the file data - ! object. + ! will entirely erase the file data object. Otherwise, + ! only the data arrays will be removed. + ! + ! Note: do only if this is the home container of + ! the file data object. IF ( Dct%DtaHome == 1 ) THEN CALL FileData_Cleanup( Dct%Dta, DeepClean ) ENDIF ! Clean up data container if DeepClean option is enabled. IF ( DeepClean ) THEN - Dct%Dta => NULL() IF( ASSOCIATED( Dct%Scal_cID ) ) DEALLOCATE( Dct%Scal_cID ) Dct%Scal_cID => NULL() DEALLOCATE( Dct ) diff --git a/src/Core/hco_filedata_mod.F90 b/src/Core/hco_filedata_mod.F90 index 1117a67b..bccde129 100644 --- a/src/Core/hco_filedata_mod.F90 +++ b/src/Core/hco_filedata_mod.F90 @@ -170,12 +170,10 @@ SUBROUTINE FileData_Init( FileDta ) ! FileData_Init begins here! !====================================================================== - FileDta => NULL() + ! Allocate memory to the FileData object ALLOCATE( FileDta ) ! Nullify all pointers and initialize variables - ! NOTE: Avoid memory leaks by working on the argument FileDta instead - ! of pointing to a local object NewFDta (Bob Yantosca, 22 Aug 2022) FileDta%V3 => NULL() FileDta%V2 => NULL() FileDta%tIDx => NULL() @@ -244,8 +242,6 @@ SUBROUTINE FileData_Cleanup( FileDta, DeepClean ) !====================================================================== ! FileData_Cleanup begins here! !====================================================================== - - ! Only if associated IF ( ASSOCIATED( FileDta ) ) THEN ! Deallocate data arrays diff --git a/src/Core/hco_geotools_mod.F90 b/src/Core/hco_geotools_mod.F90 index 3e94850c..4eba043e 100644 --- a/src/Core/hco_geotools_mod.F90 +++ b/src/Core/hco_geotools_mod.F90 @@ -767,7 +767,7 @@ SUBROUTINE HCO_CalcVertGrid ( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) ! ! !USES ! - USE HCO_Arr_Mod, ONLY : HCO_ArrAssert + USE HCO_Arr_Mod, ONLY : HCO_ArrAssert, HCO_ArrCleanup USE HCO_STATE_MOD, ONLY : HCO_STATE USE HCO_CALC_MOD, ONLY : HCO_EvalFld ! @@ -1123,9 +1123,10 @@ SUBROUTINE HCO_CalcVertGrid ( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) ENDIF ENDIF - ! If Box height not available make sure it is not associated + ! If Box height isn't available, free its memory + ! NOTE: Using NULL instead of deallocate here causes a memory leak! IF ( .NOT. EVAL_BXHEIGHT .OR. .NOT. FoundBXHEIGHT ) THEN - HcoState%Grid%BXHEIGHT_M%Val => NULL() + CALL HCO_ArrCleanup( HcoState%Grid%BXHEIGHT_M, DeepClean=.TRUE. ) ENDIF ! ------------------------------------------------------------------ diff --git a/src/Core/hco_readlist_mod.F90 b/src/Core/hco_readlist_mod.F90 index eb1ffdf6..ccdb664e 100644 --- a/src/Core/hco_readlist_mod.F90 +++ b/src/Core/hco_readlist_mod.F90 @@ -698,34 +698,31 @@ SUBROUTINE ReadList_Init( ReadLists, RC ) !------------------------------------------------------------------------------ !BOC + CHARACTER(LEN=255) :: errMsg, thisLoc + ! ================================================================ ! ReadList_Init begins here ! ================================================================ - ! Allocate ReadList and all internal lists. Make sure all internal - ! lists are defined (nullified). - ALLOCATE ( ReadLists ) - - ALLOCATE ( ReadLists%Once ) - NULLIFY ( ReadLists%Once ) - - ALLOCATE ( ReadLists%Year ) - NULLIFY ( ReadLists%Year ) - - ALLOCATE ( ReadLists%Month ) - NULLIFY ( ReadLists%Month ) - - ALLOCATE ( ReadLists%Day ) - NULLIFY ( ReadLists%Day ) - - ALLOCATE ( ReadLists%Hour ) - NULLIFY ( ReadLists%Hour ) + ! Initialize + RC = HCO_SUCCESS - ALLOCATE ( ReadLists%Hour3 ) - NULLIFY ( ReadLists%Hour3 ) + ! Allocate the ReadLists object (which is really HcoState%ReadLists). + ALLOCATE( ReadLists, STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + errMsg = 'Could not allocate ReadLists (=> HcoState%ReadLists)!' + CALL HCO_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF - ALLOCATE ( ReadLists%Always ) - NULLIFY ( ReadLists%Always ) + ! Nullify pointer fields + ReadLists%Once => NULL() + ReadLists%Year => NULL() + ReadLists%Month => NULL() + ReadLists%Day => NULL() + ReadLists%Hour => NULL() + ReadLists%Hour3 => NULL() + ReadLists%Always => NULL() ! No file in buffer yet ReadLists%FileInArchive = '' diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F index 78fecf53..ef00eb87 100644 --- a/src/Extensions/hcox_dustdead_mod.F +++ b/src/Extensions/hcox_dustdead_mod.F @@ -98,7 +98,6 @@ MODULE HCOX_DUSTDEAD_MOD REAL(hp), POINTER :: MSS_FRC_CLY (:,:) => NULL() REAL(hp), POINTER :: MSS_FRC_SND (:,:) => NULL() REAL(hp), POINTER :: SFC_TYP (:,:) => NULL() - REAL(hp), POINTER :: VAI_DST(:,:) => NULL() ! Time-varying surface info from CTM @@ -748,27 +747,69 @@ SUBROUTINE HCOX_DustDead_Init ( HcoState, ExtName, ! Init module arrays !----------------------------------------------------------------- - ALLOCATE ( Inst%ERD_FCT_GEO ( HcoState%NX, HcoState%NY), - & Inst%SRCE_FUNC ( HcoState%NX, HcoState%NY), - & Inst%LND_FRC_DRY ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_CACO3 ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_CLY ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_SND ( HcoState%NX, HcoState%NY), - & Inst%SFC_TYP ( HcoState%NX, HcoState%NY), - & Inst%VAI_DST ( HcoState%NX, HcoState%NY), - & STAT=AS ) + ALLOCATE( Inst%ERD_FCT_GEO( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'Allocation error', RC ) - RETURN + msg = 'Could not allocate Inst%ERD_FCT_GEO!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN ENDIF - Inst%ERD_FCT_GEO = 0.0_hp - Inst%SRCE_FUNC = 0.0_hp - Inst%LND_FRC_DRY = 0.0_hp - Inst%MSS_FRC_CACO3 = 0.0_hp - Inst%MSS_FRC_CLY = 0.0_hp - Inst%MSS_FRC_SND = 0.0_hp - Inst%SFC_TYP = 0.0_hp - Inst%VAI_DST = 0.0_hp + Inst%ERD_FCT_GEO = 0.0_hp + + ALLOCATE( Inst%SRCE_FUNC( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SRCE_FUNC!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SRCE_FUNC = 0.0_hp + + ALLOCATE( Inst%LND_FRC_DRY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%LND_FRC_DRY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%LND_FRC_DRY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CACO3( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CACO3!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CACO3 = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CLY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CLY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CLY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_SND( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_SND!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_SND = 0.0_hp + + ALLOCATE( Inst%SFC_TYP( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SFC_TYP!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SFC_TYP = 0.0_hp + + ALLOCATE( Inst%VAI_DST( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%VAI_DST!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%VAI_DST = 0.0_hp ! ! Allocate arrays ! ALLOCATE( Inst%FLX_LW_DWN_SFC( I, J ), STAT=AS ) @@ -5690,6 +5731,11 @@ SUBROUTINE InstRemove ( Instance ) ENDIF Inst%MSS_FRC_CACO3 => NULL() + IF ( ASSOCIATED( Inst%MSS_FRC_CLY ) ) THEN + DEALLOCATE(Inst%MSS_FRC_CLY) + ENDIF + Inst%MSS_FRC_CLY => NULL() + IF ( ASSOCIATED( Inst%MSS_FRC_SND ) ) THEN DEALLOCATE(Inst%MSS_FRC_SND ) ENDIF diff --git a/src/Extensions/hcox_tomas_dustdead_mod.F b/src/Extensions/hcox_tomas_dustdead_mod.F index c1c9825c..cbd6e3e5 100644 --- a/src/Extensions/hcox_tomas_dustdead_mod.F +++ b/src/Extensions/hcox_tomas_dustdead_mod.F @@ -96,8 +96,7 @@ MODULE HCOX_TOMAS_DustDead_Mod REAL(hp), POINTER :: MSS_FRC_CLY (:,:) => NULL() REAL(hp), POINTER :: MSS_FRC_SND (:,:) => NULL() REAL(hp), POINTER :: SFC_TYP (:,:) => NULL() - - REAL(hp), POINTER :: VAI_DST(:,:) => NULL() + REAL(hp), POINTER :: VAI_DST (:,:) => NULL() ! Time-varying surface info from CTM ! REAL*8, ALLOCATABLE :: FLX_LW_DWN_SFC(:,:) @@ -729,27 +728,140 @@ SUBROUTINE HCOX_TOMAS_DustDead_Init( HcoState, ExtName, ExtState, ! Init module arrays !----------------------------------------------------------------- - ALLOCATE ( Inst%ERD_FCT_GEO ( HcoState%NX, HcoState%NY), - & Inst%SRCE_FUNC ( HcoState%NX, HcoState%NY), - & Inst%LND_FRC_DRY ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_CACO3 ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_CLY ( HcoState%NX, HcoState%NY), - & Inst%MSS_FRC_SND ( HcoState%NX, HcoState%NY), - & Inst%SFC_TYP ( HcoState%NX, HcoState%NY), - & Inst%VAI_DST ( HcoState%NX, HcoState%NY), - & STAT=AS ) + !----------------------------------------------------------------- + ! Init module arrays + !----------------------------------------------------------------- + + ALLOCATE( Inst%ERD_FCT_GEO( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'Allocation error', RC ) - RETURN + msg = 'Could not allocate Inst%ERD_FCT_GEO!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%ERD_FCT_GEO = 0.0_hp + + ALLOCATE( Inst%SRCE_FUNC( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SRCE_FUNC!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SRCE_FUNC = 0.0_hp + + ALLOCATE( Inst%LND_FRC_DRY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%LND_FRC_DRY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%LND_FRC_DRY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CACO3( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CACO3!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CACO3 = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CLY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CLY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CLY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_SND( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_SND!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN ENDIF - Inst%ERD_FCT_GEO = 0.0_hp - Inst%SRCE_FUNC = 0.0_hp - Inst%LND_FRC_DRY = 0.0_hp - Inst%MSS_FRC_CACO3 = 0.0_hp - Inst%MSS_FRC_CLY = 0.0_hp - Inst%MSS_FRC_SND = 0.0_hp - Inst%SFC_TYP = 0.0_hp - Inst%VAI_DST = 0.0_hp + Inst%MSS_FRC_SND = 0.0_hp + + ALLOCATE( Inst%SFC_TYP( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SFC_TYP!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SFC_TYP = 0.0_hp + + ALLOCATE( Inst%VAI_DST( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%VAI_DST!' + !----------------------------------------------------------------- + ! Init module arrays + !----------------------------------------------------------------- + + ALLOCATE( Inst%ERD_FCT_GEO( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%ERD_FCT_GEO!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%ERD_FCT_GEO = 0.0_hp + + ALLOCATE( Inst%SRCE_FUNC( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SRCE_FUNC!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SRCE_FUNC = 0.0_hp + + ALLOCATE( Inst%LND_FRC_DRY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%LND_FRC_DRY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%LND_FRC_DRY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CACO3( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CACO3!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CACO3 = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_CLY( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_CLY!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_CLY = 0.0_hp + + ALLOCATE( Inst%MSS_FRC_SND( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%MSS_FRC_SND!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%MSS_FRC_SND = 0.0_hp + + ALLOCATE( Inst%SFC_TYP( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%SFC_TYP!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%SFC_TYP = 0.0_hp + + ALLOCATE( Inst%VAI_DST( HcoState%NX, HcoState%NY), STAT=AS ) + IF ( AS /= 0 ) THEN + msg = 'Could not allocate Inst%VAI_DST!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%VAI_DST = 0.0_hp + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%VAI_DST = 0.0_hp ! ! Allocate arrays ! ALLOCATE( Inst%FLX_LW_DWN_SFC( I, J ), STAT=AS ) @@ -5702,6 +5814,11 @@ SUBROUTINE InstRemove ( Instance ) ENDIF Inst%MSS_FRC_CACO3 => NULL() + IF ( ASSOCIATED( Inst%MSS_FRC_CLY ) ) THEN + DEALLOCATE(Inst%MSS_FRC_CLY) + ENDIF + Inst%MSS_FRC_CLY => NULL() + IF ( ASSOCIATED( Inst%MSS_FRC_SND ) ) THEN DEALLOCATE(Inst%MSS_FRC_SND ) ENDIF diff --git a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 index 57a61b07..c1e3941b 100644 --- a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 +++ b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 @@ -538,13 +538,15 @@ SUBROUTINE HCOI_SA_Run( RC ) DYS(1), HRS(1), MNS(1), SCS(1), & IsEmisTime=.TRUE., RC=RC) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR ( 'ERROR 0', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in "HcoClock_Set"!' + CALL HCO_ERROR ( errMsg, RC, THISLOC=LOC ) + RETURN ENDIF ELSE CALL HcoClock_Increase ( HcoState, HcoState%TS_EMIS, .TRUE., RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR ( 'ERROR 1', RC, THISLOC=LOC ) + errMsg = 'Error encountered in "HcoClock_Increase"!' + CALL HCO_ERROR ( msg, RC, THISLOC=LOC ) ENDIF ENDIF @@ -1512,8 +1514,9 @@ SUBROUTINE Set_Grid( HcoState, RC ) HcoState%Grid%zGrid, NZ, RC=RC ) ENDIF IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in "HCO_VertGrid_Define"!' + CALL HCO_ERROR( errMsg, RC, THISLOC=LOC ) + RETURN ENDIF ! Set pointers to grid variables @@ -2150,8 +2153,9 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in "HCO_Enter"!' + CALL HCO_ERROR( errMsg, RC, THISLOC=LOC ) + RETURN ENDIF ! First call? @@ -2754,13 +2758,12 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ! quantities read from disk. !----------------------------------------------------------------- - - ! Attempt to calculate vertical grid quantities CALL HCO_CalcVertGrid( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in "Hco_CalcVertGrid"!' + CALL HCO_ERROR( errMsg, RC, thisLoc ) + RETURN ENDIF ! Reset pointers @@ -3029,8 +3032,9 @@ SUBROUTINE Init_Dry_Run( IsDryRun, RC ) ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) - RETURN + errMsg = 'Error encountered in "HCO_Enter"!' + CALL HCO_ERROR( errMsg, RC, THISLOC=LOC ) + RETURN ENDIF !======================================================================= @@ -3115,7 +3119,8 @@ SUBROUTINE Cleanup_Dry_Run( RC ) ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) + errMsg = 'Error encountered in "HCO_Enter"!' + CALL HCO_ERROR( errMsg, RC, THISLOC=LOC ) RETURN ENDIF