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

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

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

-revision 1.4 by jmc,
Mon May 16 15:07:45 2005 UTC
+revision 1.5 by jmc,
Sun Jun 26 16:51:49 2005 UTC
 Line 33 
 CEOP
  C     !LOCAL VARIABLES:
  C     == Local variables ==
        INTEGER ndiagcount
-       INTEGER m,mm,n
+       INTEGER md,ld,nd
        INTEGER mate, nActiveMax
-       INTEGER l, k, kLev
+       INTEGER i, j, k, k1, k2, mm, kLev
        LOGICAL found
        CHARACTER*(MAX_LEN_MBUF) msgBuf
+       CHARACTER*3 mate_index
        _BEGIN_MASTER( myThid)
  C--   Initialize pointer arrays to zero:
-       DO n=1,ndiagMax
+       DO ld=1,numlists
-         idiag(n) = 0
+        DO md=1,numperlist
+         idiag(md,ld) = 0
+         jdiag(md,ld) = 0
+         mdiag(md,ld) = 0
+        ENDDO
        ENDDO
  C--   Calculate pointers for diagnostics set to non-zero frequency
        ndiagcount = 0
        nActiveMax = 0
-       DO n=1,nlists
+       DO ld=1,nlists
-        nActive(n) = nfields(n)
+        nActive(ld) = nfields(ld)
-        DO m=1,nfields(n)
+        DO md=1,nfields(ld)
           found = .FALSE.
  C        Search all possible model diagnostics
-          DO mm=1,ndiagt
+          DO nd=1,ndiagt
-           IF ( flds(m,n).EQ.cdiag(mm) ) THEN
+           IF ( flds(md,ld).EQ.cdiag(nd) ) THEN
-             CALL DIAGNOSTICS_SETDIAG (mate,ndiagcount,mm,myThid)
+             CALL DIAGNOSTICS_SETDIAG(mate,ndiagcount,md,ld,nd,myThid)
              found = .TRUE.
-             jdiag(m,n) = mm
+             jdiag(md,ld) = nd
            ENDIF
           ENDDO
           IF ( .NOT.found ) THEN
             WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
-      &                      flds(m,n),' is not a Diagnostic'
+      &                      flds(md,ld),' is not a Diagnostic'
             CALL PRINT_ERROR( msgBuf , myThid )
             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
           ENDIF
           IF ( found .AND. mate.GE.1 ) THEN
-             nActive(n) = nActive(n) + 1
+            mm = nActive(ld) + 1
-             IF ( nActive(n).LE.numperlist ) THEN
+            IF ( mm.LE.numperlist ) THEN
-              jdiag(nActive(n),n) = mate
+              jdiag(mm,ld) = mate
-              flds( nActive(n),n) = cdiag(mate)
+              idiag(mm,ld) = mdiag(md,ld)
+              flds (mm,ld) = cdiag(mate)
             ENDIF
+            nActive(ld) = mm
           ENDIF
         ENDDO
-        nActiveMax = MAX(nActive(n),nActiveMax)
+        nActiveMax = MAX(nActive(ld),nActiveMax)
        ENDDO
        IF (  ndiagcount.LE.numdiags .AND.
       &      nActiveMax.LE.numperlist ) THEN
          WRITE(msgBuf,'(A,I6,A)')
       &    '  space allocated for all diagnostics:',
       &    ndiagcount, ' levels'
          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
       &                      SQUEEZE_RIGHT , myThid)
-Line 114 
 C        Search all possible model diagn
+Line 121 
 C        Search all possible model diagn
        ENDIF
  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
