c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_mapfields.F,v 1.12 2005/06/29 07:11:18 heimbach Exp $
#include "EXF_OPTIONS.h"
subroutine EXF_MAPFIELDS( mythid )
c ==================================================================
c SUBROUTINE exf_mapfields
c ==================================================================
c
c o Map external forcing fields (ustress, vstress, hflux, sflux,
c swflux, apressure, climsss, climsst, etc.) onto ocean model
c arrays (fu, fv, Qnet, EmPmR, Qsw, pload, sss, sst, etc.).
c This routine is included to separate the ocean state estimation
c tool as much as possible from the ocean model. Unit and sign
c conventions can be customized using variables exf_outscal_*,
c which are set in exf_readparms.F. See the header files
c exf_fields.h and FFIELDS.h for definitions of the various input
c and output fields and for default unit and sign convetions.
c
c started: Christian Eckert eckert@mit.edu 09-Aug-1999
c
c changed: Christian Eckert eckert@mit.edu 11-Jan-2000
c - Restructured the code in order to create a package
c for the MITgcmUV.
c
c Christian Eckert eckert@mit.edu 12-Feb-2000
c - Changed Routine names (package prefix: exf_)
c
c Patrick Heimbach, heimbach@mit.edu 06-May-2000
c - added and changed CPP flag structure for
c ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP
c
c Patrick Heimbach, heimbach@mit.edu 23-May-2000
c - sign change of ustress/vstress incorporated into
c scaling factors exf_outscal_ust, exf_outscal_vst
c
c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
c
c ==================================================================
c SUBROUTINE exf_mapfields
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "FFIELDS.h"
#include "GRID.h"
#include "exf_param.h"
#include "exf_constants.h"
#include "exf_fields.h"
#include "exf_clim_fields.h"
#ifdef ALLOW_AUTODIFF_TAMC
# include "tamc.h"
# include "tamc_keys.h"
#endif
c == routine arguments ==
c mythid - thread number for this instance of the routine.
integer mythid
c == local variables ==
integer bi,bj
integer i,j
integer jtlo
integer jthi
integer itlo
integer ithi
integer jmin
integer jmax
integer imin
integer imax
c == end of interface ==
jtlo = mybylo(mythid)
jthi = mybyhi(mythid)
itlo = mybxlo(mythid)
ithi = mybxhi(mythid)
jmin = 1-oly
jmax = sny+oly
imin = 1-olx
imax = snx+olx
do bj = jtlo,jthi
do bi = itlo,ithi
#ifdef ALLOW_AUTODIFF_TAMC
act1 = bi - myBxLo(myThid)
max1 = myBxHi(myThid) - myBxLo(myThid) + 1
act2 = bj - myByLo(myThid)
max2 = myByHi(myThid) - myByLo(myThid) + 1
act3 = myThid - 1
max3 = nTx*nTy
act4 = ikey_dynamics - 1
ikey = (act1 + 1) + act2*max1
& + act3*max1*max2
& + act4*max1*max2*max3
#endif /* ALLOW_AUTODIFF_TAMC */
do j = jmin,jmax
do i = imin,imax
c Heat flux.
qnet(i,j,bi,bj) = exf_outscal_hflux*hflux(i,j,bi,bj)
enddo
enddo
do j = jmin,jmax
do i = imin,imax
c Salt flux.
empmr(i,j,bi,bj)= exf_outscal_sflux*sflux(i,j,bi,bj)
enddo
enddo
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
#endif
do j = jmin,jmax
do i = imin,imax
c Zonal wind stress.
if (ustress(i,j,bi,bj).gt.windstressmax) then
ustress(i,j,bi,bj)=windstressmax
endif
enddo
enddo
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
#endif
do j = jmin,jmax
do i = imin,imax
if (ustress(i,j,bi,bj).lt.-windstressmax) then
ustress(i,j,bi,bj)=-windstressmax
endif
enddo
enddo
do j = jmin,jmax
do i = imin+1,imax
#if (defined (ALLOW_BULKFORMULAE) defined (USE_EXF_INTERPOLATION))
c Shift wind stresses calculated at C-points to W/S points
fu(i,j,bi,bj) = exf_outscal_ustress*
& (ustress(i,j,bi,bj)+ustress(i-1,j,bi,bj))/2.*
& maskW(i,j,1,bi,bj)
#else
fu(i,j,bi,bj) = exf_outscal_ustress*ustress(i,j,bi,bj)
#endif
enddo
enddo
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
#endif
do j = jmin,jmax
do i = imin,imax
c Meridional wind stress.
if (vstress(i,j,bi,bj).gt.windstressmax) then
vstress(i,j,bi,bj)=windstressmax
endif
enddo
enddo
#ifdef ALLOW_AUTODIFF_TAMC
CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
#endif
do j = jmin,jmax
do i = imin,imax
if (vstress(i,j,bi,bj).lt.-windstressmax) then
vstress(i,j,bi,bj)=-windstressmax
endif
enddo
enddo
do j = jmin+1,jmax
do i = imin,imax
#if (defined (ALLOW_BULKFORMULAE) defined (USE_EXF_INTERPOLATION))
c Shift wind stresses calculated at C-points to W/S points
fv(i,j,bi,bj) = exf_outscal_vstress*
& (vstress(i,j,bi,bj)+vstress(i,j-1,bi,bj))/2.*
& maskS(i,j,1,bi,bj)
#else
fv(i,j,bi,bj) = exf_outscal_vstress*vstress(i,j,bi,bj)
#endif
enddo
enddo
#ifdef SHORTWAVE_HEATING
c Short wave radiative flux.
do j = jmin,jmax
do i = imin,imax
qsw(i,j,bi,bj) = exf_outscal_swflux*swflux(i,j,bi,bj)
enddo
enddo
#endif
#ifdef ALLOW_CLIMSST_RELAXATION
do j = jmin,jmax
do i = imin,imax
sst(i,j,bi,bj) = exf_outscal_sst*climsst(i,j,bi,bj)
enddo
enddo
#endif
#ifdef ALLOW_CLIMSSS_RELAXATION
do j = jmin,jmax
do i = imin,imax
sss(i,j,bi,bj) = exf_outscal_sss*climsss(i,j,bi,bj)
enddo
enddo
#endif
#ifdef ATMOSPHERIC_LOADING
do j = jmin,jmax
do i = imin,imax
pload(i,j,bi,bj)=exf_outscal_apressure*apressure(i,j,bi,bj)
enddo
enddo
#endif
enddo
enddo
c Update the tile edges.
_EXCH_XY_R4( qnet, mythid )
_EXCH_XY_R4( empmr, mythid )
c _EXCH_XY_R4( fu, mythid )
c _EXCH_XY_R4( fv, mythid )
CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
#ifdef SHORTWAVE_HEATING
_EXCH_XY_R4( qsw, mythid )
#endif
#ifdef ALLOW_CLIMSST_RELAXATION
_EXCH_XY_R4( sst, mythid )
#endif
#ifdef ALLOW_CLIMSSS_RELAXATION
_EXCH_XY_R4( sss, mythid )
#endif
#ifdef ATMOSPHERIC_LOADING
_EXCH_XY_R4( pload, mythid )
#endif
end