/[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.2 - (show annotations) (download)
Wed Jun 29 23:07:34 2005 UTC (18 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57t_post, checkpoint57o_post, checkpoint57m_post, checkpoint57s_post, checkpoint57k_post, checkpoint57y_post, checkpoint57y_pre, checkpoint57v_post, checkpoint57r_post, checkpoint58, checkpoint57x_post, checkpoint57n_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, checkpoint57z_post, checkpoint57j_post, checkpoint57l_post
Changes since 1.1: +14 -9 lines
fix for pgf compiler (cannot handle internal write to a string of char. of
 a part of the same string)

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_summary.F,v 1.1 2005/06/26 16:51:49 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, ipt, im
34 INTEGER j, k, k1, k2, l
35 INTEGER dUnit, stdUnit, iLen
36 CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
37 CHARACTER*(MAX_LEN_FNAM) fn
38 CHARACTER*(72) ccLine, ccFlds, ccList
39 LOGICAL outpSummary
40 INTEGER ILNBLNK
41 EXTERNAL ILNBLNK
42
43 _BEGIN_MASTER( myThid )
44 stdUnit = standardMessageUnit
45
46 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
47
48 IF ( debugLevel.GE.debLevA ) THEN
49 IF ( myIter.EQ.nIter0 ) THEN
50 outpSummary = .TRUE.
51 dUnit = standardMessageUnit
52 WRITE(msgBuf,'(A,I6)')
53 & ' write diagnostics summary to file ioUnit: ',dUnit
54 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
55 ELSE
56 outpSummary = ( myXGlobalLo.EQ.1 .AND. myYGlobalLo.EQ.1 )
57 IF ( outpSummary ) THEN
58 WRITE(fn,'(A,I10.10,A)') 'diagnostics_status.',myIter,'.txt'
59 iLen = ILNBLNK(fn)
60 CALL MDSFINDUNIT( dUnit, mythid )
61 OPEN(dUnit,file=fn(1:iLen),status='unknown',form='formatted')
62 WRITE(msgBuf,'(2A)')
63 & ' write diagnostics summary to file: ',fn(1:iLen)
64 CALL PRINT_MESSAGE( msgBuf, stdUnit,SQUEEZE_RIGHT, myThid)
65 ENDIF
66 ENDIF
67 ENDIF
68
69 IF ( outpSummary .AND. debugLevel.GE.debLevA ) THEN
70 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
71 C write a summary diagnostics state:
72
73 DO l=1,LEN(ccLine)
74 ccLine(l:l) = '-'
75 ENDDO
76 WRITE(ccList,'(2A)')
77 & ' nFlds, nActive, freq & phase , nLev'
78 WRITE(ccFlds,'(2A)')
79 & ' diag#| name | ipt | iMate| kLev| count | mate.C|'
80
81 WRITE(dUnit,'(A,I10,A,1PE21.13)')
82 & 'Iter.Nb:',myIter,' ; Time(s):', myTime
83 WRITE(dUnit,'(A)') ccLine
84 WRITE(dUnit,'(A,I6)')
85 & '2D/3D diagnostics: Number of lists:', nlists
86 WRITE(dUnit,'(A)') ccLine
87
88 DO ld=1,nlists
89 iLen = ILNBLNK(fnames(ld))
90 WRITE(dUnit,'(A,I4,2A)') 'listId=', ld,
91 & ' ; file name: ',fnames(ld)(1:iLen)
92 WRITE(dUnit,'(A)') ccList
93 WRITE(dUnit,'(I4,A,I4,A,2F17.6,A,I4)')
94 & nfields(ld), ' |',nActive(ld), ' |',
95 & freq(ld), phase(ld), ' |', nlevels(ld)
96 DO k1=1,nlevels(ld),50
97 k2 = MIN(nlevels(ld),k1+49)
98 WRITE(dUnit,'(A,50I4)')' levels:',(nint(levs(k,ld)),k=k1,k2)
99 ENDDO
100 WRITE(dUnit,'(A)') ccFlds
101 DO md=1,nActive(ld)
102 WRITE(msgBuf,'(I5,3A,2(I5,A),I4,A)')
103 & jdiag(md,ld),' |', flds(md,ld),'|',idiag(md,ld),' |',
104 & mdiag(md,ld),' |', kdiag(jdiag(md,ld)),' |'
105 ipt = ABS(idiag(md,ld))
106 IF (ipt.NE.0) THEN
107 iLen = ILNBLNK(msgBuf)
108 tmpBuf(1:iLen) = msgBuf(1:iLen)
109 WRITE(msgBuf,'(A,I6,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
110 ENDIF
111 im = mdiag(md,ld)
112 IF (im.NE.0) THEN
113 iLen = ILNBLNK(msgBuf)
114 tmpBuf(1:iLen) = msgBuf(1:iLen)
115 WRITE(msgBuf,'(A,I6,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
116 ENDIF
117 iLen = ILNBLNK(msgBuf)
118 WRITE(dUnit,'(A)') msgBuf(1:iLen)
119 ENDDO
120 c WRITE(dUnit,'(A)') ccFlds
121 WRITE(dUnit,'(A)') ccLine
122
123 ENDDO
124
125 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
126
127 c WRITE(dUnit,'(A)') ccLine
128 WRITE(dUnit,'(A,I6)')
129 & 'Global & Regional Statistics diagnostics: Number of lists:',
130 & diagSt_nbLists
131 WRITE(dUnit,'(A)') ccLine
132
133 WRITE(ccList,'(2A)')
134 & ' nFlds, nActive, freq & phase |'
135 WRITE(ccFlds,'(2A)')
136 & ' diag#| name | ipt | iMate| Volume | mate-Vol. |'
137
138 DO ld=1,diagSt_nbLists
139 iLen = ILNBLNK(diagSt_Fname(ld))
140 WRITE(dUnit,'(A,I4,2A)') 'listId=', ld,
141 & ' ; file name: ',diagSt_Fname(ld)(1:iLen)
142 WRITE(dUnit,'(A)') ccList
143 WRITE(dUnit,'(I4,A,I4,A,2F17.6,A,I4)')
144 & diagSt_nbFlds(ld), ' |',diagSt_nbActv(ld), ' |',
145 & diagSt_freq(ld), diagSt_phase(ld), ' |'
146 WRITE(msgBuf,'(A)') ' Regions: '
147 iLen = 10
148 DO j=0,nRegions
149 IF ( diagSt_region(j,ld).GE.1
150 & .AND. iLen+3.LE.MAX_LEN_MBUF) THEN
151 tmpBuf(1:iLen) = msgBuf(1:iLen)
152 WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
153 iLen = iLen+3
154 ENDIF
155 ENDDO
156 WRITE(dUnit,'(A)') msgBuf(1:iLen)
157
158 WRITE(dUnit,'(A)') ccFlds
159 DO md=1,diagSt_nbActv(ld)
160 WRITE(msgBuf,'(I5,3A,2(I5,A))')
161 & jSdiag(md,ld),' |', diagSt_Flds(md,ld),'|',iSdiag(md,ld),
162 & ' |', mSdiag(md,ld),' |'
163 ipt = ABS(iSdiag(md,ld))
164 IF (ipt.NE.0) THEN
165 iLen = ILNBLNK(msgBuf)
166 tmpBuf(1:iLen) = msgBuf(1:iLen)
167 WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
168 & qSdiag(0,0,ipt,1,1),' |'
169 ENDIF
170 im = mSdiag(md,ld)
171 IF (im.NE.0) THEN
172 iLen = ILNBLNK(msgBuf)
173 tmpBuf(1:iLen) = msgBuf(1:iLen)
174 WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
175 & qSdiag(0,0,im, 1,1),' |'
176 ENDIF
177 iLen = ILNBLNK(msgBuf)
178 WRITE(dUnit,'(A)') msgBuf(1:iLen)
179 ENDDO
180 c WRITE(dUnit,'(A)') ccFlds
181 WRITE(dUnit,'(A)') ccLine
182
183 ENDDO
184
185 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
186 IF ( dUnit.NE.standardMessageUnit ) CLOSE(dUnit)
187 ENDIF
188
189 _END_MASTER( myThid )
190
191 RETURN
192 END

  ViewVC Help
Powered by ViewVC 1.1.22