Back to home page

MITgcm
 
 

    

File indexing completed on 2024-05-11 05:10:22 UTC

view on githubraw file Latest commit 41c4545f on 2024-05-10 15:00:41 UTC
09ceb40cd6 Jean*0001 #include "DIAG_OPTIONS.h"
                0002 
                0003 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0004 CBOP 0
                0005 C     !ROUTINE: DIAGNOSTICS_CHECK
                0006 
                0007 C     !INTERFACE:
                0008       SUBROUTINE DIAGNOSTICS_CHECK(myThid)
                0009 
                0010 C     !DESCRIPTION:
                0011 C     Check option and parameter consistency
8b486f988e Jean*0012 
09ceb40cd6 Jean*0013 C     !USES:
                0014       IMPLICIT NONE
                0015 #include "SIZE.h"
                0016 #include "EEPARAMS.h"
                0017 #include "PARAMS.h"
8b486f988e Jean*0018 #include "GRID.h"
09ceb40cd6 Jean*0019 #include "DIAGNOSTICS_SIZE.h"
41c4545f8f Jean*0020 #include "DIAGNOSTICS_P2SHARE.h"
09ceb40cd6 Jean*0021 #include "DIAGNOSTICS.h"
                0022 
                0023 C     !INPUT PARAMETERS:
                0024       INTEGER myThid
                0025 CEOP
                0026 
                0027 C     !LOCAL VARIABLES:
a5ec81ed49 Timo*0028 C     msgBuf     :: Informational/error message buffer
                0029 C     errCount   :: Error counter
09ceb40cd6 Jean*0030       CHARACTER*(MAX_LEN_MBUF) msgBuf
a5ec81ed49 Timo*0031       INTEGER errCount
8b486f988e Jean*0032       INTEGER ld,md,nd
                0033       INTEGER k,m
                0034       INTEGER jpoint1, ipoint1, jpoint2, ipoint2
                0035       _RL     margin
09ceb40cd6 Jean*0036 
                0037       _BEGIN_MASTER(myThid)
a5ec81ed49 Timo*0038       errCount = 0
09ceb40cd6 Jean*0039 
                0040 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0041 C     Check diagnostics parameter consistency
                0042 
866f99417e Jean*0043       IF ( useMissingValue .AND. .NOT. diag_mnc ) THEN
                0044         WRITE(msgBuf,'(2A)') '** WARNING ** DIAGNOSTICS_CHECK: ',
                0045      &            'ignore "useMissingValue" since "diag_mnc" is off'
                0046         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0047      &                      SQUEEZE_RIGHT , myThid )
                0048       ENDIF
                0049 
1f837e63b3 Gael*0050       IF ( diag_mnc.AND.(diagMdsDir.NE.' ') ) THEN
                0051         WRITE(msgBuf,'(A,A)') 'S/R DIAGNOSTICS_CHECK: diagMdsDir ',
                0052      &       'and pkg/mnc cannot be used together'
                0053         CALL PRINT_ERROR( msgBuf, myThid )
a5ec81ed49 Timo*0054         errCount = errCount + 1
1f837e63b3 Gael*0055       ENDIF
                0056 
                0057       IF ( (mdsioLocalDir.NE.' ').AND.(diagMdsDir.NE.' ') ) THEN
                0058         WRITE(msgBuf,'(A)')
                0059      &   'S/R DIAGNOSTICS_CHECK: mdsioLocalDir and diagMdsDir cannot be'
                0060         CALL PRINT_ERROR( msgBuf, myThid )
                0061         WRITE(msgBuf,'(A)')
                0062      &   'S/R DIAGNOSTICS_CHECK: specified at the same time'
                0063         CALL PRINT_ERROR( msgBuf, myThid )
a5ec81ed49 Timo*0064         errCount = errCount + 1
1f837e63b3 Gael*0065       ENDIF
                0066 
