/[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.2 by jmc, Sun Jun 26 16:51:49 2005 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*8 parms1
53        CHARACTER*3 mate_index        CHARACTER*3 mate_index
# Line 51  C ************************************** Line 58  C **************************************
58  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****  C ****                SET POINTERS FOR DIAGNOSTIC NUM               ****
59  C **********************************************************************  C **********************************************************************
60    
61        parms1 = gdiag(num)(1:8)        parms1 = gdiag(ndId)(1:8)
62        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
63        errUnit = errorMessageUnit        errUnit = errorMessageUnit
64    
65        IF ( iSdiag(num).EQ.0 ) THEN  C--   Seach for the same diag (with same freq) to see if already set
66          IF (ndiagmx+kdiag(num).GT.diagSt_size) THEN        flag = .TRUE.
67           WRITE(msgBuf,'(A,I4,1X,A)')        DO l=1,listId
68       &    'SETDIAG: Not enough space for Stats-Diag #', num, cdiag(num)         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           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
90          ELSE          ELSE
91           WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',           WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
92       &    kdiag(num), ' Levels for Stats-Diag #', num, cdiag(num)       &    kdiag(ndId), ' Levels for Stats-Diag #', ndId, cdiag(ndId)
93           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
94          ENDIF          ENDIF
95          iSdiag(num) = ndiagmx + 1          iSdiag(mId,listId) = ndiagmx + 1
96          ndiagmx    = ndiagmx + kdiag(num)          ndiagmx = ndiagmx + kdiag(ndId)
97        ELSE        ELSE
98          WRITE(msgBuf,'(A,I4,1X,2A)')          WRITE(msgBuf,'(A,I4,1X,2A)')
99       &    '- WARNING - SETDIAG: Stats-Diag #', num, cdiag(num),       &    '- WARNING - SETDIAG: Stats-Diag #', ndId, cdiag(ndId),
100       &    ' has already been set'       &    ' has already been set'
101          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
102            mate = 0
103            RETURN
104        ENDIF        ENDIF
105    
106  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 81  c ---------------------------- Line 110  c ----------------------------
110          mate_index = parms1(6:8)          mate_index = parms1(6:8)
111          READ (mate_index,'(I3)') mate          READ (mate_index,'(I3)') mate
112    
113          IF ( iSdiag(mate).EQ.0 ) THEN  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            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
132             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I4,1X,A)')
133       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
134       &      num, cdiag(num)       &      mate, cdiag(mate)
135             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
136            ELSE            ELSE
137             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
138       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
139             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
140            ENDIF            ENDIF
141            iSdiag(mate) = ndiagmx + 1            mSdiag(mId,listId) = ndiagmx + 1
142            ndiagmx     = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
143          ELSE          ELSE
144            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I4,1X,2A)')
145       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
146       &    ' has already been set'       &    ' has already been set'
147            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.2
  ViewVC Help
Powered by ViewVC 1.1.22