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

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

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

revision 1.1 by jmc, Mon Dec 13 21:43:54 2004 UTC revision 1.7 by jmc, Sun Dec 24 20:22:56 2006 UTC
# Line 12  C     !INTERFACE: Line 12  C     !INTERFACE:
12    
13  C     !DESCRIPTION:  C     !DESCRIPTION:
14  C     Check option and parameter consistency  C     Check option and parameter consistency
15          
16  C     !USES:  C     !USES:
17        IMPLICIT NONE        IMPLICIT NONE
18  #include "SIZE.h"  #include "SIZE.h"
19  #include "EEPARAMS.h"  #include "EEPARAMS.h"
20  #include "PARAMS.h"  #include "PARAMS.h"
21    #include "GRID.h"
22  #include "DIAGNOSTICS_SIZE.h"  #include "DIAGNOSTICS_SIZE.h"
23  #include "DIAGNOSTICS.h"  #include "DIAGNOSTICS.h"
24    
# Line 27  CEOP Line 28  CEOP
28    
29  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
30        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
31        INTEGER k,l,n,m        INTEGER ld,md,nd
32          INTEGER k,m
33          INTEGER jpoint1, ipoint1, jpoint2, ipoint2
34          _RL     margin
35    
36        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
37    
38  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
39  C     Check diagnostics parameter consistency  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:  C-    File names:
76        DO n = 2,nlists        DO ld = 2,nlists
77         DO m = 1,n-1         DO m = 1,ld-1
78          IF ( fnames(n).EQ.fnames(m) ) THEN          IF ( fnames(ld).EQ.fnames(m) ) THEN
79           WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',           WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
80       &            'found 2 identical filenames:'       &            'found 2 identical filenames:'
81           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
# Line 45  C-    File names: Line 83  C-    File names:
83       &    '1rst (m=', m, ' ): ', fnames(m)       &    '1rst (m=', m, ' ): ', fnames(m)
84           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
85           WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',           WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
86       &    ' 2nd (n=', n, ' ): ', fnames(n)       &    ' 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,I3,2A)') 'DIAGNOSTICS_CHECK: ',
100         &    '1rst (m=', m, ' ): ', diagSt_Fname(m)
101             CALL PRINT_ERROR( msgBuf , myThid )
102             WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
103         &    ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
104           CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
105           STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'           STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
106          ENDIF          ENDIF
# Line 54  C-    File names: Line 109  C-    File names:
109    
110  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111  C-    Check for field that appears 2 times (or more) with differents frequency:  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        DO n = 2,nlists  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
115         DO m = 1,n-1  
116          IF ( freq(m).NE.freq(n) ) THEN  C--   Vertical Interpolation: check for compatibility:
117           DO k = 1,nActive(n)  C     better to stop here, rather much later, when trying to write output
118            DO l = 1,nActive(m)        DO ld = 1,nlists
119             IF ( flds(k,n).EQ.flds(l,m) ) THEN         IF ( fflags(ld)(2:2).EQ.'P' ) THEN
120              WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',          IF ( fluidIsAir ) THEN
121       &       'field : ',flds(k,n),' use 2 different freq. :'  C-    check that interpolated levels are >0 & fall within the domain +/- X %
122              CALL PRINT_ERROR( msgBuf , myThid )  C      (needs p>0 for p^kappa ; here take a 10 % margin)
123              WRITE(msgBuf,'(2A,I3,A,I6,2A)') 'DIAGNOSTICS_CHECK: ',            margin = rkSign*(rF(Nr+1)-rF(1))*0.1 _d 0
124       &       '1rst (m=', m, ' ), freq=', freq(m),' file:',fnames(m)            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,I3,2A)') 'DIAGNOSTICS_CHECK: ',
130         &       'Vertical Interp. for list l=', ld,
131         &       ', filename: ', fnames(ld)
132              CALL PRINT_ERROR( msgBuf , myThid )              CALL PRINT_ERROR( msgBuf , myThid )
133              WRITE(msgBuf,'(2A,I3,A,I6,2A)') 'DIAGNOSTICS_CHECK: ',              WRITE(msgBuf,'(2A,I4,3(A,F16.8))') 'DIAGNOSTICS_CHECK: ',
134       &       ' 2nd (n=', n, ' ), freq=', freq(n),' file:',fnames(n)       &       ' lev(k=', k, ') p=', levs(k,ld),
135         &       ' not in the domain:',rF(1),' :',rF(Nr+1)
136              CALL PRINT_ERROR( msgBuf , myThid )              CALL PRINT_ERROR( msgBuf , myThid )
137                STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
138             ENDIF             ENDIF
139            ENDDO            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,I3,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,I4)') '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           ENDDO
191          ENDIF          ENDIF
192         ENDDO         ENDIF
193        ENDDO        ENDDO
194    
 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  
   
195        _END_MASTER(myThid)        _END_MASTER(myThid)
196    
197        RETURN        RETURN
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22