pkg/ctrl/ctrl_map_ini.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini.F,v 1.25 2007/10/09 00:00:00 jmc 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"
# 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( 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_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

#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

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