/[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.3 - (show annotations) (download)
Wed Jul 6 02:13:52 2005 UTC (18 years, 10 months ago) by edhill
Branch: MAIN
Changes since 1.2: +10 -5 lines
 o add mnc output capability to diagnostics/diagstat and update
   our cvsignore files for the ACSII output generated

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

  ViewVC Help
Powered by ViewVC 1.1.22