/[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.2 - (show annotations) (download)
Sun Jun 26 16:51:49 2005 UTC (18 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57k_post, checkpoint57j_post
Changes since 1.1: +12 -10 lines
change pointers so that 1 diag. can be used several times (with # freq.)

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

  ViewVC Help
Powered by ViewVC 1.1.22