C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_forcing.F,v 1.20 2017/01/20 20:51:35 gforget Exp $
C $Name:  $

#include "CTRL_OPTIONS.h"

CBOP
C     !ROUTINE: CTRL_MAP_FORCING
C     !INTERFACE:
      SUBROUTINE CTRL_MAP_FORCING( myTime, myIter, myThid )

C     !DESCRIPTION: \bv
c     *=================================================================
c     | SUBROUTINE CTRL_MAP_FORCING
c     | Add the surface flux anomalies of the control vector
c     | to the model flux fields and update the tile halos.
c     | The control vector is defined in the header file "ctrl.h".
c     *=================================================================
C     \ev

C     !USES:
      IMPLICIT NONE

C     == Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FFIELDS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "CTRL_SIZE.h"
#include "ctrl.h"
#include "CTRL_GENARR.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_AUTODIFF
#include "AUTODIFF_MYFIELDS.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myTime :: time counter for this thread
C     myIter :: iteration counter for this thread
C     myThid :: thread number for this instance of the routine.
      _RL     myTime
      INTEGER myIter
      INTEGER myThid

C     !LOCAL VARIABLES:
C     == Local variables ==
      integer bi,bj
      integer i,j
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
#ifndef ALLOW_OPENAD
#ifdef ALLOW_GENTIM2D_CONTROL
      integer iarr
      _RL     tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
#endif
#endif

#if (defined ALLOW_TAUU0_CONTROL)  (defined ALLOW_TAUV0_CONTROL) 
    (defined ALLOW_SFLUX0_CONTROL)  (defined ALLOW_HFLUX0_CONTROL) 
    (defined ALLOW_SSS_CONTROL)  (defined ALLOW_SST_CONTROL) 
    (defined ALLOW_HFLUXM_CONTROL)
      integer il
      logical doglobalread
      logical ladinit

      character*( 80)   fnametauu
      character*( 80)   fnametauv
      character*( 80)   fnamesflux
      character*( 80)   fnamehflux
      character*( 80)   fnamesss
      character*( 80)   fnamesst
cHFLUXM_CONTROL
      character*( 80)   fnamehfluxm
cHFLUXM_CONTROL

c     == external ==
      integer  ilnblnk
      external 
#endif

c     == end of interface ==
CEOP

      jtlo = mybylo(mythid)
      jthi = mybyhi(mythid)
      itlo = mybxlo(mythid)
      ithi = mybxhi(mythid)
      jmin = 1
      jmax = sny
      imin = 1
      imax = snx

#if (defined ALLOW_TAUU0_CONTROL)  (defined ALLOW_TAUV0_CONTROL) 
    (defined ALLOW_SFLUX0_CONTROL)  (defined ALLOW_HFLUX0_CONTROL) 
    (defined ALLOW_SSS_CONTROL)  (defined ALLOW_SST_CONTROL) 
    (defined ALLOW_HFLUXM_CONTROL)

      doglobalread = .false.
      ladinit      = .false.

      IF ( myIter .EQ. nIter0 ) THEN

#ifdef ALLOW_TAUU0_CONTROL
c--   tauu0.
      il=ilnblnk( xx_tauu_file )
      write(fnametauu(1:80),'(2a,i10.10)')
     &     xx_tauu_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnametauu, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauu_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_OPENAD
              fu(i,j,bi,bj) = fu(i,j,bi,bj) +
     &                        xx_tauu0(i,j,bi,bj) +
     &                        tmpfld2d(i,j,bi,bj)
#else
              fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_TAUV0_CONTROL
c--   tauv0.
      il=ilnblnk( xx_tauv_file )
      write(fnametauv(1:80),'(2a,i10.10)')
     &     xx_tauv_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnametauv, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauv_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_OPENAD
              fv(i,j,bi,bj) = fv(i,j,bi,bj) +
     &                        xx_tauv0(i,j,bi,bj) +
     &                        tmpfld2d(i,j,bi,bj)
#else
              fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SFLUX0_CONTROL
c--   sflux0.
      il=ilnblnk( xx_sflux_file )
      write(fnamesflux(1:80),'(2a,i10.10)')
     &     xx_sflux_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnamesflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_OPENAD
              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) +
     &                           xx_sflux0(i,j,bi,bj) +
     &                           tmpfld2d(i,j,bi,bj)
#else
              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_HFLUX0_CONTROL
c--   hflux0.
      il=ilnblnk( xx_hflux_file )
      write(fnamehflux(1:80),'(2a,i10.10)')
     &     xx_hflux_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnamehflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_hflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_OPENAD
              qnet(i,j,bi,bj) = qnet(i,j,bi,bj) +
     &                          xx_hflux0(i,j,bi,bj) +
     &                          tmpfld2d(i,j,bi,bj)
#else
              qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SSS_CONTROL
c--   sss0.
      il=ilnblnk( xx_sss_file )
      write(fnamesss(1:80),'(2a,i10.10)')
     &     xx_sss_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnamesss, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sss_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SST_CONTROL
