/[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.8 - (show annotations) (download)
Tue Feb 5 15:31:19 2008 UTC (16 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint60, checkpoint61, checkpoint62, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59o, checkpoint59n, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.7: +8 -8 lines 
minor modifications for many diagnostics:
- modify "available_diagnostics.log" and diagnostics summary (write mate number)
- use wider (integer) format (generally, use I6) to write diagnostics number
- rename numdiags --> numDiags (to differentiate from mdiag)
1 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.7 2006/12/24 20:22:56 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 #ifdef DIAGNOSTICS_HAS_PICKUP
42 IF ( diag_pickup_read ) THEN
43 WRITE(msgBuf,'(2A)') '**CAUTION** (DIAGNOSTICS_CHECK): ',
44 & 'reading diagnostics previous state'
45 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
46 & SQUEEZE_RIGHT , myThid)
47 WRITE(msgBuf,'(2A)') '**CAUTION** ',
48 & ' from a pickup file can only work if data.diagnostics'
49 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
50 & SQUEEZE_RIGHT , myThid)
51 WRITE(msgBuf,'(2A)') '**CAUTION** ',
52 & ' is not changed (<= further checking not yet implemented)'
53 CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
54 & SQUEEZE_RIGHT , myThid)
55 ENDIF
56 #else /* undef DIAGNOSTICS_HAS_PICKUP */
57 C- stop if trying to use part of the code that is not compiled:
58 IF ( diag_pickup_read ) THEN
59 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
60 & 'diag_pickup_read is TRUE ',
61 & 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
62 CALL PRINT_ERROR( msgBuf , myThid)
63 ENDIF
64 IF ( diag_pickup_write ) THEN
65 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
66 & 'diag_pickup_write is TRUE ',
67 & 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
68 CALL PRINT_ERROR( msgBuf , myThid)
69 ENDIF
70 IF ( diag_pickup_read .OR. diag_pickup_write ) THEN
71 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
72 ENDIF
73 #endif /* DIAGNOSTICS_HAS_PICKUP */
74
75 C- File names:
76 DO ld = 2,nlists
77 DO m = 1,ld-1
78 IF ( fnames(ld).EQ.fnames(m) ) THEN
79 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
80 & 'found 2 identical filenames:'
81 CALL PRINT_ERROR( msgBuf , myThid )
82 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
83 & '1rst (m=', m, ' ): ', fnames(m)
84 CALL PRINT_ERROR( msgBuf , myThid )
85 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
86 & ' 2nd (n=', ld, ' ): ', fnames(ld)
87 CALL PRINT_ERROR( msgBuf , myThid )
88 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
89 ENDIF
90 ENDDO
91 ENDDO
92
93 DO ld = 2,diagSt_nbLists
94 DO m = 1,ld-1
95 IF ( diagSt_Fname(ld).EQ.diagSt_Fname(m) ) THEN
96 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
97 & 'found 2 identical stat_fname:'
98 CALL PRINT_ERROR( msgBuf , myThid )
99 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
100 & '1rst (m=', m, ' ): ', diagSt_Fname(m)
101 CALL PRINT_ERROR( msgBuf , myThid )
102 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
103 & ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
104 CALL PRINT_ERROR( msgBuf , myThid )
105 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
106 ENDIF
107 ENDDO
108 ENDDO
109
110 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111 C- Check for field that appears 2 times (or more) with differents frequency:
112 C disable this checking since now diagnostics pkg can handle this case.
113
114 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115
116 C-- Vertical Interpolation: check for compatibility:
117 C better to stop here, rather much later, when trying to write output
118 DO ld = 1,nlists
119 IF ( fflags(ld)(2:2).EQ.'P' ) THEN
120 IF ( fluidIsAir ) THEN
121 C- check that interpolated levels are >0 & fall within the domain +/- X %
122 C (needs p>0 for p^kappa ; here take a 10 % margin)
123 margin = rkSign*(rF(Nr+1)-rF(1))*0.1 _d 0
124 DO k=1,nlevels(ld)
125 IF ( levs(k,ld)-MAX(rF(1),rF(Nr+1)).GT.margin
126 & .OR. levs(k,ld)-MIN(rF(1),rF(Nr+1)).LT.-margin
127 & .OR. levs(k,ld).LE.0. ) THEN
128
129 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
130 & 'Vertical Interp. for list l=', ld,
131 & ', filename: ', fnames(ld)
132 CALL PRINT_ERROR( msgBuf , myThid )
133 WRITE(msgBuf,'(2A,I4,3(A,F16.8))') 'DIAGNOSTICS_CHECK: ',
134 & ' lev(k=', k, ') p=', levs(k,ld),
135 & ' not in the domain:',rF(1),' :',rF(Nr+1)
136 CALL PRINT_ERROR( msgBuf , myThid )
137 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
138 ENDIF
139 ENDDO
140 ELSE
141 C- p^kappa interpolation: meaningfull only if Atmosphere & P-coordiante
142 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
143 & 'INTERP_VERT not allowed in this config'
144 CALL PRINT_ERROR( msgBuf , myThid )
145 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
146 & ' for list l=', ld, ', filename: ', fnames(ld)
147 CALL PRINT_ERROR( msgBuf , myThid )
148 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
149 ENDIF
150 IF (select_rStar.GT.0) THEN
151 C- If nonlinear free surf is active, need averaged pressures
152 DO md = 1,nfields(ld)
153 nd = jdiag(md,ld)
154 CALL DIAGNOSTICS_GET_POINTERS( 'RSURF ', ld,
155 & jpoint1, ipoint1, myThid )
156 IF ( useFIZHI .AND.
157 & gdiag(nd)(10:10) .EQ. 'L') THEN
158 CALL DIAGNOSTICS_GET_POINTERS('FIZPRES ', ld,
159 & jpoint2, ipoint2, myThid )
160 ELSE
161 CALL DIAGNOSTICS_GET_POINTERS('RCENTER ', ld,
162 & jpoint2, ipoint2, myThid )
163 ENDIF
164 IF ( ipoint1.EQ.0 .OR. ipoint2.EQ.0 ) THEN
165 WRITE(msgBuf,'(2A,I5)') 'DIAGNOSTICS_CHECK: ',
166 & 'to interpolate diags from output list:', ld
167 CALL PRINT_ERROR( msgBuf , myThid )
168 IF ( ipoint1.EQ.0 .AND. jpoint1.EQ.0 ) THEN
169 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
170 & 'needs to turn ON surface pressure diagnostic "RSURF "'
171 CALL PRINT_ERROR( msgBuf , myThid )
172 ELSEIF ( ipoint1.EQ.0 ) THEN
173 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
174 & 'needs surface pressure diagnostic "RSURF " ',
175 & 'with same output time'
176 CALL PRINT_ERROR( msgBuf , myThid )
177 ENDIF
178 IF ( ipoint2.EQ.0 .AND. jpoint2.EQ.0 ) THEN
179 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
180 & 'needs to turn ON 3-D pressure diagnostic "RCENTER "'
181 CALL PRINT_ERROR( msgBuf , myThid )
182 ELSEIF ( ipoint2.EQ.0 ) THEN
183 WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
184 & 'needs 3-D pressure diagnostic "RCENTER " ',
185 & 'with same output time'
186 CALL PRINT_ERROR( msgBuf , myThid )
187 ENDIF
188 STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
189 ENDIF
190 ENDDO
191 ENDIF
192 ENDIF
193 ENDDO
194
195 _END_MASTER(myThid)
196
197 RETURN
198 END
  ViewVC Help
Powered by ViewVC 1.1.22