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

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

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

revision 1.28 by jmc, Sun Jan 25 17:00:20 2009 UTC revision 1.29 by jmc, Fri Jan 15 00:25:58 2010 UTC
# Line 8  C--    Contents: Line 8  C--    Contents:
8  C--    o GETDIAG  C--    o GETDIAG
9  C--    o DIAGNOSTICS_COUNT  C--    o DIAGNOSTICS_COUNT
10  C--    o DIAGNOSTICS_GET_POINTERS  C--    o DIAGNOSTICS_GET_POINTERS
11    C--    o DIAGNOSTICS_SETKLEV
12  C--    o DIAGS_GET_PARMS_I (Function)  C--    o DIAGS_GET_PARMS_I (Function)
13  C--    o DIAGS_MK_UNITS (Function)  C--    o DIAGS_MK_UNITS (Function)
14  C--    o DIAGS_MK_TITLE (Function)  C--    o DIAGS_MK_TITLE (Function)
# Line 295  C-    search for this diag. in the activ Line 296  C-    search for this diag. in the activ
296  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
297    
298  CBOP 0  CBOP 0
299    C     !ROUTINE: DIAGNOSTICS_SETKLEV
300    
301    C     !INTERFACE:
302          SUBROUTINE DIAGNOSTICS_SETKLEV(
303         I                                diagName, nLevDiag, myThid )
304    
305    C     !DESCRIPTION:
306    C     *==========================================================*
307    C     | S/R DIAGNOSTICS_SETKLEV
308    C     | o Define explicitly the number of level (stored in kdiag)
309    C     |   of a diagnostic field. For most diagnostics, the number
310    C     |   of levels is derived (in S/R SET_LEVELS) from gdiag(10)
311    C     |   but occasionally one may want to set it explicitly.
312    C     *==========================================================*
313    
314    C     !USES:
315          IMPLICIT NONE
316    #include "EEPARAMS.h"
317    #include "SIZE.h"
318    #include "DIAGNOSTICS_SIZE.h"
319    #include "DIAGNOSTICS.h"
320    
321    C     !INPUT PARAMETERS:
322    C     diagName  :: diagnostic identificator name (8 characters long)
323    C     nLevDiag  :: number of level to set for this diagnostics field
324    C     myThid    :: my Thread Id number
325          CHARACTER*8  diagName
326          INTEGER nLevDiag
327          INTEGER myThid
328    CEOP
329    
330    C     !LOCAL VARIABLES:
331          CHARACTER*(MAX_LEN_MBUF) msgBuf
332          INTEGER n, ndId
333    
334    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
335    
336    C--   Check if this S/R is called from the right place ;
337    C     needs to be after DIAGNOSTICS_INIT_EARLY and before DIAGNOSTICS_INIT_FIXED
338          IF ( .NOT.settingDiags ) THEN
339            WRITE(msgBuf,'(4A,I5)') 'DIAGNOSTICS_SETKLEV: ',
340         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
341            CALL PRINT_ERROR( msgBuf, myThid )
342            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
343         &     '<== called from the WRONG place, i.e.'
344            CALL PRINT_ERROR( msgBuf, myThid )
345            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
346         &     'outside diagnostics setting section = from'
347            CALL PRINT_ERROR( msgBuf, myThid )
348            WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_SETKLEV: ',
349         &     '   Diag_INIT_EARLY down to Diag_INIT_FIXED'
350            CALL PRINT_ERROR( msgBuf, myThid )
351            STOP 'ABNORMAL END: S/R DIAGNOSTICS_SETKLEV'
352          ENDIF
353    
354    C--   Find this diagnostics in the list of available diag.
355          ndId = 0
356          DO n = 1,ndiagt
357            IF ( diagName.EQ.cdiag(n) ) THEN
358              ndId = n
359            ENDIF
360          ENDDO
361          IF ( ndId.EQ.0 ) THEN
362            WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_SETKLEV: ',
363         &     'diagName="', diagName, '" not known.'
364            CALL PRINT_ERROR( msgBuf, myThid )
365            STOP 'ABNORMAL END: S/R DIAGNOSTICS_SETKLEV'
366          ENDIF
367    
368    C-    Optional level number diagnostics (X): set number of levels
369          IF ( kdiag(ndId).EQ.0
370         &   .AND. gdiag(ndId)(10:10).EQ.'X' ) THEN
371            kdiag(ndId) = nLevDiag
372          ELSEIF ( kdiag(ndId).EQ.nLevDiag
373         &   .AND. gdiag(ndId)(10:10).EQ.'X' ) THEN
374    C-    level number already set to same value: send warning
375            WRITE(msgBuf,'(4A,I5)') '** WARNING ** DIAGNOSTICS_SETKLEV: ',
376         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
377            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
378         &                      SQUEEZE_RIGHT , myThid )
379            WRITE(msgBuf,'(2A,I5,A)')'** WARNING ** DIAGNOSTICS_SETKLEV:',
380         &     ' level Nb (=', kdiag(ndId), ') already set.'
381            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
382         &                      SQUEEZE_RIGHT , myThid )
383          ELSEIF ( gdiag(ndId)(10:10).EQ.'X' ) THEN
384    C-    level number already set to a different value: do not reset but stop
385            WRITE(msgBuf,'(4A,I5)') 'DIAGNOSTICS_SETKLEV: ',
386         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
387            CALL PRINT_ERROR( msgBuf, myThid )
388            WRITE(msgBuf,'(2A,I5,3A)') 'DIAGNOSTICS_SETKLEV: ',
389         &     'level Nb already set to', kdiag(ndId), ' => STOP'
390            CALL PRINT_ERROR( msgBuf, myThid )
391          ELSE
392    C-    for now, do nothing but just send a warning
393            WRITE(msgBuf,'(4A,I5)') '** WARNING ** DIAGNOSTICS_SETKLEV: ',
394         &     'diagName="', diagName, '" , nLevDiag=', nLevDiag
395            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
396         &                      SQUEEZE_RIGHT , myThid )
397            WRITE(msgBuf,'(2A,I5,3A)') '** WARNING ** will set level Nb',
398         &     ' from diagCode(ndId=', ndId, ')="', gdiag(ndId)(1:10), '"'
399            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
400         &                      SQUEEZE_RIGHT , myThid )
401            WRITE(msgBuf,'(4A)') '** WARNING ** DIAGNOSTICS_SETKLEV',
402         &     '("', diagName, '") <== Ignore this call.'
403            CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
404         &                      SQUEEZE_RIGHT , myThid )
405          ENDIF
406    
407          RETURN
408          END
409    
410    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
411    
412    CBOP 0
413  C     !ROUTINE: DIAGS_GET_PARMS_I  C     !ROUTINE: DIAGS_GET_PARMS_I
414    
415  C     !INTERFACE:  C     !INTERFACE:
# Line 376  C     !LOCAL VARIABLES: Line 491  C     !LOCAL VARIABLES:
491        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
492        INTEGER i,j,n        INTEGER i,j,n
493    
494        DIAGS_MK_UNITS = '          '        DIAGS_MK_UNITS = '                '
495        n = LEN(diagUnitsInPieces)        n = LEN(diagUnitsInPieces)
496    
497        j = 0        j = 0
# Line 388  C     !LOCAL VARIABLES: Line 503  C     !LOCAL VARIABLES:
503        ENDDO        ENDDO
504    
505        IF ( j.GT.16 ) THEN        IF ( j.GT.16 ) THEN
506           WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',           WRITE(msgBuf,'(2A,I4,A)') '** WARNING ** ',
507       &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'       &   'DIAGS_MK_UNITS: too long (',j,' >16) input string'
508          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
509       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
510           WRITE(msgBuf,'(3A)') '**WARNING** ',           WRITE(msgBuf,'(3A)') '** WARNING ** ',
511       &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces       &   'DIAGS_MK_UNITS: input=', diagUnitsInPieces
512          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
513       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
# Line 457  C---+----1----+----2----+----3----+----4 Line 572  C---+----1----+----2----+----3----+----4
572        ENDDO        ENDDO
573    
574        IF ( j.GT.80 ) THEN        IF ( j.GT.80 ) THEN
575           WRITE(msgBuf,'(2A,I4,A)') '**WARNING** ',           WRITE(msgBuf,'(2A,I4,A)') '** WARNING ** ',
576       &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'       &   'DIAGS_MK_TITLE: too long (',j,' >80) input string'
577          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
578       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
579           WRITE(msgBuf,'(3A)') '**WARNING** ',           WRITE(msgBuf,'(3A)') '** WARNING ** ',
580       &   'DIAGS_MK_TITLE: input=', diagTitleInPieces       &   'DIAGS_MK_TITLE: input=', diagTitleInPieces
581          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,          CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
582       &       SQUEEZE_RIGHT , myThid)       &       SQUEEZE_RIGHT , myThid)
Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22