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

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

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

Revision 1.3 - (show annotations) (download)
Fri Jan 15 00:25:58 2010 UTC (14 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint63, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x
Changes since 1.2: +19 -1 lines 
- add optional level number diagnostics (i.e., level number to be define
  explictly with S/R DIAGNOSTICS_SETKLEV) with parser-code(10)="X".
- strictly check for valid parser-code(10) ;
- check if adding diag to the list from the right place.
1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_addtolist.F,v 1.2 2010/01/12 05:28:47 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_ADDTOLIST
9
10 C !INTERFACE:
11 SUBROUTINE DIAGNOSTICS_ADDTOLIST (
12 O diagNum,
13 I diagName, diagCode, diagUnits, diagTitle, diagMate,
14 I myThid )
15
16 C !DESCRIPTION:
17 C routine to add 1 diagnostics to the list of available diagnostics:
18 C set the attributes:
19 C name (=cdiag), parsing code (=gdiag), units (=udiag), title (=tdiag)
20 C and diagnostic mate number (=hdiag) of the new diagnostic and
21 C update the total number of available diagnostics
22 C Note: needs to be called after DIAGNOSTICS_INIT_EARLY
23 C and before DIAGNOSTICS_INIT_FIXED
24
25 C !USES:
26 IMPLICIT NONE
27 #include "SIZE.h"
28 #include "EEPARAMS.h"
29 #include "DIAGNOSTICS_SIZE.h"
30 #include "DIAGNOSTICS.h"
31
32 C !INPUT PARAMETERS:
33 C diagName :: diagnostic name to declare
34 C diagCode :: parser code for this diagnostic
35 C diagUnits :: field units for this diagnostic
36 C diagTitle :: field description for this diagnostic
37 C diagMate :: diagnostic mate number
38 C myThid :: my Thread Id number
39 CHARACTER*8 diagName
40 CHARACTER*16 diagCode
41 CHARACTER*16 diagUnits
42 CHARACTER*(*) diagTitle
43 INTEGER diagMate
44 INTEGER myThid
45
46 C !OUTPUT PARAMETERS:
47 C numDiag :: diagnostic number in the list of available diagnostics
48 INTEGER diagNum
49 CEOP
50
51 C !LOCAL VARIABLES:
52 C msgBuf :: Informational/error message buffer
53 CHARACTER*(MAX_LEN_MBUF) msgBuf
54 INTEGER n
55
56 C-- Initialise
57 diagNum = 0
58
59 _BEGIN_MASTER( myThid)
60
61 C-- Check if this S/R is called from the right place ;
62 C needs to be after DIAGNOSTICS_INIT_EARLY and before DIAGNOSTICS_INIT_FIXED
63 IF ( .NOT.settingDiags ) THEN
64 WRITE(msgBuf,'(6A)') 'DIAGNOSTICS_ADDTOLIST: ',
65 & 'diagName="', diagName, '", diagCode="',diagCode(1:10),'"'
66 CALL PRINT_ERROR( msgBuf, myThid )
67 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADDTOLIST: ',
68 & '<== called from the WRONG place, i.e.'
69 CALL PRINT_ERROR( msgBuf, myThid )
70 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADDTOLIST: ',
71 & 'outside diagnostics setting section = from'
72 CALL PRINT_ERROR( msgBuf, myThid )
73 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADDTOLIST: ',
74 & ' Diag_INIT_EARLY down to Diag_INIT_FIXED'
75 CALL PRINT_ERROR( msgBuf, myThid )
76 STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADDTOLIST'
77 ENDIF
78
79 C-- Search for "diagName" in the list of available diagnostics:
80 DO n=1,ndiagt
81 IF ( cdiag(n).EQ.diagName ) THEN
82 diagNum = n
83 IF ( gdiag(n).EQ.diagCode .AND. hdiag(n).EQ.diagMate ) THEN
84 C- diagnostics is already defined and has the same characteristics
85 WRITE(msgBuf,'(3A,I6,A)') 'DIAGNOSTICS_ADDTOLIST: diag=',
86 & diagName,' is already defined (# ',n,' )'
87 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
88 & SQUEEZE_RIGHT , myThid)
89 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_ADDTOLIST:',
90 & ' with same parser => update Title & Units '
91 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
92 & SQUEEZE_RIGHT , myThid)
93 udiag(diagNum) = diagUnits
94 tdiag(diagNum) = diagTitle
95 ELSE
96 C- diagnostics is already defined but with different characteristics
97 WRITE(msgBuf,'(3A,I6,A)') 'DIAGNOSTICS_ADDTOLIST: diag=',
98 & diagName,' is already defined (# ',n,' )'
99 CALL PRINT_ERROR( msgBuf , myThid)
100 WRITE(msgBuf,'(4A,I6)') 'DIAGNOSTICS_ADDTOLIST: cannot ',
101 & 'change parser="',gdiag(n),'" & mate=',hdiag(n)
102 CALL PRINT_ERROR( msgBuf , myThid)
103 WRITE(msgBuf,'(4A,I6,A)') 'DIAGNOSTICS_ADDTOLIST:',
104 & ' to : "',diagCode,'" and mate=',diagMate,' ; => STOP'
105 CALL PRINT_ERROR( msgBuf , myThid)
106 STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADDTOLIST'
107 ENDIF
108 ENDIF
109 ENDDO
110
111 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
112
113 IF ( diagNum.EQ.0 ) THEN
114 C-- Add one diagnostic to the list of available diagnostics:
115 diagNum = ndiagt + 1
116
117 IF ( diagNum .LE. ndiagMax ) THEN
118 cdiag(diagNum) = diagName
119 gdiag(diagNum) = diagCode
120 hdiag(diagNum) = diagMate
121 udiag(diagNum) = diagUnits
122 tdiag(diagNum) = diagTitle
123 ndiagt = diagNum
124 ELSE
125 WRITE(msgBuf,'(2A,I6)') 'DIAGNOSTICS_ADDTOLIST:',
126 & ' Exceed Max.Number of diagnostics ndiagMax=', ndiagMax
127 CALL PRINT_ERROR( msgBuf , myThid)
128 WRITE(msgBuf,'(2A)')
129 & 'DIAGNOSTICS_ADDTOLIST: when setting diagnostic: ',diagName
130 CALL PRINT_ERROR( msgBuf , myThid)
131 STOP 'ABNORMAL END: S/R DIAGNOSTICS_ADDTOLIST'
132 ENDIF
133
134 ENDIF
135
136 _END_MASTER( myThid )
137
138 RETURN
139 END
  ViewVC Help
Powered by ViewVC 1.1.22