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

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

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

revision 1.1 by jmc, Mon Dec 13 21:43:54 2004 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: DIAGNOSTICS_SETDIAG  C     !ROUTINE: DIAGNOSTICS_SETDIAG
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE DIAGNOSTICS_SETDIAG(        SUBROUTINE DIAGNOSTICS_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 DIAGNOSTICS_SETDIAG  C     | S/R DIAGNOSTICS_SETDIAG
17  C     | o activate diagnostic "num":  C     | o activate 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 ( idiag(num).EQ.0 ) THEN  C--   Seach for the same diag (with same freq) to see if already set
66          IF (ndiagmx+kdiag(num).GT.numdiags) THEN        flag = .TRUE.
67           WRITE(msgBuf,'(A,I4,1X,A)')        DO l=1,listId
68       &    'SETDIAG: Not enough space for Diagnostic #', num, cdiag(num)         IF (flag .AND. freq(l) .EQ. freq(listId)
69         &          .AND. phase(l).EQ.phase(listId) ) THEN
70            DO k=1,MIN(nActive(l),numperlist)
71             IF (flag .AND. jdiag(k,l).GT.0) THEN
72              IF ( cdiag(ndId).EQ.cdiag(jdiag(k,l)) ) THEN
73    C-    diagnostics already set ; use the same slot:
74               flag = .FALSE.
75               idiag(mId,listId) = -ABS(idiag(k,l))
76               mdiag(mId,listId) = mdiag(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.numdiags) THEN
87             WRITE(msgBuf,'(A,I4,1X,A)')
88         &    'SETDIAG: Not enough space for Diagnostic #',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 Diagnostic #', num, cdiag(num)       &    kdiag(ndId), ' Levels for Diagnostic #', ndId, cdiag(ndId)
93           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)           CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
94          ENDIF          ENDIF
95          idiag(num) = ndiagmx + 1          idiag(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: Diagnostic #', num, cdiag(num),       &    '- WARNING - SETDIAG: Diagnostic #', 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            RETURN
103        ENDIF        ENDIF
104    
105  c Check for Counter Diagnostic  c Check for Counter Diagnostic
# Line 81  c ---------------------------- Line 109  c ----------------------------
109          mate_index = parms1(6:8)          mate_index = parms1(6:8)
110          READ (mate_index,'(I3)') mate          READ (mate_index,'(I3)') mate
111    
112          IF ( idiag(mate).EQ.0 ) THEN  C--     Seach for the same diag (with same freq) to see if already set
113            flag = .TRUE.
114            DO l=1,listId
115             IF (flag .AND. freq(l).EQ.freq(listId)
116         &            .AND. phase(l).EQ.phase(listId) ) THEN
117              DO k=1,MIN(nActive(l),numperlist)
118               IF (flag .AND. jdiag(k,l).GT.0) THEN
119                IF (cdiag(mate).EQ.cdiag(jdiag(k,l)) ) THEN
120    C-    diagnostics already set ; use the same slot:
121                 flag = .FALSE.
122                 mdiag(mId,listId) = ABS(idiag(k,l))
123                ENDIF
124               ENDIF
125              ENDDO
126             ENDIF
127            ENDDO
128    
129            IF ( flag ) THEN
130            IF (ndiagmx+kdiag(mate).GT.numdiags) THEN            IF (ndiagmx+kdiag(mate).GT.numdiags) THEN
131             WRITE(msgBuf,'(A,I4,1X,A)')             WRITE(msgBuf,'(A,I4,1X,A)')
132       &      'SETDIAG: Not enough space for Counter Diagnostic #',       &      'SETDIAG: Not enough space for Counter Diagnostic #',
133       &      num, cdiag(num)       &      mate, cdiag(mate)
134             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, errUnit, SQUEEZE_RIGHT, myThid)
135            ELSE            ELSE
136             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',             WRITE(msgBuf,'(A,I3,A,I4,1X,A)') 'SETDIAG: Allocate',
137       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)       &     kdiag(mate), ' Levels for Count.Diag #', mate, cdiag(mate)
138             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)             CALL PRINT_MESSAGE(msgBuf, stdUnit, SQUEEZE_RIGHT, myThid)
139            ENDIF            ENDIF
140            idiag(mate) = ndiagmx + 1            mdiag(mId,listId) = ndiagmx + 1
141            ndiagmx     = ndiagmx + kdiag(mate)            ndiagmx = ndiagmx + kdiag(mate)
142          ELSE          ELSE
143            WRITE(msgBuf,'(A,I4,1X,2A)')            WRITE(msgBuf,'(A,I4,1X,2A)')
144       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),       &    '- NOTE - SETDIAG: Counter Diagnostic #', mate, cdiag(mate),
145       &    ' has already been set'       &    ' has already been set'
146            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