pkg/diagnostics/diagnostics_check.F

C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.3 2005/02/23 14:45:00 jmc Exp $
C $Name:  $

#include "DIAG_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP 0
C     !ROUTINE: DIAGNOSTICS_CHECK

C     !INTERFACE:
      SUBROUTINE DIAGNOSTICS_CHECK(myThid)

C     !DESCRIPTION:
C     Check option and parameter consistency
      
C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIAGNOSTICS_SIZE.h"
#include "DIAGNOSTICS.h"

C     !INPUT PARAMETERS:
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      INTEGER k,l,n,m

      _BEGIN_MASTER(myThid)

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C     Check diagnostics parameter consistency

#ifdef DIAGNOSTICS_HAS_PICKUP
      IF ( diag_pickup_read ) THEN
        WRITE(msgBuf,'(2A)') '**CAUTION** (DIAGNOSTICS_CHECK): ',
     &   'reading diagnostics previous state'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &       SQUEEZE_RIGHT , myThid)
        WRITE(msgBuf,'(2A)') '**CAUTION** ',
     &   ' from a pickup file can only work if data.diagnostics'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &       SQUEEZE_RIGHT , myThid)
        WRITE(msgBuf,'(2A)') '**CAUTION** ',
     &   ' is not changed (<= further checking not yet implemented)'
        CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
     &       SQUEEZE_RIGHT , myThid)
      ENDIF
#else /* undef DIAGNOSTICS_HAS_PICKUP */
C-    stop if trying to use part of the code that is not compiled:
      IF ( diag_pickup_read  ) THEN
        WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
     &   'diag_pickup_read  is TRUE ',
     &   'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
        CALL PRINT_ERROR( msgBuf , myThid)
      ENDIF
      IF ( diag_pickup_write ) THEN
        WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
     &   'diag_pickup_write is TRUE ',
     &   'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
        CALL PRINT_ERROR( msgBuf , myThid)
      ENDIF
      IF ( diag_pickup_read .OR. diag_pickup_write ) THEN
        STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
      ENDIF
#endif /* DIAGNOSTICS_HAS_PICKUP */
      
C-    File names:
      DO n = 2,nlists
       DO m = 1,n-1
        IF ( fnames(n).EQ.fnames(m) ) THEN
         WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
     &            'found 2 identical filenames:'
         CALL PRINT_ERROR( msgBuf , myThid )
         WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
     &    '1rst (m=', m, ' ): ', fnames(m)
         CALL PRINT_ERROR( msgBuf , myThid )
         WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
     &    ' 2nd (n=', n, ' ): ', fnames(n)
         CALL PRINT_ERROR( msgBuf , myThid )
         STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
        ENDIF
       ENDDO
      ENDDO

      DO n = 2,diagSt_nbLists
       DO m = 1,n-1
        IF ( diagSt_Fname(n).EQ.diagSt_Fname(m) ) THEN
         WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
     &            'found 2 identical stat_fname:'
         CALL PRINT_ERROR( msgBuf , myThid )
         WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
     &    '1rst (m=', m, ' ): ', diagSt_Fname(m)
         CALL PRINT_ERROR( msgBuf , myThid )
         WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
     &    ' 2nd (n=', n, ' ): ', diagSt_Fname(n)
         CALL PRINT_ERROR( msgBuf , myThid )
         STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
        ENDIF
       ENDDO
      ENDDO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C-    Check for field that appears 2 times (or more) with differents frequency:

      DO n = 2,nlists
       DO m = 1,n-1
        IF ( freq(m).NE.freq(n) .OR. phase(m).NE.phase(n) ) THEN
C--     once the SWITCH_ONOFF is changed to only turns ON diag with <0 freq
C                 and CLRDIAG is changed to turns OFF diag with <0 freq,
C       then we can allow 1 diag to be used with 2 differents <0 freq.
C       and this would become:
c       IF (  ( freq(m).GT.0. .OR. freq(n).GT.0. )
c    &   .AND.( freq(m).NE.freq(n) .OR. phase(m).NE.phase(n) )
c    &     ) THEN
         DO k = 1,nActive(n)
          DO l = 1,nActive(m)
           IF ( flds(k,n).EQ.flds(l,m) ) THEN
            WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',
     &       'field : ',flds(k,n),' use 2 different freq. :'
            CALL PRINT_ERROR( msgBuf , myThid )
            WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
     &       '1rst (m=', m, ' ) freq,phase=', freq(m),phase(m),
     &       ' file:',fnames(m)
            CALL PRINT_ERROR( msgBuf , myThid )
            WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
     &       ' 2nd (n=', n, ' ) freq,phase=', freq(n),phase(n),
     &       ' file:',fnames(n)
            CALL PRINT_ERROR( msgBuf , myThid )
            STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
           ENDIF
          ENDDO
         ENDDO
        ENDIF
       ENDDO
      ENDDO

      DO n = 2,diagSt_nbLists
       DO m = 1,n-1
        IF    ( diagSt_freq(m) .NE. diagSt_freq(n) .OR.
     &          diagSt_phase(m).NE.diagSt_phase(n) ) THEN