a70ecea8ae Jean*0067 #ifdef DIAGNOSTICS_HAS_PICKUP
                0068       IF ( diag_pickup_read ) THEN
                0069         WRITE(msgBuf,'(2A)') '**CAUTION** (DIAGNOSTICS_CHECK): ',
                0070      &   'reading diagnostics previous state'
                0071         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0072      &       SQUEEZE_RIGHT , myThid)
                0073         WRITE(msgBuf,'(2A)') '**CAUTION** ',
                0074      &   ' from a pickup file can only work if data.diagnostics'
                0075         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0076      &       SQUEEZE_RIGHT , myThid)
                0077         WRITE(msgBuf,'(2A)') '**CAUTION** ',
                0078      &   ' is not changed (<= further checking not yet implemented)'
                0079         CALL PRINT_MESSAGE( msgBuf, errorMessageUnit,
                0080      &       SQUEEZE_RIGHT , myThid)
                0081       ENDIF
                0082 #else /* undef DIAGNOSTICS_HAS_PICKUP */
                0083 C-    stop if trying to use part of the code that is not compiled:
                0084       IF ( diag_pickup_read  ) THEN
                0085         WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0086      &   'diag_pickup_read  is TRUE ',
                0087      &   'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
                0088         CALL PRINT_ERROR( msgBuf , myThid)
a5ec81ed49 Timo*0089         errCount = errCount + 1
a70ecea8ae Jean*0090       ENDIF
                0091       IF ( diag_pickup_write ) THEN
                0092         WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0093      &   'diag_pickup_write is TRUE ',
                0094      &   'but DIAGNOSTICS_HAS_PICKUP is "#undef"'
                0095         CALL PRINT_ERROR( msgBuf , myThid)
a5ec81ed49 Timo*0096         errCount = errCount + 1
a70ecea8ae Jean*0097       ENDIF
                0098 #endif /* DIAGNOSTICS_HAS_PICKUP */
8b486f988e Jean*0099 
09ceb40cd6 Jean*0100 C-    File names:
8b486f988e Jean*0101       DO ld = 2,nlists
                0102        DO m = 1,ld-1
                0103         IF ( fnames(ld).EQ.fnames(m) ) THEN
09ceb40cd6 Jean*0104          WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
a5ec81ed49 Timo*0105      &            'found 2 identical file-names:'
09ceb40cd6 Jean*0106          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0107          WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
09ceb40cd6 Jean*0108      &    '1rst (m=', m, ' ): ', fnames(m)
                0109          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0110          WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
8b486f988e Jean*0111      &    ' 2nd (n=', ld, ' ): ', fnames(ld)
09ceb40cd6 Jean*0112          CALL PRINT_ERROR( msgBuf , myThid )
a5ec81ed49 Timo*0113          errCount = errCount + 1
09ceb40cd6 Jean*0114         ENDIF
                0115        ENDDO
                0116       ENDDO
                0117 
8b486f988e Jean*0118       DO ld = 2,diagSt_nbLists
                0119        DO m = 1,ld-1
                0120         IF ( diagSt_Fname(ld).EQ.diagSt_Fname(m) ) THEN
3e5de6a370 Jean*0121          WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
a5ec81ed49 Timo*0122      &            'found 2 identical stat_fName:'
3e5de6a370 Jean*0123          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0124          WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
3e5de6a370 Jean*0125      &    '1rst (m=', m, ' ): ', diagSt_Fname(m)
                0126          CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0127          WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
8b486f988e Jean*0128      &    ' 2nd (n=', ld, ' ): ', diagSt_Fname(ld)
3e5de6a370 Jean*0129          CALL PRINT_ERROR( msgBuf , myThid )
a5ec81ed49 Timo*0130          errCount = errCount + 1
3e5de6a370 Jean*0131         ENDIF
                0132        ENDDO
                0133       ENDDO
                0134 
09ceb40cd6 Jean*0135 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0136 C-    Check for field that appears 2 times (or more) with differents frequency:
3ae5f90260 Jean*0137 C     disable this checking since now diagnostics pkg can handle this case.
09ceb40cd6 Jean*0138 
                0139 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0140 
