pkg/ctrl/ctrl_map_ini.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.20 2006/02/15 03:52:54 heimbach Exp $

#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"
# include "PTRACERS.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_loc( 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_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
                if(theta(i,j,k,bi,bj).lt.-2.0) 
     &               theta(i,j,k,bi,bj)= -2.0 
              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_loc( 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_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_loc( 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_loc ( 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_loc ( 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_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_loc( 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

#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_loc( 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

#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_loc( 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_loc( 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_loc ( 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_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_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_loc ( 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_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_loc ( 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_loc ( 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

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