c       IF (  ( diagSt_freq(m).GT.0. .OR. diagSt_freq(n).GT.0. )
c    &   .AND.( diagSt_freq(m) .NE. diagSt_freq(n) .OR.
c    &          diagSt_phase(m).NE.diagSt_phase(n) )
c    &     ) THEN
         DO k = 1,diagSt_nbActv(n)
          DO l = 1,diagSt_nbActv(m)
           IF ( diagSt_Flds(k,n).EQ.diagSt_Flds(l,m) ) THEN
            WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',
     &       'field : ',diagSt_Flds(k,n),' use 2 different stat_freq.:'
            CALL PRINT_ERROR( msgBuf , myThid )
            WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
     &       '1rst (m=', m, ' ) freq,phase=', diagSt_freq(m),
     &       diagSt_phase(m), ' file:', diagSt_Fname(m)
            CALL PRINT_ERROR( msgBuf , myThid )
            WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
     &       ' 2nd (n=', n, ' ) freq,phase=', diagSt_freq(n),
     &       diagSt_phase(n), ' file:', diagSt_Fname(n)
            CALL PRINT_ERROR( msgBuf , myThid )
            STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
           ENDIF
          ENDDO
         ENDDO
        ENDIF
       ENDDO
      ENDDO

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      _END_MASTER(myThid)

      RETURN
      END
