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

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

Parent Directory Parent Directory | Revision Log 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.15 by jmc, Mon Jan 11 19:44:41 2010 UTC
# Line 59  C     myThid :: my Thread Id number Line 59  C     myThid :: my Thread Id number
59  CEOP  CEOP
60    
61  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
62        INTEGER l, n, nlevs, nGroundLev        INTEGER l, n, ncount
63          INTEGER nlevs, nGroundLev
64        INTEGER  dUnit, stdUnit        INTEGER  dUnit, stdUnit
65        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
66        CHARACTER*(72) ccHead, ccLine        CHARACTER*84 ccHead, ccLine
67        CHARACTER*8 blk8c        CHARACTER*8  blk8c
68          CHARACTER*10 gcode
69        INTEGER  ILNBLNK        INTEGER  ILNBLNK
70        EXTERNAL ILNBLNK        EXTERNAL ILNBLNK
71    
# Line 74  C---+----1----+----2----+----3----+----4 Line 76  C---+----1----+----2----+----3----+----4
76        nlevs   = MAX(Nr,Nrphys)        nlevs   = MAX(Nr,Nrphys)
77        nGroundLev = land_nLev        nGroundLev = land_nLev
78    
79  c     Diagnostic Levels  C     Diagnostic Levels
80  c     -----------------  C     -----------------
81        DO n = 1,ndiagt        DO n = 1,ndiagt
82          IF     (gdiag(n)(10:10) .EQ. '0') THEN          IF     (gdiag(n)(10:10) .EQ. '0') THEN
83            kdiag(n) = 0            kdiag(n) = 0
# Line 95  C-      others: set 1 level: Line 97  C-      others: set 1 level:
97          ENDIF          ENDIF
98        ENDDO        ENDDO
99    
100    C--   Check for inconsistent diagnostic parser field
101          ncount = 0
102          DO n = 1,ndiagt
103           gcode = gdiag(n)(1:10)
104           IF ( ( gcode(3:3).EQ.'r' .OR. gcode(3:3).EQ.'R' )
105         &                         .AND. gcode(10:10).NE.'R' ) THEN
106            WRITE(msgBuf,'(2A,4A)') 'DIAGNOSTICS_SET_LEVELS: ',
107         &   'inconsistent gdiag(3&10)="',gcode,'" for diag."',cdiag(n),'"'
108            CALL PRINT_ERROR( msgBuf , myThid )
109            ncount = ncount + 1
110           ENDIF
111          ENDDO
112          IF ( ncount.GT.0 ) THEN
113            WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
114         &   'found', ncount, ' inconsistent parser "gdiag" => STOP'
115            CALL PRINT_ERROR( msgBuf , myThid )
116            STOP 'ABNORMAL END: S/R DIAGSTATS_SET_LEVELS'
117          ENDIF
118    
119    C--   Check for unvalid diag.mate number
120          ncount = 0
121          DO n = 1,ndiagt
122           IF ( hdiag(n).LT.0 .OR. hdiag(n).GT.ndiagt ) THEN
123            WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
124         &    'unvalid mate number=',hdiag(n),' for diag."',cdiag(n),'"'
125            CALL PRINT_ERROR( msgBuf , myThid )
126            ncount = ncount + 1
127           ENDIF
128          ENDDO
129          IF ( ncount.GT.0 ) THEN
130            WRITE(msgBuf,'(2A,I6,3A)') 'DIAGNOSTICS_SET_LEVELS: ',
131         &    'found', ncount, ' unvalid mate number(s) => STOP'
132            CALL PRINT_ERROR( msgBuf , myThid )
133            STOP 'ABNORMAL END: S/R DIAGSTATS_SET_LEVELS'
134          ENDIF
135    
136    C--   Print to standard output
137        stdUnit = standardMessageUnit        stdUnit = standardMessageUnit
138        WRITE(msgBuf,'(2A)')        WRITE(msgBuf,'(2A)')
139       &   '------------------------------------------------------------'       &   '------------------------------------------------------------'
140        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
141        WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_LEVELS: done'        WRITE(msgBuf,'(A)') 'DIAGNOSTICS_SET_LEVELS: done'
142        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
143        WRITE(msgBuf,'(A,I4)')        WRITE(msgBuf,'(A,I6)')
144       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt
145        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)        CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
146    
147  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
148  C     write a summary of the (long) list of all available diagnostics:  C     write a summary of the (long) list of all available diagnostics:
149        IF ( debugLevel.GE.debLevA ) THEN        IF ( debugLevel.GE.debLevA .AND. myProcId.EQ.0 ) THEN
150    
151          WRITE(msgBuf,'(2A)')          WRITE(msgBuf,'(2A)')
152       &   ' write list of available Diagnostics to file: ',       &   ' write list of available Diagnostics to file: ',
# Line 115  C     write a summary of the (long) list Line 154  C     write a summary of the (long) list
154          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
155    
156          WRITE(ccHead,'(2A)')          WRITE(ccHead,'(2A)')
157       &   ' Num |<-Name->|Levs|<-parsing code->|<--  Units   -->|',       &   '  Num  |<-Name->|Levs|  mate |<- code ->|',
158       &   '<- Tile (max=80c)'       &   '<--  Units   -->|<- Tile (max=80c)'
159          DO l=1,LEN(ccLine)          DO l=1,LEN(ccLine)
160           ccLine(l:l) = '-'           ccLine(l:l) = '-'
161          ENDDO          ENDDO
# Line 124  C     write a summary of the (long) list Line 163  C     write a summary of the (long) list
163          CALL MDSFINDUNIT( dUnit, mythid )          CALL MDSFINDUNIT( dUnit, mythid )
164          OPEN(dUnit, file='available_diagnostics.log',          OPEN(dUnit, file='available_diagnostics.log',
165       &              status='unknown', form='formatted')       &              status='unknown', form='formatted')
166          WRITE(dUnit,'(A,I4)')          WRITE(dUnit,'(A,I6)')
167       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt       &   ' Total Nb of available Diagnostics: ndiagt=', ndiagt
168          WRITE(dUnit,'(A)') ccLine          WRITE(dUnit,'(A)') ccLine
169          WRITE(dUnit,'(A)') ccHead          WRITE(dUnit,'(A)') ccHead
# Line 136  C     write a summary of the (long) list Line 175  C     write a summary of the (long) list
175             WRITE(dUnit,'(A)') ccLine             WRITE(dUnit,'(A)') ccLine
176           ENDIF           ENDIF
177           l = ILNBLNK(tdiag(n))           l = ILNBLNK(tdiag(n))
178           IF (l.GE.1) THEN           gcode = gdiag(n)(1:10)
179             WRITE(dUnit,'(I4,3A,I3,6A)') n,' |',cdiag(n),'|',           IF ( hdiag(n).NE.0 .AND. l.GE.1 ) THEN
180       &           kdiag(n),' |',gdiag(n),'|',udiag(n),'|',tdiag(n)(1:l)             WRITE(dUnit,'(I6,3A,I3,A,I6,6A)') n, ' |', cdiag(n), '|',
181         &                 kdiag(n),' |', hdiag(n), ' |', gcode, '|',
182         &                 udiag(n), '|', tdiag(n)(1:l)
183             ELSEIF ( hdiag(n).NE.0 ) THEN
184               WRITE(dUnit,'(I6,3A,I3,A,I6,6A)') n, ' |', cdiag(n), '|',
185         &                 kdiag(n),' |', hdiag(n), ' |', gcode, '|',
186         &                 udiag(n), '|'
187             ELSEIF (l.GE.1) THEN
188               WRITE(dUnit,'(I6,3A,I3,6A)')      n, ' |', cdiag(n), '|',
189         &                 kdiag(n),' |       |',         gcode, '|',
190         &                 udiag(n), '|', tdiag(n)(1:l)
191           ELSE           ELSE
192             WRITE(dUnit,'(I4,3A,I3,6A)') n,' |',cdiag(n),'|',             WRITE(dUnit,'(I6,3A,I3,6A)')      n, ' |', cdiag(n), '|',
193       &           kdiag(n),' |',gdiag(n),'|',udiag(n),'|'       &                 kdiag(n),' |       |',         gcode, '|',
194         &                 udiag(n), '|'
195           ENDIF           ENDIF
196          ENDDO          ENDDO
197          WRITE(dUnit,'(A)') ccLine          WRITE(dUnit,'(A)') ccLine
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22