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

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

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

revision 1.12 by jmc, Mon Jun 8 14:40:47 2009 UTC revision 1.15 by jmc, Tue Jun 21 18:00:15 2011 UTC
# Line 26  C     == Global variables === Line 26  C     == Global variables ===
26    
27  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
28  C     == Routine arguments ==  C     == Routine arguments ==
29  C     myThid - Thread number for this instance of the routine.  C     myThid :: my Thread Id. number
30        INTEGER myThid        INTEGER myThid
31  CEOP  CEOP
32    
# Line 35  C     == Local variables == Line 35  C     == Local variables ==
35        INTEGER ndiagcount, ndCount        INTEGER ndiagcount, ndCount
36        INTEGER md,ld,nd        INTEGER md,ld,nd
37        INTEGER mate, nActiveMax        INTEGER mate, nActiveMax
38        INTEGER i, j, k, k1, k2, mm, kLev        INTEGER i, j, k, k1, k2, kLev
39        LOGICAL found        LOGICAL found
40        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
41          CHARACTER*12 suffix
42    
43        _BEGIN_MASTER( myThid)        _BEGIN_MASTER( myThid)
44    
45  C--   Initialize pointer arrays to zero:  C--   Initialize pointer arrays to zero:
46        DO ld=1,numlists        DO ld=1,numLists
47         DO md=1,numperlist         DO md=1,numperList
48          idiag(md,ld) = 0          idiag(md,ld) = 0
49          jdiag(md,ld) = 0          jdiag(md,ld) = 0
50          mdiag(md,ld) = 0          mdiag(md,ld) = 0
# Line 79  C        Search all possible model diagn Line 80  C        Search all possible model diagn
80             ENDIF             ENDIF
81             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
82           ENDIF           ENDIF
          IF ( found .AND. mate.GE.1 ) THEN  
            mm = nActive(ld) + 1  
            IF ( mm.LE.numperlist ) THEN  
              jdiag(mm,ld) = mate  
              idiag(mm,ld) = mdiag(md,ld)  
              flds (mm,ld) = cdiag(mate)  
            ENDIF  
            nActive(ld) = mm  
          ENDIF  
83    
84         ENDDO         ENDDO
85         nActiveMax = MAX(nActive(ld),nActiveMax)         nActiveMax = MAX(nActive(ld),nActiveMax)
86        ENDDO        ENDDO
87    
88        IF (  ndiagcount.LE.numDiags .AND.        IF (  ndiagcount.LE.numDiags .AND.
89       &      nActiveMax.LE.numperlist ) THEN       &      nActiveMax.LE.numperList ) THEN
90          WRITE(msgBuf,'(A,I8,A)')          WRITE(msgBuf,'(A,I8,A)')
91       &    '  space allocated for all diagnostics:',       &    '  space allocated for all diagnostics:',
92       &    ndiagcount, ' levels'       &    ndiagcount, ' levels'
# Line 111  C        Search all possible model diagn Line 103  C        Search all possible model diagn
103       &    ' but needs at least', ndiagcount       &    ' but needs at least', ndiagcount
104           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
105         ENDIF         ENDIF
106         IF ( nActiveMax.GT.numperlist ) THEN         IF ( nActiveMax.GT.numperList ) THEN
107           WRITE(msgBuf,'(2A)')           WRITE(msgBuf,'(2A)')
108       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',       &    'DIAGNOSTICS_SET_POINTERS: Not enough space',
109       &    ' for all active diagnostics (from data.diagnostics)'       &    ' for all active diagnostics (from data.diagnostics)'
110           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
111           WRITE(msgBuf,'(A,I6,A,I6)')           WRITE(msgBuf,'(A,I6,A,I6)')
112       &    'DIAGNOSTICS_SET_POINTERS: numperlist=', numperlist,       &    'DIAGNOSTICS_SET_POINTERS: numperList=', numperList,
113       &    ' but needs at least', nActiveMax       &    ' but needs at least', nActiveMax
114           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
115         ENDIF         ENDIF
# Line 137  C     and if it exists. Note: for now, o Line 129  C     and if it exists. Note: for now, o
129            DO j=1,nlists            DO j=1,nlists
130             DO i=1,nActive(j)             DO i=1,nActive(j)
131              IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN              IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN
132                mdiag(md,ld) = ABS(idiag(i,j))               IF ( freq(j).EQ.freq(ld) .AND. phase(j).EQ.phase(ld)
133         &           .AND. averageFreq(j) .EQ.averageFreq(ld)
134         &           .AND. averagePhase(j).EQ.averagePhase(ld)
135         &           .AND. averageCycle(j).EQ.averageCycle(ld) )
136         &          mdiag(md,ld) = ABS(idiag(i,j))
137              ENDIF              ENDIF
138             ENDDO             ENDDO
139            ENDDO            ENDDO
# Line 189  C-      set Nb of levels to the minimum Line 185  C-      set Nb of levels to the minimum
185       &      'Set levels for Outp.Stream: ',fnames(ld)       &      'Set levels for Outp.Stream: ',fnames(ld)
186            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
187       &                        SQUEEZE_RIGHT, myThid)       &                        SQUEEZE_RIGHT, myThid)
188              suffix = ' Levels:    '
189              IF ( fflags(ld)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
190            DO k1=1,nlevels(ld),20            DO k1=1,nlevels(ld),20
191              k2 = MIN(nlevels(ld),k1+19)              k2 = MIN(nlevels(ld),k1+19)
192              WRITE(msgBuf,'(A,20F5.0)')              WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,ld),k=k1,k2)
      &         ' Levels:    ', (levs(k,ld),k=k1,k2)  
193              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
194       &                          SQUEEZE_RIGHT, myThid)       &                          SQUEEZE_RIGHT, myThid)
195            ENDDO            ENDDO
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22