pkg/obsfit/obsfit_read_obs.F

ad59256d7d aver*0001 #include "OBSFIT_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBSFIT_READ_OBS
                0005
                0006 C     !INTERFACE:
                0007       SUBROUTINE OBSFIT_READ_OBS(
                0008      I                            fNb,
                0009      I                            vNb,
                0010      I                            irec,
                0011      O                            vec_loc,
                0012      I                            myThid )
                0013
                0014 C     !DESCRIPTION:
                0015 C     ==================================================================
                0016 C     | Reads an observation and its uncertainty from a netcdf ObsFit
                0017 C     | input file
                0018 C     ==================================================================
                0019
                0020 C     !USES:
                0021       IMPLICIT NONE
                0022 C     == Global variables ===
                0023 #include "SIZE.h"
                0024 #include "EEPARAMS.h"
                0025 #include "PARAMS.h"
                0026 #include "GRID.h"
                0027 #include "DYNVARS.h"
                0028 #ifdef ALLOW_OBSFIT
                0029 # include "netcdf.inc"
                0030 # include "OBSFIT_SIZE.h"
                0031 # include "OBSFIT.h"
                0032 #endif
                0033
                0034 C     !INPUT PARAMETERS:
                0035 C     fNb, vNb ::
                0036 C     irec     :: sample record number
                0037 C     myThid   :: my thread ID number
                0038 C     vec_loc  ::
                0039       INTEGER fNb, vNb
                0040       INTEGER irec, myThid
                0041       _RL     vec_loc
                0042 CEOP
                0043
                0044 #ifdef ALLOW_OBSFIT
                0045 C     !LOCAL VARIABLES:
                0046 C     tmpObsNo :: number of obs in the file
                0047       INTEGER vv, err, varID, tmpObsNo
                0048       INTEGER vec_start,vec_count
                0049       _RL     vec_tmp1(1000),vec_tmp2(1000)
033a68c0be Jean*0050       CHARACTER*(MAX_LEN_MBUF) msgbuf
ad59256d7d aver*0051
                0052       IF ( (irec.LT.obsfit_minind_buff) .OR.
                0053      &     (irec.GT.obsfit_maxind_buff) .OR.
                0054      &     (obsfit_curfile_buff.NE.fNb) ) THEN
                0055        err = NF_INQ_DIMID( fiddata_obs(fNb),'iOBS', varID )
                0056        CALL OBSFIT_NF_ERROR(
                0057      &      'READ_OBS: NF_INQ_DIMID fiddata iObs',
033a68c0be Jean*0058      &      err, 0, 0, myThid )
ad59256d7d aver*0059        err = NF_INQ_DIMLEN( fiddata_obs(fNb), varID, tmpObsNo )
                0060        CALL OBSFIT_NF_ERROR( 'READ_OBS: NF_INQ_DIMLEN tmpObsNo',
033a68c0be Jean*0061      &      err, 0, 0, myThid )
ad59256d7d aver*0062
                0063        IF ( obsfit_curfile_buff.NE.fNb ) THEN
                0064 C No asumption on whether a forward or a backward loop is calling
                0065          obsfit_minind_buff = MAX(1,irec-500+1)
                0066          obsfit_maxind_buff = MIN(tmpObsNo,irec+500)
                0067
                0068        ELSEIF ( irec.LT.obsfit_minind_buff ) THEN
                0069 C Implies that a backward loop is calling
                0070          obsfit_minind_buff = MAX(1,irec-999)
                0071          obsfit_maxind_buff = irec
                0072
                0073        ELSE
                0074 C Implies that a forward loop is calling
                0075          obsfit_minind_buff = irec
                0076          obsfit_maxind_buff = MIN(tmpObsNo,irec+999)
                0077
                0078        ENDIF !IF (obsfit_curfile_buff.NE.fNb)
                0079
                0080 #ifdef ALLOW_DEBUG
                0081        IF ( debugLevel.GE.debLevD ) THEN
                0082          WRITE( msgbuf,'(A,5I9)' )
                0083      &    'buffer readobsfile ',
                0084      &    obsfit_minind_buff, obsfit_maxind_buff,
                0085      &    irec, ObsNo(fNb), tmpObsNo
                0086          CALL PRINT_MESSAGE( msgbuf,
                0087      &        standardMessageUnit, SQUEEZE_RIGHT, myThid )
                0088        ENDIF
                0089 #endif
                0090
                0091        vec_start = obsfit_minind_buff
                0092        vec_count = obsfit_maxind_buff-obsfit_minind_buff+1
                0093
                0094        err = NF_INQ_VARID( fiddata_obs(fNb), obsfit_nameval, varID )
                0095        CALL OBSFIT_NF_ERROR(
033a68c0be Jean*0096      &      'READ_OBS: NF_INQ_VARID obsfit_nameval',err,0,0,myThid )
ad59256d7d aver*0097        err = NF_GET_VARA_DOUBLE( fiddata_obs(fNb), varID, vec_start,
                0098      &       vec_count, vec_tmp1 )
                0099        CALL OBSFIT_NF_ERROR(
033a68c0be Jean*0100      &      'READ_OBS: NF_GET_VARA_DOUBLE vec_tmp1',err,0,0,myThid )
ad59256d7d aver*0101        err = NF_INQ_VARID( fiddata_obs(fNb), obsfit_nameuncert, varID )
                0102        CALL OBSFIT_NF_ERROR(
033a68c0be Jean*0103      &      'READ_OBS: NF_INQ_VARID obsfit_nameuncert',err,0,0,myThid )
ad59256d7d aver*0104        err = NF_GET_VARA_DOUBLE( fiddata_obs(fNb), varID, vec_start,
                0105      &       vec_count, vec_tmp2 )
                0106        CALL OBSFIT_NF_ERROR(
033a68c0be Jean*0107      &      'READ_OBS: NF_GET_VARA_DOUBLE vec_tmp2',err,0,0,myThid )
ad59256d7d aver*0108
                0109         IF ( err.NE.NF_NOERR ) THEN
                0110          WRITE( errorMessageUnit,'(A)' )
                0111      &        'WARNING in obsfit_read_obs: record not found!!'
                0112         ENDIF
                0113
                0114         DO vv = 1, vec_count
                0115           obsfit_data_buff(vv) = vec_tmp1(vv)
                0116           obsfit_uncert_buff(vv) = vec_tmp2(vv)
                0117         ENDDO
                0118
                0119         obsfit_curfile_buff = fNb
                0120       ENDIF
                0121
                0122       IF ( vNb.LT.0 ) THEN
                0123         vec_loc = obsfit_uncert_buff(irec-obsfit_minind_buff+1)
                0124
                0125       ELSE
                0126         vec_loc = obsfit_data_buff(irec-obsfit_minind_buff+1)
                0127       ENDIF
                0128
                0129 #endif /* ALLOW_OBSFIT */
                0130
                0131       RETURN
                0132       END
                0133
                0134 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|