--- MITgcm/pkg/diagnostics/diagnostics_set_pointers.F	2006/11/19 21:59:56	1.7
+++ MITgcm/pkg/diagnostics/diagnostics_set_pointers.F	2010/01/11 19:44:07	1.13
@@ -1,4 +1,4 @@
-C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/diagnostics/diagnostics_set_pointers.F,v 1.7 2006/11/19 21:59:56 jmc Exp $
+C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/diagnostics/diagnostics_set_pointers.F,v 1.13 2010/01/11 19:44:07 jmc Exp $
 C $Name:  $
 
 #include "DIAG_OPTIONS.h"
@@ -26,7 +26,7 @@
 
 C     !INPUT/OUTPUT PARAMETERS:
 C     == Routine arguments ==
-C     myThid - Thread number for this instance of the routine.
+C     myThid :: my Thread Id. number
       INTEGER myThid
 CEOP
 
@@ -38,8 +38,7 @@
       INTEGER i, j, k, k1, k2, mm, kLev
       LOGICAL found
       CHARACTER*(MAX_LEN_MBUF) msgBuf
-      CHARACTER*3 mate_index
-
+      CHARACTER*12 suffix
 
       _BEGIN_MASTER( myThid)
 
@@ -73,7 +72,7 @@
          IF ( .NOT.found ) THEN
            CALL DIAGNOSTICS_LIST_CHECK(
      O                      ndCount,
-     I                      ld, md, nfields, flds, myThid )
+     I                      ld, md, nlists, nfields, flds, myThid )
            IF ( ndCount.EQ.0 ) THEN
              WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_SET_POINTERS: ',
      &                      flds(md,ld),' is not a Diagnostic'
@@ -95,21 +94,21 @@
        nActiveMax = MAX(nActive(ld),nActiveMax)
       ENDDO
 
-      IF (  ndiagcount.LE.numdiags .AND.
+      IF (  ndiagcount.LE.numDiags .AND.
      &      nActiveMax.LE.numperlist ) THEN
-        WRITE(msgBuf,'(A,I6,A)')
+        WRITE(msgBuf,'(A,I8,A)')
      &    '  space allocated for all diagnostics:',
      &    ndiagcount, ' levels'
         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
      &                      SQUEEZE_RIGHT , myThid)
       ELSE
-       IF ( ndiagcount.GT.numdiags ) THEN
+       IF ( ndiagcount.GT.numDiags ) THEN
          WRITE(msgBuf,'(2A)')
      &    'DIAGNOSTICS_SET_POINTERS: Not enough space',
      &    ' for all active diagnostics (from data.diagnostics)'
          CALL PRINT_ERROR( msgBuf , myThid )
-         WRITE(msgBuf,'(A,I6,A,I6)')
-     &    'DIAGNOSTICS_SET_POINTERS: numdiags=', numdiags,
+         WRITE(msgBuf,'(A,I8,A,I8)')
+     &    'DIAGNOSTICS_SET_POINTERS: numDiags=', numDiags,
      &    ' but needs at least', ndiagcount
          CALL PRINT_ERROR( msgBuf , myThid )
        ENDIF
@@ -134,9 +133,8 @@
         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
+         mate = hdiag(nd)
+         IF ( mate.GT.0 ) THEN
           DO j=1,nlists
            DO i=1,nActive(j)
             IF ( mdiag(md,ld).EQ.0 .AND. jdiag(i,j).EQ.mate ) THEN
@@ -146,8 +144,9 @@
           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)
+          WRITE(msgBuf,'(A,I6,5A,I6)') '  set mate pointer for diag #',
+     &         nd, '  ', cdiag(nd), ' , Parms: ', gdiag(nd)(1:10),
+     &             ' , mate:', hdiag(nd)
           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
      &                        SQUEEZE_RIGHT , myThid)
          ENDIF
@@ -162,15 +161,24 @@
       DO ld=1,nlists
         IF ( nlevels(ld).EQ.-1 ) THEN
 C-      set Nb of levels to the minimum size of all diag of this list:
-          kLev = numLevels
+          kLev = numLevels*10
           DO md=1,nfields(ld)
             nd = jdiag(md,ld)
             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 l=',ld,', fnames: ', fnames(ld)
+     &      'DIAGNOSTICS_SET_POINTERS: kLev < 1 in',
+     &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
+            CALL PRINT_ERROR( msgBuf , myThid )
+            STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
+          ELSEIF ( kLev.GT.numLevels ) THEN
+            WRITE(msgBuf,'(A,2(I6,A))')
+     &      'DIAGNOSTICS_SET_POINTERS: kLev=', kLev,
+     &                  ' >', numLevels, ' =numLevels'
+            CALL PRINT_ERROR( msgBuf , myThid )
+            WRITE(msgBuf,'(2A,I4,2A)') 'DIAGNOSTICS_SET_POINTERS: in',
+     &      ' setting levs of list l=',ld,', fnames=', fnames(ld)
             CALL PRINT_ERROR( msgBuf , myThid )
             STOP 'ABNORMAL END: S/R DIAGNOSTICS_SET_POINTERS'
           ENDIF
@@ -182,15 +190,16 @@
      &      'Set levels for Outp.Stream: ',fnames(ld)
           CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
      &                        SQUEEZE_RIGHT, myThid)
+          suffix = ' Levels:    '
+          IF ( fflags(ld)(2:2).EQ.'I' ) suffix = ' Sum Levels:'
           DO k1=1,nlevels(ld),20
             k2 = MIN(nlevels(ld),k1+19)
-            WRITE(msgBuf,'(A,20F5.0)')
-     &         ' Levels:    ', (levs(k,ld),k=k1,k2)
+            WRITE(msgBuf,'(A,20F5.0)') suffix, (levs(k,ld),k=k1,k2)
             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
      &                          SQUEEZE_RIGHT, myThid)
           ENDDO
-        ELSE
-C-      Check for levels out of range ( > kdiag)
+        ELSEIF ( fflags(ld)(2:2).NE.'P' ) THEN
+C-      if no Vert.Interpolation, check for levels out of range ( > kdiag):
           kLev = 0
           DO k=1,nlevels(ld)
             kLev = MAX(NINT(levs(k,ld)),kLev)
@@ -202,11 +211,11 @@
 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)')
+             WRITE(msgBuf,'(A,I4,A,I6,2A)')
      &       'DIAGNOSTICS_SET_POINTERS: Ask for level=',kLev,
      &         ' in list l=', ld, ', filename: ', fnames(ld)
              CALL PRINT_ERROR( msgBuf , myThid )
-             WRITE(msgBuf,'(2A,I3,A,I3,2A)')
+             WRITE(msgBuf,'(2A,I4,A,I6,2A)')
      &       'DIAGNOSTICS_SET_POINTERS: ==> exceed Max.Nb of lev.',
      &       '(=',kdiag(nd),') for Diag. #', nd, ' : ',cdiag(nd)
              CALL PRINT_ERROR( msgBuf , myThid )