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

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

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


Revision 1.5 - (show annotations) (download)
Wed Jul 6 14:58:11 2005 UTC (18 years, 10 months ago) by edhill
Branch: MAIN
Changes since 1.4: +5 -4 lines
 o add myIter to the output and fix type for myTime

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_output.F,v 1.4 2005/07/06 13:52:31 edhill Exp $
2 C $Name: $
3
4 #include "DIAG_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP 0
8 C !ROUTINE: DIAGSTATS_OUTPUT
9
10 C !INTERFACE:
11 SUBROUTINE DIAGSTATS_OUTPUT(
12 I listId,
13 I myTime, myIter, myThid )
14
15 C !DESCRIPTION:
16 C Write output for diagnostics fields.
17
18 C !USES:
19 IMPLICIT NONE
20 #include "SIZE.h"
21 #include "EEPARAMS.h"
22 #include "PARAMS.h"
23 #include "GRID.h"
24 #include "DIAGNOSTICS_SIZE.h"
25 #include "DIAGNOSTICS.h"
26
27 INTEGER nLev
28 #ifdef ALLOW_FIZHI
29 #include "fizhi_SIZE.h"
30 PARAMETER (nLev = Nr+Nrphys)
31 #else
32 PARAMETER (nLev = Nr)
33 #endif
34
35 C !INPUT PARAMETERS:
36 C listId :: Diagnostics list number being written
37 C myIter :: current iteration number
38 C myTime :: Current time of simulation (s)
39 C myThid :: my Thread Id number
40 _RL myTime
41 INTEGER listId, myIter, myThid
42 CEOP
43
44 C !LOCAL VARIABLES:
45 INTEGER j, m, ndId, iSp, iSm
46 CHARACTER*8 parms1
47 CHARACTER*3 mate_index
48 INTEGER mate
49 _RL statGlob(0:nStats,0:nLev,0:nRegions)
50 _RL tmp_Glob(0:nStats,0:nLev)
51 _RL undef, getcon
52 EXTERNAL getcon
53 c INTEGER ILNBLNK
54 c EXTERNAL ILNBLNK
55
56 INTEGER ioUnit
57 CHARACTER*(MAX_LEN_MBUF) msgBuf
58
59 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
60
61 ioUnit= standardMessageUnit
62 undef = getcon('UNDEF')
63
64 DO m = 1,diagSt_nbFlds(listId)
65 ndId = jSdiag(m,listId)
66 parms1 = gdiag(ndId)(1:8)
67 IF ( iSdiag(m,listId).NE.0 .AND. parms1(5:5).NE.'D' ) THEN
68 C-- Start processing 1 Fld :
69
70 IF ( parms1(5:5).EQ.'C' ) THEN
71 C Check for Mate of a Counter Diagnostic
72 C --------------------------------------
73 mate_index = parms1(6:8)
74 READ (mate_index,'(I3)') mate
75 ELSE
76 mate = 0
77 ENDIF
78
79 DO j=0,nRegions
80 IF ( diagSt_region(j,listId).GT.0 ) THEN
81 iSp = ABS(iSdiag(m,listId))
82 iSm = mSdiag(m,listId)
83 CALL DIAGSTATS_GLOBAL(
84 O statGlob(0,0,j), tmp_Glob,
85 I undef, nLev, j,
86 I ndId, mate, iSp, iSm, myThid )
87
88 C- Check for empty Diag (= not filled or using empty mask)
89 IF ( statGlob(0,0,j).EQ.0. ) THEN
90 _BEGIN_MASTER( myThid )
91 WRITE(msgBuf,'(A,I10,A,I3)')
92 & '- WARNING - from DIAGSTATS_OUTPUT at iter=', myIter,
93 & ' , region:', j
94 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
95 & SQUEEZE_RIGHT, myThid)
96 WRITE(msgBuf,'(A,I4,3A,I3,2A)')
97 & '- WARNING - diagSt.#',ndId, ' : ',diagSt_Flds(m,listId),
98 & ' (#',m,' ) in outp.Stream: ',diagSt_Fname(listId)
99 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
100 & SQUEEZE_RIGHT, myThid)
101 WRITE(msgBuf,'(2A)') '- WARNING - has not been filled,',
102 & ' OR using empty mask/region'
103 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
104 & SQUEEZE_RIGHT, myThid)
105 WRITE(msgBuf,'(A)')
106 & 'WARNING DIAGSTATS_OUTPUT => write UNDEF instead'
107 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
108 & SQUEEZE_RIGHT, myThid)
109 _END_MASTER( myThid )
110 ENDIF
111
112 IF ( debugLevel .GE. debLevA ) THEN
113 _BEGIN_MASTER( myThid )
114 WRITE(ioUnit,'(A,I3,3A,I3,A,1PE10.3,2A)')
115 & ' Compute Stats, Diag. # ',ndId, ' ', cdiag(ndId),
116 & ' vol(',j,' ):', statGlob(0,0,j),' Parms: ',gdiag(ndId)
117 IF ( mate.GT.0 ) THEN
118 WRITE(ioUnit,'(A,I3,3A,I3,2(A,1PE10.3))')
119 & ' use Counter Mate # ', mate,' ',cdiag(mate),
120 & ' vol(',j,' ):',tmp_Glob(0,0), ' integral',tmp_Glob(1,0)
121 ENDIF
122 _END_MASTER( myThid )
123 ENDIF
124 ENDIF
125 ENDDO
126
127 C-- Write to ASCII file:
128 IF (diagSt_Ascii) THEN
129 CALL DIAGSTATS_ASCII_OUT( statGlob, nLev, ndId,
130 & m, listId, myIter, myThid )
131 ENDIF
132
133 IF (diagSt_mnc) THEN
134 CALL DIAGSTATS_MNC_OUT(
135 & statGlob, nLev, ndId,
136 & m, listId, myTime, myIter, myThid )
137 ENDIF
138
139 C-- end of Processing Fld # m
140 ENDIF
141 ENDDO
142
143 RETURN
144 END
145
146 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22