8b486f988e Jean*0141 C--   Vertical Interpolation: check for compatibility:
                0142 C     better to stop here, rather much later, when trying to write output
                0143       DO ld = 1,nlists
                0144        IF ( fflags(ld)(2:2).EQ.'P' ) THEN
                0145         IF ( fluidIsAir ) THEN
                0146 C-    check that interpolated levels are >0 & fall within the domain +/- X %
                0147 C      (needs p>0 for p^kappa ; here take a 10 % margin)
                0148           margin = rkSign*(rF(Nr+1)-rF(1))*0.1 _d 0
                0149           DO k=1,nlevels(ld)
                0150            IF ( levs(k,ld)-MAX(rF(1),rF(Nr+1)).GT.margin
                0151      &     .OR. levs(k,ld)-MIN(rF(1),rF(Nr+1)).LT.-margin
                0152      &     .OR. levs(k,ld).LE.0. ) THEN
                0153 
e129400813 Jean*0154             WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
8b486f988e Jean*0155      &       'Vertical Interp. for list l=', ld,
a5ec81ed49 Timo*0156      &       ', fileName: ', fnames(ld)
8b486f988e Jean*0157             CALL PRINT_ERROR( msgBuf , myThid )
                0158             WRITE(msgBuf,'(2A,I4,3(A,F16.8))') 'DIAGNOSTICS_CHECK: ',
                0159      &       ' lev(k=', k, ') p=', levs(k,ld),
                0160      &       ' not in the domain:',rF(1),' :',rF(Nr+1)
                0161             CALL PRINT_ERROR( msgBuf , myThid )
a5ec81ed49 Timo*0162             errCount = errCount + 1
8b486f988e Jean*0163            ENDIF
                0164           ENDDO
                0165         ELSE
                0166 C-    p^kappa interpolation: meaningfull only if Atmosphere & P-coordiante
                0167           WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
                0168      &       'INTERP_VERT not allowed in this config'
                0169           CALL PRINT_ERROR( msgBuf , myThid )
e129400813 Jean*0170            WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
a5ec81ed49 Timo*0171      &       ' for list l=', ld, ', fileName: ', fnames(ld)
8b486f988e Jean*0172           CALL PRINT_ERROR( msgBuf , myThid )
a5ec81ed49 Timo*0173           errCount = errCount + 1
8b486f988e Jean*0174         ENDIF
                0175         IF (select_rStar.GT.0) THEN
                0176 C-    If nonlinear free surf is active, need averaged pressures
                0177          DO md = 1,nfields(ld)
b38beaf3c1 Jean*0178           nd = ABS(jdiag(md,ld))
8b486f988e Jean*0179           CALL DIAGNOSTICS_GET_POINTERS( 'RSURF   ', ld,
                0180      &                                   jpoint1, ipoint1, myThid )
                0181           IF ( useFIZHI .AND.
                0182      &          gdiag(nd)(10:10) .EQ. 'L') THEN
                0183            CALL DIAGNOSTICS_GET_POINTERS('FIZPRES ', ld,
                0184      &                                   jpoint2, ipoint2, myThid )
                0185           ELSE
                0186            CALL DIAGNOSTICS_GET_POINTERS('RCENTER ', ld,
                0187      &                                   jpoint2, ipoint2, myThid )
                0188           ENDIF
                0189           IF ( ipoint1.EQ.0 .OR. ipoint2.EQ.0 ) THEN
e129400813 Jean*0190             WRITE(msgBuf,'(2A,I5)') 'DIAGNOSTICS_CHECK: ',
8b486f988e Jean*0191      &      'to interpolate diags from output list:', ld
                0192             CALL PRINT_ERROR( msgBuf , myThid )
                0193             IF ( ipoint1.EQ.0 .AND. jpoint1.EQ.0 ) THEN
                0194               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0195      &        'needs to turn ON surface pressure diagnostic "RSURF   "'
                0196               CALL PRINT_ERROR( msgBuf , myThid )
                0197             ELSEIF ( ipoint1.EQ.0 ) THEN
                0198               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0199      &        'needs surface pressure diagnostic "RSURF   " ',
                0200      &        'with same output time'
                0201               CALL PRINT_ERROR( msgBuf , myThid )
                0202             ENDIF
                0203             IF ( ipoint2.EQ.0 .AND. jpoint2.EQ.0 ) THEN
                0204               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0205      &        'needs to turn ON  3-D pressure diagnostic "RCENTER "'
                0206               CALL PRINT_ERROR( msgBuf , myThid )
                0207             ELSEIF ( ipoint2.EQ.0 ) THEN
                0208               WRITE(msgBuf,'(3A)') 'DIAGNOSTICS_CHECK: ',
                0209      &        'needs  3-D pressure diagnostic "RCENTER " ',
                0210      &        'with same output time'
                0211               CALL PRINT_ERROR( msgBuf , myThid )
                0212             ENDIF
