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

Contents of /MITgcm/pkg/diagnostics/diagnostics_check.F

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

Revision 1.9 - (show annotations) (download)
Mon Jun 27 22:23:09 2011 UTC (12 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint64y, checkpoint64x, checkpoint64z, checkpoint64q, checkpoint64p, checkpoint64s, checkpoint64r, checkpoint64u, checkpoint64t, checkpoint64w, checkpoint64v, checkpoint64i, checkpoint64h, checkpoint64k, checkpoint64j, checkpoint64m, checkpoint64l, checkpoint64o, checkpoint64n, checkpoint64a, checkpoint64c, checkpoint64b, checkpoint64e, checkpoint64d, checkpoint64g, checkpoint64f, checkpoint63p, checkpoint63q, checkpoint63r, checkpoint63s, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63g, checkpoint63a, checkpoint63b, checkpoint63c, checkpoint64, checkpoint65, checkpoint63, checkpoint66b, checkpoint66a, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65j, checkpoint65k, checkpoint65h, checkpoint65i, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, checkpoint65b, checkpoint65c, checkpoint65a, checkpoint65f, checkpoint65g, checkpoint65d, checkpoint65e
Changes since 1.8: +8 -1 lines 
add run-time parameter "useMissingValue" (def=False) to fill land-point
 (i.e., where mask=0) with MissingValue ; used only in MNC output file.
this replace CPP-option DIAGNOSTICS_MISSING_VALUE.
1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.8 2008/02/05 15:31:19 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: DIAGNOSTICS_CHECK
9
10 C !INTERFACE:
11 SUBROUTINE DIAGNOSTICS_CHECK(myThid)
12
13 C !DESCRIPTION:
14 C Check option and parameter consistency
15
16 C !USES:
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PARAMS.h"
21 #include "GRID.h"
22 #include "DIAGNOSTICS_SIZE.h"
23 #include "DIAGNOSTICS.h"
24
25 C !INPUT PARAMETERS:
26 INTEGER myThid
27 CEOP
28
29 C !LOCAL VARIABLES:
30 CHARACTER*(MAX_LEN_MBUF) msgBuf
31 INTEGER ld,md,nd
32 INTEGER k,m
33 INTEGER jpoint1, ipoint1, jpoint2, ipoint2
34 _RL margin
35
36 _BEGIN_MASTER(myThid)
37
38 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
39 C Check diagnostics parameter consistency
40
41 IF ( useMissingValue .AND. .NOT. diag_mnc ) THEN
42 WRITE(msgBuf,'(2A)') '** WARNING ** DIAGNOSTICS_CHECK: ',
43 & 'ignore "useMissingValue" since "diag_mnc" is off'
44 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
45 & SQUEEZE_RIGHT , myThid )
46 ENDIF
47
48 #ifdef DIAGNOSTICS_HAS_PICKUP
49 IF ( diag_pickup_read ) THEN
50 WRITE(msgBuf,'(2A)') '**CAUTION** (DIAGNOSTICS_CHECK): ',
51 & 'reading diagnostics previous state'
52 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
53 & SQUEEZE_RIGHT , myThid)
54 WRITE(msgBuf,'(2A)') '**CAUTION** ',
55 & ' from a pickup file can only work if data.diagnostics'
56 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
57 & SQUEEZE_RIGHT , myThid)
58 WRITE(msgBuf,'(2A)') '**CAUTION** ',
59 & ' is not changed (<= further checking not yet implemented)'
60 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
61 & SQUEEZE_RIGHT , myThid)
62 ENDIF
63 #else /* undef DIAGNOSTICS_HAS_PICKUP */
64 C- stop if trying to use part of the code that is not compiled:
65 IF ( diag_pickup_read ) THEN
66 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
67 & 'diag_pickup_read is TRUE ',
68 & 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
69 CALL PRINT_ERROR( msgBuf , myThid)
70 ENDIF
71 IF ( diag_pickup_write ) THEN
72 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
73 & 'diag_pickup_write is TRUE ',
74 & 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
75 CALL PRINT_ERROR( msgBuf , myThid)
76 ENDIF
77 IF ( diag_pickup_read .OR. diag_pickup_write ) THEN
78 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
79 ENDIF
80 #endif /* DIAGNOSTICS_HAS_PICKUP */
81
82 C- File names:
83 DO ld = 2,nlists
84 DO m = 1,ld-1
85 IF ( fnames(ld).EQ.fnames(m) ) THEN
86 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
87 & 'found 2 identical filenames:'
88 CALL PRINT_ERROR( msgBuf , myThid )
89 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
90 & '1rst (m=', m, ' ): ', fnames(m)
91 CALL PRINT_ERROR( msgBuf , myThid )
92 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
93 & ' 2nd (n=', ld, ' ): ', fnames(ld)
94 CALL PRINT_ERROR( msgBuf , myThid )
95 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
96 ENDIF
97 ENDDO
98 ENDDO
99
100 DO ld = 2,diagSt_nbLists
101 DO m = 1,ld-1
102 IF ( diagSt_Fname(ld).EQ.diagSt_Fname(m) ) THEN
103 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
104 & 'found 2 identical stat_fname:'
105 CALL PRINT_ERROR( msgBuf , myThid )
106 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
107 & '1rst (m=', m, ' ): ', diagSt_Fname(m)
108 CALL PRINT_ERROR( msgBuf , myThid )
109 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
110 & ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
111 CALL PRINT_ERROR( msgBuf , myThid )
112 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
113 ENDIF
114 ENDDO
115 ENDDO
116
117 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
118 C- Check for field that appears 2 times (or more) with differents frequency:
119 C disable this checking since now diagnostics pkg can handle this case.
120
121 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
122
123 C-- Vertical Interpolation: check for compatibility:
124 C better to stop here, rather much later, when trying to write output
125 DO ld = 1,nlists
126 IF ( fflags(ld)(2:2).EQ.'P' ) THEN
127 IF ( fluidIsAir ) THEN
128 C- check that interpolated levels are >0 & fall within the domain +/- X %
129 C (needs p>0 for p^kappa ; here take a 10 % margin)
130 margin = rkSign*(rF(Nr+1)-rF(1))*0.1 _d 0
131 DO k=1,nlevels(ld)
132 IF ( levs(k,ld)-MAX(rF(1),rF(Nr+1)).GT.margin
133 & .OR. levs(k,ld)-MIN(rF(1),rF(Nr+1)).LT.-margin
134 & .OR. levs(k,ld).LE.0. ) THEN
135
136 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
137 & 'Vertical Interp. for list l=', ld,
138 & ', filename: ', fnames(ld)
139 CALL PRINT_ERROR( msgBuf , myThid )
140 WRITE(msgBuf,'(2A,I4,3(A,F16.8))') 'DIAGNOSTICS_CHECK: ',
141 & ' lev(k=', k, ') p=', levs(k,ld),
142 & ' not in the domain:',rF(1),' :',rF(Nr+1)
143 CALL PRINT_ERROR( msgBuf , myThid )
144 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
145 ENDIF
146 ENDDO
147 ELSE
148 C- p^kappa interpolation: meaningfull only if Atmosphere & P-coordiante
149 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
150 & 'INTERP_VERT not allowed in this config'
151 CALL PRINT_ERROR( msgBuf , myThid )
152 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
153 & ' for list l=', ld, ', filename: ', fnames(ld)
154 CALL PRINT_ERROR( msgBuf , myThid )
155 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
156 ENDIF
157 IF (select_rStar.GT.0) THEN
158 C- If nonlinear free surf is active, need averaged pressures
159 DO md = 1,nfields(ld)
160 nd = jdiag(md,ld)
161 CALL DIAGNOSTICS_GET_POINTERS( 'RSURF ', ld,
162 & jpoint1, ipoint1, myThid )
163 IF ( useFIZHI .AND.
164 & gdiag(nd)(10:10) .EQ. 'L') THEN
165 CALL DIAGNOSTICS_GET_POINTERS('FIZPRES ', ld,
166 & jpoint2, ipoint2, myThid )
167 ELSE
168 CALL DIAGNOSTICS_GET_POINTERS('RCENTER ', ld,
169 & jpoint2, ipoint2, myThid )
170 ENDIF
171 IF ( ipoint1.EQ.0 .OR. ipoint2.EQ.0 ) THEN
172 WRITE(msgBuf,'(2A,I5)') 'DIAGNOSTICS_CHECK: ',
173 & 'to interpolate diags from output list:', ld
174 CALL PRINT_ERROR( msgBuf , myThid )
175 IF ( ipoint1.EQ.0 .AND. jpoint1.EQ.0 ) THEN
176 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
177 & 'needs to turn ON surface pressure diagnostic "RSURF "'
178 CALL PRINT_ERROR( msgBuf , myThid )
179 ELSEIF ( ipoint1.EQ.0 ) THEN
180 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
181 & 'needs surface pressure diagnostic "RSURF " ',
182 & 'with same output time'
183 CALL PRINT_ERROR( msgBuf , myThid )
184 ENDIF
185 IF ( ipoint2.EQ.0 .AND. jpoint2.EQ.0 ) THEN
186 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
187 & 'needs to turn ON 3-D pressure diagnostic "RCENTER "'
188 CALL PRINT_ERROR( msgBuf , myThid )
189 ELSEIF ( ipoint2.EQ.0 ) THEN
190 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
191 & 'needs 3-D pressure diagnostic "RCENTER " ',
192 & 'with same output time'
193 CALL PRINT_ERROR( msgBuf , myThid )
194 ENDIF
195 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
196 ENDIF
197 ENDDO
198 ENDIF
199 ENDIF
200 ENDDO
201
202 _END_MASTER(myThid)
203
204 RETURN
205 END
  ViewVC Help
Powered by ViewVC 1.1.22