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

Contents of /MITgcm/pkg/diagnostics/diagnostics_summary.F

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


Revision 1.8 - (show annotations) (download)
Sun Jul 23 00:24:18 2017 UTC (6 years, 9 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, HEAD
Changes since 1.7: +6 -5 lines
allows for negative "jdiag" (interpret |jdiag| instead)

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_summary.F,v 1.7 2011/06/06 15:42:58 jmc Exp $
2 C $Name: $
3
4 #include "DIAG_OPTIONS.h"
5
6 CBOP 0
7 C !ROUTINE: DIAGNOSTICS_SUMMARY
8
9 C !INTERFACE:
10 SUBROUTINE DIAGNOSTICS_SUMMARY( myTime, myIter, myThid )
11
12 C !DESCRIPTION:
13 C Write a summary of diagnostics state to ASCII file unit "dUnit"
14 C Notes: Only called after initialisation but could be called
15 C from any place in the code.
16
17 C !USES:
18 IMPLICIT NONE
19
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "DIAGNOSTICS_SIZE.h"
24 #include "DIAGNOSTICS.h"
25
26 C !INPUT PARAMETERS:
27 C myThid :: my Thread Id number
28 _RL myTime
29 INTEGER myIter, myThid
30 CEOP
31
32 C !LOCAL VARIABLES:
33 INTEGER md, ld, ndId, ipt, im
34 INTEGER j, k, k1, k2, l
35 INTEGER dUnit, stdUnit, iLen
36 INTEGER xNew, xOld, ii, nDup
37 CHARACTER*(2) cSep
38 CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
39 CHARACTER*(MAX_LEN_FNAM) fn
40 CHARACTER*(72) ccLine, ccFlds, ccList
41 LOGICAL outpSummary
42 INTEGER ILNBLNK
43 EXTERNAL ILNBLNK
44
45 _BEGIN_MASTER( myThid )
46 stdUnit = standardMessageUnit
47
48 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
49
50 IF ( debugLevel.GE.debLevB ) THEN
51 IF ( myIter.EQ.nIter0 ) THEN
52 outpSummary = .TRUE.
53 dUnit = standardMessageUnit
54 WRITE(msgBuf,'(A,I6)')
55 & ' write diagnostics summary to file ioUnit: ',dUnit
56 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
57 ELSE
58 outpSummary = ( myXGlobalLo.EQ.1 .AND. myYGlobalLo.EQ.1 )
59 IF ( outpSummary ) THEN
60 WRITE(fn,'(A,I10.10,A)') 'diagnostics_status.',myIter,'.txt'
61 iLen = ILNBLNK(fn)
62 CALL MDSFINDUNIT( dUnit, myThid )
63 OPEN(dUnit,file=fn(1:iLen),status='unknown',form='formatted')
64 WRITE(msgBuf,'(2A)')
65 & ' write diagnostics summary to file: ',fn(1:iLen)
66 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
67 ENDIF
68 ENDIF
69 ELSE
70 outpSummary = .FALSE.
71 ENDIF
72
73 IF ( outpSummary .AND. debugLevel.GE.debLevB ) THEN
74 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
75 C write a summary diagnostics state:
76
77 DO l=1,LEN(ccLine)
78 ccLine(l:l) = '-'
79 ENDDO
80 WRITE(ccList,'(2A)')
81 & ' nFlds, nActive, freq & phase , nLev'
82 WRITE(ccFlds,'(2A)')
83 & ' diag# | name | ipt | iMate | kLev| count | mate.C|'
84
85 WRITE(dUnit,'(A,I10,A,1PE21.13)')
86 & 'Iter.Nb:',myIter,' ; Time(s):', myTime
87 WRITE(dUnit,'(A)') ccLine
88 WRITE(dUnit,'(A,I6)')
89 & '2D/3D diagnostics: Number of lists:', nlists
90 WRITE(dUnit,'(A)') ccLine
91
92 DO ld=1,nlists
93 iLen = ILNBLNK(fnames(ld))
94 WRITE(dUnit,'(A,I5,2A)') 'listId=', ld,
95 & ' ; file name: ',fnames(ld)(1:iLen)
96 WRITE(dUnit,'(A)') ccList
97 WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
98 & nfields(ld), ' |',nActive(ld), ' |',
99 & freq(ld), phase(ld), ' |', nlevels(ld)
100 IF ( fflags(ld)(2:2).EQ.'P' ) THEN
101 DO k1=1,nlevels(ld),10
102 k2 = MIN(nlevels(ld),k1+9)
103 WRITE(dUnit,'(A,1P10E10.3)')' interp:', (levs(k,ld),k=k1,k2)
104 ENDDO
105 ELSE
106 DO k1=1,nlevels(ld),25
107 k2 = MIN(nlevels(ld),k1+24)
108 WRITE(dUnit,'(A,25I4)')' levels:',(NINT(levs(k,ld)),k=k1,k2)
109 ENDDO
110 ENDIF
111 WRITE(dUnit,'(A)') ccFlds
112 DO md=1,nActive(ld)
113 ndId = ABS(jdiag(md,ld))
114 WRITE(msgBuf,'(I6,3A,2(I7,A),I4,A)')
115 & jdiag(md,ld),' |', flds(md,ld),'|',idiag(md,ld),' |',
116 & mdiag(md,ld),' |', kdiag(ndId),' |'
117 ipt = ABS(idiag(md,ld))
118 IF (ipt.NE.0 .AND. averageCycle(ld).GT.1) THEN
119 xOld=ndiag(ipt,1,1)
120 nDup = 1
121 cSep = ', '
122 DO l=1,averageCycle(ld)
123 ii = ipt+l*kdiag(ndId)
124 IF (l.EQ.averageCycle(ld)) THEN
125 cSep = ' |'
126 xNew=xOld+1
127 ELSE
128 xNew=ndiag(ii,1,1)
129 ENDIF
130 IF (xNew.EQ.xOld) THEN
131 nDup = nDup + 1
132 ELSE
133 iLen = ILNBLNK(msgBuf)
134 tmpBuf(1:iLen) = msgBuf(1:iLen)
135 IF (nDup.EQ.1) THEN
136 WRITE(msgBuf,'(A,I7,A)') tmpBuf(1:iLen),xOld,cSep
137 ELSE
138 WRITE(msgBuf,'(A,I7,A,I3,2A)') tmpBuf(1:iLen),xOld,
139 & '(x',nDup,')',cSep
140 ENDIF
141 xOld = xNew
142 nDup = 1
143 ENDIF
144 ENDDO
145 ELSEIF (ipt.NE.0) THEN
146 iLen = ILNBLNK(msgBuf)
147 tmpBuf(1:iLen) = msgBuf(1:iLen)
148 WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
149 im = mdiag(md,ld)
150 IF (im.NE.0) THEN
151 iLen = ILNBLNK(msgBuf)
152 tmpBuf(1:iLen) = msgBuf(1:iLen)
153 WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
154 ENDIF
155 ENDIF
156 iLen = ILNBLNK(msgBuf)
157 WRITE(dUnit,'(A)') msgBuf(1:iLen)
158 ENDDO
159 c WRITE(dUnit,'(A)') ccFlds
160 WRITE(dUnit,'(A)') ccLine
161
162 ENDDO
163
164 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
165
166 c WRITE(dUnit,'(A)') ccLine
167 WRITE(dUnit,'(A,I6)')
168 & 'Global & Regional Statistics diagnostics: Number of lists:',
169 & diagSt_nbLists
170 WRITE(dUnit,'(A)') ccLine
171
172 WRITE(ccList,'(2A)')
173 & ' nFlds, nActive, freq & phase |'
174 WRITE(ccFlds,'(2A)')
175 & ' diag# | name | ipt | iMate |',
176 & ' Volume | mate-Vol. |'
177
178 DO ld=1,diagSt_nbLists
179 iLen = ILNBLNK(diagSt_Fname(ld))
180 WRITE(dUnit,'(A,I4,2A)') 'listId=', ld,
181 & ' ; file name: ',diagSt_Fname(ld)(1:iLen)
182 WRITE(dUnit,'(A)') ccList
183 WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
184 & diagSt_nbFlds(ld), ' |',diagSt_nbActv(ld), ' |',
185 & diagSt_freq(ld), diagSt_phase(ld), ' |'
186 WRITE(msgBuf,'(A)') ' Regions: '
187 iLen = 10
188 DO j=0,nRegions
189 IF ( diagSt_region(j,ld).GE.1
190 & .AND. iLen+3.LE.MAX_LEN_MBUF) THEN
191 tmpBuf(1:iLen) = msgBuf(1:iLen)
192 WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
193 iLen = iLen+3
194 ENDIF
195 ENDDO
196 WRITE(dUnit,'(A)') msgBuf(1:iLen)
197
198 WRITE(dUnit,'(A)') ccFlds
199 DO md=1,diagSt_nbActv(ld)
200 WRITE(msgBuf,'(I6,3A,2(I7,A))')
201 & jSdiag(md,ld),' |', diagSt_Flds(md,ld),'|',iSdiag(md,ld),
202 & ' |', mSdiag(md,ld),' |'
203 ipt = ABS(iSdiag(md,ld))
204 IF (ipt.NE.0) THEN
205 iLen = ILNBLNK(msgBuf)
206 tmpBuf(1:iLen) = msgBuf(1:iLen)
207 WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
208 & qSdiag(0,0,ipt,1,1),' |'
209 ENDIF
210 im = mSdiag(md,ld)
211 IF (im.NE.0) THEN
212 iLen = ILNBLNK(msgBuf)
213 tmpBuf(1:iLen) = msgBuf(1:iLen)
214 WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
215 & qSdiag(0,0,im, 1,1),' |'
216 ENDIF
217 iLen = ILNBLNK(msgBuf)
218 WRITE(dUnit,'(A)') msgBuf(1:iLen)
219 ENDDO
220 c WRITE(dUnit,'(A)') ccFlds
221 WRITE(dUnit,'(A)') ccLine
222
223 ENDDO
224
225 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
226 IF ( dUnit.NE.standardMessageUnit ) CLOSE(dUnit)
227 ENDIF
228
229 _END_MASTER( myThid )
230
231 RETURN
232 END

  ViewVC Help
Powered by ViewVC 1.1.22