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
0004
0005
0006
41c4545f8f Jean*0007 SUBROUTINE DIAGNOSTICS_SUMMARY(
0008 I seqFlag, myTime, myIter, myThid )
3ae5f90260 Jean*0009
0010
0011
0012
0013
0014
0015
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
41c4545f8f Jean*0025
0026
0027
0028
0029
0030
0031
0032 INTEGER seqFlag
3ae5f90260 Jean*0033 _RL myTime
0034 INTEGER myIter, myThid
41c4545f8f Jean*0035
0036
0037 INTEGER ILNBLNK
0038 EXTERNAL ILNBLNK
3ae5f90260 Jean*0039
0040
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
3ae5f90260 Jean*0054
0055 _BEGIN_MASTER( myThid )
0056 stdUnit = standardMessageUnit
0057
0058
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
0092
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
0177 WRITE(dUnit,'(A)') ccLine
0178
0179 ENDDO
0180
0181
0182
0183
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
0238 WRITE(dUnit,'(A)') ccLine
0239
0240 ENDDO
0241
0242
0243 IF ( dUnit.NE.standardMessageUnit ) CLOSE(dUnit)
0244 ENDIF
0245
0246 _END_MASTER( myThid )
0247
0248 RETURN
0249 END