C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_add2list.F,v 1.4 2005/02/13 23:22:56 jmc Exp $
C $Name: $
#include "DIAG_OPTIONS.h"
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C !ROUTINE: DIAGNOSTICS_ADD2LIST
C !INTERFACE:
SUBROUTINE DIAGNOSTICS_ADD2LIST (
O diagNum,
I diagName, diagCode, diagUnits, diagTitle,
I myThid )
C !DESCRIPTION:
C routine to add 1 diagnostics to the list of available diagnostics:
C set the attributes:
C name (=cdiag), parsing code (=gdiag), units (=udiag), and title (=tdiag)
C of the new diagnostics and update the total number of available diagnostic
C Note: needs to be called after DIAGNOSTICS_INIT_EARLY
C and before DIAGNOSTICS_INIT_FIXED
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"
C !INPUT PARAMETERS:
CHARACTER*8 diagName
CHARACTER*16 diagCode
CHARACTER*16 diagUnits
CHARACTER*(*) diagTitle
INTEGER myThid
C !OUTPUT PARAMETERS:
C numDiag :: diagnostic number in the list of available diagnostics
INTEGER diagNum
CEOP
C !LOCAL VARIABLES:
C msgBuf :: Informational/error meesage buffer
CHARACTER*(MAX_LEN_MBUF) msgBuf
INTEGER n
C-- Search for "diagName" in the list of available diagnostics:
diagNum = 0
DO n=1,ndiagt
IF ( cdiag(n).EQ.diagName ) THEN
diagNum = n
_BEGIN_MASTER( myThid)
IF ( gdiag(n).EQ.diagCode ) THEN
C- diagnostics is already defined and has the same characteristics
WRITE(msgBuf,'(3A,I4,A)') 'DIAGNOSTICS_ADD2LIST: diag=',
& diagName,' is already defined (# ',n,' )'
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid)
WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADD2LIST:',
& ' with same parser => update Title & Units '
CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
& SQUEEZE_RIGHT , myThid)
udiag(diagNum) = diagUnits
tdiag(diagNum) = diagTitle
ELSE
C- diagnostics is already defined but with different characteristics
WRITE(msgBuf,'(3A,I4,A)') 'DIAGNOSTICS_ADD2LIST: diag=',
& diagName,' is already defined (# ',n,' )'
CALL PRINT_ERROR( msgBuf , myThid)
WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_ADD2LIST:',
& ' parser=',gdiag(n),'< cannot be changed'
CALL PRINT_ERROR( msgBuf , myThid)
WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_ADD2LIST:',
& ' to ->',diagCode,'< ; => STOP'
CALL PRINT_ERROR( msgBuf , myThid)
STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADD2LIST'
ENDIF
_END_MASTER( myThid )
ENDIF
ENDDO
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( diagNum.EQ.0 ) THEN
C-- Add one diagnostic to the list of available diagnostics:
diagNum = ndiagt + 1
_BEGIN_MASTER( myThid)
IF ( diagNum .LE. ndiagMax ) THEN
cdiag(diagNum) = diagName
gdiag(diagNum) = diagCode
udiag(diagNum) = diagUnits
tdiag(diagNum) = diagTitle
ndiagt = diagNum
ELSE
WRITE(msgBuf,'(2A,I4)') 'DIAGNOSTICS_ADD2LIST:',
& ' Exceed Max.Number of diagnostics ndiagMax=', ndiagMax
CALL PRINT_ERROR( msgBuf , myThid)
WRITE(msgBuf,'(2A)')
& 'DIAGNOSTICS_ADD2LIST: when setting diagnostic: ',diagName
CALL PRINT_ERROR( msgBuf , myThid)
STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADD2LIST'
ENDIF
_END_MASTER( myThid )
ENDIF
RETURN
END