pkg/diagnostics/diagnostics_add2list.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_add2list.F,v 1.5 2006/10/17 18:56:31 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     old version of this subroutine (new version= DIAGNOSTICS_ADDTOLIST)
C     the diagnostic-mate number, which is missing from the argument list,
C     is read from the parsing code before calling DIAGNOSTICS_ADDTOLIST ;
C     (see description of DIAGNOSTICS_ADDTOLIST for more details).
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:
C     diagName  :: diagnostic name to declare
C     diagCode  :: parser code for this diagnostic
C     diagUnits :: field units for this diagnostic
C     diagTitle :: field description for this diagnostic
C     myThid    :: my Thread Id number
      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
C     diagMate  :: diagnostic mate number
C     errIO     :: IO error flag
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER diagMate
      INTEGER errIO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      IF ( diagCode(6:8) .EQ. '   ' ) THEN
        diagMate = 0
      ELSEIF ( diagCode(5:5).EQ.'C' ) THEN
        READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
        IF ( errIO.NE.0 ) THEN
          WRITE(msgBuf,'(6A)') 'DIAGNOSTICS_ADD2LIST: ',
     &     'adding diagnostic: "',diagName,
     &     '" with diagcode="',diagCode,'"'
          CALL PRINT_ERROR( msgBuf , myThid)
          WRITE(msgBuf,'(A,I6,A)') 'DIAGNOSTICS_ADD2LIST: Error (=',
     &      errIO,') reading mate number from diagcode => STOP'
          CALL PRINT_ERROR( msgBuf , myThid)
          STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADD2LIST'
        ENDIF
      ELSE
        READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
        IF ( errIO.NE.0 ) THEN
          WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
     &    'mate number not readable from diagCode="',diagCode,'"'
          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                        SQUEEZE_RIGHT , myThid)
          WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
     &    'mate number of diag="',diagName,'" is reset to zero'
          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &                      SQUEEZE_RIGHT , myThid)
          diagMate = 0
        ENDIF
      ENDIF

      CALL DIAGNOSTICS_ADDTOLIST (
     O     diagNum,
     I     diagName, diagCode, diagUnits, diagTitle, diagMate,
     I     myThid )

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_add2list.F,v 1.5 2006/10/17 18:56:31 jmc Exp $
2	C $Name: $
3
4	#include "DIAG_OPTIONS.h"
5
6	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7	CBOP 0
8	C !ROUTINE: DIAGNOSTICS_ADD2LIST
9
10	C !INTERFACE:
11	SUBROUTINE DIAGNOSTICS_ADD2LIST (
12	O diagNum,
13	I diagName, diagCode, diagUnits, diagTitle,
14	I myThid )
15
16	C !DESCRIPTION:
17	C old version of this subroutine (new version= DIAGNOSTICS_ADDTOLIST)
18	C the diagnostic-mate number, which is missing from the argument list,
19	C is read from the parsing code before calling DIAGNOSTICS_ADDTOLIST ;
20	C (see description of DIAGNOSTICS_ADDTOLIST for more details).
21	C Note: needs to be called after DIAGNOSTICS_INIT_EARLY
22	C and before DIAGNOSTICS_INIT_FIXED
23
24	C !USES:
25	IMPLICIT NONE
26	#include "SIZE.h"
27	#include "EEPARAMS.h"
28	#include "DIAGNOSTICS_SIZE.h"
29	#include "DIAGNOSTICS.h"
30
31	C !INPUT PARAMETERS:
32	C diagName :: diagnostic name to declare
33	C diagCode :: parser code for this diagnostic
34	C diagUnits :: field units for this diagnostic
35	C diagTitle :: field description for this diagnostic
36	C myThid :: my Thread Id number
37	CHARACTER*8 diagName
38	CHARACTER*16 diagCode
39	CHARACTER*16 diagUnits
40	CHARACTER() diagTitle
41	INTEGER myThid
42
43	C !OUTPUT PARAMETERS:
44	C numDiag :: diagnostic number in the list of available diagnostics
45	INTEGER diagNum
46	CEOP
47
48	C !LOCAL VARIABLES:
49	C msgBuf :: Informational/error meesage buffer
50	C diagMate :: diagnostic mate number
51	C errIO :: IO error flag
52	CHARACTER*(MAX_LEN_MBUF) msgBuf
53	INTEGER diagMate
54	INTEGER errIO
55
56	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
57
58	IF ( diagCode(6:8) .EQ. ' ' ) THEN
59	diagMate = 0
60	ELSEIF ( diagCode(5:5).EQ.'C' ) THEN
61	READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
62	IF ( errIO.NE.0 ) THEN
63	WRITE(msgBuf,'(6A)') 'DIAGNOSTICS_ADD2LIST: ',
64	& 'adding diagnostic: "',diagName,
65	& '" with diagcode="',diagCode,'"'
66	CALL PRINT_ERROR( msgBuf , myThid)
67	WRITE(msgBuf,'(A,I6,A)') 'DIAGNOSTICS_ADD2LIST: Error (=',
68	& errIO,') reading mate number from diagcode => STOP'
69	CALL PRINT_ERROR( msgBuf , myThid)
70	STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADD2LIST'
71	ENDIF
72	ELSE
73	READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
74	IF ( errIO.NE.0 ) THEN
75	WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
76	& 'mate number not readable from diagCode="',diagCode,'"'
77	CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
78	& SQUEEZE_RIGHT , myThid)
79	WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
80	& 'mate number of diag="',diagName,'" is reset to zero'
81	CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
82	& SQUEEZE_RIGHT , myThid)
83	diagMate = 0
84	ENDIF
85	ENDIF
86
87	CALL DIAGNOSTICS_ADDTOLIST (
88	O diagNum,
89	I diagName, diagCode, diagUnits, diagTitle, diagMate,
90	I myThid )
91
92	RETURN
93	END