Skip to content

Commit

Permalink
Merge pull request #111 from geoschem/feature/make_error_handling_rob…
Browse files Browse the repository at this point in the history 
…ust_for_mpi

Make error handling robust for mpi
  • Loading branch information
@lizziel
lizziel committed Sep 30, 2021
2 parents a461211 + 729142e commit 2e5b703
Show file tree
Hide file tree
Showing 48 changed files with 945 additions and 923 deletions.
68 changes: 34 additions & 34 deletions src/Core/hco_calc_mod.F90
View file
Expand Up @@ -503,7 +503,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC )
! Cannot use temporary array for more than one species!
IF ( nnSpec > 1 ) THEN
MSG = 'Cannot fill buffer for more than one species!'
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand All @@ -512,14 +512,14 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC )
OutArr => HcoState%Buffer3D%Val
IF ( .NOT. ASSOCIATED( OutArr ) ) THEN
MSG = 'Buffer array is not associated'
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF
IF ( (SIZE(OutArr,1) /= nI) .OR. &
(SIZE(OutArr,2) /= nJ) .OR. &
(SIZE(OutArr,3) /= nL) ) THEN
MSG = 'Buffer array has wrong dimension!'
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -582,7 +582,7 @@ SUBROUTINE HCO_CalcEmis( HcoState, UseConc, RC )
ELSE
MSG = 'Negative emissions in: '// TRIM(Dct%cName) // '. ' // &
'To allow negatives, edit settings in the configuration file.'
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF
ENDIF
Expand Down Expand Up @@ -833,7 +833,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
! Check if container contains data
IF ( .NOT. FileData_ArrIsDefined(BaseDct%Dta) ) THEN
MSG = 'Array not defined: ' // TRIM(BaseDct%cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand All @@ -850,7 +850,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
! Put check for PBLHEIGHT here (bmy, 3/4/21)
IF ( .NOT. ASSOCIATED(HcoState%Grid%PBLHEIGHT%Val) ) THEN
MSG = 'PBLHEIGHT (in meters) is missing in HEMCO state'
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

Expand Down Expand Up @@ -891,7 +891,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 ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RC = HCO_FAIL
RETURN
ENDIF
Expand All @@ -902,7 +902,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 ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF
ENDIF
Expand All @@ -912,7 +912,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
LevDct2_Unit == HCO_EMISL_M ) THEN
IF ( .NOT. ASSOCIATED(HcoState%Grid%BXHEIGHT_M%Val) ) THEN
MSG = 'Boxheight (in meters) is missing in HEMCO state'
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF
ENDIF
Expand All @@ -922,7 +922,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
LevDct2_Unit == HCO_EMISL_PBL ) THEN
IF ( .NOT. ASSOCIATED(HcoState%Grid%PBLHEIGHT%Val) ) THEN
MSG = 'Boundary layer height is missing in HEMCO state'
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF
ENDIF
Expand Down Expand Up @@ -1028,7 +1028,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &

! Check for error
IF ( ERROR == 1 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand All @@ -1053,7 +1053,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
! 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( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -1094,7 +1094,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
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( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF
ENDIF
Expand Down Expand Up @@ -1308,7 +1308,7 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, &
MSG = 'Error when applying scale factor: ' // TRIM(ScalDct%cName)
ENDIF
ScalDct => NULL()
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -1429,7 +1429,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, &
! Check if field data is defined
IF ( .NOT. FileData_ArrIsDefined(BaseDct%Dta) ) THEN
MSG = 'Array not defined: ' // TRIM(BaseDct%cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -1567,7 +1567,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, &
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( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
ERROR = 5
EXIT
ENDIF
Expand Down Expand Up @@ -1699,7 +1699,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, &
! Return w/ error otherwise (Oper 3 only allowed for masks!)
ELSE
MSG = 'Illegal data operator: ' // TRIM(ScalDct%cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
ERROR = 2
EXIT
ENDIF
Expand Down Expand Up @@ -1734,7 +1734,7 @@ SUBROUTINE Get_Current_Emissions_B( HcoState, BaseDct, &
ELSE
MSG = 'Error when applying scale factor: ' // TRIM(ScalDct%cName)
ENDIF
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
ScalDct => NULL()
RETURN
ENDIF
Expand Down Expand Up @@ -1832,7 +1832,7 @@ SUBROUTINE HCO_EvalFld_3D( HcoState, cName, Arr3D, RC, FOUND )
RETURN
ELSE
MSG = 'Cannot find in EmisList: ' // TRIM(cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
RETURN
ENDIF
ENDIF
Expand All @@ -1848,14 +1848,14 @@ SUBROUTINE HCO_EvalFld_3D( HcoState, cName, Arr3D, RC, FOUND )
! Sanity check: horizontal grid dimensions are expected to be on HEMCO grid
IF ( nI /= HcoState%NX .OR. nJ /= HcoState%nY ) THEN
WRITE(MSG,*) "Horizontal dimension error: ", TRIM(cName), nI, nJ
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

! Make sure mask array is defined
ALLOCATE(MASK(nI,nJ,nL),STAT=AS)
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'Cannot allocate MASK', RC, THISLOC=LOC )
CALL HCO_ERROR( 'Cannot allocate MASK', RC, THISLOC=LOC )
RETURN
ENDIF

Expand Down Expand Up @@ -1953,7 +1953,7 @@ SUBROUTINE HCO_EvalFld_2D( HcoState, cName, Arr2D, RC, FOUND )
RETURN
ELSE
MSG = 'Cannot find in EmisList: ' // TRIM(cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
RETURN
ENDIF
ENDIF
Expand All @@ -1969,14 +1969,14 @@ SUBROUTINE HCO_EvalFld_2D( HcoState, cName, Arr2D, RC, FOUND )
! Sanity check: horizontal grid dimensions are expected to be on HEMCO grid
IF ( nI /= HcoState%NX .OR. nJ /= HcoState%nY ) THEN
WRITE(MSG,*) "Horizontal dimension error: ", TRIM(cName), nI, nJ
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

! Make sure mask array is defined
ALLOCATE(MASK(nI,nJ,nL),Arr3D(nI,nJ,nL),STAT=AS)
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'Cannot allocate MASK', RC, THISLOC=LOC )
CALL HCO_ERROR( 'Cannot allocate MASK', RC, THISLOC=LOC )
RETURN
ENDIF
Arr3D = 0.0_hp
Expand Down Expand Up @@ -2165,7 +2165,7 @@ SUBROUTINE HCO_MaskFld ( HcoState, MaskName, Mask, RC, FOUND )
CALL HCO_MSG(HcoState%Config%Err,MSG)
MSG = '5000 TESTMASK -140/10/-40/90 - - - xy 1 1 -140/10/-40/90 yes'
CALL HCO_MSG(HcoState%Config%Err,MSG)
CALL HCO_ERROR ( HcoState%Config%Err, &
CALL HCO_ERROR ( &
'Error reading mask '//TRIM(MaskName), RC, THISLOC=LOC )
RETURN
ENDIF
Expand All @@ -2181,7 +2181,7 @@ SUBROUTINE HCO_MaskFld ( HcoState, MaskName, Mask, RC, FOUND )
IF ( SIZE(MASK,1) /= HcoState%NX .OR. SIZE(MASK,2) /= HcoState%NY ) THEN
WRITE(MSG,*) 'Input mask array has wrong dimensions. Must be ', &
HcoState%NX, HcoState%NY, ' but found ', SIZE(MASK,1), SIZE(MASK,2)
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

Expand All @@ -2203,7 +2203,7 @@ SUBROUTINE HCO_MaskFld ( HcoState, MaskName, Mask, RC, FOUND )
! Error check
IF ( ERR ) THEN
MSG = 'Error in GetMaskVal'
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

Expand Down Expand Up @@ -2554,7 +2554,7 @@ SUBROUTINE GetIdx( HcoState, I, J, alt, altu, lidx, RC )

ELSE
MSG = 'Illegal altitude unit'
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

Expand Down Expand Up @@ -2684,7 +2684,7 @@ SUBROUTINE GetDilFact( HcoState, EmisL1, EmisL1Unit, EmisL2, &
DilFact = dh / ( h2 - h1 )
ELSE
MSG = 'GetDilFact h2 not greater than h1'
CALL HCO_ERROR ( HcoState%Config%Err, MSG, RC, THISLOC=LOC )
CALL HCO_ERROR ( MSG, RC, THISLOC=LOC )
RETURN
ENDIF

Expand Down Expand Up @@ -2809,7 +2809,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, &
! Check if container contains data
IF ( .NOT. FileData_ArrIsDefined(BaseDct%Dta) ) THEN
MSG = 'Array not defined: ' // TRIM(BaseDct%cName)
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -2935,7 +2935,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, &

! Check for error
IF ( ERROR == 1 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand All @@ -2960,7 +2960,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, &
! 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( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -3001,7 +3001,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, &
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( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF
ENDIF
Expand Down Expand Up @@ -3207,7 +3207,7 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, &
MSG = 'Error when applying scale factor: ' // TRIM(ScalDct%cName)
ENDIF
ScalDct => NULL()
CALL HCO_ERROR( HcoState%Config%Err, MSG, RC )
CALL HCO_ERROR( MSG, RC )
RETURN
ENDIF

Expand Down
22 changes: 11 additions & 11 deletions src/Core/hco_clock_mod.F90
View file
Expand Up @@ -212,35 +212,35 @@ SUBROUTINE HcoClock_Init ( HcoState, RC )

ALLOCATE ( HcoState%Clock%ThisLocYear(HcoState%Clock%ntz), STAT=AS )
IF ( AS /= 0 ) THEN
CALL HCO_ERROR ( HcoState%Config%Err, 'ThisLocYear', RC )
CALL HCO_ERROR ( 'ThisLocYear', RC )
RETURN
ENDIF
HcoState%Clock%ThisLocYear(:) = -1

ALLOCATE ( HcoState%Clock%ThisLocMonth(HcoState%Clock%ntz), STAT=AS )
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'ThisLocMonth', RC )
CALL HCO_ERROR( 'ThisLocMonth', RC )
RETURN
ENDIF
HcoState%Clock%ThisLocMonth(:) = -1

ALLOCATE ( HcoState%Clock%ThisLocDay(HcoState%Clock%ntz), STAT=AS )
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'ThisLocDay', RC )
CALL HCO_ERROR( 'ThisLocDay', RC )
RETURN
ENDIF
HcoState%Clock%ThisLocDay(:) = -1

ALLOCATE ( HcoState%Clock%ThisLocWD(HcoState%Clock%ntz), STAT=AS )
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'ThisLocWD', RC )
CALL HCO_ERROR( 'ThisLocWD', RC )
RETURN
ENDIF
HcoState%Clock%ThisLocWD(:) = -1

ALLOCATE ( HcoState%Clock%ThisLocHour(HcoState%Clock%ntz), STAT=AS )
IF ( AS /= 0 ) THEN
CALL HCO_ERROR( HcoState%Config%Err, 'ThisLocHour', RC )
CALL HCO_ERROR( 'ThisLocHour', RC )
RETURN
ENDIF
HcoState%Clock%ThisLocHour(:) = -1.0_sp
Expand Down Expand Up @@ -410,7 +410,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
FOUND=FND, RC=RC )
IF ( RC /= HCO_SUCCESS ) THEN
ErrMsg = 'Error getting emission year'
CALL HCO_Error( HcoState%Config%Err, ErrMsg, RC )
CALL HCO_Error( ErrMsg, RC )
RETURN
ENDIF
IF ( FND ) THEN
Expand All @@ -423,7 +423,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
FOUND=FND, RC=RC )
IF ( RC /= HCO_SUCCESS ) THEN
ErrMsg = 'Error getting emission month'
CALL HCO_Error( HcoState%Config%Err, ErrMsg, RC )
CALL HCO_Error( ErrMsg, RC )
RETURN
ENDIF

Expand All @@ -437,7 +437,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
FOUND=FND, RC=RC )
IF ( RC /= HCO_SUCCESS ) THEN
ErrMsg = 'Error getting emission day'
CALL HCO_Error( HcoState%Config%Err, ErrMsg, RC )
CALL HCO_Error( ErrMsg, RC )
RETURN
ENDIF

Expand All @@ -451,7 +451,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
FOUND=FND, RC=RC )
IF ( RC /= HCO_SUCCESS ) THEN
ErrMsg = 'Error getting emission hour'
CALL HCO_Error( HcoState%Config%Err, ErrMsg, RC )
CALL HCO_Error( ErrMsg, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -540,7 +540,7 @@ SUBROUTINE HcoClock_Set ( HcoState, cYr, cMt, cDy, cHr, &
CALL Set_LocalTime ( HcoState, Clock, UTC, RC )
IF ( RC /= HCO_SUCCESS ) THEN
ErrMsg = 'Error setting local time'
CALL HCO_Error( HcoState%Config%Err, ErrMsg, RC )
CALL HCO_Error( ErrMsg, RC )
RETURN
ENDIF

Expand Down Expand Up @@ -922,7 +922,7 @@ SUBROUTINE HcoClock_GetLocal ( HcoState, I, J, cYYYY, cMM, &

! Check time zone index
IF ( IX > HcoState%Clock%ntz ) THEN
CALL HCO_ERROR ( HcoState%Config%Err, 'time zone index too large!', RC )
CALL HCO_ERROR ( 'time zone index too large!', RC )
RETURN
ENDIF

Expand Down

0 comments on commit 2e5b703

Please sign in to comment.