Back to home page

MITgcm

 
 

    


File indexing completed on 2024-05-11 05:10:24 UTC

view on githubraw file Latest commit 41c4545f on 2024-05-10 15:00:41 UTC
3ae5f90260 Jean*0001 #include "DIAG_OPTIONS.h"
                0002 
                0003 CBOP 0
                0004 C     !ROUTINE: DIAGNOSTICS_SUMMARY
                0005 
                0006 C     !INTERFACE:
41c4545f8f Jean*0007       SUBROUTINE DIAGNOSTICS_SUMMARY(
                0008      I                       seqFlag, myTime, myIter, myThid )
3ae5f90260 Jean*0009 
                0010 C     !DESCRIPTION:
                0011 C     Write a summary of diagnostics state to ASCII file unit "dUnit"
                0012 C     Notes: Only called after initialisation but could be called
                0013 C            from any place in the code.
                0014 
                0015 C     !USES:
                0016       IMPLICIT NONE
                0017 
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "DIAGNOSTICS_SIZE.h"
                0022 #include "DIAGNOSTICS.h"
                0023 
                0024 C     !INPUT PARAMETERS:
41c4545f8f Jean*0025 C     seqFlag  :: flag that indicates where this S/R is called from:
                0026 C              :: = 0 : called from DIAGNOSTICS_INIT_VARIA
                0027 C              :: = 1 : called from DIAGNOSTICS_WRITE, forward sweep
                0028 C              :: =-1 : called from DIAGNOSTICS_WRITE_ADJ, backward sweep
                0029 C     myTime   :: current Time of simulation ( s )
                0030 C     myIter   :: current Iteration number
                0031 C     myThid   :: my Thread Id number
                0032       INTEGER seqFlag
3ae5f90260 Jean*0033       _RL     myTime
                0034       INTEGER myIter, myThid
41c4545f8f Jean*0035 
                0036 C     !FUNCTIONS:
                0037       INTEGER  ILNBLNK
                0038       EXTERNAL ILNBLNK
3ae5f90260 Jean*0039 
                0040 C     !LOCAL VARIABLES:
b38beaf3c1 Jean*0041       INTEGER md, ld, ndId, ipt, im
3ae5f90260 Jean*0042       INTEGER j, k, k1, k2, l
                0043       INTEGER  dUnit, stdUnit, iLen
666b944083 Jean*0044       INTEGER xNew, xOld, ii, nDup
                0045       CHARACTER*(2) cSep
f8852da817 Jean*0046       CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
3ae5f90260 Jean*0047       CHARACTER*(MAX_LEN_FNAM) fn
                0048       CHARACTER*(72) ccLine, ccFlds, ccList
                0049       LOGICAL  outpSummary
41c4545f8f Jean*0050 #ifdef ALLOW_AUTODIFF
                0051       CHARACTER*(3) sfx3c
                0052 #endif
                0053 CEOP
3ae5f90260 Jean*0054 
                0055       _BEGIN_MASTER( myThid )
                0056       stdUnit = standardMessageUnit
                0057 
                0058 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0059 
41c4545f8f Jean*0060       IF ( diag_dBugLevel.GE.debLevB ) THEN
                0061        IF ( seqFlag.EQ.0 ) THEN
3ae5f90260 Jean*0062         outpSummary = .TRUE.
                0063         dUnit = standardMessageUnit
                0064         WRITE(msgBuf,'(A,I6)')
                0065      &   ' write diagnostics summary to file ioUnit: ',dUnit
                0066         CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0067        ELSE
                0068         outpSummary = ( myXGlobalLo.EQ.1 .AND. myYGlobalLo.EQ.1 )
                0069         IF ( outpSummary ) THEN
41c4545f8f Jean*0070 #ifdef ALLOW_AUTODIFF
                0071          sfx3c = 'fwd'
                0072          IF ( seqFlag.EQ.-1 ) sfx3c = 'adm'
                0073          WRITE(fn,'(3A,I10.10,A)') 'diagnostics_status.',
                0074      %                              sfx3c, '.', myIter, '.txt'
                0075 #else /* ALLOW_AUTODIFF */
                0076          WRITE(fn,'(A,I10.10,A)') 'diagnostics_status.', myIter, '.txt'
                0077 #endif /* ALLOW_AUTODIFF */
3ae5f90260 Jean*0078          iLen = ILNBLNK(fn)
b38beaf3c1 Jean*0079          CALL MDSFINDUNIT( dUnit, myThid )
3ae5f90260 Jean*0080          OPEN(dUnit,file=fn(1:iLen),status='unknown',form='formatted')
                0081          WRITE(msgBuf,'(2A)')
                0082      &   ' write diagnostics summary to file: ',fn(1:iLen)
                0083          CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
                0084         ENDIF
                0085        ENDIF
