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

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

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


Revision 1.8 - (hide 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 jmc 1.8 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_summary.F,v 1.7 2011/06/06 15:42:58 jmc Exp $
2 jmc 1.1 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 jmc 1.8 INTEGER md, ld, ndId, ipt, im
34 jmc 1.1 INTEGER j, k, k1, k2, l
35     INTEGER dUnit, stdUnit, iLen
36 jmc 1.4 INTEGER xNew, xOld, ii, nDup
37     CHARACTER*(2) cSep
38 jmc 1.2 CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
39 jmc 1.1 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 jmc 1.7 IF ( debugLevel.GE.debLevB ) THEN
51 jmc 1.1 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 jmc 1.8 CALL MDSFINDUNIT( dUnit, myThid )
63 jmc 1.1 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 jmc 1.3 ELSE
70     outpSummary = .FALSE.
71 jmc 1.1 ENDIF
72    
73 jmc 1.7 IF ( outpSummary .AND. debugLevel.GE.debLevB ) THEN
74 jmc 1.1 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 jmc 1.6 & ' nFlds, nActive, freq & phase , nLev'
82 jmc 1.1 WRITE(ccFlds,'(2A)')
83 jmc 1.6 & ' diag# | name | ipt | iMate | kLev| count | mate.C|'
84 jmc 1.1
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 jmc 1.6 WRITE(dUnit,'(A,I5,2A)') 'listId=', ld,
95 jmc 1.1 & ' ; file name: ',fnames(ld)(1:iLen)
96     WRITE(dUnit,'(A)') ccList
97 jmc 1.6 WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
98 jmc 1.1 & nfields(ld), ' |',nActive(ld), ' |',
99     & freq(ld), phase(ld), ' |', nlevels(ld)
100 jmc 1.5 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 jmc 1.1 WRITE(dUnit,'(A)') ccFlds
112     DO md=1,nActive(ld)
113 jmc 1.8 ndId = ABS(jdiag(md,ld))
114 jmc 1.6 WRITE(msgBuf,'(I6,3A,2(I7,A),I4,A)')
115 jmc 1.1 & jdiag(md,ld),' |', flds(md,ld),'|',idiag(md,ld),' |',
116 jmc 1.8 & mdiag(md,ld),' |', kdiag(ndId),' |'
117 jmc 1.1 ipt = ABS(idiag(md,ld))
118 jmc 1.4 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 jmc 1.8 ii = ipt+l*kdiag(ndId)
124 jmc 1.4 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 jmc 1.6 WRITE(msgBuf,'(A,I7,A)') tmpBuf(1:iLen),xOld,cSep
137 jmc 1.4 ELSE
138 jmc 1.6 WRITE(msgBuf,'(A,I7,A,I3,2A)') tmpBuf(1:iLen),xOld,
139 jmc 1.4 & '(x',nDup,')',cSep
140     ENDIF
141     xOld = xNew
142     nDup = 1
143     ENDIF
144     ENDDO
145     ELSEIF (ipt.NE.0) THEN
146 jmc 1.1 iLen = ILNBLNK(msgBuf)
147 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
148 jmc 1.6 WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
149 jmc 1.4 im = mdiag(md,ld)
150     IF (im.NE.0) THEN
151     iLen = ILNBLNK(msgBuf)
152     tmpBuf(1:iLen) = msgBuf(1:iLen)
153 jmc 1.6 WRITE(msgBuf,'(A,I8,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
154 jmc 1.4 ENDIF
155 jmc 1.1 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 jmc 1.6 & ' nFlds, nActive, freq & phase |'
174 jmc 1.1 WRITE(ccFlds,'(2A)')
175 jmc 1.6 & ' diag# | name | ipt | iMate |',
176     & ' Volume | mate-Vol. |'
177 jmc 1.1
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 jmc 1.6 WRITE(dUnit,'(2(I5,A),2F17.6,A,I4)')
184 jmc 1.1 & 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 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
192     WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
193 jmc 1.1 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 jmc 1.6 WRITE(msgBuf,'(I6,3A,2(I7,A))')
201 jmc 1.1 & 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 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
207     WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
208 jmc 1.1 & qSdiag(0,0,ipt,1,1),' |'
209     ENDIF
210     im = mSdiag(md,ld)
211     IF (im.NE.0) THEN
212     iLen = ILNBLNK(msgBuf)
213 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
214     WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
215 jmc 1.1 & 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