/[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.9 - (show annotations) (download)
Tue Nov 18 21:41:06 2008 UTC (15 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint61f, checkpoint61g, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.8: +14 -6 lines
move getcon.F from model/src to pkg/fizhi

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_output.F,v 1.8 2008/02/05 15:13:01 jmc 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 !FUNCTIONS:
45 c INTEGER ILNBLNK
46 c EXTERNAL ILNBLNK
47 #ifdef ALLOW_FIZHI
48 _RL getcon
49 EXTERNAL getcon
50 #endif
51
52 C !LOCAL VARIABLES:
53 INTEGER j, m, ndId, iSp, iSm
54 CHARACTER*10 gcode
55 INTEGER mate
56 _RL statGlob(0:nStats,0:nLev,0:nRegions)
57 _RL tmp_Glob(0:nStats,0:nLev)
58 _RL undef
59
60 INTEGER ioUnit
61 CHARACTER*(MAX_LEN_MBUF) msgBuf
62
63 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
64
65 ioUnit= standardMessageUnit
66 undef = UNSET_RL
67 #ifdef ALLOW_FIZHI
68 IF ( useFIZHI ) undef = getcon('UNDEF')
69 #endif
70
71 DO m = 1,diagSt_nbFlds(listId)
72 ndId = jSdiag(m,listId)
73 gcode = gdiag(ndId)(1:10)
74 IF ( iSdiag(m,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
75 C-- Start processing 1 Fld :
76
77 IF ( gcode(5:5).EQ.'C' ) THEN
78 C Check for Mate of a Counter Diagnostic
79 C --------------------------------------
80 mate = hdiag(ndId)
81 ELSE
82 mate = 0
83 ENDIF
84
85 DO j=0,nRegions
86 IF ( diagSt_region(j,listId).GT.0 ) THEN
87 iSp = ABS(iSdiag(m,listId))
88 iSm = mSdiag(m,listId)
89 CALL DIAGSTATS_GLOBAL(
90 O statGlob(0,0,j), tmp_Glob,
91 I undef, nLev, j,
92 I ndId, mate, iSp, iSm, myThid )
93
94 C- Check for empty Diag (= not filled or using empty mask)
95 IF ( tmp_Glob(0,0).EQ.0. ) THEN
96 _BEGIN_MASTER( myThid )
97 WRITE(msgBuf,'(A,I10,A,I4)')
98 & '- WARNING - from DIAGSTATS_OUTPUT at iter=', myIter,
99 & ' , region:', j
100 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
101 & SQUEEZE_RIGHT, myThid)
102 WRITE(msgBuf,'(A,I6,3A,I4,2A)')
103 & '- WARNING - diagSt.#',ndId, ' : ',diagSt_Flds(m,listId),
104 & ' (#',m,' ) in outp.Stream: ',diagSt_Fname(listId)
105 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
106 & SQUEEZE_RIGHT, myThid)
107 WRITE(msgBuf,'(2A)') '- WARNING - has not been filled,',
108 & ' OR using empty mask/region'
109 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
110 & SQUEEZE_RIGHT, myThid)
111 WRITE(msgBuf,'(A)')
112 & 'WARNING DIAGSTATS_OUTPUT => write UNDEF instead'
113 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
114 & SQUEEZE_RIGHT, myThid)
115 _END_MASTER( myThid )
116 ENDIF
117
118 IF ( debugLevel .GE. debLevA ) THEN
119 _BEGIN_MASTER( myThid )
120 WRITE(ioUnit,'(A,I6,3A,I4,A,1PE10.3,2A)')
121 & ' Compute Stats, Diag. # ',ndId, ' ', cdiag(ndId),
122 & ' vol(',j,' ):', statGlob(0,0,j),' Parms: ',gdiag(ndId)
123 IF ( mate.GT.0 ) THEN
124 WRITE(ioUnit,'(A,I6,3A,I4,2(A,1PE10.3))')
125 & ' use Counter Mate # ', mate,' ',cdiag(mate),
126 & ' vol(',j,' ):',tmp_Glob(0,0), ' integral',tmp_Glob(1,0)
127 ENDIF
128 _END_MASTER( myThid )
129 ENDIF
130 ENDIF
131 ENDDO
132
133 C-- Write to ASCII file:
134 IF (diagSt_Ascii) THEN
135 CALL DIAGSTATS_ASCII_OUT( statGlob, nLev, ndId,
136 & m, listId, myIter, myThid )
137 ENDIF
138
139 #ifdef ALLOW_MNC
140 IF (diagSt_mnc) THEN
141 CALL DIAGSTATS_MNC_OUT(
142 & statGlob, nLev, ndId,
143 & m, listId, myTime, myIter, myThid )
144 ENDIF
145 #endif
146
147 C-- end of Processing Fld # m
148 ENDIF
149 ENDDO
150
151 RETURN
152 END
153
154 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22