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

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

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

-revision 1.12 by jmc,
Wed Jan 31 21:47:55 2007 UTC
+revision 1.18 by jmc,
Wed Aug 14 00:57:33 2013 UTC
 Line 26 
 C                   &  L  &  levels = MA
  C                   &  M  &  levels = MAX(Nr,NrPhys) - 1  \\
  C                   &  G  &  levels = Ground_level Number \\
  C                   &  I  &  levels = sea-Ice_level Number \\
+ C                   &  X  &  free levels option (need to be set explicitly) \\
  C       \end{tabular}
  C     \end{center}
-Line 59 
 C     myThid :: my Thread Id number
+Line 60 
 C     myThid :: my Thread Id number
  CEOP
  C     !LOCAL VARIABLES:
-       INTEGER l, n, nlevs, nGroundLev
+       INTEGER l, n, ncount
+       INTEGER nlevs, nGroundLev
        INTEGER  dUnit, stdUnit
        CHARACTER*(MAX_LEN_MBUF) msgBuf
-       CHARACTER*(72) ccHead, ccLine
+       CHARACTER*84 ccHead, ccLine
-       CHARACTER*8 blk8c
+       CHARACTER*10 gcode
+       CHARACTER*1  g10code
        INTEGER  ILNBLNK
        EXTERNAL ILNBLNK
-Line 71 
 C---+----1----+----2----+----3----+----4
+Line 74 
 C---+----1----+----2----+----3----+----4
        _BEGIN_MASTER( myThid )
+ C--   Diagnostics definition/setting ends (cannot add diags to list anymore)
+ c     IF ( diag_pkgStatus.NE.2 ) STOP
+       diag_pkgStatus = 3
        nlevs   = MAX(Nr,Nrphys)
        nGroundLev = land_nLev
- c     Diagnostic Levels
+ C     Diagnostic Levels
- c     -----------------
+ C     -----------------
+       ncount = 0
        DO n = 1,ndiagt
-         IF     (gdiag(n)(10:10) .EQ. '0') THEN
+         g10code = gdiag(n)(10:10)
+         IF     ( g10code .EQ. '0' ) THEN
            kdiag(n) = 0
-         ELSEIF (gdiag(n)(10:10) .EQ. '1') THEN
+         ELSEIF ( g10code .EQ. '1' ) THEN
            kdiag(n) = 1
-         ELSEIF (gdiag(n)(10:10) .EQ. 'R') THEN
+         ELSEIF ( g10code .EQ. 'R' ) THEN
            kdiag(n) = Nr
-         ELSEIF (gdiag(n)(10:10) .EQ. 'L') THEN
+         ELSEIF ( g10code .EQ. 'L' ) THEN
            kdiag(n) = nlevs
-         ELSEIF (gdiag(n)(10:10) .EQ. 'M') THEN
+         ELSEIF ( g10code .EQ. 'M' ) THEN
            kdiag(n) = nlevs - 1
-         ELSEIF (gdiag(n)(10:10) .EQ. 'G') THEN
+         ELSEIF ( g10code .EQ. 'G' ) THEN
            kdiag(n) = nGroundLev
-         ELSEIF (gdiag(n)(10:10) .NE. ' ') THEN
+         ELSEIF ( g10code .EQ. 'g' ) THEN
- C-      others: set 1 level:
            kdiag(n) = 1
