/[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.3 - (hide annotations) (download)
Tue Feb 5 15:13:01 2008 UTC (17 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint62, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint59n, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.2: +12 -14 lines 
In order to deal with large number of diagnostics (happens with large number
of tracers), store diagnostic mate number in dedicate array "hdiag":
- new version of S/R DIAGNOSTICS_ADD2LIST : DIAGNOSTICS_ADDTOLIST
  with 1 more argument (mate number).
- change old version of DIAGNOSTICS_ADD2LIST to extract mate number
  from parsing code and then call DIAGNOSTICS_ADDTOLIST
- modify setting, filling & output to use "hdiag" instead of reading
  mate number from gdiag.
1 jmc 1.3 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_setdiag.F,v 1.2 2005/06/26 16:51:49 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.2 & '- WARNING - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
99 jmc 1.1 & ' has already been set'
100     CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
101 jmc 1.2 mate = 0
102     RETURN
103 jmc 1.1 ENDIF
104    
105     c Check for Counter Diagnostic
106     c ----------------------------
107     mate = 0
108 jmc 1.3 IF ( gcode(5:5).EQ.'C') THEN
109     mate = hdiag(ndId)
110 jmc 1.1
111 jmc 1.2 C-- Seach for the same diag (with same freq) to see if already set
112     flag = .TRUE.
113     DO l=1,listId
114     IF (flag .AND. diagSt_freq(l) .EQ. diagSt_freq(listId)
115     & .AND. diagSt_phase(l).EQ.diagSt_phase(listId) ) THEN
116     DO k=1,MIN(diagSt_nbActv(l),numperlist)
117     IF (flag .AND. jSdiag(k,l).GT.0) THEN
118     IF (cdiag(mate).EQ.cdiag(jSdiag(k,l)) ) THEN
119     C- diagnostics already set ; use the same slot:
120     flag = .FALSE.
121     mSdiag(mId,listId) = ABS(iSdiag(k,l))
122     ENDIF
123     ENDIF
124     ENDDO
125     ENDIF
126     ENDDO
127    
128     IF ( flag ) THEN
129 jmc 1.1 IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
130 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,A)')
131 jmc 1.2 & 'SETDIAG: Not enough space for Counter Diagnostic #',
132     & mate, cdiag(mate)
133 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
134     ELSE
135 jmc 1.3 WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
136 jmc 1.1 & kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
137     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
138     ENDIF
139 jmc 1.2 mSdiag(mId,listId) = ndiagmx + 1
140     ndiagmx = ndiagmx + kdiag(mate)
141 jmc 1.1 ELSE
142 jmc 1.3 WRITE(msgBuf,'(A,I6,1X,2A)')
143 jmc 1.1 & '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
144     & ' has already been set'
145     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
146     mate = -mate
147     ENDIF
148     ENDIF
149    
150     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
151     RETURN
152     END
  ViewVC Help
Powered by ViewVC 1.1.22