+ C--   Set pointer for mate (e.g.vector component mate) if not already done
+ C     and if it exists. Note: for now, only used to print message.
+       DO ld=1,nlists
+        DO md=1,nActive(ld)
+         IF (mdiag(md,ld).EQ.0 ) THEN
+          nd = jdiag(md,ld)
+          mate_index = gdiag(nd)(6:8)
+          IF ( mate_index.NE.'   ' ) THEN
+           READ(mate_index,'(I3)') mate
+           DO j=1,nlists
+            DO i=1,nActive(j)
+             IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN
+               mdiag(md,ld) = ABS(idiag(i,j))
+             ENDIF
+            ENDDO
+           ENDDO
+          ENDIF
+          IF ( mdiag(md,ld).NE.0 ) THEN
+           WRITE(msgBuf,'(A,I4,4A)') '  set mate pointer for diag #',
+      &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)
+           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
+      &                        SQUEEZE_RIGHT , myThid)
+          ENDIF
+         ENDIF
+        ENDDO
+       ENDDO
+ C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  C--   Set list of levels to write (if not specified in data.diagnostics)
-       DO n=1,nlists
+       DO ld=1,nlists
-         IF ( nlevels(n).EQ.-1 ) THEN
+         IF ( nlevels(ld).EQ.-1 ) THEN
  C-      set Nb of levels to the minimum size of all diag of this list:
            kLev = numLevels
-           DO m=1,nfields(n)
+           DO md=1,nfields(ld)
-             mm = jdiag(m,n)
+             nd = jdiag(md,ld)
-             kLev = MIN(kdiag(mm),kLev)
+             kLev = MIN(kdiag(nd),kLev)
            ENDDO
            IF ( kLev.LE.0 ) THEN
              WRITE(msgBuf,'(2A,I4,2A)')
       &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in ',
-      &      ' setting levs of list n=',n,', fnames: ', fnames(n)
+      &      ' setting levs of list l=',ld,', fnames: ', fnames(ld)
              CALL PRINT_ERROR( msgBuf , myThid )
              STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
            ENDIF
-           nlevels(n) = kLev
+           nlevels(ld) = kLev
            DO k=1,kLev
-            levs(k,n) = k
+            levs(k,ld) = k
            ENDDO
            WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
-      &      'Set levels for Outp.Stream: ',fnames(n)
+      &      'Set levels for Outp.Stream: ',fnames(ld)
            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
       &                        SQUEEZE_RIGHT, myThid)
-           DO l=1,nlevels(n),20
+           DO k1=1,nlevels(ld),20
-             m = MIN(nlevels(n),l+19)
+             k2 = MIN(nlevels(ld),k1+19)
-             WRITE(msgBuf,'(A,20F5.0)')' Levels:    ',(levs(k,n),k=l,m)
+             WRITE(msgBuf,'(A,20F5.0)')
+      &         ' Levels:    ', (levs(k,ld),k=k1,k2)
              CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
       &                          SQUEEZE_RIGHT, myThid)
            ENDDO
          ELSE
  C-      Check for levels out of range ( > kdiag)
            kLev = 0
-           DO k=1,nlevels(n)
+           DO k=1,nlevels(ld)
-             kLev = MAX(NINT(levs(k,n)),kLev)
+             kLev = MAX(NINT(levs(k,ld)),kLev)
            ENDDO
-           DO m=1,nfields(n)
+           DO md=1,nfields(ld)
-             mm = jdiag(m,n)
+             nd = jdiag(md,ld)
-             IF ( kLev.GT.kdiag(mm) ) THEN
+             IF ( kLev.GT.kdiag(nd) ) THEN
  C- Note: diagnostics_out take care (in some way) of this case
  C        so that it does not cause "index out-off bounds" error.
  C        However, the output file looks strange.
  C- For now, choose to stop, but could change it to just a warning
               WRITE(msgBuf,'(A,I3,A,I3,2A)')
       &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
-      &         ' in list n=', n, ', filename: ', fnames(n)
+      &         ' in list l=', ld, ', filename: ', fnames(ld)
               CALL PRINT_ERROR( msgBuf , myThid )
               WRITE(msgBuf,'(2A,I3,A,I3,2A)')
       &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
-      &       '(=',kdiag(mm),') for Diag. #', mm, ' : ',cdiag(mm)
+      &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)
               CALL PRINT_ERROR( msgBuf , myThid )
               WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SET_POINTERS: ',
-      &       ' parsing code >>',gdiag(mm),'<<'
+      &       ' parsing code >>',gdiag(nd),'<<'
               CALL PRINT_ERROR( msgBuf , myThid )
               STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
              ENDIF

 Legend:



Removed from v.1.4
 


changed lines


 
Added in v.1.5
 Legend:



Removed from v.1.4
 


changed lines


 
Added in v.1.5
-Removed from v.1.4
+Added in v.1.5

	ViewVC Help
Powered by ViewVC 1.1.22