/[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.2 - (hide annotations) (download)
Sun Jun 26 16:51:49 2005 UTC (18 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint57m_post, checkpoint57s_post, checkpoint57k_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint57v_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint57j_post, checkpoint58b_post, checkpoint58m_post, checkpoint57l_post
Changes since 1.1: +72 -26 lines 
change pointers so that 1 diag. can be used several times (with # freq.)
1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_setdiag.F,v 1.1 2005/05/20 07:28:52 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     CHARACTER*8 parms1
53     CHARACTER*3 mate_index
54     CHARACTER*(MAX_LEN_MBUF) msgBuf
55    
56    
57     C **********************************************************************
58     C **** SET POINTERS FOR DIAGNOSTIC NUM ****
59     C **********************************************************************
60    
61 jmc 1.2 parms1 = gdiag(ndId)(1:8)
62 jmc 1.1 stdUnit = standardMessageUnit
63     errUnit = errorMessageUnit
64    
65 jmc 1.2 C-- Seach for the same diag (with same freq) to see if already set
66     flag = .TRUE.
67     DO l=1,listId
68     IF (flag .AND. diagSt_freq(l) .EQ. diagSt_freq(listId)
69     & .AND. diagSt_phase(l).EQ.diagSt_phase(listId) ) THEN
70     DO k=1,MIN(diagSt_nbActv(l),numperlist)
71     IF (flag .AND. jSdiag(k,l).GT.0) THEN
72     IF (cdiag(ndId).EQ.cdiag(jSdiag(k,l)) ) THEN
73     C- diagnostics already set ; use the same slot:
74     flag = .FALSE.
75     iSdiag(mId,listId) = -ABS(iSdiag(k,l))
76     mSdiag(mId,listId) = mSdiag(k,l)
77     ENDIF
78     ENDIF
79     ENDDO
80     ENDIF
81     ENDDO
82    
83     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
84    
85     IF ( flag ) THEN
86     IF (ndiagmx+kdiag(ndId).GT.diagSt_size) THEN
87     WRITE(msgBuf,'(A,I4,1X,A)')
88     & 'SETDIAG: Not enough space for Stats-Diag #',ndId,cdiag(ndId)
89 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
90     ELSE
91 jmc 1.2 WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
92     & kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)
93 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
94     ENDIF
95 jmc 1.2 iSdiag(mId,listId) = ndiagmx + 1
96     ndiagmx = ndiagmx + kdiag(ndId)
97 jmc 1.1 ELSE
98 jmc 1.2 WRITE(msgBuf,'(A,I4,1X,2A)')
99     & '- WARNING - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
100 jmc 1.1 & ' has already been set'
101     CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
102 jmc 1.2 mate = 0
103     RETURN
104 jmc 1.1 ENDIF
105    
106     c Check for Counter Diagnostic
107     c ----------------------------
108     mate = 0
109     IF ( parms1(5:5).EQ.'C') THEN
110     mate_index = parms1(6:8)
111     READ (mate_index,'(I3)') mate
112    
113 jmc 1.2 C-- Seach for the same diag (with same freq) to see if already set
114     flag = .TRUE.
115     DO l=1,listId
116     IF (flag .AND. diagSt_freq(l) .EQ. diagSt_freq(listId)
117     & .AND. diagSt_phase(l).EQ.diagSt_phase(listId) ) THEN
118     DO k=1,MIN(diagSt_nbActv(l),numperlist)
119     IF (flag .AND. jSdiag(k,l).GT.0) THEN
120     IF (cdiag(mate).EQ.cdiag(jSdiag(k,l)) ) THEN
121     C- diagnostics already set ; use the same slot:
122     flag = .FALSE.
123     mSdiag(mId,listId) = ABS(iSdiag(k,l))
124     ENDIF
125     ENDIF
126     ENDDO
127     ENDIF
128     ENDDO
129    
130     IF ( flag ) THEN
131 jmc 1.1 IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
132 jmc 1.2 WRITE(msgBuf,'(A,I4,1X,A)')
133     & 'SETDIAG: Not enough space for Counter Diagnostic #',
134     & mate, cdiag(mate)
135 jmc 1.1 CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
136     ELSE
137 jmc 1.2 WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
138 jmc 1.1 & kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
139     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
140     ENDIF
141 jmc 1.2 mSdiag(mId,listId) = ndiagmx + 1
142     ndiagmx = ndiagmx + kdiag(mate)
143 jmc 1.1 ELSE
144 jmc 1.2 WRITE(msgBuf,'(A,I4,1X,2A)')
145 jmc 1.1 & '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
146     & ' has already been set'
147     CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
148     mate = -mate
149     ENDIF
150     ENDIF
151    
152     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
153     RETURN
154     END
  ViewVC Help
Powered by ViewVC 1.1.22