C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_summary.F,v 1.8 2017/07/23 00:24:18 jmc Exp $
C $Name: $
#include "DIAG_OPTIONS.h"
CBOP 0
C !ROUTINE: DIAGNOSTICS_SUMMARY
C !INTERFACE:
SUBROUTINE DIAGNOSTICS_SUMMARY( myTime, myIter, myThid )
C !DESCRIPTION:
C Write a summary of diagnostics state to ASCII file unit "dUnit"
C Notes: Only called after initialisation but could be called
C from any place in the code.
C !USES:
IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"
C !INPUT PARAMETERS:
C myThid :: my Thread Id number
_RL myTime
INTEGER myIter, myThid
CEOP
C !LOCAL VARIABLES:
INTEGER md, ld, ndId, ipt, im
INTEGER j, k, k1, k2, l
INTEGER dUnit, stdUnit, iLen
INTEGER xNew, xOld, ii, nDup
CHARACTER*(2) cSep
CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
CHARACTER*(MAX_LEN_FNAM) fn
CHARACTER*(72) ccLine, ccFlds, ccList
LOGICAL outpSummary
INTEGER ILNBLNK
EXTERNAL
_BEGIN_MASTER( myThid )
stdUnit = standardMessageUnit
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( debugLevel.GE.debLevB ) THEN
IF ( myIter.EQ.nIter0 ) THEN
outpSummary = .TRUE.
dUnit = standardMessageUnit
WRITE(msgBuf,'(A,I6)')
& ' write diagnostics summary to file ioUnit: ',dUnit
CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ELSE
outpSummary = ( myXGlobalLo.EQ.1 .AND. myYGlobalLo.EQ.1 )
IF ( outpSummary ) THEN
WRITE(fn,'(A,I10.10,A)') 'diagnostics_status.',myIter,'.txt'
iLen = ILNBLNK(fn)
CALL MDSFINDUNIT( dUnit, myThid )
OPEN(dUnit,file=fn(1:iLen),status='unknown',form='formatted')
WRITE(msgBuf,'(2A)')
& ' write diagnostics summary to file: ',fn(1:iLen)
CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
ENDIF
ENDIF
ELSE
outpSummary = .FALSE.
ENDIF
IF ( outpSummary .AND. debugLevel.GE.debLevB ) THEN
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C write a summary diagnostics state:
DO l=1,LEN(ccLine)
ccLine(l:l) = '-'
ENDDO
WRITE(ccList,'(2A)')
& ' nFlds, nActive, freq & phase , nLev'
WRITE(ccFlds,'(2A)')
& ' diag# | name | ipt | iMate | kLev| count | mate.C|'
WRITE(dUnit,'(A,I10,A,1PE21.13)')
& 'Iter.Nb:',myIter,' ; Time(s):', myTime
WRITE(dUnit,'(A)') ccLine
WRITE(dUnit,'(A,I6)')
& '2D/3D diagnostics: Number of lists:', nlists
WRITE(dUnit,'(A)') ccLine
DO ld=1,nlists
iLen = ILNBLNK(fnames(ld))
WRITE(dUnit,'(A,I5,2A)') 'listId=', ld,
& ' ; file name: ',fnames(ld)(1:iLen)
WRITE(dUnit,'(A)') ccList
WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
& nfields(ld), ' |',nActive(ld), ' |',
& freq(ld), phase(ld), ' |', nlevels(ld)
IF ( fflags(ld)(2:2).EQ.'P' ) THEN
DO k1=1,nlevels(ld),10
k2 = MIN(nlevels(ld),k1+9)
WRITE(dUnit,'(A,1P10E10.3)')' interp:', (levs(k,ld),k=k1,k2)
ENDDO
ELSE
DO k1=1,nlevels(ld),25
k2 = MIN(nlevels(ld),k1+24)
WRITE(dUnit,'(A,25I4)')' levels:',(NINT(levs(k,ld)),k=k1,k2)
ENDDO
ENDIF
WRITE(dUnit,'(A)') ccFlds
DO md=1,nActive(ld)
ndId = ABS(jdiag(md,ld))
WRITE(msgBuf,'(I6,3A,2(I7,A),I4,A)')
& jdiag(md,ld),' |', flds(md,ld),'|',idiag(md,ld),' |',
& mdiag(md,ld),' |', kdiag(ndId),' |'
ipt = ABS(idiag(md,ld))
IF (ipt.NE.0 .AND. averageCycle(ld).GT.1) THEN
xOld=ndiag(ipt,1,1)
nDup = 1
cSep = ', '
DO l=1,averageCycle(ld)
ii = ipt+l*kdiag(ndId)
IF (l.EQ.averageCycle(ld)) THEN
cSep = ' |'
xNew=xOld+1
ELSE
xNew=ndiag(ii,1,1)
ENDIF
IF (xNew.EQ.xOld) THEN
nDup = nDup + 1
ELSE
iLen = ILNBLNK(msgBuf)
tmpBuf(1:iLen) = msgBuf(1:iLen)
IF (nDup.EQ.1) THEN
WRITE(msgBuf,'(A,I7,A)') tmpBuf(1:iLen),xOld,cSep
ELSE
WRITE(msgBuf,'(A,I7,A,I3,2A)') tmpBuf(1:iLen),xOld,
& '(x',nDup,')',cSep
ENDIF
xOld = xNew
nDup = 1
ENDIF
ENDDO
ELSEIF (ipt.NE.0) THEN
iLen = ILNBLNK(msgBuf)
tmpBuf(1:iLen) = msgBuf(1:iLen)
WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
im = mdiag(md,ld)
IF (im.NE.0) THEN
iLen = ILNBLNK(msgBuf)
tmpBuf(1:iLen) = msgBuf(1:iLen)
WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
ENDIF
ENDIF
iLen = ILNBLNK(msgBuf)
WRITE(dUnit,'(A)') msgBuf(1:iLen)
ENDDO
c WRITE(dUnit,'(A)') ccFlds
WRITE(dUnit,'(A)') ccLine
ENDDO
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
c WRITE(dUnit,'(A)') ccLine
WRITE(dUnit,'(A,I6)')
& 'Global & Regional Statistics diagnostics: Number of lists:',
& diagSt_nbLists
WRITE(dUnit,'(A)') ccLine
WRITE(ccList,'(2A)')
& ' nFlds, nActive, freq & phase |'
WRITE(ccFlds,'(2A)')
& ' diag# | name | ipt | iMate |',
& ' Volume | mate-Vol. |'
DO ld=1,diagSt_nbLists
iLen = ILNBLNK(diagSt_Fname(ld))
WRITE(dUnit,'(A,I4,2A)') 'listId=', ld,
& ' ; file name: ',diagSt_Fname(ld)(1:iLen)
WRITE(dUnit,'(A)') ccList
WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
& diagSt_nbFlds(ld), ' |',diagSt_nbActv(ld), ' |',
& diagSt_freq(ld), diagSt_phase(ld), ' |'
WRITE(msgBuf,'(A)') ' Regions: '
iLen = 10
DO j=0,nRegions
IF ( diagSt_region(j,ld).GE.1
& .AND. iLen+3.LE.MAX_LEN_MBUF) THEN
tmpBuf(1:iLen) = msgBuf(1:iLen)
WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
iLen = iLen+3
ENDIF
ENDDO
WRITE(dUnit,'(A)') msgBuf(1:iLen)
WRITE(dUnit,'(A)') ccFlds
DO md=1,diagSt_nbActv(ld)
WRITE(msgBuf,'(I6,3A,2(I7,A))')
& jSdiag(md,ld),' |', diagSt_Flds(md,ld),'|',iSdiag(md,ld),
& ' |', mSdiag(md,ld),' |'
ipt = ABS(iSdiag(md,ld))
IF (ipt.NE.0) THEN
iLen = ILNBLNK(msgBuf)
tmpBuf(1:iLen) = msgBuf(1:iLen)
WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
& qSdiag(0,0,ipt,1,1),' |'
ENDIF
im = mSdiag(md,ld)
IF (im.NE.0) THEN
iLen = ILNBLNK(msgBuf)
tmpBuf(1:iLen) = msgBuf(1:iLen)
WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
& qSdiag(0,0,im, 1,1),' |'
ENDIF
iLen = ILNBLNK(msgBuf)
WRITE(dUnit,'(A)') msgBuf(1:iLen)
ENDDO
c WRITE(dUnit,'(A)') ccFlds
WRITE(dUnit,'(A)') ccLine
ENDDO
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
IF ( dUnit.NE.standardMessageUnit ) CLOSE(dUnit)
ENDIF
_END_MASTER( myThid )
RETURN
END