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

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

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

Revision 1.12 - (hide annotations) (download)
Tue Dec 8 19:24:40 2015 UTC (8 years, 5 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, HEAD
Changes since 1.11: +9 -9 lines 
simplify setting of local-array size: uses "numLevels" (from DIAGNOSTICS_SIZE.h)
 to allow to write out more than Nr levels
1 jmc 1.12 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_output.F,v 1.11 2011/06/06 15:42:58 jmc Exp $
2 jmc 1.1 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 jmc 1.10 SUBROUTINE DIAGSTATS_OUTPUT(
12 jmc 1.1 I listId,
13 edhill 1.5 I myTime, myIter, myThid )
14 jmc 1.1
15     C !DESCRIPTION:
16     C Write output for diagnostics fields.
17 jmc 1.2
18 jmc 1.1 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 jmc 1.12 PARAMETER( nLev = numLevels )
29 jmc 1.1
30     C !INPUT PARAMETERS:
31 edhill 1.4 C listId :: Diagnostics list number being written
32 jmc 1.1 C myIter :: current iteration number
33 edhill 1.4 C myTime :: Current time of simulation (s)
34 jmc 1.1 C myThid :: my Thread Id number
35 edhill 1.5 _RL myTime
36     INTEGER listId, myIter, myThid
37 jmc 1.1 CEOP
38    
39 jmc 1.9 C !FUNCTIONS:
40     c INTEGER ILNBLNK
41     c EXTERNAL ILNBLNK
42     #ifdef ALLOW_FIZHI
43     _RL getcon
44     EXTERNAL getcon
45     #endif
46    
47 jmc 1.1 C !LOCAL VARIABLES:
48 jmc 1.2 INTEGER j, m, ndId, iSp, iSm
49 jmc 1.8 CHARACTER*10 gcode
50 jmc 1.1 INTEGER mate
51     _RL statGlob(0:nStats,0:nLev,0:nRegions)
52     _RL tmp_Glob(0:nStats,0:nLev)
53 jmc 1.9 _RL undef
54 jmc 1.1
55     INTEGER ioUnit
56     CHARACTER*(MAX_LEN_MBUF) msgBuf
57    
58     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
59    
60     ioUnit= standardMessageUnit
61 jmc 1.9 undef = UNSET_RL
62     #ifdef ALLOW_FIZHI
63     IF ( useFIZHI ) undef = getcon('UNDEF')
64     #endif
65 jmc 1.1
66     DO m = 1,diagSt_nbFlds(listId)
67     ndId = jSdiag(m,listId)
68 jmc 1.8 gcode = gdiag(ndId)(1:10)
69     IF ( iSdiag(m,listId).NE.0 .AND. gcode(5:5).NE.'D' ) THEN
70 jmc 1.1 C-- Start processing 1 Fld :
71    
72 jmc 1.8 IF ( gcode(5:5).EQ.'C' ) THEN
73 jmc 1.1 C Check for Mate of a Counter Diagnostic
74     C --------------------------------------
75 jmc 1.8 mate = hdiag(ndId)
76 jmc 1.1 ELSE
77     mate = 0
78     ENDIF
79    
80     DO j=0,nRegions
81     IF ( diagSt_region(j,listId).GT.0 ) THEN
82 jmc 1.2 iSp = ABS(iSdiag(m,listId))
83     iSm = mSdiag(m,listId)
84 jmc 1.1 CALL DIAGSTATS_GLOBAL(
85     O statGlob(0,0,j), tmp_Glob,
86 jmc 1.2 I undef, nLev, j,
87     I ndId, mate, iSp, iSm, myThid )
88 jmc 1.1
89     C- Check for empty Diag (= not filled or using empty mask)
90 jmc 1.6 IF ( tmp_Glob(0,0).EQ.0. ) THEN
91 jmc 1.1 _BEGIN_MASTER( myThid )
92 jmc 1.8 WRITE(msgBuf,'(A,I10,A,I4)')
93 jmc 1.1 & '- WARNING - from DIAGSTATS_OUTPUT at iter=', myIter,
94     & ' , region:', j
95     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
96     & SQUEEZE_RIGHT, myThid)
97 jmc 1.8 WRITE(msgBuf,'(A,I6,3A,I4,2A)')
98 jmc 1.1 & '- WARNING - diagSt.#',ndId, ' : ',diagSt_Flds(m,listId),
99     & ' (#',m,' ) in outp.Stream: ',diagSt_Fname(listId)
100     CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
101     & SQUEEZE_RIGHT, myThid)
102 jmc 1.12 IF ( kdiag(ndId).GT.nLev ) THEN
103     WRITE(msgBuf,'(2(A,I4))') '- WARNING - kdiag=',
104     & kdiag(ndId), ' exceeds local nLev=', nLev
105     ELSE
106     WRITE(msgBuf,'(2A)') '- WARNING - has not been filled,',
107     & ' OR using empty mask/region'
108     ENDIF
109 jmc 1.1 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 jmc 1.11 IF ( debugLevel .GE. debLevB ) THEN
119 jmc 1.1 _BEGIN_MASTER( myThid )
120 jmc 1.8 WRITE(ioUnit,'(A,I6,3A,I4,A,1PE10.3,2A)')
121 jmc 1.1 & ' Compute Stats, Diag. # ',ndId, ' ', cdiag(ndId),
122     & ' vol(',j,' ):', statGlob(0,0,j),' Parms: ',gdiag(ndId)
123     IF ( mate.GT.0 ) THEN
124 jmc 1.8 WRITE(ioUnit,'(A,I6,3A,I4,2(A,1PE10.3))')
125 jmc 1.1 & ' 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 edhill 1.3 C-- Write to ASCII file:
134 jmc 1.1 IF (diagSt_Ascii) THEN
135     CALL DIAGSTATS_ASCII_OUT( statGlob, nLev, ndId,
136     & m, listId, myIter, myThid )
137     ENDIF
138    
139 molod 1.7 #ifdef ALLOW_MNC
140 edhill 1.3 IF (diagSt_mnc) THEN
141 jmc 1.8 CALL DIAGSTATS_MNC_OUT(
142 edhill 1.3 & statGlob, nLev, ndId,
143 edhill 1.5 & m, listId, myTime, myIter, myThid )
144 edhill 1.3 ENDIF
145 molod 1.7 #endif
146 edhill 1.3
147 jmc 1.1 C-- end of Processing Fld # m
148     ENDIF
149     ENDDO
150    
151 jmc 1.2 RETURN
152 jmc 1.1 END
153 jmc 1.2
154 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
  ViewVC Help
Powered by ViewVC 1.1.22