4b726811a4 Jean*0086       ELSE
                0087        outpSummary = .FALSE.
3ae5f90260 Jean*0088       ENDIF
                0089 
41c4545f8f Jean*0090       IF ( outpSummary .AND. diag_dBugLevel.GE.debLevB ) THEN
3ae5f90260 Jean*0091 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0092 C     write a summary diagnostics state:
                0093 
                0094         DO l=1,LEN(ccLine)
                0095          ccLine(l:l) = '-'
                0096         ENDDO
                0097         WRITE(ccList,'(2A)')
e129400813 Jean*0098      &  ' nFlds, nActive,       freq     &     phase        , nLev'
3ae5f90260 Jean*0099         WRITE(ccFlds,'(2A)')
e129400813 Jean*0100      &  ' diag# | name   |   ipt  |  iMate | kLev|   count |   mate.C|'
3ae5f90260 Jean*0101 
                0102         WRITE(dUnit,'(A,I10,A,1PE21.13)')
                0103      &   'Iter.Nb:',myIter,' ; Time(s):', myTime
                0104         WRITE(dUnit,'(A)') ccLine
                0105         WRITE(dUnit,'(A,I6)')
                0106      &   '2D/3D diagnostics: Number of lists:', nlists
                0107         WRITE(dUnit,'(A)') ccLine
                0108 
                0109         DO ld=1,nlists
                0110          iLen = ILNBLNK(fnames(ld))
e129400813 Jean*0111          WRITE(dUnit,'(A,I5,2A)') 'listId=', ld,
3ae5f90260 Jean*0112      &                            ' ; file name: ',fnames(ld)(1:iLen)
                0113          WRITE(dUnit,'(A)') ccList
e129400813 Jean*0114          WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
3ae5f90260 Jean*0115      &    nfields(ld), '  |',nActive(ld), '  |',
                0116      &    freq(ld), phase(ld), ' |', nlevels(ld)
c65a5004af Jean*0117          IF ( fflags(ld)(2:2).EQ.'P' ) THEN
                0118           DO k1=1,nlevels(ld),10
                0119            k2 = MIN(nlevels(ld),k1+9)
                0120            WRITE(dUnit,'(A,1P10E10.3)')' interp:', (levs(k,ld),k=k1,k2)
                0121           ENDDO
                0122          ELSE
                0123           DO k1=1,nlevels(ld),25
                0124            k2 = MIN(nlevels(ld),k1+24)
                0125            WRITE(dUnit,'(A,25I4)')' levels:',(NINT(levs(k,ld)),k=k1,k2)
                0126           ENDDO
                0127          ENDIF
3ae5f90260 Jean*0128          WRITE(dUnit,'(A)') ccFlds
                0129          DO md=1,nActive(ld)
b38beaf3c1 Jean*0130            ndId = ABS(jdiag(md,ld))
e129400813 Jean*0131            WRITE(msgBuf,'(I6,3A,2(I7,A),I4,A)')
3ae5f90260 Jean*0132      &       jdiag(md,ld),' |', flds(md,ld),'|',idiag(md,ld),' |',
b38beaf3c1 Jean*0133      &       mdiag(md,ld),' |', kdiag(ndId),' |'
3ae5f90260 Jean*0134            ipt = ABS(idiag(md,ld))
666b944083 Jean*0135            IF (ipt.NE.0 .AND. averageCycle(ld).GT.1) THEN
                0136              xOld=ndiag(ipt,1,1)
                0137              nDup = 1
                0138              cSep = ', '
                0139              DO l=1,averageCycle(ld)
b38beaf3c1 Jean*0140                ii = ipt+l*kdiag(ndId)
666b944083 Jean*0141                IF (l.EQ.averageCycle(ld)) THEN
                0142                  cSep = ' |'
                0143                  xNew=xOld+1
                0144                ELSE
                0145                  xNew=ndiag(ii,1,1)
                0146                ENDIF
                0147                IF (xNew.EQ.xOld) THEN
                0148                  nDup = nDup + 1
                0149                ELSE
                0150                  iLen = ILNBLNK(msgBuf)
                0151                  tmpBuf(1:iLen) = msgBuf(1:iLen)
                0152                  IF (nDup.EQ.1) THEN
e129400813 Jean*0153                    WRITE(msgBuf,'(A,I7,A)') tmpBuf(1:iLen),xOld,cSep
666b944083 Jean*0154                  ELSE
e129400813 Jean*0155                    WRITE(msgBuf,'(A,I7,A,I3,2A)') tmpBuf(1:iLen),xOld,
666b944083 Jean*0156      &              '(x',nDup,')',cSep
                0157                  ENDIF
                0158                  xOld = xNew
                0159                  nDup = 1
                0160                ENDIF
                0161              ENDDO
                0162            ELSEIF (ipt.NE.0) THEN