1	jmc	1.4	C $Header: /u/gcmpack/MITgcm/pkg/diagnostics/diagnostics_check.F,v 1.3 2005/02/23 14:45:00 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
16			C !USES:
17			IMPLICIT NONE
18			#include "SIZE.h"
19			#include "EEPARAMS.h"
20			#include "PARAMS.h"
21			#include "DIAGNOSTICS_SIZE.h"
22			#include "DIAGNOSTICS.h"
23
24			C !INPUT PARAMETERS:
25			INTEGER myThid
26			CEOP
27
28			C !LOCAL VARIABLES:
29			CHARACTER*(MAX_LEN_MBUF) msgBuf
30			INTEGER k,l,n,m
31
32			_BEGIN_MASTER(myThid)
33
34			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
35			C Check diagnostics parameter consistency
36
37	jmc	1.3	#ifdef DIAGNOSTICS_HAS_PICKUP
38			IF ( diag_pickup_read ) THEN
39			WRITE(msgBuf,'(2A)') 'CAUTION (DIAGNOSTICS_CHECK): ',
40			& 'reading diagnostics previous state'
41			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
42			& SQUEEZE_RIGHT , myThid)
43			WRITE(msgBuf,'(2A)') 'CAUTION ',
44			& ' from a pickup file can only work if data.diagnostics'
45			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
46			& SQUEEZE_RIGHT , myThid)
47			WRITE(msgBuf,'(2A)') 'CAUTION ',
48			& ' is not changed (<= further checking not yet implemented)'
49			CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
50			& SQUEEZE_RIGHT , myThid)
51			ENDIF
52			#else /* undef DIAGNOSTICS_HAS_PICKUP */
53			C- stop if trying to use part of the code that is not compiled:
54			IF ( diag_pickup_read ) THEN
55			WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
56			& 'diag_pickup_read is TRUE ',
57			& 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
58			CALL PRINT_ERROR( msgBuf , myThid)
59			ENDIF
60			IF ( diag_pickup_write ) THEN
61			WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
62			& 'diag_pickup_write is TRUE ',
63			& 'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
64			CALL PRINT_ERROR( msgBuf , myThid)
65			ENDIF
66			IF ( diag_pickup_read .OR. diag_pickup_write ) THEN
67			STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
68			ENDIF
69			#endif /* DIAGNOSTICS_HAS_PICKUP */
70
71	jmc	1.1	C- File names:
72			DO n = 2,nlists
73			DO m = 1,n-1
74			IF ( fnames(n).EQ.fnames(m) ) THEN
75			WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
76			& 'found 2 identical filenames:'
77			CALL PRINT_ERROR( msgBuf , myThid )
78			WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
79			& '1rst (m=', m, ' ): ', fnames(m)
80			CALL PRINT_ERROR( msgBuf , myThid )
81			WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
82			& ' 2nd (n=', n, ' ): ', fnames(n)
83			CALL PRINT_ERROR( msgBuf , myThid )
84			STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
85			ENDIF
86			ENDDO
87			ENDDO
88
89	jmc	1.4	DO n = 2,diagSt_nbLists
90			DO m = 1,n-1
91			IF ( diagSt_Fname(n).EQ.diagSt_Fname(m) ) THEN
92			WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
93			& 'found 2 identical stat_fname:'
94			CALL PRINT_ERROR( msgBuf , myThid )
95			WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
96			& '1rst (m=', m, ' ): ', diagSt_Fname(m)
97			CALL PRINT_ERROR( msgBuf , myThid )
98			WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
99			& ' 2nd (n=', n, ' ): ', diagSt_Fname(n)
100			CALL PRINT_ERROR( msgBuf , myThid )
101			STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
102			ENDIF
103			ENDDO
104			ENDDO
105
106	jmc	1.1	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
107			C- Check for field that appears 2 times (or more) with differents frequency:
108
109			DO n = 2,nlists
110			DO m = 1,n-1
111	jmc	1.4	IF ( freq(m).NE.freq(n) .OR. phase(m).NE.phase(n) ) THEN
112			C-- once the SWITCH_ONOFF is changed to only turns ON diag with <0 freq
113			C and CLRDIAG is changed to turns OFF diag with <0 freq,
114			C then we can allow 1 diag to be used with 2 differents <0 freq.
115			C and this would become:
116			c IF ( ( freq(m).GT.0. .OR. freq(n).GT.0. )
117			c & .AND.( freq(m).NE.freq(n) .OR. phase(m).NE.phase(n) )
118			c & ) THEN
119	jmc	1.1	DO k = 1,nActive(n)
120			DO l = 1,nActive(m)
121			IF ( flds(k,n).EQ.flds(l,m) ) THEN
122			WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',
123			& 'field : ',flds(k,n),' use 2 different freq. :'
124			CALL PRINT_ERROR( msgBuf , myThid )
125	jmc	1.4	WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
126			& '1rst (m=', m, ' ) freq,phase=', freq(m),phase(m),
127			& ' file:',fnames(m)
128			CALL PRINT_ERROR( msgBuf , myThid )
129			WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
130			& ' 2nd (n=', n, ' ) freq,phase=', freq(n),phase(n),
131			& ' file:',fnames(n)
132			CALL PRINT_ERROR( msgBuf , myThid )
133			STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
134			ENDIF
135			ENDDO
136			ENDDO
137			ENDIF
138			ENDDO
139			ENDDO
140
141			DO n = 2,diagSt_nbLists
142			DO m = 1,n-1
143			IF ( diagSt_freq(m) .NE. diagSt_freq(n) .OR.
144			& diagSt_phase(m).NE.diagSt_phase(n) ) THEN
145			c IF ( ( diagSt_freq(m).GT.0. .OR. diagSt_freq(n).GT.0. )
146			c & .AND.( diagSt_freq(m) .NE. diagSt_freq(n) .OR.
147			c & diagSt_phase(m).NE.diagSt_phase(n) )
148			c & ) THEN
149			DO k = 1,diagSt_nbActv(n)
150			DO l = 1,diagSt_nbActv(m)
151			IF ( diagSt_Flds(k,n).EQ.diagSt_Flds(l,m) ) THEN
152			WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',
153			& 'field : ',diagSt_Flds(k,n),' use 2 different stat_freq.:'
154			CALL PRINT_ERROR( msgBuf , myThid )
155			WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
156			& '1rst (m=', m, ' ) freq,phase=', diagSt_freq(m),
157			& diagSt_phase(m), ' file:', diagSt_Fname(m)
158	jmc	1.1	CALL PRINT_ERROR( msgBuf , myThid )
159	jmc	1.4	WRITE(msgBuf,'(2A,I3,A,2F17.6,2A)') 'DIAGNOSTICS_CHECK: ',
160			& ' 2nd (n=', n, ' ) freq,phase=', diagSt_freq(n),
161			& diagSt_phase(n), ' file:', diagSt_Fname(n)
162	jmc	1.1	CALL PRINT_ERROR( msgBuf , myThid )
163	jmc	1.2	STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
164	jmc	1.1	ENDIF
165			ENDDO
166			ENDDO
167			ENDIF
168			ENDDO
169			ENDDO
170
171			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
172
173			_END_MASTER(myThid)
174
175			RETURN
176			END