pkg/ctrl/ctrl_map_ini.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.16 2005/02/28 19:05:12 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
                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)
                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
                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
     &                               fac*tmpfld3d(i,j,k,bi,bj)

              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) +
     &                                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) +
     &                                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
                uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
     &                              tmpfld3d(i,j,k,bi,bj)
              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
                vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
     &                              tmpfld3d(i,j,k,bi,bj)
              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
              etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            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	heimbach	1.17	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.16 2005/02/28 19:05:12 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.1	theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj) +
112			& fac*tmpfld3d(i,j,k,bi,bj)
113	heimbach	1.9	if(theta(i,j,k,bi,bj).lt.-2.0)
114	heimbach	1.12	& theta(i,j,k,bi,bj)= -2.0
115	heimbach	1.1	enddo
116			enddo
117			enddo
118			enddo
119			enddo
120	heimbach	1.12
121	heimbach	1.1	#endif
122
123			#ifdef ALLOW_SALT0_CONTROL
124			c-- Temperature field.
125			il=ilnblnk( xx_salt_file )
126	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
127	heimbach	1.1	& xx_salt_file(1:il),'.',optimcycle
128	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
129	heimbach	1.1	& doglobalread, ladinit, optimcycle,
130			& mythid, xx_salt_dummy )
131
132			do bj = jtlo,jthi
133			do bi = itlo,ithi
134			do k = 1,nr
135			do j = jmin,jmax
136			do i = imin,imax
137	heimbach	1.12	#ifdef ALLOW_ECCO
138			IF (abs(tmpfld3d(i,j,k,bi,bj)).gt.
139			$ 2.0/sqrt(wsalt(k,bi,bj)))
140			$ tmpfld3d(i,j,k,bi,bj)=
141			$ sign(2.0/sqrt(wsalt(k,bi,bj)),tmpfld3d(i,j,k,bi,bj))
142			#endif
143	heimbach	1.1	salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj) +
144			& fac*tmpfld3d(i,j,k,bi,bj)
145	heimbach	1.12
146	heimbach	1.1	enddo
147			enddo
148			enddo
149			enddo
150	heimbach	1.12	enddO
151	heimbach	1.1	#endif
152
153	heimbach	1.2	#ifdef ALLOW_TR10_CONTROL
154	heimbach	1.13	#ifdef ALLOW_PTRACERS
155	heimbach	1.2	c-- Temperature field.
156			il=ilnblnk( xx_tr1_file )
157	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
158	heimbach	1.2	& xx_tr1_file(1:il),'.',optimcycle
159	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
160	heimbach	1.2	& doglobalread, ladinit, optimcycle,
161			& mythid, xx_tr1_dummy )
162
163			do bj = jtlo,jthi
164			do bi = itlo,ithi
165			do k = 1,nr
166			do j = jmin,jmax
167			do i = imin,imax
168	heimbach	1.13	ptracer(i,j,k,bi,bj,1) = ptracer(i,j,k,bi,bj,1) +
169	heimbach	1.2	& fac*tmpfld3d(i,j,k,bi,bj)
170			enddo
171			enddo
172			enddo
173			enddo
174			enddo
175			#endif
176	heimbach	1.13	#endif
177	heimbach	1.2
178	heimbach	1.14	#ifdef ALLOW_SST0_CONTROL
179			c-- sst0.
180			il=ilnblnk( xx_sst_file )
181	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
182	heimbach	1.14	& xx_sst_file(1:il),'.',optimcycle
183	heimbach	1.17	call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
184	heimbach	1.14	& doglobalread, ladinit, optimcycle,
185			& mythid, xx_sst_dummy )
186			do bj = jtlo,jthi
187			do bi = itlo,ithi
188			do j = jmin,jmax
189			do i = imin,imax
190			cph sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
191			theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
192			& + tmpfld2d(i,j,bi,bj)
193			enddo
194			enddo
195			enddo
196			enddo
197			#endif
198
199			#ifdef ALLOW_SSS0_CONTROL
200			c-- sss0.
201			il=ilnblnk( xx_sss_file )
202	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
203	heimbach	1.14	& xx_sss_file(1:il),'.',optimcycle
204	heimbach	1.17	call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
205	heimbach	1.14	& doglobalread, ladinit, optimcycle,
206			& mythid, xx_sss_dummy )
207			do bj = jtlo,jthi
208			do bi = itlo,ithi
209			do j = jmin,jmax
210			do i = imin,imax
211			cph sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
212			salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
213			& + tmpfld2d(i,j,bi,bj)
214			enddo
215			enddo
216			enddo
217			enddo
218			#endif
219
220	heimbach	1.3	#ifdef ALLOW_DIFFKR_CONTROL
221			c-- diffkr.
222			il=ilnblnk( xx_diffkr_file )
223	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
224	heimbach	1.3	& xx_diffkr_file(1:il),'.',optimcycle
225	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
226	heimbach	1.3	& doglobalread, ladinit, optimcycle,
227			& mythid, xx_diffkr_dummy )
228			do bj = jtlo,jthi
229			do bi = itlo,ithi
230			do k = 1,nr
231			do j = jmin,jmax
232			do i = imin,imax
233			diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj) +
234			& tmpfld3d(i,j,k,bi,bj)
235			enddo
236			enddo
237			enddo
238			enddo
239			enddo
240			#endif
241
242			#ifdef ALLOW_KAPGM_CONTROL
243			c-- kapgm.
244			il=ilnblnk( xx_kapgm_file )
245	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
246	heimbach	1.3	& xx_kapgm_file(1:il),'.',optimcycle
247	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
248	heimbach	1.3	& doglobalread, ladinit, optimcycle,
249			& mythid, xx_kapgm_dummy )
250			do bj = jtlo,jthi
251			do bi = itlo,ithi
252			do k = 1,nr
253			do j = jmin,jmax
254			do i = imin,imax
255			kapgm(i,j,k,bi,bj) = kapgm(i,j,k,bi,bj) +
256			& tmpfld3d(i,j,k,bi,bj)
257			enddo
258			enddo
259			enddo
260			enddo
261			enddo
262			#endif
263
264	heimbach	1.6	#ifdef ALLOW_EFLUXY0_CONTROL
265			c-- y-component EP-flux field.
266			il=ilnblnk( xx_efluxy_file )
267	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
268	heimbach	1.6	& xx_efluxy_file(1:il),'.',optimcycle
269	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
270	heimbach	1.6	& doglobalread, ladinit, optimcycle,
271			& mythid, xx_efluxy_dummy )
272
273			do bj = jtlo,jthi
274			do bi = itlo,ithi
275			do k = 1,nr
276			do j = jmin,jmax
277			do i = imin,imax
278			EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
279			& - fac*tmpfld3d(i,j,k,bi,bj)
280			& *maskS(i,j,k,bi,bj)
281			cph EfluxY(i,j,k,bi,bj) = EfluxY(i,j,k,bi,bj)
282			cph & - rSphere*cosFacU(J,bi,bj)
283			cph & factmpfld3d(i,j,k,bi,bj)
284			enddo
285			enddo
286			enddo
287			enddo
288			enddo
289			#endif
290
291			#ifdef ALLOW_EFLUXP0_CONTROL
292			c-- p-component EP-flux field.
293			il=ilnblnk( xx_efluxp_file )
294	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
295	heimbach	1.6	& xx_efluxp_file(1:il),'.',optimcycle
296	heimbach	1.17	call active_read_xyz_loc( fnamegeneric, tmpfld3d, 1,
297	heimbach	1.6	& doglobalread, ladinit, optimcycle,
298			& mythid, xx_efluxp_dummy )
299
300			do bj = jtlo,jthi
301			do bi = itlo,ithi
302			do k = 1,nr
303			do j = jmin,jmax
304			do i = imin,imax
305			EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
306			& + fCori(i,j,bi,bj)
307			& factmpfld3d(i,j,k,bi,bj)
308			& *hFacV(i,j,k,bi,bj)
309			cph EfluxP(i,j,k,bi,bj) = EfluxP(i,j,k,bi,bj)
310			cph & + fCori(i,j,bi,bj)
311			cph & rSpherecosFacU(J,bi,bj)
312			cph & factmpfld3d(i,j,k,bi,bj)
313			enddo
314			enddo
315			enddo
316			enddo
317			enddo
318			#endif
319
320	heimbach	1.7	#ifdef ALLOW_BOTTOMDRAG_CONTROL
321			c-- bottom drag
322			il=ilnblnk( xx_bottomdrag_file )
323	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
324	heimbach	1.7	& xx_bottomdrag_file(1:il),'.',optimcycle
325	heimbach	1.17	call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
326	heimbach	1.7	& doglobalread, ladinit, optimcycle,
327			& mythid, xx_bottomdrag_dummy )
328			do bj = jtlo,jthi
329			do bi = itlo,ithi
330			do j = jmin,jmax
331			do i = imin,imax
332			bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
333			& + tmpfld2d(i,j,bi,bj)
334			enddo
335			enddo
336			enddo
337			enddo
338			#endif
339
340	heimbach	1.16	#ifdef ALLOW_EDTAUX_CONTROL
341	heimbach	1.15	c-- zonal eddy stress : edtaux
342			il=ilnblnk( xx_edtaux_file )
343	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
344	heimbach	1.15	& xx_edtaux_file(1:il),'.',optimcycle
345	heimbach	1.17	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
346	heimbach	1.15	& doglobalread, ladinit, optimcycle,
347			& mythid, xx_edtaux_dummy )
348			do bj = jtlo,jthi
349			do bi = itlo,ithi
350			do k = 1,nr
351			do j = jmin,jmax
352			do i = imin,imax
353			Eddytaux(i,j,k,bi,bj) = Eddytaux(i,j,k,bi,bj) +
354			& tmpfld3d(i,j,k,bi,bj)
355			enddo
356			enddo
357			enddo
358			enddo
359			enddo
360			#endif
361
362			#ifdef ALLOW_EDTAUY_CONTROL
363			c-- meridional eddy stress : edtauy
364			il=ilnblnk( xx_edtauy_file )
365	heimbach	1.17	write(fnamegeneric(1:80),'(2a,i10.10)')
366	heimbach	1.15	& xx_edtauy_file(1:il),'.',optimcycle
367	heimbach	1.17	call active_read_xyz( fnamegeneric, tmpfld3d, 1,
368	heimbach	1.15	& doglobalread, ladinit, optimcycle,
369			& mythid, xx_edtauy_dummy )
370			do bj = jtlo,jthi
371			do bi = itlo,ithi
372			do k = 1,nr
373			do j = jmin,jmax
374			do i = imin,imax
375			Eddytauy(i,j,k,bi,bj) = Eddytauy(i,j,k,bi,bj) +
376			& tmpfld3d(i,j,k,bi,bj)
377			enddo
378			enddo
379			enddo
380			enddo
381			enddo
382			#endif
383	heimbach	1.1
384	heimbach	1.17	#ifdef ALLOW_UVEL0_CONTROL
385			c-- initial zonal velocity
386			il=ilnblnk( xx_uvel_file )
387			write(fnamegeneric(1:80),'(2a,i10.10)')
388			& xx_uvel_file(1:il),'.',optimcycle
389			call active_read_xyz( fnamegeneric, tmpfld3d, 1,
390			& doglobalread, ladinit, optimcycle,
391			& mythid, xx_uvel_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			uVel(i,j,k,bi,bj) = uVel(i,j,k,bi,bj) +
398			& tmpfld3d(i,j,k,bi,bj)
399			enddo
400			enddo
401			enddo
402			enddo
403			enddo
404			#endif
405
406			#ifdef ALLOW_VVEL0_CONTROL
407			c-- initial merid. velocity
408			il=ilnblnk( xx_vvel_file )
409			write(fnamegeneric(1:80),'(2a,i10.10)')
410			& xx_vvel_file(1:il),'.',optimcycle
411			call active_read_xyz( fnamegeneric, tmpfld3d, 1,
412			& doglobalread, ladinit, optimcycle,
413			& mythid, xx_vvel_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			vVel(i,j,k,bi,bj) = vVel(i,j,k,bi,bj) +
420			& tmpfld3d(i,j,k,bi,bj)
421			enddo
422			enddo
423			enddo
424			enddo
425			enddo
426			#endif
427
428			#ifdef ALLOW_ETAN0_CONTROL
429			c-- initial Eta.
430			il=ilnblnk( xx_etan_file )
431			write(fnamegeneric(1:80),'(2a,i10.10)')
432			& xx_etan_file(1:il),'.',optimcycle
433			call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
434			& doglobalread, ladinit, optimcycle,
435			& mythid, xx_etan_dummy )
436			do bj = jtlo,jthi
437			do bi = itlo,ithi
438			do j = jmin,jmax
439			do i = imin,imax
440			etaN(i,j,bi,bj) = etaN(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
441			enddo
442			enddo
443			enddo
444			enddo
445			#endif
446
447			#ifdef ALLOW_RELAXSST_CONTROL
448			c-- SST relaxation coefficient.
449			il=ilnblnk( xx_relaxsst_file )
450			write(fnamegeneric(1:80),'(2a,i10.10)')
451			& xx_relaxsst_file(1:il),'.',optimcycle
452			call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
453			& doglobalread, ladinit, optimcycle,
454			& mythid, xx_relaxsst_dummy )
455			do bj = jtlo,jthi
456			do bi = itlo,ithi
457			do j = jmin,jmax
458			do i = imin,imax
459			lambdaThetaClimRelax(i,j,bi,bj) =
460			& lambdaThetaClimRelax(i,j,bi,bj)
461			& + tmpfld2d(i,j,bi,bj)
462			enddo
463			enddo
464			enddo
465			enddo
466			#endif
467
468			#ifdef ALLOW_RELAXSSS_CONTROL
469			c-- SSS relaxation coefficient.
470			il=ilnblnk( xx_relaxsss_file )
471			write(fnamegeneric(1:80),'(2a,i10.10)')
472			& xx_relaxsss_file(1:il),'.',optimcycle
473			call active_read_xy_loc ( fnamegeneric, tmpfld2d, 1,
474			& doglobalread, ladinit, optimcycle,
475			& mythid, xx_relaxsss_dummy )
476			do bj = jtlo,jthi
477			do bi = itlo,ithi
478			do j = jmin,jmax
479			do i = imin,imax
480			lambdaSaltClimRelax(i,j,bi,bj) =
481			& lambdaSaltClimRelax(i,j,bi,bj)
482			& + tmpfld2d(i,j,bi,bj)
483			enddo
484			enddo
485			enddo
486			enddo
487			#endif
488
489	heimbach	1.1	c-- Update the tile edges.
490
491	heimbach	1.14	#if (defined (ALLOW_THETA0_CONTROL) \|\| defined (ALLOW_SST0_CONTROL))
492	heimbach	1.1	_EXCH_XYZ_R8( theta, mythid )
493			#endif
494	heimbach	1.14	#if (defined (ALLOW_SALT0_CONTROL) \|\| defined (ALLOW_SSS0_CONTROL))
495	heimbach	1.1	_EXCH_XYZ_R8( salt, mythid )
496	heimbach	1.2	#endif
497			#ifdef ALLOW_TR10_CONTROL
498	heimbach	1.13	#ifdef ALLOW_PTRACERS
499			_EXCH_XYZ_R8(pTracer(1-Olx,1-Oly,1,1,1,1),myThid)
500			#endif
501	heimbach	1.1	#endif
502	heimbach	1.3	#ifdef ALLOW_DIFFKR_CONTROL
503			_EXCH_XYZ_R8( diffkr, mythid)
504			#endif
505			#ifdef ALLOW_KAPGM_CONTROL
506			_EXCH_XYZ_R8( kapgm, mythid)
507	heimbach	1.6	#endif
508			#ifdef ALLOW_EFLUXY0_CONTROL
509			_EXCH_XYZ_R8( EfluxY, mythid )
510			#endif
511			#ifdef ALLOW_EFLUXP0_CONTROL
512			_EXCH_XYZ_R8( EfluxP, mythid )
513	heimbach	1.7	#endif
514			#ifdef ALLOW_BOTTOMDRAG_CONTROL
515			_EXCH_XY_R8( bottomdragfld, mythid )
516	heimbach	1.3	#endif
517
518	heimbach	1.15	#if (defined (ALLOW_EDTAUX_CONTROL) && defined (ALLOW_EDTAUY_CONTROL))
519			CALL EXCH_UV_XYZ_RS(Eddytaux,Eddytauy,.TRUE.,myThid)
520			#elif (defined (ALLOW_EDTAUX_CONTROL) \|\| defined (ALLOW_EDTAUY_CONTROL))
521			STOP 'ctrl_map_forcing: need BOTH ALLOW_EDTAU[X,Y]_CONTROL'
522			#endif
523	heimbach	1.1
524	heimbach	1.17	#ifdef ALLOW_UVEL0_CONTROL
525			_EXCH_XYZ_R8( uVel, mythid)
526			#endif
527
528			#ifdef ALLOW_VVEL0_CONTROL
529			_EXCH_XYZ_R8( vVel, mythid)
530			#endif
531
532			#ifdef ALLOW_ETAN0_CONTROL
533			_EXCH_XY_R8( etaN, mythid )
534			#endif
535
536			#ifdef ALLOW_RELAXSST_CONTROL
537			_EXCH_XY_R4( lambdaThetaClimRelax, mythid )
538			#endif
539
540			#ifdef ALLOW_RELAXSSS_CONTROL
541			_EXCH_XY_R4( lambdaThetaClimRelax, mythid )
542			#endif
543
544	heimbach	1.1	return
545			end
546