/[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.2 - (hide annotations) (download)
Wed Jun 29 23:07:34 2005 UTC (18 years, 11 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 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_summary.F,v 1.1 2005/06/26 16:51:49 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     INTEGER md, ld, ipt, im
34     INTEGER j, k, k1, k2, l
35     INTEGER dUnit, stdUnit, iLen
36 jmc 1.2 CHARACTER*(MAX_LEN_MBUF) msgBuf, tmpBuf
37 jmc 1.1 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 jmc 1.2 WRITE(msgBuf,'(I5,3A,2(I5,A),I4,A)')
103 jmc 1.1 & 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 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
109     WRITE(msgBuf,'(A,I6,A)') tmpBuf(1:iLen),ndiag(ipt,1,1),' |'
110 jmc 1.1 ENDIF
111     im = mdiag(md,ld)
112     IF (im.NE.0) THEN
113     iLen = ILNBLNK(msgBuf)
114 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
115     WRITE(msgBuf,'(A,I6,A)') tmpBuf(1:iLen),ndiag(im,1,1),' |'
116 jmc 1.1 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 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
152     WRITE(msgBuf,'(A,I3)') tmpBuf(1:iLen),j
153 jmc 1.1 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 jmc 1.2 WRITE(msgBuf,'(I5,3A,2(I5,A))')
161 jmc 1.1 & 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 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
167     WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
168 jmc 1.1 & qSdiag(0,0,ipt,1,1),' |'
169     ENDIF
170     im = mSdiag(md,ld)
171     IF (im.NE.0) THEN
172     iLen = ILNBLNK(msgBuf)
173 jmc 1.2 tmpBuf(1:iLen) = msgBuf(1:iLen)
174     WRITE(msgBuf,'(A,1PE12.5,A)') tmpBuf(1:iLen),
175 jmc 1.1 & 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