pkg/obsfit/obsfit_inloop.F

ad59256d7d aver*0001 #include "OBSFIT_OPTIONS.h"
                0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: OBSFIT_INLOOP
                0008
                0009 C     !INTERFACE:
                0010       SUBROUTINE OBSFIT_INLOOP( myTime, myIter, myThid )
                0011
                0012 C     !DESCRIPTION:
                0013 C     ==================================================================
                0014 C     | Computes and writes model counterparts for ObsFit data
                0015 C     ==================================================================
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     == Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "GRID.h"
                0023 #include "DYNVARS.h"
                0024 #include "PARAMS.h"
                0025 #ifdef ALLOW_CAL
                0026 # include "cal.h"
                0027 #endif
                0028 #ifdef ALLOW_CTRL
                0029 # include "OPTIMCYCLE.h"
                0030 #endif
                0031 #ifdef ALLOW_OBSFIT
                0032 # include "OBSFIT_SIZE.h"
                0033 # include "OBSFIT.h"
                0034 # include "netcdf.inc"
                0035 #endif
                0036
                0037 C     !INPUT PARAMETERS:
                0038 C     myTime :: Current time in simulation
                0039 C     myIter :: Current iteration number in simulation
                0040 C     myThid :: my thread ID number
                0041       _RL     myTime
                0042       INTEGER myIter
                0043       INTEGER myThid
                0044 CEOP
                0045
                0046 #ifdef ALLOW_OBSFIT
                0047 C     !LOCAL VARIABLES:
                0048       INTEGER sample_num, num_file, iq
                0049       INTEGER bi, bj
                0050       INTEGER sample_i(NUM_INTERP_PTS_OBS)
                0051       INTEGER sample_j(NUM_INTERP_PTS_OBS)
                0052       INTEGER sample_k(NUM_INTERP_PTS_OBS)
                0053       _RL     sample_frac(NUM_INTERP_PTS_OBS)
                0054       _RL     sample_modval, saved_modval
                0055 # ifndef ALLOW_CTRL
                0056       INTEGER optimcycle
                0057 # endif
                0058 # ifndef ALLOW_ECCO
                0059       INTEGER i,j,k
                0060 # endif
                0061
                0062 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0063
                0064 # ifndef ALLOW_CTRL
                0065       optimcycle = 0
                0066 # endif
                0067
                0068 # ifndef ALLOW_ECCO
                0069       DO bj = myByLo(myThid), myByHi(myThid)
                0070         DO bi = myBxLo(myThid), myBxHi(myThid)
                0071           DO k = 1, Nr
                0072             DO j = 1, sNy
                0073               DO i =  1, sNx
                0074                 m_UE(i,j,k,bi,bj) = 0. _d 0
                0075                 m_VN(i,j,k,bi,bj) = 0. _d 0
                0076               ENDDO
                0077             ENDDO
                0078           ENDDO
                0079         ENDDO
                0080       ENDDO
                0081
                0082       CALL ROTATE_UV2EN_RL(
                0083      U     uVel, vVel, m_UE, m_VN,
                0084      I     .TRUE., .TRUE., .FALSE., Nr, myThid )
                0085 # endif /* not ALLOW_ECCO */
                0086
                0087       _BEGIN_MASTER( myThid )
                0088
                0089       DO bj = 1, nSy
                0090         DO bi = 1, nSx
                0091           DO num_file = 1, NFILESMAX_OBS
                0092             DO sample_num = 1, NSAMP_PER_TILE_MAX
                0093               IF ( sample_num.LE.sampleNo(num_file,bi,bj) ) THEN
                0094                 IF ( (sample_timeE(num_file,sample_num,bi,bj).GE.
                0095      &           myTime).AND.
                0096      &           (sample_timeS(num_file,sample_num,bi,bj).LT.
                0097      &           (myTime+deltaTClock)) ) THEN
                0098                   DO iq = 1, NUM_INTERP_PTS_OBS
                0099                     sample_i(iq) =
                0100      &               sample_interp_i(num_file,sample_num,iq,bi,bj)
                0101                     sample_j(iq) =
                0102      &               sample_interp_j(num_file,sample_num,iq,bi,bj)
                0103                     sample_k(iq) =
                0104      &               sample_interp_k(num_file,sample_num,iq,bi,bj)
                0105                     sample_frac(iq) = sample_interp_frac
                0106      &               (num_file,sample_num,iq,bi,bj)
                0107                   ENDDO
                0108
                0109                   sample_modval = 0
                0110                   saved_modval = 0
                0111
                0112 C If averaging or integrating in time, read previously
                0113 C recorded value and add to it
                0114                   IF ( obsfitOperation(num_file).GT.0 ) THEN
                0115                     CALL ACTIVE_READ_OBS_TILE(
                0116      I                   num_file,
                0117      O                   saved_modval,
                0118      I                   sample_num,.FALSE.,optimcycle,bi,bj,myThid,
                0119      I                   obsfit_dummy(num_file,bi,bj) )
                0120                   ENDIF
                0121
                0122                   CALL OBSFIT_SAMPLING(
                0123      O                 sample_modval,
                0124      I                 sample_i, sample_j, sample_k, sample_frac,
                0125      I                 sample_type(num_file,sample_num,bi,bj),
                0126      I                 num_file, bi, bj, myTime, myIter, myThid )
                0127
                0128                   sample_modval = sample_modval*
                0129      &             obsfit_facmod(num_file)
                0130
                0131                   IF ( obsfitOperation(num_file).GT.0 ) THEN
                0132                     sample_modval = saved_modval
                0133      &               +sample_modval*deltaTClock
                0134                   ENDIF
                0135
                0136                   sample_modmask(bi,bj) = sample_modmask(bi,bj)*
                0137      &             sample_weight(num_file,sample_num,bi,bj)
                0138
                0139                   CALL ACTIVE_WRITE_OBS_TILE(
                0140      I                 num_file,sample_modval,
                0141      I                 sample_num,optimcycle,bi,bj,myThid,
                0142      I                 obsfit_dummy(num_file,bi,bj) )
                0143
                0144                 ENDIF !IF ((sample_time
                0145               ENDIF !IF (sampleNo(num_file,bi,bj).NE.0)
                0146             ENDDO !DO sample_num
                0147           ENDDO !DO num_file
                0148
                0149         ENDDO
                0150       ENDDO
                0151
                0152       _END_MASTER( myThid )
                0153
                0154 #endif /* ALLOW_OBSFIT */
                0155
                0156       RETURN
                0157       END