+         ELSEIF ( g10code .EQ. 'X' ) THEN
+          IF ( kdiag(n) .LE. 0 ) THEN
+           WRITE(msgBuf,'(2A,I4,3A)')
+      &     '** WARNING ** DIAGNOSTICS_SET_LEVELS: ',
+      &     'level Nb =', kdiag(n), ' < 1 for diag."', cdiag(n),'"'
+           CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
+      &                        SQUEEZE_RIGHT , myThid )
+          ENDIF
+         ELSE
+ C-      enforce a strict matching:
+           WRITE(msgBuf,'(2A,4A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &     'invalid gdiag(10)="', g10code, '" code for diag."',
+      &                            cdiag(n),'"'
+           CALL PRINT_ERROR( msgBuf , myThid )
+           ncount = ncount + 1
          ENDIF
        ENDDO
+       IF ( ncount.GT.0 ) THEN
+         WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &   'found', ncount, ' invalid parser "gdiag(10)" => STOP'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         STOP 'ABNORMAL END: S/R DIAGSTATS_SET_LEVELS'
+       ENDIF
+ C--   Check for inconsistent diagnostic parser field
+       ncount = 0
+       DO n = 1,ndiagt
+        gcode = gdiag(n)(1:10)
+        IF ( ( gcode(3:3).EQ.'r' .OR. gcode(3:3).EQ.'R' )
+      &                         .AND. gcode(10:10).NE.'R' ) THEN
+         WRITE(msgBuf,'(2A,4A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &   'inconsistent gdiag(3&10)="',gcode,'" for diag."',cdiag(n),'"'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         ncount = ncount + 1
+        ENDIF
+       ENDDO
+       IF ( ncount.GT.0 ) THEN
+         WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &   'found', ncount, ' inconsistent parser "gdiag" => STOP'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         STOP 'ABNORMAL END: S/R DIAGSTATS_SET_LEVELS'
+       ENDIF
+ C--   Check for unvalid diag.mate number
+       ncount = 0
+       DO n = 1,ndiagt
+        IF ( hdiag(n).LT.0 .OR. hdiag(n).GT.ndiagt ) THEN
+         WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &    'unvalid mate number=',hdiag(n),' for diag."',cdiag(n),'"'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         ncount = ncount + 1
+        ENDIF
+        gcode = gdiag(n)(1:10)
+        IF ( ( gcode(5:5).EQ.'C' .OR. gcode(5:5).EQ.'P' )
+      &                         .AND. hdiag(n).EQ.0 ) THEN
+         WRITE(msgBuf,'(6A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &    'mate number required for diag."',cdiag(n),
+      &    '" (gdiag(5)=',gcode(5:5),')'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         ncount = ncount + 1
+        ENDIF
+       ENDDO
+       IF ( ncount.GT.0 ) THEN
+         WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
+      &    'found', ncount, ' unvalid/missing mate number(s) => STOP'
+         CALL PRINT_ERROR( msgBuf , myThid )
+         STOP 'ABNORMAL END: S/R DIAGSTATS_SET_LEVELS'
+       ENDIF
+ C--   Print to standard output
        stdUnit = standardMessageUnit
        WRITE(msgBuf,'(2A)')
       &   '------------------------------------------------------------'
        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
        WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_LEVELS: done'
        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
-       WRITE(msgBuf,'(A,I4)')
+       WRITE(msgBuf,'(A,I6)')
       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt
        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  C     write a summary of the (long) list of all available diagnostics:
-       IF ( debugLevel.GE.debLevA ) THEN
+       IF ( debugLevel.GE.debLevA .AND. myProcId.EQ.0 ) THEN
          WRITE(msgBuf,'(2A)')
       &   ' write list of available Diagnostics to file: ',
-Line 115 
 C     write a summary of the (long) list
+Line 190 
 C     write a summary of the (long) list
          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
          WRITE(ccHead,'(2A)')
-      &   ' Num |<-Name->|Levs|<-parsing code->|<--  Units   -->|',
+      &   '  Num  |<-Name->|Levs|  mate |<- code ->|',
-      &   '<- Tile (max=80c)'
+      &   '<--  Units   -->|<- Tile (max=80c)'
          DO l=1,LEN(ccLine)
           ccLine(l:l) = '-'
          ENDDO
-Line 124 
 C     write a summary of the (long) list
+Line 199 
 C     write a summary of the (long) list
          CALL MDSFINDUNIT( dUnit, mythid )
          OPEN(dUnit, file='available_diagnostics.log',
       &              status='unknown', form='formatted')
-         WRITE(dUnit,'(A,I4)')
+         WRITE(dUnit,'(A,I6)')
       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt
          WRITE(dUnit,'(A)') ccLine
          WRITE(dUnit,'(A)') ccHead
-Line 136 
 C     write a summary of the (long) list
+Line 211 
 C     write a summary of the (long) list
             WRITE(dUnit,'(A)') ccLine
           ENDIF
           l = ILNBLNK(tdiag(n))
-          IF (l.GE.1) THEN
+          gcode = gdiag(n)(1:10)
-            WRITE(dUnit,'(I4,3A,I3,6A)') n,' |',cdiag(n),'|',
+          IF ( hdiag(n).NE.0 .AND. l.GE.1 ) THEN
-      &           kdiag(n),' |',gdiag(n),'|',udiag(n),'|',tdiag(n)(1:l)
+            WRITE(dUnit,'(I6,3A,I3,A,I6,6A)') n, ' |', cdiag(n), '|',
+      &                 kdiag(n),' |', hdiag(n), ' |', gcode, '|',
+      &                 udiag(n), '|', tdiag(n)(1:l)
+          ELSEIF ( hdiag(n).NE.0 ) THEN
+            WRITE(dUnit,'(I6,3A,I3,A,I6,6A)') n, ' |', cdiag(n), '|',
+      &                 kdiag(n),' |', hdiag(n), ' |', gcode, '|',
+      &                 udiag(n), '|'
+          ELSEIF (l.GE.1) THEN
+            WRITE(dUnit,'(I6,3A,I3,6A)')      n, ' |', cdiag(n), '|',
+      &                 kdiag(n),' |       |',         gcode, '|',
+      &                 udiag(n), '|', tdiag(n)(1:l)
           ELSE
-            WRITE(dUnit,'(I4,3A,I3,6A)') n,' |',cdiag(n),'|',
+            WRITE(dUnit,'(I6,3A,I3,6A)')      n, ' |', cdiag(n), '|',
-      &           kdiag(n),' |',gdiag(n),'|',udiag(n),'|'
+      &                 kdiag(n),' |       |',         gcode, '|',
+      &                 udiag(n), '|'
           ENDIF
          ENDDO
          WRITE(dUnit,'(A)') ccLine
-Line 153 
 C---+----1----+----2----+----3----+----4
+Line 239 
 C---+----1----+----2----+----3----+----4
        ENDIF
  C--   Check for multiple definition of the same diagnostic name
-       blk8c  = '        '
        DO n = 2,ndiagt
-        IF ( cdiag(n).NE.blk8c ) THEN
+        IF ( cdiag(n).NE.blkName ) THEN
          DO l = 1,n-1
           IF ( cdiag(l).EQ.cdiag(n) ) THEN
              WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SET_LEVELS: ',

 Legend:



Removed from v.1.12
 


changed lines


 
Added in v.1.18
 Legend:



Removed from v.1.12
 


changed lines


 
Added in v.1.18
-Removed from v.1.12
+Added in v.1.18

	ViewVC Help
Powered by ViewVC 1.1.22