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

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

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

Revision 1.9 - (hide 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 jmc 1.9 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.8 2008/02/05 15:31:19 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: DIAGNOSTICS_CHECK
9    
10     C !INTERFACE:
11     SUBROUTINE DIAGNOSTICS_CHECK(myThid)
12    
13     C !DESCRIPTION:
14     C Check option and parameter consistency
15 jmc 1.7
16 jmc 1.1 C !USES:
17     IMPLICIT NONE
18     #include "SIZE.h"
19     #include "EEPARAMS.h"
20     #include "PARAMS.h"
21 jmc 1.7 #include "GRID.h"
22 jmc 1.1 #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 jmc 1.7 INTEGER ld,md,nd
32     INTEGER k,m
33     INTEGER jpoint1, ipoint1, jpoint2, ipoint2
34     _RL margin
35 jmc 1.1
36     _BEGIN_MASTER(myThid)
37    
38     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
39     C Check diagnostics parameter consistency
40    
41 jmc 1.9 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 jmc 1.3 #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 jmc 1.7
82 jmc 1.1 C- File names:
83 jmc 1.7 DO ld = 2,nlists
84     DO m = 1,ld-1
85     IF ( fnames(ld).EQ.fnames(m) ) THEN
86 jmc 1.1 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
87     & 'found 2 identical filenames:'
88     CALL PRINT_ERROR( msgBuf , myThid )
89 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
90 jmc 1.1 & '1rst (m=', m, ' ): ', fnames(m)
91     CALL PRINT_ERROR( msgBuf , myThid )
92 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
93 jmc 1.7 & ' 2nd (n=', ld, ' ): ', fnames(ld)
94 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
95     STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
96     ENDIF
97     ENDDO
98     ENDDO
99    
100 jmc 1.7 DO ld = 2,diagSt_nbLists
101     DO m = 1,ld-1
102     IF ( diagSt_Fname(ld).EQ.diagSt_Fname(m) ) THEN
103 jmc 1.4 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
104     & 'found 2 identical stat_fname:'
105     CALL PRINT_ERROR( msgBuf , myThid )
106 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
107 jmc 1.4 & '1rst (m=', m, ' ): ', diagSt_Fname(m)
108     CALL PRINT_ERROR( msgBuf , myThid )
109 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
110 jmc 1.7 & ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
111 jmc 1.4 CALL PRINT_ERROR( msgBuf , myThid )
112     STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
113     ENDIF
114     ENDDO
115     ENDDO
116    
117 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
118     C- Check for field that appears 2 times (or more) with differents frequency:
119 jmc 1.5 C disable this checking since now diagnostics pkg can handle this case.
120 jmc 1.1
121     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
122    
123 jmc 1.7 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 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
137 jmc 1.7 & '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 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
153 jmc 1.7 & ' 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 jmc 1.8 WRITE(msgBuf,'(2A,I5)') 'DIAGNOSTICS_CHECK: ',
173 jmc 1.7 & '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 jmc 1.1 _END_MASTER(myThid)
203    
204     RETURN
205     END
  ViewVC Help
Powered by ViewVC 1.1.22