/[MITgcm]/MITgcm/pkg/diagnostics/diagnostics_add2list.F
ViewVC logotype

Contents of /MITgcm/pkg/diagnostics/diagnostics_add2list.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download)
Sat Jan 16 22:29:54 2010 UTC (14 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +1 -1 lines
FILE REMOVED
remove unused S/R (DIAGNOSTICS_ADDTOLIST replaces DIAGNOSTICS_ADD2LIST)

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_add2list.F,v 1.7 2010/01/12 05:37:50 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 message buffer
50 C diagMate :: diagnostic mate number
51 C errIO :: IO error flag
52 CHARACTER*(MAX_LEN_MBUF) msgBuf
53 CHARACTER*16 tempCode
54 INTEGER diagMate
55 INTEGER errIO
56
57 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
58
59 tempCode = diagCode
60 IF ( diagCode(6:8) .EQ. ' ' ) THEN
61 diagMate = 0
62 ELSEIF ( diagCode(5:5).EQ.'C' ) THEN
63 READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
64 IF ( errIO.NE.0 ) THEN
65 WRITE(msgBuf,'(6A)') 'DIAGNOSTICS_ADD2LIST: ',
66 & 'adding diagnostic: "',diagName,
67 & '" with diagcode="',diagCode,'"'
68 CALL PRINT_ERROR( msgBuf , myThid)
69 WRITE(msgBuf,'(A,I6,A)') 'DIAGNOSTICS_ADD2LIST: Error (=',
70 & errIO,') reading mate number from diagcode => STOP'
71 CALL PRINT_ERROR( msgBuf , myThid)
72 STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADD2LIST'
73 ELSE
74 tempCode(6:8) = ' '
75 ENDIF
76 ELSE
77 READ(diagCode(6:8),'(I3)',IOSTAT=errIO) diagMate
78 IF ( errIO.NE.0 ) THEN
79 WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
80 & 'mate number not readable from diagCode="',diagCode,'"'
81 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
82 & SQUEEZE_RIGHT , myThid)
83 WRITE(msgBuf,'(4A)') 'WARNING: DIAGNOSTICS_ADD2LIST: ',
84 & 'mate number of diag="',diagName,'" is reset to zero'
85 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
86 & SQUEEZE_RIGHT , myThid)
87 diagMate = 0
88 ELSE
89 tempCode(6:8) = ' '
90 ENDIF
91 ENDIF
92
93 CALL DIAGNOSTICS_ADDTOLIST (
94 O diagNum,
95 I diagName, tempCode, diagUnits, diagTitle, diagMate,
96 I myThid )
97
98 RETURN
99 END

  ViewVC Help
Powered by ViewVC 1.1.22