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

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

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

revision 1.1 by jmc, Fri May 20 07:28:52 2005 UTC revision 1.4 by jmc, Wed Jun 15 13:44:42 2011 UTC
# Line 6  C $Name$ Line 6  C $Name$
6  CBOP  CBOP
7  C     !ROUTINE: DIAGSTATS_SETDIAG  C     !ROUTINE: DIAGSTATS_SETDIAG
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGSTATS_SETDIAG(        SUBROUTINE DIAGSTATS_SETDIAG(
10       O                      mate,       O                      mate,
11       U                      ndiagmx,       U                      ndiagmx,
12       I                      num, myThid )       I                      mId, listId, ndId, myThid )
13    
14  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
15  C     *==================================================================  C     *==================================================================
16  C     | S/R DIAGSTATS_SETDIAG  C     | S/R DIAGSTATS_SETDIAG
17  C     | o activate statistics diagnostic "num":  C     | o activate statistics diagnostic "ndId":
18  C     |   set pointer locations for this diagnostic ;  C     |   set pointer locations for this diagnostic ;
19  C     |   look for a counter mate and set it  C     |   look for a counter mate and set it
20  C     *==================================================================  C     *==================================================================
# Line 31  C     == Global variables === Line 31  C     == Global variables ===
31    
32  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
33  C     == Routine arguments ==  C     == Routine arguments ==
34  C     myThid - Thread number for this instance of the routine.  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        INTEGER mate        INTEGER mate
41        INTEGER ndiagmx        INTEGER ndiagmx
42        INTEGER num        INTEGER mId, listId, ndId
43        INTEGER myThid        INTEGER myThid
44  CEOP  CEOP
45    
46  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER stdUnit, errUnit        INTEGER stdUnit, errUnit
49          INTEGER k, l
50          LOGICAL flag
51    
52        CHARACTER*8 parms1        CHARACTER*10 gcode
       CHARACTER*3 mate_index  
53        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
54    
55    
56  C **********************************************************************  C **********************************************************************
57  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****  C ****                SET POINTERS FOR DIAGNOSTIC ndId              ****
58  C **********************************************************************  C **********************************************************************
59    
60        parms1 = gdiag(num)(1:8)        gcode   = gdiag(ndId)(1:8)
61        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
62        errUnit = errorMessageUnit        errUnit = errorMessageUnit
63    
64        IF ( iSdiag(num).EQ.0 ) THEN  C--   Seach for the same diag (with same freq) to see if already set
65          IF (ndiagmx+kdiag(num).GT.diagSt_size) THEN        flag = .TRUE.
66           WRITE(msgBuf,'(A,I4,1X,A)')        DO l=1,listId
67       &    'SETDIAG: Not enough space for Stats-Diag #', num, cdiag(num)         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             WRITE(msgBuf,'(A,I6,1X,A)')
87         &    'SETDIAG: Not enough space for Stats-Diag #',ndId,cdiag(ndId)
88           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
89          ELSE          ELSE
90           WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
91       &    kdiag(num), ' Levels for Stats-Diag #', num, cdiag(num)       &    kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)
92           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
93          ENDIF          ENDIF
94          iSdiag(num) = ndiagmx + 1          iSdiag(mId,listId) = ndiagmx + 1
95          ndiagmx    = ndiagmx + kdiag(num)          ndiagmx = ndiagmx + kdiag(ndId)
96        ELSE        ELSE
97          WRITE(msgBuf,'(A,I4,1X,2A)')          WRITE(msgBuf,'(A,I6,1X,2A)')
98       &    '- WARNING - SETDIAG: Stats-Diag #', num, cdiag(num),       &    '- NOTE - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
99       &    ' has already been set'       &    ' has already been set'
100          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
101        ENDIF        ENDIF
102    
103  c Check for Counter Diagnostic  C---  Check for Counter Diagnostic
104  c ----------------------------  
105        mate = 0        mate = 0
106        IF ( parms1(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
107          mate_index = parms1(6:8)          mate = hdiag(ndId)
108          READ (mate_index,'(I3)') mate  
109    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 ( iSdiag(mate).EQ.0 ) THEN          IF ( flag ) THEN
127            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
128             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I6,1X,A)')
129       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
130       &      num, cdiag(num)       &      mate, cdiag(mate)
131             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
132            ELSE            ELSE
133             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
134       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
135             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
136            ENDIF            ENDIF
137            iSdiag(mate) = ndiagmx + 1            mSdiag(mId,listId) = ndiagmx + 1
138            ndiagmx     = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
139          ELSE          ELSE
140            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I6,1X,2A)')
141       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
142       &    ' has already been set'       &    ' has already been set'
143            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)            CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22