C $Header: /u/gcmpack/MITgcm/pkg/cal/cal_printerror.F,v 1.8 2016/02/18 20:30:39 heimbach Exp $
C $Name: $
#include "CAL_OPTIONS.h"
subroutine CAL_PRINTERROR(
I calerr,
I mythid
& )
c ==================================================================
c SUBROUTINE cal_PrintError
c ==================================================================
c
c Purpose: Use the MITgcmuvs print routines to document errors that
c occured during the execution of the calendar tool.
c
c o Calling this routine allows to print out an error message for
c several errors that might occur.
c
c The error codes for the calendar tool are specified by a four
c digit integer:
c RRCC
c
c The RR digits identify the routine that detected the error.
c The CC digits identify the specific error in the routine that
c detected the error.
c
c RR translates to routines in the following way:
c
c cal_Init 0
c cal_Set 1
c cal_GetDate 2
c cal_FullDate 3
c cal_IsLeap 4
c cal_TimePassed 5
c cal_AddTime 6
c cal_TimeInterval 7
c cal_SubDates 8
c cal_ConvDate 9
c cal_ToSeconds 10
c cal_StepsPerDay 11
c cal_DaysPerMonth 12
c cal_MonthsPerYear 13
c cal_IntYears 14
c cal_IntMonths 15
c cal_IntDays 16
c cal_nStepDay 17
c cal_CheckDate 18
c cal_PrintError 19
c cal_PrintDate 20
c cal_NumInts 25
c
c
c started: Christian Eckert eckert@mit.edu 30-Jun-1999
c
c changed: Christian Eckert eckert@mit.edu 29-Dec-1999
c
c Christian Eckert eckert@mit.edu 10-Jan-2000
c
c - Corrected the print statement for error code 104.
c It contained more than 72 characters in one line.
c
c Christian Eckert eckert@mit.edu 03-Feb-2000
c
c - Introduced new routine and function names, cal_,
c for verion 0.1.3.
c
c Christian Eckert eckert@mit.edu 24-Feb-2000
c
c - Included cal_NumInts error code.
c
c ==================================================================
c SUBROUTINE cal_PrintError
c ==================================================================
implicit none
C == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
C == routine arguments ==
C mythid - thread number for this instance of the routine.
C calerr - error code
integer mythid
integer calerr
C == local variables ==
integer nroutine
integer nerrcode
logical missingerrcode
CHARACTER*(MAX_LEN_MBUF) msgBuf
C == end of interface ==
nerrcode = mod(calerr,100)
nroutine = (calerr - nerrcode)/100
missingerrcode = .false.
c if (nroutine .eq. 0) then
C Error in cal_Init
c if (nerrcode .eq. 1) then
c WRITE(msgBuf,'(A)')
c & ' cal_Init: Unable to open calendar parameter file'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c WRITE(msgBuf,'(A)')
c & ' file "data.calendar".'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c endif
c else if (nroutine .eq. 1) then
if (nroutine .eq. 1) then
C Error in cal_Set
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_Set: No appropriate calendar has been specified.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 2) then
WRITE(msgBuf,'(A)')
& ' cal_Set: The time step specified is not valid.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 3) then
WRITE(msgBuf,'(A)')
& ' cal_Set: The time step is less than a second.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 4) then
WRITE(msgBuf,'(A)')
& ' cal_Set: The time step contains fractions of a second.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
c else if (nerrcode .eq. 5) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: Less than one time step per calendar day.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if (nerrcode .eq. 6) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: The specifications are incomplete. Please'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c WRITE(msgBuf,'(A)')
c & ' refer to the documentation.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if (nerrcode .eq. 7) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: The final date of integration is before its'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c WRITE(msgBuf,'(A)')
c & ' start date.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if (nerrcode .eq. 10) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: The Julian Calendar is not implemented yet.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if (nerrcode .eq. 11) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: The No Calendar case is not implemented yet.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if ( nerrcode .eq. 12) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modelstart .ne. startTime ... please check.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if ( nerrcode .eq. 13 ) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modelend .ne. endTime ... please check.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if ( nerrcode .eq. 14 ) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modelstep .ne. deltaTclock ... please check.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if ( nerrcode .eq. 15 ) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modeliter0 .ne. nIter0 ... please check.'
c else if ( nerrcode .eq. 16 ) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modeliterend .ne. nEndIter ... please check.'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
c else if ( nerrcode .eq. 17 ) then
c WRITE(msgBuf,'(A)')
c & ' cal_Set: modelintsteps .ne. nTimeSteps'
c CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
c CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 2) then
C Error in cal_GetDate
missingerrcode = .true.
else if (nroutine .eq. 3) then
C Error in cal_FullDate
missingerrcode = .true.
else if (nroutine .eq. 4) then
C Error in cal_IsLeap
missingerrcode = .true.
else if (nroutine .eq. 5) then
C Error in cal_TimePassed
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& 'cal_TimePassed: cal and timeinterval cannot be compared'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 6) then
C Error in cal_AddTime
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_AddTime: not a valid time interval.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 7) then
C Error in cal_TimeInterval
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_TimeInterval: not a valid time unit.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 8) then
C Error in cal_SubDates
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_SubDates: Not a valid combination of calendar dates'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
WRITE(msgBuf,'(A)')
& ' or time intervals.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 9) then
C Error in cal_ConvDate
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_ConvDate: date specification has mixed signs.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 10) then
C Error in cal_ToSeconds
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_ToSeconds: input not a time interval array.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 11) then
C Error in cal_StepsPerDay
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_StepsPerDay: nothing else to do.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 12) then
C Error in cal_DaysPerMonth
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_DaysPerMonth: current year after final year.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 13) then
C Error in cal_MonthsPerYear
missingerrcode = .true.
else if (nroutine .eq. 14) then
C Error in cal_IntYears
missingerrcode = .true.
else if (nroutine .eq. 15) then
C Error in cal_IntMonths
missingerrcode = .true.
else if (nroutine .eq. 16) then
C Error in cal_IntDays
missingerrcode = .true.
else if (nroutine .eq. 17) then
C Error in cal_nStepDay
missingerrcode = .true.
else if (nroutine .eq. 18) then
C Error in cal_CheckDate
if (nerrcode .eq. 0) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: A valid date specification!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
WRITE(msgBuf,'(A)')
& ' This only means that the format is ok'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Last component of array not valid!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 2) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Third component of interval array not 0'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 3) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Signs of first two components unequal!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 4) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Second component not in hhmmss format!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 5) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Weekday indentifier not correct!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 6) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: Leap year identifier not correct!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 7) then
WRITE(msgBuf,'(A)')
& 'cal_CheckDate: Calendar date before predef. reference date'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else if (nerrcode .eq. 8) then
WRITE(msgBuf,'(A)')
& ' cal_CheckDate: First component not in yymmdd format!'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 19) then
C Error in cal_PrintError
missingerrcode = .true.
else if (nroutine .eq. 20) then
C Error in cal_PrintDate
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_PrintDate: date not a legal calendar array.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else if (nroutine .eq. 21) then
C Error in cal_PrintError
missingerrcode = .true.
else if (nroutine .eq. 25) then
C Error in cal_NumInts
if (nerrcode .eq. 1) then
WRITE(msgBuf,'(A)')
& ' cal_NumInts: Expected a time interval as third argument.'
CALL PRINT_MESSAGE(msgBuf,standardMessageUnit,SQUEEZE_RIGHT,1)
CALL PRINT_ERROR( msgBuf , 1)
else
missingerrcode = .true.
endif
else
missingerrcode = .true.
endif
if (missingerrcode) then
print*,' cal_PrintError: routine called by an undefined'
print*,' error code.'
print*,' cal_PrintError: error code = ',calerr
stop ' stopped in cal_PrintError.'
endif
return
end