3ae5f90260 Jean*0163             iLen = ILNBLNK(msgBuf)
f8852da817 Jean*0164             tmpBuf(1:iLen) = msgBuf(1:iLen)
e129400813 Jean*0165             WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
666b944083 Jean*0166             im = mdiag(md,ld)
                0167             IF (im.NE.0) THEN
                0168              iLen = ILNBLNK(msgBuf)
                0169              tmpBuf(1:iLen) = msgBuf(1:iLen)
e129400813 Jean*0170              WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
666b944083 Jean*0171             ENDIF
3ae5f90260 Jean*0172            ENDIF
                0173            iLen = ILNBLNK(msgBuf)
                0174            WRITE(dUnit,'(A)') msgBuf(1:iLen)
                0175          ENDDO
                0176 c        WRITE(dUnit,'(A)') ccFlds
                0177          WRITE(dUnit,'(A)') ccLine
                0178 
                0179         ENDDO
                0180 
                0181 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0182 
                0183 c       WRITE(dUnit,'(A)') ccLine
                0184         WRITE(dUnit,'(A,I6)')
                0185      &   'Global & Regional Statistics diagnostics: Number of lists:',
                0186      &     diagSt_nbLists
                0187         WRITE(dUnit,'(A)') ccLine
                0188 
                0189         WRITE(ccList,'(2A)')
e129400813 Jean*0190      &   ' nFlds, nActive,       freq     &     phase        |'
3ae5f90260 Jean*0191         WRITE(ccFlds,'(2A)')
e129400813 Jean*0192      &   ' diag# | name   |   ipt  |  iMate |',
                0193      &          '    Volume   |   mate-Vol. |'
3ae5f90260 Jean*0194 
                0195         DO ld=1,diagSt_nbLists
                0196          iLen = ILNBLNK(diagSt_Fname(ld))
                0197          WRITE(dUnit,'(A,I4,2A)') 'listId=', ld,
                0198      &                     ' ; file name: ',diagSt_Fname(ld)(1:iLen)
                0199          WRITE(dUnit,'(A)') ccList
e129400813 Jean*0200          WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
3ae5f90260 Jean*0201      &    diagSt_nbFlds(ld), '  |',diagSt_nbActv(ld), '  |',
                0202      &    diagSt_freq(ld), diagSt_phase(ld), ' |'
                0203          WRITE(msgBuf,'(A)') ' Regions: '
                0204          iLen = 10
                0205          DO j=0,nRegions
                0206            IF ( diagSt_region(j,ld).GE.1
                0207      &          .AND. iLen+3.LE.MAX_LEN_MBUF) THEN
f8852da817 Jean*0208              tmpBuf(1:iLen) = msgBuf(1:iLen)
                0209              WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
3ae5f90260 Jean*0210              iLen = iLen+3
                0211            ENDIF
                0212          ENDDO
                0213          WRITE(dUnit,'(A)') msgBuf(1:iLen)
                0214 
                0215          WRITE(dUnit,'(A)') ccFlds
                0216          DO md=1,diagSt_nbActv(ld)
e129400813 Jean*0217            WRITE(msgBuf,'(I6,3A,2(I7,A))')
3ae5f90260 Jean*0218      &       jSdiag(md,ld),' |', diagSt_Flds(md,ld),'|',iSdiag(md,ld),
                0219      &       ' |', mSdiag(md,ld),' |'
                0220            ipt = ABS(iSdiag(md,ld))
                0221            IF (ipt.NE.0) THEN
                0222             iLen = ILNBLNK(msgBuf)
f8852da817 Jean*0223             tmpBuf(1:iLen) = msgBuf(1:iLen)
                0224             WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
3ae5f90260 Jean*0225      &                         qSdiag(0,0,ipt,1,1),' |'
                0226            ENDIF
                0227            im = mSdiag(md,ld)
                0228            IF (im.NE.0) THEN
                0229             iLen = ILNBLNK(msgBuf)
f8852da817 Jean*0230             tmpBuf(1:iLen) = msgBuf(1:iLen)
                0231             WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
3ae5f90260 Jean*0232      &                         qSdiag(0,0,im, 1,1),' |'
                0233            ENDIF
                0234            iLen = ILNBLNK(msgBuf)
                0235            WRITE(dUnit,'(A)') msgBuf(1:iLen)
                0236          ENDDO
                0237 c        WRITE(dUnit,'(A)') ccFlds
                0238          WRITE(dUnit,'(A)') ccLine
                0239 
                0240         ENDDO
                0241 
                0242 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0243         IF ( dUnit.NE.standardMessageUnit ) CLOSE(dUnit)
                0244       ENDIF
                0245 
                0246       _END_MASTER( myThid )
                0247 
                0248       RETURN
                0249       END