pkg/ctrl/ctrl_map_ini.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.28 2008/02/02 02:34:49 gforget Exp $
C $Name:  $

#include "CTRL_CPPOPTIONS.h"

CBOP
C     !ROUTINE: ctrl_map_ini
C     !INTERFACE:
      subroutine ctrl_map_ini( mythid )

C     !DESCRIPTION: \bv
c     *=================================================================
c     | SUBROUTINE ctrl_map_ini
c     | Add the temperature, salinity, and diffusivity parts of the
c     | control vector to the model state 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 "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_PTRACERS
# include "PTRACERS_SIZE.h"
c#include "PTRACERS_PARAMS.h"
# include "PTRACERS_FIELDS.h"
#endif
#ifdef ALLOW_ECCO
# include "ecco_cost.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
c     == routine arguments ==
      integer mythid

C     !LOCAL VARIABLES:
c     == local variables ==

      integer bi,bj
      integer i,j,k
      integer itlo,ithi
      integer jtlo,jthi
      integer jmin,jmax
      integer imin,imax
      integer il

      logical equal
      logical doglobalread
      logical ladinit

      character*( 80)   fnamegeneric

      _RL     fac
      _RL tmptest

c     == external ==
      integer  ilnblnk
      external ilnblnk

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

      doglobalread = .false.
      ladinit      = .false.

      equal = .true.

      if ( equal ) then
        fac = 1. _d 0
      else
        fac = 0. _d 0
      endif