c--   sst0.
      il=ilnblnk( xx_sst_file )
      write(fnamesst(1:80),'(2a,i10.10)')
     &     xx_sst_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnamesst, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sst_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_HFLUXM_CONTROL
c--   hfluxm.
      il=ilnblnk( xx_hfluxm_file )
      write(fnamehfluxm(1:80),'(2a,i10.10)')
     &     xx_hfluxm_file(1:il),'.',optimcycle
      call ACTIVE_READ_XY ( fnamehfluxm, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_hfluxm_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_OPENAD
              Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) +
     &                          xx_hfluxm(i,j,bi,bj) +
     &                          tmpfld2d(i,j,bi,bj)
#else
              Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#if (defined (ALLOW_TAUU0_CONTROL)  defined (ALLOW_TAUV0_CONTROL))
       CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
#endif
#ifdef ALLOW_SFLUX0_CONTROL
       _EXCH_XY_RS(EmPmR, myThid )
#endif
#ifdef ALLOW_HFLUX0_CONTROL
       _EXCH_XY_RS(Qnet,  myThid )
#endif
#ifdef ALLOW_SST_CONTROL
       _EXCH_XY_RS(SST,   myThid )
#endif
#ifdef ALLOW_SSS_CONTROL
       _EXCH_XY_RS(SSS,   myThid )
#endif
#ifdef ALLOW_HFLUXM_CONTROL
       _EXCH_XY_RS(Qnetm, myThid )
#endif

      ENDIF !IF ( myIter .EQ. nIter0 ) THEN

#endif

#ifndef ALLOW_OPENAD
#ifdef ALLOW_GENTIM2D_CONTROL
      IF ( ctrlUseGen ) THEN

      do bj = mybylo(mythid),mybyhi(mythid)
       do bi = mybxlo(mythid),mybxhi(mythid)
        do j = 1-oly,sny+oly
         do i = 1-olx,snx+olx
           tmpUE(i,j,bi,bj) = 0. _d 0
           tmpVN(i,j,bi,bj) = 0. _d 0
           tmpUX(i,j,bi,bj) = 0. _d 0
           tmpVY(i,j,bi,bj) = 0. _d 0
         enddo
        enddo
       enddo
      enddo

      DO bj = myByLo(myThid),myByHi(myThid)
       DO bi = myBxLo(myThid),mybxhi(myThid)
        DO j = 1,sNy
         DO i = 1,sNx
          DO iarr = 1, maxCtrlTim2D
           if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fe') tmpUE
     &      (i,j,bi,bj)=tmpUE(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fn') tmpVN
     &       (i,j,bi,bj)=tmpVN(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      _EXCH_XY_RL(tmpUE,myThid)
      _EXCH_XY_RL(tmpVN,myThid)
      CALL ROTATE_UV2EN_RL(tmpUX,tmpVY,tmpUE,tmpVN,
     &     .FALSE.,.TRUE.,.TRUE.,1,mythid)

      DO bj = myByLo(myThid),myByHi(myThid)
       DO bi = myBxLo(myThid),mybxhi(myThid)
        DO j = 1,sny
         DO i = 1,snx
          fu(i,j,bi,bj)=fu(i,j,bi,bj)+tmpUX(i,j,bi,bj)
          fv(i,j,bi,bj)=fv(i,j,bi,bj)+tmpVY(i,j,bi,bj)
          DO iarr = 1, maxCtrlTim2D
           if (xx_gentim2d_file(iarr)(1:7).EQ.'xx_qnet') Qnet
     &      (i,j,bi,bj)=Qnet(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_empmr') EmPmR
     &      (i,j,bi,bj)=EmPmR(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_qsw') Qsw
     &      (i,j,bi,bj)=Qsw(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_sst') SST
     &      (i,j,bi,bj)=SST(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:6).EQ.'xx_sss') SSS
     &      (i,j,bi,bj)=SSS(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:8).EQ.'xx_pload') pLoad
     &      (i,j,bi,bj)=pLoad(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:11).EQ.'xx_saltflux') saltFlux
     &      (i,j,bi,bj)=saltFlux(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fu') fu
     &      (i,j,bi,bj)=fu(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
           if (xx_gentim2d_file(iarr)(1:5).EQ.'xx_fv') fv
     &      (i,j,bi,bj)=fv(i,j,bi,bj)+xx_gentim2d(i,j,bi,bj,iarr)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDDO

      CALL EXCH_XY_RS( Qnet , myThid )
      CALL EXCH_XY_RS( EmPmR , myThid )
      CALL EXCH_XY_RS( Qsw , myThid )
      CALL EXCH_XY_RS( SST , myThid )
      CALL EXCH_XY_RS( SSS , myThid )
      CALL EXCH_XY_RS( pLoad , myThid )
      CALL EXCH_XY_RS( saltFlux , myThid )
      CALL EXCH_UV_XY_RS( fu, fv, .TRUE., myThid )

      ENDIF !IF (ctrlUseGen) then
#endif
#endif

      RETURN
      END