a5ec81ed49 Timo*0213             errCount = errCount + 1
8b486f988e Jean*0214           ENDIF
                0215          ENDDO
                0216         ENDIF
                0217        ENDIF
                0218       ENDDO
                0219 
a5ec81ed49 Timo*0220 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0221 C     To print adjoint variables through diagnostics package, must keep
                0222 C     fwd and adjoint variables separate within lists.
                0223 C     Here: Check to see if variables are mixed, stop if so
                0224       IF ( useDiag4AdjOutp ) THEN
                0225        DO ld = 1,nlists
                0226         nd = ABS(jdiag(1,ld))
                0227         IF (gdiag(nd)(4:4).EQ.'A') THEN
                0228          DO md = 1,nfields(ld)
                0229           nd = ABS(jdiag(md,ld))
                0230           IF (gdiag(nd)(4:4).NE.'A') THEN
                0231             WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
                0232      &        'Cannot define forward and adjoint variables within the'
                0233             CALL PRINT_ERROR( msgBuf , myThid )
                0234             WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
                0235      &       ' same diag list, l=', ld, ', fileName: ', fnames(ld)
                0236             CALL PRINT_ERROR( msgBuf , myThid )
                0237             errCount = errCount + 1
                0238           ENDIF
                0239          ENDDO
                0240         ELSE
                0241          DO md = 1,nfields(ld)
                0242           nd = ABS(jdiag(md,ld))
                0243           IF (gdiag(nd)(4:4).EQ.'A') THEN
                0244             WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
                0245      &        'Cannot define forward and adjoint variables within the'
                0246             CALL PRINT_ERROR( msgBuf , myThid )
                0247             WRITE(msgBuf,'(2A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
                0248      &       ' same diag list, l=', ld, ', fileName: ', fnames(ld)
                0249             CALL PRINT_ERROR( msgBuf , myThid )
                0250             errCount = errCount + 1
                0251           ENDIF
                0252          ENDDO
                0253         ENDIF
                0254        ENDDO
                0255       ENDIF
                0256 C-    for now, adjoint variable diagnostics not implemented for stats-diags
                0257       DO ld = 1,diagSt_nbLists
                0258        DO md=1,diagSt_nbFlds(ld)
                0259         nd = ABS(jSdiag(md,ld))
                0260         IF ( gdiag(nd)(4:4).EQ.'A' ) THEN
                0261          WRITE(msgBuf,'(4A,I5,2A)') 'DIAGNOSTICS_CHECK: ',
                0262      &    'Adj-diag "', diagSt_Flds(md,ld), '" in list ld=', ld,
                0263      &    ', stat_fName: ', diagSt_Fname(ld)
                0264          CALL PRINT_ERROR( msgBuf , myThid )
                0265          WRITE(msgBuf,'(2A)') 'DIAGNOSTICS_CHECK: ',
                0266      &    'but Adj-Var diagnostic not coded for Stats-Diags output'
                0267          CALL PRINT_ERROR( msgBuf , myThid )
                0268          errCount = errCount + 1
                0269         ENDIF
                0270        ENDDO
                0271       ENDDO
                0272 
                0273 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0274 
                0275       IF ( errCount.GE.1 ) THEN
                0276         WRITE(msgBuf,'(A,I5,A)')
                0277      &     'DIAGNOSTICS_CHECK: detected', errCount,' fatal error(s)'
                0278         CALL PRINT_ERROR( msgBuf, myThid )
                0279         CALL ALL_PROC_DIE( 0 )
                0280         STOP 'ABNORMAL END: S/R DIAGNOSTICS_CHECK'
                0281       ENDIF
                0282 
09ceb40cd6 Jean*0283       _END_MASTER(myThid)
                0284 
                0285       RETURN
                0286       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!