#ifdef ALLOW_THETA0_CONTROL
c--   Temperature field.
      il=ilnblnk( xx_theta_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_theta_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_theta_dummy )

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
#ifdef ALLOW_ECCO
               IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
     $          2.0/sqrt(wtheta(k,bi,bj)))
     $          tmpfld3d(i,j,k,bi,bj)=
     $          sign(2.0/sqrt(wtheta(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
#endif
#ifdef ALLOW_AUTODIFF_OPENAD
                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
     &                               fac*xx_theta(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
#else
                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
#endif
#ifndef DISABLE_CTRL_THETA_LIMIT
                if(theta(i,j,k,bi,bj).lt.-2.0)
     &               theta(i,j,k,bi,bj)= -2.0
#endif
              enddo
            enddo
          enddo
       enddo
      enddo

#endif

#ifdef ALLOW_SALT0_CONTROL
c--   Temperature field.
      il=ilnblnk( xx_salt_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_salt_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_salt_dummy )

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
#ifdef ALLOW_ECCO
               IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
     $          2.0/sqrt(wsalt(k,bi,bj)))
     $          tmpfld3d(i,j,k,bi,bj)=
     $          sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
#endif
#ifdef ALLOW_AUTODIFF_OPENAD
                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
     &                               fac*xx_salt(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
#else
                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
#endif

              enddo
            enddo
          enddo
       enddo
      enddO
#endif

#ifdef ALLOW_TR10_CONTROL
#ifdef ALLOW_PTRACERS
c--   Temperature field.
      il=ilnblnk( xx_tr1_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_tr1_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tr1_dummy )

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif
#endif

#ifdef ALLOW_SST0_CONTROL
c--   sst0.
      il=ilnblnk( xx_sst_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_sst_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, 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
cph              sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
              theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
     &                             + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SSS0_CONTROL
c--   sss0.
      il=ilnblnk( xx_sss_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_sss_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, 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
cph              sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
              salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
     &                             + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_AUTODIFF
#ifdef ALLOW_DIFFKR_CONTROL
c--   diffkr.
      il=ilnblnk( xx_diffkr_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_diffkr_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_diffkr_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
     &                                tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif
#endif

#ifdef ALLOW_AUTODIFF
#ifdef ALLOW_KAPGM_CONTROL
c--   kapgm.
      il=ilnblnk( xx_kapgm_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_kapgm_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_kapgm_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
     &                               tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif
#endif

#ifdef ALLOW_AUTODIFF
#ifdef ALLOW_KAPREDI_CONTROL
c--   kapredi.
      il=ilnblnk( xx_kapredi_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_kapredi_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_kapredi_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                kapredi(i,j,k,bi,bj) = kapredi(i,j,k,bi,bj) +
     &                               tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif
#endif

#ifdef ALLOW_EFLUXY0_CONTROL
c--   y-component EP-flux field.
      il=ilnblnk( xx_efluxy_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_efluxy_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_efluxy_dummy )

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
     &                                - fac*tmpfld3d(i,j,k,bi,bj)
     &                                  *maskS(i,j,k,bi,bj)
cph                EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
cph     &                                - rSphere*cosFacU(J,bi,bj)
cph     &                                  *fac*tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_EFLUXP0_CONTROL
c--   p-component EP-flux field.
      il=ilnblnk( xx_efluxp_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_efluxp_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_efluxp_dummy )

      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
     &                                + fCori(i,j,bi,bj)
     &                                  *fac*tmpfld3d(i,j,k,bi,bj)
     &                                  *hFacV(i,j,k,bi,bj)
cph                EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
cph     &                                + fCori(i,j,bi,bj)
cph     &                                  *rSphere*cosFacU(J,bi,bj)
cph     &                                  *fac*tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_BOTTOMDRAG_CONTROL
c--   bottom drag
      il=ilnblnk( xx_bottomdrag_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_bottomdrag_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_bottomdrag_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
     &                                   + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_EDTAUX_CONTROL
c-- zonal eddy stress : edtaux
      il=ilnblnk( xx_edtaux_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_edtaux_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_edtaux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                eddyTauX(i,j,k,bi,bj) = eddyTauX(i,j,k,bi,bj) +
     &            fCori(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_EDTAUY_CONTROL
c-- meridional eddy stress : edtauy
      il=ilnblnk( xx_edtauy_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_edtauy_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_edtauy_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
                eddyTauY(i,j,k,bi,bj) = eddyTauY(i,j,k,bi,bj) +
     &            fCoriG(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_UVEL0_CONTROL
c-- initial zonal velocity
      il=ilnblnk( xx_uvel_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_uvel_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_uvel_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
#ifdef ALLOW_AUTODIFF_OPENAD
                uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
     &                                  fac*xx_uvel(i,j,k,bi,bj)
#else
                uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
     &                                  fac*tmpfld3d(i,j,k,bi,bj)
#endif
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_VVEL0_CONTROL
c-- initial merid. velocity
      il=ilnblnk( xx_vvel_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_vvel_file(1:il),'.',optimcycle
      call active_read_xyz( fnamegeneric, tmpfld3d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_vvel_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do k = 1,nr
            do j = jmin,jmax
              do i = imin,imax
#ifdef ALLOW_AUTODIFF_OPENAD
                vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
     &                                  fac*xx_vvel(i,j,k,bi,bj)
#else
                vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
     &                                  fac*tmpfld3d(i,j,k,bi,bj)
#endif
              enddo
            enddo
          enddo
       enddo
      enddo
#endif

#ifdef ALLOW_ETAN0_CONTROL
c--   initial Eta.
      il=ilnblnk( xx_etan_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_etan_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_etan_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
#ifdef ALLOW_AUTODIFF_OPENAD
              etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
     &                              fac*xx_etan(i,j,bi,bj)
#else
              etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
     &                              fac*tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_RELAXSST_CONTROL
c--   SST relaxation coefficient.
      il=ilnblnk( xx_relaxsst_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_relaxsst_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_relaxsst_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              lambdaThetaClimRelax(i,j,bi,bj) =
     &              lambdaThetaClimRelax(i,j,bi,bj)
     &              + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_RELAXSSS_CONTROL
c--   SSS relaxation coefficient.
      il=ilnblnk( xx_relaxsss_file )
      write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_relaxsss_file(1:il),'.',optimcycle
      call active_read_xy ( fnamegeneric, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_relaxsss_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              lambdaSaltClimRelax(i,j,bi,bj) =
     &              lambdaSaltClimRelax(i,j,bi,bj)
     &              + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SEAICE
      call seaice_ctrl_map_ini( mythid )
#endif

c--   Update the tile edges.

#if (defined (ALLOW_THETA0_CONTROL) || defined (ALLOW_SST0_CONTROL))
      _EXCH_XYZ_R8( theta, mythid )
#endif
#if (defined (ALLOW_SALT0_CONTROL) || defined (ALLOW_SSS0_CONTROL))
      _EXCH_XYZ_R8(  salt, mythid )
#endif
#ifdef ALLOW_TR10_CONTROL
#ifdef ALLOW_PTRACERS
      _EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
#endif
#endif

#ifdef ALLOW_AUTODIFF
# ifdef ALLOW_DIFFKR_CONTROL
      _EXCH_XYZ_R8( diffkr, mythid)
# endif
# ifdef ALLOW_KAPGM_CONTROL
      _EXCH_XYZ_R8( kapgm, mythid)
# endif
# ifdef ALLOW_KAPREDI_CONTROL
      _EXCH_XYZ_R8( kapredi, mythid)
# endif
#endif

#ifdef ALLOW_EFLUXY0_CONTROL
      _EXCH_XYZ_R8( EfluxY, mythid )
#endif
#ifdef ALLOW_EFLUXP0_CONTROL
      _EXCH_XYZ_R8( EfluxP, mythid )
#endif
#ifdef ALLOW_BOTTOMDRAG_CONTROL
      _EXCH_XY_R8( bottomdragfld, mythid )
#endif

#if (defined (ALLOW_EDTAUX_CONTROL) && defined (ALLOW_EDTAUY_CONTROL))
       CALL EXCH_UV_XYZ_RS(eddyTauX,eddyTauY,.TRUE.,myThid)
#elif (defined (ALLOW_EDTAUX_CONTROL) || defined (ALLOW_EDTAUY_CONTROL))
       STOP 'ctrl_map_forcing: need BOTH ALLOW_EDTAU[X,Y]_CONTROL'
#endif

#ifdef ALLOW_UVEL0_CONTROL
      _EXCH_XYZ_R8( uVel, mythid)
#endif

#ifdef ALLOW_VVEL0_CONTROL
      _EXCH_XYZ_R8( vVel, mythid)
#endif

#ifdef ALLOW_ETAN0_CONTROL
      _EXCH_XY_R8( etaN, mythid )
#endif

#ifdef ALLOW_RELAXSST_CONTROL
      _EXCH_XY_R4( lambdaThetaClimRelax, mythid )
#endif

#ifdef ALLOW_RELAXSSS_CONTROL
      _EXCH_XY_R4( lambdaThetaClimRelax, mythid )
#endif

      return
      end

1	heimbach	1.29	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.28 2008/02/02 02:34:49 gforget Exp $
2	jmc	1.25	C $Name: $
3	heimbach	1.1
4			#include "CTRL_CPPOPTIONS.h"
5
6	heimbach	1.5	CBOP
7			C !ROUTINE: ctrl_map_ini
8			C !INTERFACE:
9			subroutine ctrl_map_ini( mythid )
10
11			C !DESCRIPTION: \bv
12			c *=================================================================
13			c \| SUBROUTINE ctrl_map_ini
14	jmc	1.25	c \| Add the temperature, salinity, and diffusivity parts of the
15			c \| control vector to the model state and update the tile halos.
16	heimbach	1.5	c \| The control vector is defined in the header file "ctrl.h".
17			c *=================================================================
18			C \ev
19	heimbach	1.1
20	heimbach	1.5	C !USES:
21	heimbach	1.1	implicit none
22
23			c == global variables ==
24	heimbach	1.6	#include "SIZE.h"
25	heimbach	1.1	#include "EEPARAMS.h"
26	heimbach	1.6	#include "PARAMS.h"
27	heimbach	1.15	#include "GRID.h"
28	heimbach	1.1	#include "DYNVARS.h"
29	heimbach	1.15	#include "FFIELDS.h"
30	heimbach	1.1	#include "ctrl.h"
31			#include "ctrl_dummy.h"
32	heimbach	1.2	#include "optim.h"
33	heimbach	1.13	#ifdef ALLOW_PTRACERS
34			# include "PTRACERS_SIZE.h"
35	jmc	1.27	c#include "PTRACERS_PARAMS.h"
36			# include "PTRACERS_FIELDS.h"
37	heimbach	1.13	#endif
38	heimbach	1.12	#ifdef ALLOW_ECCO
39			# include "ecco_cost.h"
40			#endif
41	heimbach	1.1
42	heimbach	1.5	C !INPUT/OUTPUT PARAMETERS:
43	heimbach	1.1	c == routine arguments ==
44			integer mythid
45
46	heimbach	1.5	C !LOCAL VARIABLES:
47	heimbach	1.1	c == local variables ==
48
49			integer bi,bj
50			integer i,j,k
51			integer itlo,ithi
52			integer jtlo,jthi
53			integer jmin,jmax
54			integer imin,imax
55			integer il
56
57			logical equal
58			logical doglobalread
59			logical ladinit
60
61	heimbach	1.17	character*( 80) fnamegeneric
62	heimbach	1.1
63	heimbach	1.5	_RL fac
64	heimbach	1.12	_RL tmptest
65	heimbach	1.5
66	heimbach	1.1	c == external ==
67			integer ilnblnk
68			external ilnblnk
69
70			c == end of interface ==
71	heimbach	1.5	CEOP
72	heimbach	1.1
73			jtlo = mybylo(mythid)
74			jthi = mybyhi(mythid)
75			itlo = mybxlo(mythid)
76			ithi = mybxhi(mythid)
77	heimbach	1.8	jmin = 1
78			jmax = sny
79			imin = 1
80			imax = snx
81	heimbach	1.1
82			doglobalread = .false.
83			ladinit = .false.
84
85			equal = .true.
86
87			if ( equal ) then
88			fac = 1. _d 0
89			else
90			fac = 0. _d 0
91			endif
92
93			#ifdef ALLOW_THETA0_CONTROL
94			c-- Temperature field.
95			il=ilnblnk( xx_theta_file )
96	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
97	heimbach	1.1	& xx_theta_file(1:il),'.',optimcycle
98	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
99	heimbach	1.1	& doglobalread, ladinit, optimcycle,
100			& mythid, xx_theta_dummy )
101
102			do bj = jtlo,jthi
103			do bi = itlo,ithi
104			do k = 1,nr
105			do j = jmin,jmax
106			do i = imin,imax
107	heimbach	1.12	#ifdef ALLOW_ECCO
108			IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
109			$ 2.0/sqrt(wtheta(k,bi,bj)))
110			$ tmpfld3d(i,j,k,bi,bj)=
111			$ sign(2.0/sqrt(wtheta(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
112			#endif
113	utke	1.23	#ifdef ALLOW_AUTODIFF_OPENAD
114	heimbach	1.18	theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
115	utke	1.21	& fac*xx_theta(i,j,k,bi,bj) +
116			& fac*tmpfld3d(i,j,k,bi,bj)
117	heimbach	1.18	#else
118	heimbach	1.1	theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
119			& fac*tmpfld3d(i,j,k,bi,bj)
120	heimbach	1.18	#endif
121	heimbach	1.26	#ifndef DISABLE_CTRL_THETA_LIMIT
122	jmc	1.25	if(theta(i,j,k,bi,bj).lt.-2.0)
123			& theta(i,j,k,bi,bj)= -2.0
124	heimbach	1.26	#endif
125	heimbach	1.1	enddo
126			enddo
127			enddo
128			enddo
129			enddo
130	heimbach	1.12
131	heimbach	1.1	#endif
132
133			#ifdef ALLOW_SALT0_CONTROL
134			c-- Temperature field.
135			il=ilnblnk( xx_salt_file )
136	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
137	heimbach	1.1	& xx_salt_file(1:il),'.',optimcycle
138	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
139	heimbach	1.1	& doglobalread, ladinit, optimcycle,
140			& mythid, xx_salt_dummy )
141
142			do bj = jtlo,jthi
143			do bi = itlo,ithi
144			do k = 1,nr
145			do j = jmin,jmax
146			do i = imin,imax
147	heimbach	1.12	#ifdef ALLOW_ECCO
148			IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
149			$ 2.0/sqrt(wsalt(k,bi,bj)))
150			$ tmpfld3d(i,j,k,bi,bj)=
151			$ sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
152			#endif
153	utke	1.23	#ifdef ALLOW_AUTODIFF_OPENAD
154	heimbach	1.18	salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
155	utke	1.21	& fac*xx_salt(i,j,k,bi,bj) +
156			& fac*tmpfld3d(i,j,k,bi,bj)
157	heimbach	1.18	#else
158	heimbach	1.1	salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
159			& fac*tmpfld3d(i,j,k,bi,bj)
160	heimbach	1.18	#endif
161	heimbach	1.12
162	heimbach	1.1	enddo
163			enddo
164			enddo
165			enddo
166	heimbach	1.12	enddO
167	heimbach	1.1	#endif
168
169	heimbach	1.2	#ifdef ALLOW_TR10_CONTROL
170	heimbach	1.13	#ifdef ALLOW_PTRACERS
171	heimbach	1.2	c-- Temperature field.
172			il=ilnblnk( xx_tr1_file )
173	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
174	heimbach	1.2	& xx_tr1_file(1:il),'.',optimcycle
175	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
176	heimbach	1.2	& doglobalread, ladinit, optimcycle,
177			& mythid, xx_tr1_dummy )
178
179			do bj = jtlo,jthi
180			do bi = itlo,ithi
181			do k = 1,nr
182			do j = jmin,jmax
183			do i = imin,imax
184	heimbach	1.13	ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
185	heimbach	1.2	& fac*tmpfld3d(i,j,k,bi,bj)
186			enddo
187			enddo
188			enddo
189			enddo
190			enddo
191			#endif
192	heimbach	1.13	#endif
193	heimbach	1.2
194	heimbach	1.14	#ifdef ALLOW_SST0_CONTROL
195			c-- sst0.
196			il=ilnblnk( xx_sst_file )
197	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
198	heimbach	1.14	& xx_sst_file(1:il),'.',optimcycle
199	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
200	heimbach	1.14	& doglobalread, ladinit, optimcycle,
201			& mythid, xx_sst_dummy )
202			do bj = jtlo,jthi
203			do bi = itlo,ithi
204			do j = jmin,jmax
205			do i = imin,imax
206			cph sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
207	jmc	1.25	theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
208	heimbach	1.14	& + tmpfld2d(i,j,bi,bj)
209			enddo
210			enddo
211			enddo
212			enddo
213			#endif
214
215			#ifdef ALLOW_SSS0_CONTROL
216			c-- sss0.
217			il=ilnblnk( xx_sss_file )
218	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
219	heimbach	1.14	& xx_sss_file(1:il),'.',optimcycle
220	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
221	heimbach	1.14	& doglobalread, ladinit, optimcycle,
222			& mythid, xx_sss_dummy )
223			do bj = jtlo,jthi
224			do bi = itlo,ithi
225			do j = jmin,jmax
226			do i = imin,imax
227			cph sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
228			salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
229			& + tmpfld2d(i,j,bi,bj)
230			enddo
231			enddo
232			enddo
233			enddo
234			#endif
235
236	heimbach	1.29	#ifdef ALLOW_AUTODIFF
237	heimbach	1.3	#ifdef ALLOW_DIFFKR_CONTROL
238			c-- diffkr.
239			il=ilnblnk( xx_diffkr_file )
240	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
241	heimbach	1.3	& xx_diffkr_file(1:il),'.',optimcycle
242	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
243	heimbach	1.3	& doglobalread, ladinit, optimcycle,
244			& mythid, xx_diffkr_dummy )
245			do bj = jtlo,jthi
246			do bi = itlo,ithi
247			do k = 1,nr
248			do j = jmin,jmax
249			do i = imin,imax
250			diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
251			& tmpfld3d(i,j,k,bi,bj)
252			enddo
253			enddo
254			enddo
255			enddo
256			enddo
257			#endif
258	heimbach	1.29	#endif
259	heimbach	1.3
260	heimbach	1.29	#ifdef ALLOW_AUTODIFF
261	heimbach	1.3	#ifdef ALLOW_KAPGM_CONTROL
262			c-- kapgm.
263			il=ilnblnk( xx_kapgm_file )
264	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
265	heimbach	1.3	& xx_kapgm_file(1:il),'.',optimcycle
266	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
267	heimbach	1.3	& doglobalread, ladinit, optimcycle,
268			& mythid, xx_kapgm_dummy )
269			do bj = jtlo,jthi
270			do bi = itlo,ithi
271			do k = 1,nr
272			do j = jmin,jmax
273			do i = imin,imax
274			kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
275			& tmpfld3d(i,j,k,bi,bj)
276			enddo
277			enddo
278			enddo
279			enddo
280			enddo
281			#endif
282	heimbach	1.29	#endif
283	heimbach	1.3
284	heimbach	1.29	#ifdef ALLOW_AUTODIFF
285	gforget	1.28	#ifdef ALLOW_KAPREDI_CONTROL
286			c-- kapredi.
287			il=ilnblnk( xx_kapredi_file )
288			write(fnamegeneric(1:80),'(2a,i10.10)')
289			& xx_kapredi_file(1:il),'.',optimcycle
290			call active_read_xyz( fnamegeneric, tmpfld3d, 1,
291			& doglobalread, ladinit, optimcycle,
292			& mythid, xx_kapredi_dummy )
293			do bj = jtlo,jthi
294			do bi = itlo,ithi
295			do k = 1,nr
296			do j = jmin,jmax
297			do i = imin,imax
298			kapredi(i,j,k,bi,bj) = kapredi(i,j,k,bi,bj) +
299			& tmpfld3d(i,j,k,bi,bj)
300			enddo
301			enddo
302			enddo
303			enddo
304			enddo
305			#endif
306	heimbach	1.29	#endif
307	gforget	1.28
308	heimbach	1.6	#ifdef ALLOW_EFLUXY0_CONTROL
309			c-- y-component EP-flux field.
310			il=ilnblnk( xx_efluxy_file )
311	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
312	heimbach	1.6	& xx_efluxy_file(1:il),'.',optimcycle
313	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
314	heimbach	1.6	& doglobalread, ladinit, optimcycle,
315			& mythid, xx_efluxy_dummy )
316
317			do bj = jtlo,jthi
318			do bi = itlo,ithi
319			do k = 1,nr
320			do j = jmin,jmax
321			do i = imin,imax
322			EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
323			& - fac*tmpfld3d(i,j,k,bi,bj)
324			& *maskS(i,j,k,bi,bj)
325			cph EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
326			cph & - rSphere*cosFacU(J,bi,bj)
327			cph & factmpfld3d(i,j,k,bi,bj)
328			enddo
329			enddo
330			enddo
331			enddo
332			enddo
333			#endif
334
335			#ifdef ALLOW_EFLUXP0_CONTROL
336			c-- p-component EP-flux field.
337			il=ilnblnk( xx_efluxp_file )
338	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
339	heimbach	1.6	& xx_efluxp_file(1:il),'.',optimcycle
340	heimbach	1.22	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
341	heimbach	1.6	& doglobalread, ladinit, optimcycle,
342			& mythid, xx_efluxp_dummy )
343
344			do bj = jtlo,jthi
345			do bi = itlo,ithi
346			do k = 1,nr
347			do j = jmin,jmax
348			do i = imin,imax
349			EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
350			& + fCori(i,j,bi,bj)
351			& factmpfld3d(i,j,k,bi,bj)
352			& *hFacV(i,j,k,bi,bj)
353			cph EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
354			cph & + fCori(i,j,bi,bj)
355			cph & rSpherecosFacU(J,bi,bj)
356			cph & factmpfld3d(i,j,k,bi,bj)
357			enddo
358			enddo
359			enddo
360			enddo
361			enddo
362			#endif
363
364	heimbach	1.7	#ifdef ALLOW_BOTTOMDRAG_CONTROL
365			c-- bottom drag
366			il=ilnblnk( xx_bottomdrag_file )
367	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
368	heimbach	1.7	& xx_bottomdrag_file(1:il),'.',optimcycle
369	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
370	heimbach	1.7	& doglobalread, ladinit, optimcycle,
371			& mythid, xx_bottomdrag_dummy )
372			do bj = jtlo,jthi
373			do bi = itlo,ithi
374			do j = jmin,jmax
375			do i = imin,imax
376	jmc	1.25	bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
377	heimbach	1.7	& + tmpfld2d(i,j,bi,bj)
378			enddo
379			enddo
380			enddo
381			enddo
382			#endif
383
384	heimbach	1.16	#ifdef ALLOW_EDTAUX_CONTROL
385	heimbach	1.15	c-- zonal eddy stress : edtaux
386			il=ilnblnk( xx_edtaux_file )
387	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
388	heimbach	1.15	& xx_edtaux_file(1:il),'.',optimcycle
389	heimbach	1.17	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
390	heimbach	1.15	& doglobalread, ladinit, optimcycle,
391			& mythid, xx_edtaux_dummy )
392			do bj = jtlo,jthi
393			do bi = itlo,ithi
394			do k = 1,nr
395			do j = jmin,jmax
396			do i = imin,imax
397	heimbach	1.20	eddyTauX(i,j,k,bi,bj) = eddyTauX(i,j,k,bi,bj) +
398			& fCori(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
399	heimbach	1.15	enddo
400			enddo
401			enddo
402			enddo
403			enddo
404			#endif
405
406			#ifdef ALLOW_EDTAUY_CONTROL
407			c-- meridional eddy stress : edtauy
408			il=ilnblnk( xx_edtauy_file )
409	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
410	heimbach	1.15	& xx_edtauy_file(1:il),'.',optimcycle
411	heimbach	1.17	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
412	heimbach	1.15	& doglobalread, ladinit, optimcycle,
413			& mythid, xx_edtauy_dummy )
414			do bj = jtlo,jthi
415			do bi = itlo,ithi
416			do k = 1,nr
417			do j = jmin,jmax
418			do i = imin,imax
419	heimbach	1.20	eddyTauY(i,j,k,bi,bj) = eddyTauY(i,j,k,bi,bj) +
420			& fCoriG(i,j,bi,bj)*tmpfld3d(i,j,k,bi,bj)
421	heimbach	1.15	enddo
422			enddo
423			enddo
424			enddo
425			enddo
426			#endif
427	heimbach	1.1
428	heimbach	1.17	#ifdef ALLOW_UVEL0_CONTROL
429			c-- initial zonal velocity
430			il=ilnblnk( xx_uvel_file )
431			write(fnamegeneric(1:80),'(2a,i10.10)')
432			& xx_uvel_file(1:il),'.',optimcycle
433			call active_read_xyz( fnamegeneric, tmpfld3d, 1,
434			& doglobalread, ladinit, optimcycle,
435			& mythid, xx_uvel_dummy )
436			do bj = jtlo,jthi
437			do bi = itlo,ithi
438			do k = 1,nr
439			do j = jmin,jmax
440			do i = imin,imax
441	utke	1.23	#ifdef ALLOW_AUTODIFF_OPENAD
442	heimbach	1.19	uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
443			& fac*xx_uvel(i,j,k,bi,bj)
444			#else
445	heimbach	1.17	uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
446	heimbach	1.19	& fac*tmpfld3d(i,j,k,bi,bj)
447			#endif
448	heimbach	1.17	enddo
449			enddo
450			enddo
451			enddo
452			enddo
453			#endif
454
455			#ifdef ALLOW_VVEL0_CONTROL
456			c-- initial merid. velocity
457			il=ilnblnk( xx_vvel_file )
458			write(fnamegeneric(1:80),'(2a,i10.10)')
459			& xx_vvel_file(1:il),'.',optimcycle
460			call active_read_xyz( fnamegeneric, tmpfld3d, 1,
461			& doglobalread, ladinit, optimcycle,
462			& mythid, xx_vvel_dummy )
463			do bj = jtlo,jthi
464			do bi = itlo,ithi
465			do k = 1,nr
466			do j = jmin,jmax
467			do i = imin,imax
468	utke	1.23	#ifdef ALLOW_AUTODIFF_OPENAD
469	heimbach	1.17	vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
470	heimbach	1.19	& fac*xx_vvel(i,j,k,bi,bj)
471			#else
472			vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
473			& fac*tmpfld3d(i,j,k,bi,bj)
474			#endif
475	heimbach	1.17	enddo
476			enddo
477			enddo
478			enddo
479			enddo
480			#endif
481
482			#ifdef ALLOW_ETAN0_CONTROL
483			c-- initial Eta.
484			il=ilnblnk( xx_etan_file )
485			write(fnamegeneric(1:80),'(2a,i10.10)')
486			& xx_etan_file(1:il),'.',optimcycle
487	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
488	heimbach	1.17	& doglobalread, ladinit, optimcycle,
489			& mythid, xx_etan_dummy )
490			do bj = jtlo,jthi
491			do bi = itlo,ithi
492			do j = jmin,jmax
493			do i = imin,imax
494	utke	1.23	#ifdef ALLOW_AUTODIFF_OPENAD
495	heimbach	1.19	etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
496			& fac*xx_etan(i,j,bi,bj)
497			#else
498	jmc	1.25	etaN(i,j,bi,bj) = etaN(i,j,bi,bj) +
499	heimbach	1.19	& fac*tmpfld2d(i,j,bi,bj)
500			#endif
501	heimbach	1.17	enddo
502			enddo
503			enddo
504			enddo
505			#endif
506
507			#ifdef ALLOW_RELAXSST_CONTROL
508			c-- SST relaxation coefficient.
509			il=ilnblnk( xx_relaxsst_file )
510			write(fnamegeneric(1:80),'(2a,i10.10)')
511			& xx_relaxsst_file(1:il),'.',optimcycle
512	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
513	heimbach	1.17	& doglobalread, ladinit, optimcycle,
514			& mythid, xx_relaxsst_dummy )
515			do bj = jtlo,jthi
516			do bi = itlo,ithi
517			do j = jmin,jmax
518			do i = imin,imax
519	jmc	1.25	lambdaThetaClimRelax(i,j,bi,bj) =
520			& lambdaThetaClimRelax(i,j,bi,bj)
521	heimbach	1.17	& + tmpfld2d(i,j,bi,bj)
522			enddo
523			enddo
524			enddo
525			enddo
526			#endif
527
528			#ifdef ALLOW_RELAXSSS_CONTROL
529			c-- SSS relaxation coefficient.
530			il=ilnblnk( xx_relaxsss_file )
531			write(fnamegeneric(1:80),'(2a,i10.10)')
532			& xx_relaxsss_file(1:il),'.',optimcycle
533	heimbach	1.22	call active_read_xy ( fnamegeneric, tmpfld2d, 1,
534	heimbach	1.17	& doglobalread, ladinit, optimcycle,
535			& mythid, xx_relaxsss_dummy )
536			do bj = jtlo,jthi
537			do bi = itlo,ithi
538			do j = jmin,jmax
539			do i = imin,imax
540	jmc	1.25	lambdaSaltClimRelax(i,j,bi,bj) =
541			& lambdaSaltClimRelax(i,j,bi,bj)
542	heimbach	1.17	& + tmpfld2d(i,j,bi,bj)
543			enddo
544			enddo
545			enddo
546			enddo
547			#endif
548
549	heimbach	1.24	#ifdef ALLOW_SEAICE
550			call seaice_ctrl_map_ini( mythid )
551			#endif
552
553	heimbach	1.1	c-- Update the tile edges.
554
555	heimbach	1.14	#if (defined (ALLOW_THETA0_CONTROL) \|\| defined (ALLOW_SST0_CONTROL))
556	heimbach	1.1	_EXCH_XYZ_R8( theta, mythid )
557			#endif
558	heimbach	1.14	#if (defined (ALLOW_SALT0_CONTROL) \|\| defined (ALLOW_SSS0_CONTROL))
559	heimbach	1.1	_EXCH_XYZ_R8( salt, mythid )
560	heimbach	1.2	#endif
561			#ifdef ALLOW_TR10_CONTROL
562	heimbach	1.13	#ifdef ALLOW_PTRACERS
563			_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
564			#endif
565	heimbach	1.1	#endif
566	heimbach	1.29
567			#ifdef ALLOW_AUTODIFF
568			# ifdef ALLOW_DIFFKR_CONTROL
569	heimbach	1.3	_EXCH_XYZ_R8( diffkr, mythid)
570	heimbach	1.29	# endif
571			# ifdef ALLOW_KAPGM_CONTROL
572	heimbach	1.3	_EXCH_XYZ_R8( kapgm, mythid)
573	heimbach	1.29	# endif
574			# ifdef ALLOW_KAPREDI_CONTROL
575	gforget	1.28	_EXCH_XYZ_R8( kapredi, mythid)
576	heimbach	1.29	# endif
577	gforget	1.28	#endif
578	heimbach	1.29
579	heimbach	1.6	#ifdef ALLOW_EFLUXY0_CONTROL
580			_EXCH_XYZ_R8( EfluxY, mythid )
581			#endif
582			#ifdef ALLOW_EFLUXP0_CONTROL
583			_EXCH_XYZ_R8( EfluxP, mythid )
584	heimbach	1.7	#endif
585			#ifdef ALLOW_BOTTOMDRAG_CONTROL
586			_EXCH_XY_R8( bottomdragfld, mythid )
587	heimbach	1.3	#endif
588
589	heimbach	1.15	#if (defined (ALLOW_EDTAUX_CONTROL) && defined (ALLOW_EDTAUY_CONTROL))
590	heimbach	1.20	CALL EXCH_UV_XYZ_RS(eddyTauX,eddyTauY,.TRUE.,myThid)
591	heimbach	1.15	#elif (defined (ALLOW_EDTAUX_CONTROL) \|\| defined (ALLOW_EDTAUY_CONTROL))
592			STOP 'ctrl_map_forcing: need BOTH ALLOW_EDTAU[X,Y]_CONTROL'
593			#endif
594	heimbach	1.1
595	heimbach	1.17	#ifdef ALLOW_UVEL0_CONTROL
596			_EXCH_XYZ_R8( uVel, mythid)
597			#endif
598
599			#ifdef ALLOW_VVEL0_CONTROL
600			_EXCH_XYZ_R8( vVel, mythid)
601			#endif
602
603			#ifdef ALLOW_ETAN0_CONTROL
604			_EXCH_XY_R8( etaN, mythid )
605			#endif
606
607			#ifdef ALLOW_RELAXSST_CONTROL
608			_EXCH_XY_R4( lambdaThetaClimRelax, mythid )
609			#endif
610
611			#ifdef ALLOW_RELAXSSS_CONTROL
612			_EXCH_XY_R4( lambdaThetaClimRelax, mythid )
613			#endif
614
615	heimbach	1.1	return
616			end
617