/[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.8 - (hide 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 jmc 1.8 C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.7 2006/12/24 20:22:56 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.3 #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 jmc 1.7
75 jmc 1.1 C- File names:
76 jmc 1.7 DO ld = 2,nlists
77     DO m = 1,ld-1
78     IF ( fnames(ld).EQ.fnames(m) ) THEN
79 jmc 1.1 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
80     & 'found 2 identical filenames:'
81     CALL PRINT_ERROR( msgBuf , myThid )
82 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
83 jmc 1.1 & '1rst (m=', m, ' ): ', fnames(m)
84     CALL PRINT_ERROR( msgBuf , myThid )
85 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
86 jmc 1.7 & ' 2nd (n=', ld, ' ): ', fnames(ld)
87 jmc 1.1 CALL PRINT_ERROR( msgBuf , myThid )
88     STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
89     ENDIF
90     ENDDO
91     ENDDO
92    
93 jmc 1.7 DO ld = 2,diagSt_nbLists
94     DO m = 1,ld-1
95     IF ( diagSt_Fname(ld).EQ.diagSt_Fname(m) ) THEN
96 jmc 1.4 WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
97     & 'found 2 identical stat_fname:'
98     CALL PRINT_ERROR( msgBuf , myThid )
99 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
100 jmc 1.4 & '1rst (m=', m, ' ): ', diagSt_Fname(m)
101     CALL PRINT_ERROR( msgBuf , myThid )
102 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
103 jmc 1.7 & ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
104 jmc 1.4 CALL PRINT_ERROR( msgBuf , myThid )
105     STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
106     ENDIF
107     ENDDO
108     ENDDO
109    
110 jmc 1.1 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111     C- Check for field that appears 2 times (or more) with differents frequency:
112 jmc 1.5 C disable this checking since now diagnostics pkg can handle this case.
113 jmc 1.1
114     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115    
116 jmc 1.7 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 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
130 jmc 1.7 & '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 jmc 1.8 WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
146 jmc 1.7 & ' 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 jmc 1.8 WRITE(msgBuf,'(2A,I5)') 'DIAGNOSTICS_CHECK: ',
166 jmc 1.7 & '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 jmc 1.1 _END_MASTER(myThid)
196    
197     RETURN
198     END
  ViewVC Help
Powered by ViewVC 1.1.22