/[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.7 - (show annotations) (download)
Mon Jul 11 16:16:29 2005 UTC (18 years, 9 months ago) by molod
Branch: MAIN
CVS Tags: checkpoint58l_post, checkpoint57t_post, checkpoint57o_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint57m_post, checkpoint57s_post, checkpoint58r_post, checkpoint57y_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint57y_pre, checkpoint58q_post, checkpoint57v_post, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57x_post, checkpoint57n_post, checkpoint58d_post, checkpoint58c_post, checkpoint57w_post, checkpoint57p_post, checkpint57u_post, checkpoint58a_post, checkpoint58i_post, checkpoint57q_post, checkpoint58g_post, checkpoint58o_post, checkpoint57z_post, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint58p_post, checkpoint58b_post, checkpoint58m_post, checkpoint57l_post
Changes since 1.6: +3 -1 lines
Add ifdef mnc sequence around the if sequence for the mnc output call

1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagstats_output.F,v 1.6 2005/07/10 00:52:12 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 !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 ( tmp_Glob(0,0).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 #ifdef ALLOW_MNC
134 IF (diagSt_mnc) THEN
135 CALL DIAGSTATS_MNC_OUT(
136 & statGlob, nLev, ndId,
137 & m, listId, myTime, myIter, myThid )
138 ENDIF
139 #endif
140
141 C-- end of Processing Fld # m
142 ENDIF
143 ENDDO
144
145 RETURN
146 END
147
148 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

  ViewVC Help
Powered by ViewVC 1.1.22