/[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.2 by jmc, Thu Dec 16 21:39:53 2004 UTC revision 1.6 by jmc, Fri Nov 4 01:30:33 2005 UTC
# Line 27  CEOP Line 27  CEOP
27    
28  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
29        CHARACTER*(MAX_LEN_MBUF) msgBuf        CHARACTER*(MAX_LEN_MBUF) msgBuf
30        INTEGER k,l,n,m        INTEGER n,m
31    
32        _BEGIN_MASTER(myThid)        _BEGIN_MASTER(myThid)
33    
34  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
35  C     Check diagnostics parameter consistency  C     Check diagnostics parameter consistency
36    
37    #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  C-    File names:  C-    File names:
72        DO n = 2,nlists        DO n = 2,nlists
73         DO m = 1,n-1         DO m = 1,n-1
# Line 52  C-    File names: Line 86  C-    File names:
86         ENDDO         ENDDO
87        ENDDO        ENDDO
88    
89  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|        DO n = 2,diagSt_nbLists
 C-    Check for field that appears 2 times (or more) with differents frequency:  
   
       DO n = 2,nlists  
90         DO m = 1,n-1         DO m = 1,n-1
91          IF ( freq(m).NE.freq(n) ) THEN          IF ( diagSt_Fname(n).EQ.diagSt_Fname(m) ) THEN
92           DO k = 1,nActive(n)           WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
93            DO l = 1,nActive(m)       &            'found 2 identical stat_fname:'
94             IF ( flds(k,n).EQ.flds(l,m) ) THEN           CALL PRINT_ERROR( msgBuf , myThid )
95              WRITE(msgBuf,'(4A)') 'DIAGNOSTICS_CHECK: ',           WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
96       &       'field : ',flds(k,n),' use 2 different freq. :'       &    '1rst (m=', m, ' ): ', diagSt_Fname(m)
97              CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
98              WRITE(msgBuf,'(2A,I3,A,I6,2A)') 'DIAGNOSTICS_CHECK: ',           WRITE(msgBuf,'(2A,I3,2A)') 'DIAGNOSTICS_CHECK: ',
99       &       '1rst (m=', m, ' ), freq=', freq(m),' file:',fnames(m)       &    ' 2nd (n=', n, ' ): ', diagSt_Fname(n)
100              CALL PRINT_ERROR( msgBuf , myThid )           CALL PRINT_ERROR( msgBuf , myThid )
101              WRITE(msgBuf,'(2A,I3,A,I6,2A)') 'DIAGNOSTICS_CHECK: ',           STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
      &       ' 2nd (n=', n, ' ), freq=', freq(n),' file:',fnames(n)  
             CALL PRINT_ERROR( msgBuf , myThid )  
             STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'  
            ENDIF  
           ENDDO  
          ENDDO  
102          ENDIF          ENDIF
103         ENDDO         ENDDO
104        ENDDO        ENDDO
105    
106  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
107    C-    Check for field that appears 2 times (or more) with differents frequency:
108    C     disable this checking since now diagnostics pkg can handle this case.
109    
110    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111    
112        _END_MASTER(myThid)        _END_MASTER(myThid)
113    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22