Back to home page

darwin3
 
 

    

File indexing completed on 2025-12-21 17:50:54 UTC

view on githubraw file Latest commit ad59256d on 2025-12-15 00:05:36 UTC
ad59256d7d aver*0001 #include "OBSFIT_OPTIONS.h"
                0002 #include "AD_CONFIG.h"
                0003 
                0004 C--  File obsfit_nc_utils.F:
                0005 C--   Contents
                0006 C--   o OBSFIT_NF_ERROR
                0007 C--   o OBSFIT_NC_CLOSE
                0008 
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP
                0011 C !ROUTINE: OBSFIT_NF_ERROR
                0012 
                0013 C !INTERFACE:
                0014       SUBROUTINE OBSFIT_NF_ERROR( message, STATUS, bi, bj, myThid )
                0015 
                0016 C     !DESCRIPTION:
                0017 C     Print NetCDF error message
                0018 
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021 C     == Global variables ===
                0022 #ifdef ALLOW_OBSFIT
                0023 # include "SIZE.h"
                0024 # include "EEPARAMS.h"
                0025 # include "PARAMS.h"
                0026 # include "netcdf.inc"
                0027 #endif
                0028 
                0029 C     !INPUT PARAMETERS:
                0030 C     message   :: optional message
                0031 C     STATUS    :: NetCDF error status
                0032 C     bi,bj     :: Tile indices
                0033 C     myThid    :: my thread ID number
                0034       CHARACTER*(*) message
                0035       INTEGER STATUS, bi, bj, myThid
                0036 
                0037 C     !OUTPUT PARAMETERS:
                0038 CEOP
                0039 
                0040 C     !FUNCTIONS:
                0041       INTEGER ILNBLNK
                0042       EXTERNAL ILNBLNK
                0043 
                0044 C     !LOCAL VARIABLES:
                0045 #ifdef ALLOW_OBSFIT
                0046       INTEGER IL
                0047       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0048 
                0049       IF ( debugLevel .GE. debLevA .AND. STATUS .NE. NF_NOERR ) THEN
                0050         IL = ILNBLNK(message)
                0051         IF ( IL .GT. 0 ) THEN
                0052           IF ( (bi.GT.0).AND.(bj.GT.0) ) THEN
                0053             WRITE( msgBuf,'(A,A,2I3,1X,A)' )
                0054      &       'NF_MESSAGE: OBSFIT_', message(1:IL),
                0055      &       bi, bj, NF_STRERROR(STATUS)
                0056           ELSE
                0057              WRITE( msgBuf,'(A,A,1X,A)' )
                0058      &       'NF_MESSAGE: OBSFIT_', message(1:IL),
                0059      &       NF_STRERROR(STATUS)
                0060           ENDIF
                0061         ELSE
                0062           IF ( (bi.GT.0).AND.(bj.GT.0) ) THEN
                0063             WRITE( msgBuf,'(A,2I3,1X,A)' ) 'NF_MESSAGE: OBSFIT ',
                0064      &       bi, bj, NF_STRERROR(STATUS)
                0065           ELSE
                0066             WRITE( msgBuf,'(A,1X,A)' ) 'NF_MESSAGE: OBSFIT ',
                0067      &       NF_STRERROR(STATUS)
                0068           ENDIF
                0069         ENDIF
                0070         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0071      &       SQUEEZE_RIGHT,myThid )
                0072       ENDIF
                0073 #endif /* ALLOW_OBSFIT */
                0074 
                0075       RETURN
                0076       END
                0077 
                0078 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0079 CBOP
                0080 C !ROUTINE: OBSFIT_NC_CLOSE
                0081 
                0082 C !INTERFACE:
                0083       SUBROUTINE OBSFIT_NC_CLOSE( myThid )
                0084 
                0085 C     !DESCRIPTION:
                0086 C     Close NetCDF files
                0087 
                0088 C     !USES:
                0089       IMPLICIT NONE
                0090 C     == Global variables ===
                0091 #ifdef ALLOW_OBSFIT
                0092 # include "SIZE.h"
                0093 # include "EEPARAMS.h"
                0094 # include "OBSFIT_SIZE.h"
                0095 # include "OBSFIT.h"
                0096 # include "netcdf.inc"
                0097 #endif
                0098 
                0099 C     !INPUT PARAMETERS:
                0100 C     myThid :: my thread ID number
                0101       INTEGER myThid
                0102 
                0103 C     !OUTPUT PARAMETERS:
                0104 CEOP
                0105 
                0106 C     !FUNCTIONS:
                0107       INTEGER ILNBLNK
                0108       EXTERNAL ILNBLNK
                0109 
                0110 C     !LOCAL VARIABLES:
                0111 #ifdef ALLOW_OBSFIT
                0112 C     bi,bj :: tile indices
                0113       INTEGER bi, bj
                0114       INTEGER IL, num_file
                0115       INTEGER STATUS
                0116       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0117 
                0118       _BEGIN_MASTER( myThid )
                0119 
                0120       DO num_file = 1, NFILESMAX_OBS
                0121         IL = ILNBLNK( obsfitFiles(num_file) )
                0122 
                0123         IF ( IL.NE.0 ) THEN
                0124           WRITE( msgBuf,'(A,A,5(1X,I8))' )
                0125      &         'S/R OBSFIT_NC_CLOSE:',
                0126      &         ' Closing '//obsfitFiles(num_file)(1:IL), num_file,
                0127      &         fiddata_obs(num_file)
                0128            CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0129      &          SQUEEZE_RIGHT,myThid )
                0130 C Data file
                0131           IF ( fiddata_obs(num_file) .GT. 0 ) THEN
                0132             STATUS = NF_CLOSE( fiddata_obs(num_file) )
                0133             WRITE( msgBuf,'(A,I3,I8)' )
                0134      &           'NC_CLOSE: NF_CLOSE data unit',
                0135      &           num_file, fiddata_obs(num_file)
                0136             CALL OBSFIT_NF_ERROR( msgBuf, STATUS,
                0137      &           0, 0, myThid )
                0138           ENDIF
                0139 
                0140 C Global equi file
                0141           IF ( fidglobal(num_file) .GT. 0 ) THEN
                0142             STATUS = NF_CLOSE( fidglobal(num_file) )
                0143             WRITE( msgBuf,'(A,I3,I8)' )
                0144      &           'NC_CLOSE: NF_CLOSE global equi unit',
                0145      &           num_file, fidglobal(num_file)
                0146             CALL OBSFIT_NF_ERROR( msgBuf, STATUS,
                0147      &           0, 0, myThid )
                0148           ENDIF
                0149 
                0150           IF (obsfitDoNcOutput) THEN
                0151 c            DO bj = myByLo(myThid), myByHi(myThid)
                0152 c               DO bi = myBxLo(myThid), myBxHi(myThid)
                0153 C Since this is only done by the master thread, we loop over the
                0154 C entire range of tiles
                0155             DO bj = 1, nSy
                0156               DO bi = 1, nSx
                0157                 WRITE( msgBuf,'(A,A,5(1X,I8))' )
                0158      &           'S/R OBSFIT_NC_CLOSE:',
                0159      &           ' Closing '//obsfitFiles(num_file)(1:IL), num_file,
                0160      &           fidfwd_obs(num_file,bi,bj),
                0161      &           fidadj_obs(num_file,bi,bj),
                0162      &           fidtan_obs(num_file,bi,bj)
                0163                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0164      &               SQUEEZE_RIGHT,myThid )
                0165 
                0166 C Forward equivalent (.equi) file
                0167                 IF ( fidfwd_obs(num_file,bi,bj) .GT. 0 ) THEN
                0168                  STATUS = NF_CLOSE( fidfwd_obs(num_file,bi,bj) )
                0169                  WRITE( msgBuf,'(A,I3,I8)' )
                0170      &                'NC_CLOSE: NF_CLOSE fwd unit',
                0171      &                num_file, fidfwd_obs(num_file,bi,bj)
                0172                  CALL OBSFIT_NF_ERROR( msgBuf, STATUS,
                0173      &                bi, bj, myThid )
                0174                 ENDIF
                0175 #ifdef ALLOW_ADJOINT_RUN
                0176 C Adjoint equivalent (.equi) file
                0177                 IF ( fidadj_obs(num_file,bi,bj) .GT. 0 ) THEN
                0178                  STATUS = NF_CLOSE( fidadj_obs(num_file,bi,bj) )
                0179                  WRITE( msgBuf,'(A,I3,I8)' )
                0180      &                'NC_CLOSE: NF_CLOSE adj unit',
                0181      &                num_file, fidadj_obs(num_file,bi,bj)
                0182                  CALL OBSFIT_NF_ERROR( msgBuf, STATUS,
                0183      &                bi, bj, myThid )
                0184                 ENDIF
                0185 #endif
                0186 #ifdef ALLOW_TANGENTLINEAR_RUN
                0187 C Tangent linear equivalent (.equi) file
                0188                 IF ( fidtan_obs(num_file,bi,bj) .GT. 0 ) THEN
                0189                  STATUS = NF_CLOSE( fidtan_obs(num_file,bi,bj) )
                0190                  WRITE( msgBuf,'(A,I3,I8)' )
                0191      &                'NC_CLOSE: NF_CLOSE tlm unit',
                0192      &                num_file, fidtan_obs(num_file,bi,bj)
                0193                  CALL OBSFIT_NF_ERROR( msgBuf, STATUS,
                0194      &                bi, bj, myThid )
                0195                 ENDIF
                0196 #endif
                0197 
                0198               ENDDO
                0199             ENDDO
                0200           ENDIF
                0201         ENDIF
                0202       ENDDO
                0203 
                0204       _END_MASTER( myThid )
                0205 #endif /* ALLOW_OBSFIT */
                0206 
                0207       RETURN
                0208       END
                0209
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

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

The LXR team
Valid CSS 2.1! Valid HTML 4.01!