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

Annotation of /MITgcm/pkg/diagnostics/diagstats_setdiag.F

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

Revision 1.4 - (hide annotations) (download)
Wed Jun 15 13:44:42 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, 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, checkpoint65, checkpoint63, checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e, checkpoint62z, HEAD
Changes since 1.3: +5 -7 lines 
- turn a warning (in STDERR) to just a simple "-NOTE-" (in STDOUT)
- always check counter diagnostics: a) does not hurt if already set
   b) needed even if current diag was already set but was added as a mate (no output);
    in this case, it's counter mate is needed but has not yet been set.
1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_setdiag.F,v 1.3 2008/02/05 15:13:01 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "DIAG_OPTIONS.h"
5    
6     CBOP
7     C !ROUTINE: DIAGSTATS_SETDIAG
8     C !INTERFACE:
9 jmc 1.2 SUBROUTINE DIAGSTATS_SETDIAG(
10 jmc 1.1 O mate,
11 jmc 1.2 U ndiagmx,
12     I mId, listId, ndId, myThid )
13 jmc 1.1
14     C !DESCRIPTION: \bv
15     C *==================================================================
16     C | S/R DIAGSTATS_SETDIAG
17 jmc 1.2 C | o activate statistics diagnostic "ndId":
18 jmc 1.1 C | set pointer locations for this diagnostic ;
19     C | look for a counter mate and set it
20     C *==================================================================
21     C \ev
22    
23     C !USES:
24     IMPLICIT NONE
25    
26     C == Global variables ===
27     #include "EEPARAMS.h"
28     #include "SIZE.h"
29     #include "DIAGNOSTICS_SIZE.h"
30     #include "DIAGNOSTICS.h"
31    
32     C !INPUT/OUTPUT PARAMETERS:
33     C == Routine arguments ==
34 jmc 1.2 C mate :: counter-mate number in available diagnostics list
35     C ndiagmx :: current space allocated in storage array
36     C mId :: current field index in list "listId"
37     C listId :: current list number that contains field "mId"
38     C ndId :: diagnostic number in available diagnostics list
39     C myThid :: Thread number for this instance of the routine.
40 jmc 1.1 INTEGER mate
41     INTEGER ndiagmx
42 jmc 1.2 INTEGER mId, listId, ndId
43 jmc 1.1 INTEGER myThid
44     CEOP
45    
46     C !LOCAL VARIABLES:
47     C == Local variables ==
48     INTEGER stdUnit, errUnit
49 jmc 1.2 INTEGER k, l
50     LOGICAL flag
51 jmc 1.1
52 jmc 1.3 CHARACTER*10 gcode
53 jmc 1.1 CHARACTER*(MAX_LEN_MBUF) msgBuf
54    
55    
56     C **********************************************************************
57 jmc 1.3 C **** SET POINTERS FOR DIAGNOSTIC ndId ****
58 jmc 1.1 C **********************************************************************
59    
60 jmc 1.3 gcode = gdiag(ndId)(1:8)
61 jmc 1.1 stdUnit = standardMessageUnit
62     errUnit = errorMessageUnit
63    
64 jmc 1.2 C-- Seach for the same diag (with same freq) to see if already set
65     flag = .TRUE.
66     DO l=1,listId
67     IF (flag .AND. diagSt_freq(l) .EQ. diagSt_freq(listId)
68     & .AND. diagSt_phase(l).EQ.diagSt_phase(listId) ) THEN
69     DO k=1,MIN(diagSt_nbActv(l),numperlist)
70     IF (flag .AND. jSdiag(k,l).GT.0) THEN
71     IF (cdiag(ndId).EQ.cdiag(jSdiag(k,l)) ) THEN
72     C- diagnostics already set ; use the same slot:
73     flag = .FALSE.
74     iSdiag(mId,listId) = -ABS(iSdiag(k,l))
75     mSdiag(mId,listId) = mSdiag(k,l)
76     ENDIF
77     ENDIF
78     ENDDO
79     ENDIF
80     ENDDO
81    
82     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83    
84     IF ( flag ) THEN
85     IF (ndiagmx+kdiag(ndId).GT.diagSt_size) THEN
86 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,A)')
87 jmc 1.2 & 'SETDIAG: Not enough space for Stats-Diag #',ndId,cdiag(ndId)
88 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
89     ELSE
90 jmc 1.3 WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
91 jmc 1.2 & kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)
92 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
93     ENDIF
94 jmc 1.2 iSdiag(mId,listId) = ndiagmx + 1
95     ndiagmx = ndiagmx + kdiag(ndId)
96 jmc 1.1 ELSE
97 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,2A)')
98 jmc 1.4 & '- NOTE - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
99 jmc 1.1 & ' has already been set'
100 jmc 1.4 CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
101 jmc 1.1 ENDIF
102    
103 jmc 1.4 C--- Check for Counter Diagnostic
104    
105 jmc 1.1 mate = 0
106 jmc 1.3 IF ( gcode(5:5).EQ.'C') THEN
107     mate = hdiag(ndId)
108 jmc 1.1
109 jmc 1.2 C-- Seach for the same diag (with same freq) to see if already set
110     flag = .TRUE.
111     DO l=1,listId
112     IF (flag .AND. diagSt_freq(l) .EQ. diagSt_freq(listId)
113     & .AND. diagSt_phase(l).EQ.diagSt_phase(listId) ) THEN
114     DO k=1,MIN(diagSt_nbActv(l),numperlist)
115     IF (flag .AND. jSdiag(k,l).GT.0) THEN
116     IF (cdiag(mate).EQ.cdiag(jSdiag(k,l)) ) THEN
117     C- diagnostics already set ; use the same slot:
118     flag = .FALSE.
119     mSdiag(mId,listId) = ABS(iSdiag(k,l))
120     ENDIF
121     ENDIF
122     ENDDO
123     ENDIF
124     ENDDO
125    
126     IF ( flag ) THEN
127 jmc 1.1 IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
128 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,A)')
129 jmc 1.2 & 'SETDIAG: Not enough space for Counter Diagnostic #',
130     & mate, cdiag(mate)
131 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
132     ELSE
133 jmc 1.3 WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
134 jmc 1.1 & kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
135     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
136     ENDIF
137 jmc 1.2 mSdiag(mId,listId) = ndiagmx + 1
138     ndiagmx = ndiagmx + kdiag(mate)
139 jmc 1.1 ELSE
140 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,2A)')
141 jmc 1.1 & '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
142     & ' has already been set'
143     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
144     mate = -mate
145     ENDIF
146     ENDIF
147    
148     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
149     RETURN
150     END
  ViewVC Help
Powered by ViewVC 1.1.22