/[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.3 by jmc, Tue Feb 5 15:13:01 2008 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),       &    '- WARNING - 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, errUnit, SQUEEZE_RIGHT, myThid)
101            mate = 0
102            RETURN
103        ENDIF        ENDIF
104    
105  c Check for Counter Diagnostic  c Check for Counter Diagnostic
106  c ----------------------------  c ----------------------------
107        mate = 0        mate = 0
108        IF ( parms1(5:5).EQ.'C') THEN        IF ( gcode(5:5).EQ.'C') THEN
109          mate_index = parms1(6:8)          mate = hdiag(ndId)
110          READ (mate_index,'(I3)') mate  
111    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 ( iSdiag(mate).EQ.0 ) THEN          IF ( flag ) THEN
129            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN            IF (ndiagmx+kdiag(mate).GT.diagSt_size) THEN
130             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I6,1X,A)')
131       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
132       &      num, cdiag(num)       &      mate, cdiag(mate)
133             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
134            ELSE            ELSE
135             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I6,1X,A)') 'SETDIAG: Allocate',
136       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
137             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
138            ENDIF            ENDIF
139            iSdiag(mate) = ndiagmx + 1            mSdiag(mId,listId) = ndiagmx + 1
140            ndiagmx     = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
141          ELSE          ELSE
142            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I6,1X,2A)')
143       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
144       &    ' has already been set'       &    ' has already been set'
145            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.3
  ViewVC Help
Powered by ViewVC 1.1.22