Back to home page

MITgcm
 
 

    

File indexing completed on 2025-08-05 05:09:15 UTC

view on githubraw file Latest commit 13ce79fe on 2025-08-04 21:05:34 UTC
13ce79fe94 Ivan*0001 #include "PROFILES_OPTIONS.h"
                0002 #include "AD_CONFIG.h"
                0003 
                0004 C--  File profiles_nc_utils.F:
                0005 C--   Contents
                0006 C--   o PROFILES_NF_ERROR
                0007 C--   o PROFILES_NC_CLOSE
                0008 
                0009 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0010 CBOP
                0011 C !ROUTINE: PROFILES_NF_ERROR
                0012 
                0013 C !INTERFACE:
                0014       SUBROUTINE PROFILES_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_PROFILES
                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_PROFILES
                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           WRITE(msgBuf,'(A,A,2I3,1X,A)')
                0053      &     'NF_MESSAGE: PROFILES_', message(1:IL),
                0054      &     bi, bj, NF_STRERROR(STATUS)
                0055         ELSE
                0056           WRITE(msgBuf,'(A,2I3,1X,A)') 'NF_MESSAGE: PROFILES ',
                0057      &     bi, bj, NF_STRERROR(STATUS)
                0058         ENDIF
                0059         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0060      &       SQUEEZE_RIGHT,myThid )
                0061       ENDIF
                0062 #endif /* ALLOW_PROFILES */
                0063 
                0064       RETURN
                0065       END
                0066 
                0067 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0068 CBOP
                0069 C !ROUTINE: PROFILES_NC_CLOSE
                0070 
                0071 C !INTERFACE:
                0072       SUBROUTINE PROFILES_NC_CLOSE( myThid )
                0073 
                0074 C     !DESCRIPTION:
                0075 C     Close NetCDF files
                0076 
                0077 C     !USES:
                0078       IMPLICIT NONE
                0079 C     == Global variables ===
                0080 #ifdef ALLOW_PROFILES
                0081 # include "SIZE.h"
                0082 # include "EEPARAMS.h"
                0083 # include "PROFILES_SIZE.h"
                0084 # include "profiles.h"
                0085 # include "netcdf.inc"
                0086 #endif
                0087 
                0088 C     !INPUT PARAMETERS:
                0089 C     myThid :: my Thread Id number
                0090       INTEGER myThid
                0091 
                0092 C     !OUTPUT PARAMETERS:
                0093 CEOP
                0094 
                0095 C     !FUNCTIONS:
                0096       INTEGER ILNBLNK
                0097       EXTERNAL ILNBLNK
                0098 
                0099 C     !LOCAL VARIABLES:
                0100 #ifdef ALLOW_PROFILES
                0101 C     bi,bj :: Tile indices
                0102       INTEGER bi, bj
                0103       INTEGER IL, numFile
                0104       INTEGER STATUS
                0105       CHARACTER*(MAX_LEN_MBUF) msgBuf
                0106 
                0107       _BEGIN_MASTER( myThid )
                0108 
                0109       IF (profilesDoNcOutput) THEN
                0110 c       DO bj = myByLo(myThid), myByHi(myThid)
                0111 c         DO bi = myBxLo(myThid), myBxHi(myThid)
                0112 C     Since this is only done by the master thread, we loop over the
                0113 C     enire range of tiles
                0114         DO bj = 1, nSy
                0115           DO bi = 1, nSx
                0116             DO numFile = 1, NFILESPROFMAX
                0117               IL = ILNBLNK( profilesfiles(numFile) )
                0118 
                0119               IF (IL.NE.0) THEN
                0120                 WRITE(msgBuf,'(A,A,5(1X,I8))')
                0121      &           'S/R PROFILES_NC_CLOSE:',
                0122      &           ' Closing '//profilesfiles(numFile)(1:IL), numFile,
                0123      &           fiddata(numFile,bi,bj),fidforward(numFile,bi,bj),
                0124      &           fidadjoint(numFile,bi,bj),fidtangent(numFile,bi,bj)
                0125                 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0126      &               SQUEEZE_RIGHT,myThid )
                0127 C Data file
                0128                 IF ( fiddata(numFile,bi,bj) .GT. 0 ) THEN
                0129                  STATUS = NF_CLOSE( fiddata(numFile,bi,bj) )
                0130                  WRITE(msgBuf,'(A,I3,I8)')
                0131      &                'NC_CLOSE: NF_CLOSE data unit',
                0132      &                numFile, fiddata(numFile,bi,bj)
                0133                  CALL PROFILES_NF_ERROR( msgBuf, STATUS,
                0134      &                bi, bj, myThid )
                0135                 ENDIF
                0136 
                0137 C Forward equivalent (.equi) file
                0138                 IF ( fidforward(numFile,bi,bj) .GT. 0 ) THEN
                0139                  STATUS = NF_CLOSE( fidforward(numFile,bi,bj) )
                0140                  WRITE(msgBuf,'(A,I3,I8)')
                0141      &                'NC_CLOSE: NF_CLOSE fwd unit',
                0142      &                numFile, fidforward(numFile,bi,bj)
                0143                  CALL PROFILES_NF_ERROR( msgBuf, STATUS,
                0144      &                bi, bj, myThid )
                0145                 ENDIF
                0146 #ifdef ALLOW_ADJOINT_RUN
                0147 C Adjoint equivalent (.equi) file
                0148                 IF ( fidadjoint(numFile,bi,bj) .GT. 0 ) THEN
                0149                  STATUS = NF_CLOSE( fidadjoint(numFile,bi,bj) )
                0150                  WRITE(msgBuf,'(A,I3,I8)')
                0151      &                'NC_CLOSE: NF_CLOSE adj unit',
                0152      &                numFile, fidadjoint(numFile,bi,bj)
                0153                  CALL PROFILES_NF_ERROR( msgBuf, STATUS,
                0154      &                bi, bj, myThid )
                0155                 ENDIF
                0156 #endif
                0157 #ifdef ALLOW_TANGENTLINEAR_RUN
                0158 C Tangent linear equivalent (.equi) file
                0159                 IF ( fidtangent(numFile,bi,bj) .GT. 0 ) THEN
                0160                  STATUS = NF_CLOSE( fidtangent(numFile,bi,bj) )
                0161                  WRITE(msgBuf,'(A,I3,I8)')
                0162      &                'NC_CLOSE: NF_CLOSE tlm unit',
                0163      &                numFile, fidtangent(numFile,bi,bj)
                0164                  CALL PROFILES_NF_ERROR( msgBuf, STATUS,
                0165      &                bi, bj, myThid )
                0166                 ENDIF
                0167 #endif
                0168               ENDIF !(IL.NE.0)
                0169 
                0170             ENDDO
                0171           ENDDO
                0172         ENDDO
                0173       ENDIF
                0174 
                0175       _END_MASTER( myThid )
                0176 #endif /* ALLOW_PROFILES */
                0177 
                0178       RETURN
                0179       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!