#include "OBCS_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif

CBOP
C !ROUTINE: OBCS_COST_OB_N

C !INTERFACE: ==========================================================
      SUBROUTINE OBCS_COST_OB_N(
     I                           startrec, endrec,
     I                           myTime, myIter, myThid )

C !DESCRIPTION:
C     - Calculatesd cost function contribution (Tikhonov regulariation)
C       of northern open-boundary
C     - modified from pkg/ecco/cost_obcsn.F

C !USES: ===============================================================
      IMPLICIT NONE
C     == Global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"
#ifdef ALLOW_CTRL
# ifndef ALLOW_AUTODIFF
#  include "CTRL_SIZE.h"
#  include "CTRL.h"
# endif
# include "OPTIMCYCLE.h"
# include "CTRL_OBCS.h"
#endif

C !INPUT PARAMETERS: ===================================================
      INTEGER startrec, endrec
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

#if defined ALLOW_CTRL && defined ALLOW_OBCSN_CONTROL && defined ALLOW_COST
C !FUNCTIONS: ==========================================================
      INTEGER  ILNBLNK
      EXTERNAL ILNBLNK

C !LOCAL VARIABLES: ====================================================
      INTEGER bi,bj
      INTEGER i,k
      INTEGER imin,imax
      INTEGER irec
      INTEGER iobcs
      INTEGER nrec
      INTEGER ilfld
      INTEGER igg
      _RL fctile
      _RL fcthread
#ifdef ALLOW_AUTODIFF
      _RL dummy
#endif
      _RL gg
      _RL tmpx
      _RL tmpfield (1-OLx:sNx+OLx,Nr,nSx,nSy)
      _RL maskxz   (1-OLx:sNx+OLx,Nr,nSx,nSy)
      CHARACTER*(MAX_LEN_FNAM) fnamefld
      LOGICAL doglobalread
      LOGICAL ladinit
      CHARACTER*(MAX_LEN_MBUF) msgBuf
CEOP

      imin = 1
      imax = sNx

c--   Read tiled data.
      doglobalread = .false.
      ladinit      = .false.

c     Number of records to be used.
      nrec = endrec-startrec+1

c     jp1 = 0
      fcthread = 0. _d 0

      IF ( debugLevel.GE.debLevC ) THEN
       _BEGIN_MASTER( myThid )
       WRITE(msgBuf,'(a)') ' '
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT, myThid )
       WRITE(msgBuf,'(a)') ' '
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT, myThid )
       WRITE(msgBuf,'(a,i9.8)')
     &      ' OBCS_COST_OB_N: number of records to process: ',nrec
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT, myThid )
       WRITE(msgBuf,'(a)') ' '
       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                     SQUEEZE_RIGHT, myThid )
       _END_MASTER( myThid )
      ENDIF

      IF (optimcycle .GE. 0) THEN
       ilfld=ILNBLNK( xx_obcsN_file )
       WRITE(fnamefld,'(2a,i10.10)')
     &      xx_obcsN_file(1:ilfld), '.', optimcycle
      ENDIF

c--   Loop over records.
      DO irec = 1,nrec

#ifdef ALLOW_AUTODIFF
       CALL ACTIVE_READ_XZ( fnamefld, tmpfield, irec,
     &                      doglobalread, ladinit, optimcycle,
     &                      myThid, xx_obcsN_dummy )
#else
       CALL READ_REC_XZ_RL( fnamefld, ctrlprec, Nr,
     &                      tmpfield, irec, 1, myThid )
#endif

cgg    Need to solve for iobcs would have been.
       gg    = (irec-1)/nobcs
       igg   = int(gg)
       iobcs = irec - igg*nobcs

#ifdef ALLOW_AUTODIFF
       CALL ACTIVE_READ_XZ( 'maskobcsn', maskxz, iobcs,
     &                      doglobalread, ladinit, 0,
     &                      myThid, dummy )
#else
       CALL READ_REC_XZ_RL( 'maskobcsn', ctrlprec, Nr,
     &                      maskxz, iobcs, 1, myThid )
#endif

c--   Loop over this thread s tiles.
       DO bj = myByLo(myThid), myByHi(myThid)
        DO bi = myBxLo(myThid), myBxHi(myThid)

c--   Determine the weights to be used.
         fctile = 0. _d 0

         DO k = 1, Nr
          DO i = imin,imax
c          j = OB_Jn(I,bi,bj)
cgg        IF (maskS(i,j+jp1,k,bi,bj) .NE. 0.) THEN
           tmpx = tmpfield(i,k,bi,bj)
CMM        fctile = fctile + wobcsN2(i,k,bi,bj,iobcs)
           fctile = fctile + wobcsN(k,iobcs)
     &                       *tmpx*tmpx*maskxz(i,k,bi,bj)
cgg        ENDIF
CMM        IF (wobcsN2(i,k,bi,bj,iobcs)*maskxz(i,k,bi,bj).NE.0.)
           IF (wobcsN(k,iobcs)*maskxz(i,k,bi,bj).NE.0.)
     &          num_obcsN(bi,bj) = num_obcsN(bi,bj) + 1. _d 0
cgg        PRINT*,'S fctile',fctile
          ENDDO
         ENDDO

         objf_obcsN(bi,bj) = objf_obcsN(bi,bj) + fctile
         fcthread          = fcthread + fctile
        ENDDO
       ENDDO

       IF ( debugLevel.GE.debLevC ) THEN
c--     Print cost function for all tiles.
        _GLOBAL_SUM_RL( fcthread , myThid )
        WRITE(msgBuf,'(a)') ' '
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        WRITE(msgBuf,'(a,i8.8)')
     &    ' OBCS_COST_OB_N: irec = ',irec
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        WRITE(msgBuf,'(a,a,d22.15)')
     &    ' global cost function value',
     &    ' (obcsN) = ',fcthread
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
        WRITE(msgBuf,'(a)') ' '
        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
     &                      SQUEEZE_RIGHT, myThid )
       ENDIF

      ENDDO
c--   End of loop over records.

#endif /* ALLOW_CTRL etc */

      RETURN
      END
