pkg/exf/exf_mapfields.F

c $Header: /u/u0/gcmpack/MITgcm/pkg/exf/exf_mapfields.F,v 1.2 2002/11/12 20:34:41 heimbach Exp $

#include "EXF_CPPOPTIONS.h"


      subroutine exf_mapfields( mythid )

c     ==================================================================
c     SUBROUTINE exf_mapfields
c     ==================================================================
c
c     o Map the external forcing fields on the ocean model arrays. This
c       routine is included to separate the ocean state estimation tool
c       as much as possible from the ocean model. Unit conversion factors
c       are to be set by the user.
c
c       The units have to be such that the individual forcing record has
c       units equal to [quantity/s]. See the header file *FFIELDS.h* of
c       the MITgcmuv.
c
c       Required units such that no scaling has to be applied:
c
c       heat flux:          input file W/m^2
c       salt flux:          input file m/s
c       zonal wind stress:  input file N/m^2
c       merid. wind stress: input file N/m^2
c
c       To allow for such unit conversions this routine contains scaling
c       factors scal_quantity.
c
c     started: Christian Eckert eckert@mit.edu  09-Aug-1999
c
c     changed: Christian Eckert eckert@mit.edu  11-Jan-2000
c
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
c              - Changed Routine names (package prefix: exf_)
c
c              Patrick Heimbach, heimbach@mit.edu  06-May-2000
c
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
c              - sign change of ustress/vstress incorporated into
c                scaling factors scal_ust, scal_vst
c
c     ==================================================================
c     SUBROUTINE exf_mapfields
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "FFIELDS.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)  = scal_hfl*hflux(i,j,bi,bj)
            enddo
          enddo


          do j = jmin,jmax
            do i = imin,imax
c             Salt flux.
#if (defined (ALLOW_BULKFORMULAE)  && defined (ALLOW_ATM_TEMP))
              empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)
#else
              empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)
#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
c             Zonal wind stress.
              if (ustress(i,j,bi,bj).gt.2.0D0) then
                ustress(i,j,bi,bj)=2.0D0
              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.-2.0D0) then
                ustress(i,j,bi,bj)=-2.0D0
              endif
            enddo
          enddo
          do j = jmin,jmax
            do i = imin,imax
              fu(i,j,bi,bj)    = scal_ust*ustress(i,j,bi,bj)
            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.2.0D0) then
                vstress(i,j,bi,bj)=2.0D0
              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.-2.0D0) then
                vstress(i,j,bi,bj)=-2.0D0
              endif
            enddo
          enddo
          do j = jmin,jmax
            do i = imin,imax
              fv(i,j,bi,bj)    = scal_vst*vstress(i,j,bi,bj)
            enddo
          enddo

#ifdef ALLOW_KPP || \
 (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))
c             Short wave radiative flux.
          do j = jmin,jmax
            do i = imin,imax
              qsw(i,j,bi,bj)   = scal_swf*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)   = scal_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)   = scal_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) = scal_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 ALLOW_KPP
      _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
1	cheisey	1.3	c $Header: /u/u0/gcmpack/MITgcm/pkg/exf/exf_mapfields.F,v 1.2 2002/11/12 20:34:41 heimbach Exp $
2	heimbach	1.1
3			#include "EXF_CPPOPTIONS.h"
4
5
6	heimbach	1.2	subroutine exf_mapfields( mythid )
7	heimbach	1.1
8			c ==================================================================
9	heimbach	1.2	c SUBROUTINE exf_mapfields
10	heimbach	1.1	c ==================================================================
11			c
12			c o Map the external forcing fields on the ocean model arrays. This
13			c routine is included to separate the ocean state estimation tool
14			c as much as possible from the ocean model. Unit conversion factors
15			c are to be set by the user.
16			c
17			c The units have to be such that the individual forcing record has
18			c units equal to [quantity/s]. See the header file FFIELDS.h of
19			c the MITgcmuv.
20			c
21			c Required units such that no scaling has to be applied:
22			c
23			c heat flux: input file W/m^2
24			c salt flux: input file m/s
25			c zonal wind stress: input file N/m^2
26			c merid. wind stress: input file N/m^2
27			c
28			c To allow for such unit conversions this routine contains scaling
29			c factors scal_quantity.
30			c
31			c started: Christian Eckert eckert@mit.edu 09-Aug-1999
32			c
33			c changed: Christian Eckert eckert@mit.edu 11-Jan-2000
34			c
35			c - Restructured the code in order to create a package
36			c for the MITgcmUV.
37			c
38			c Christian Eckert eckert@mit.edu 12-Feb-2000
39			c
40			c - Changed Routine names (package prefix: exf_)
41			c
42			c Patrick Heimbach, heimbach@mit.edu 06-May-2000
43			c
44			c - added and changed CPP flag structure for
45			c ALLOW_BULKFORMULAE, ALLOW_ATM_TEMP
46			c
47			c Patrick Heimbach, heimbach@mit.edu 23-May-2000
48			c
49			c - sign change of ustress/vstress incorporated into
50			c scaling factors scal_ust, scal_vst
51			c
52			c ==================================================================
53	heimbach	1.2	c SUBROUTINE exf_mapfields
54	heimbach	1.1	c ==================================================================
55
56			implicit none
57
58			c == global variables ==
59
60			#include "EEPARAMS.h"
61			#include "SIZE.h"
62			#include "FFIELDS.h"
63	heimbach	1.2	#include "exf_param.h"
64	heimbach	1.1	#include "exf_constants.h"
65			#include "exf_fields.h"
66			#include "exf_clim_fields.h"
67	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
68			# include "tamc.h"
69			# include "tamc_keys.h"
70			#endif
71	heimbach	1.1	c == routine arguments ==
72
73			c mythid - thread number for this instance of the routine.
74
75			integer mythid
76
77			c == local variables ==
78
79			integer bi,bj
80			integer i,j
81			integer jtlo
82			integer jthi
83			integer itlo
84			integer ithi
85			integer jmin
86			integer jmax
87			integer imin
88			integer imax
89
90			c == end of interface ==
91
92			jtlo = mybylo(mythid)
93			jthi = mybyhi(mythid)
94			itlo = mybxlo(mythid)
95			ithi = mybxhi(mythid)
96			jmin = 1-oly
97			jmax = sny+oly
98			imin = 1-olx
99			imax = snx+olx
100
101			do bj = jtlo,jthi
102			do bi = itlo,ithi
103	heimbach	1.2
104			#ifdef ALLOW_AUTODIFF_TAMC
105			act1 = bi - myBxLo(myThid)
106			max1 = myBxHi(myThid) - myBxLo(myThid) + 1
107			act2 = bj - myByLo(myThid)
108			max2 = myByHi(myThid) - myByLo(myThid) + 1
109			act3 = myThid - 1
110			max3 = nTx*nTy
111			act4 = ikey_dynamics - 1
112			ikey = (act1 + 1) + act2*max1
113			& + act3max1max2
114			& + act4max1max2*max3
115			#endif /* ALLOW_AUTODIFF_TAMC */
116
117	heimbach	1.1	do j = jmin,jmax
118			do i = imin,imax
119			c Heat flux.
120			qnet(i,j,bi,bj) = scal_hfl*hflux(i,j,bi,bj)
121	heimbach	1.2	enddo
122			enddo
123	heimbach	1.1
124	heimbach	1.2
125			do j = jmin,jmax
126			do i = imin,imax
127	heimbach	1.1	c Salt flux.
128			#if (defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP))
129			empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)
130			#else
131			empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)
132			#endif
133	heimbach	1.2	enddo
134			enddo
135	heimbach	1.1
136	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
137			CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
138			#endif
139			do j = jmin,jmax
140			do i = imin,imax
141	heimbach	1.1	c Zonal wind stress.
142	heimbach	1.2	if (ustress(i,j,bi,bj).gt.2.0D0) then
143			ustress(i,j,bi,bj)=2.0D0
144			endif
145			enddo
146			enddo
147			#ifdef ALLOW_AUTODIFF_TAMC
148			CADJ STORE ustress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
149			#endif
150			do j = jmin,jmax
151			do i = imin,imax
152			if (ustress(i,j,bi,bj).lt.-2.0D0) then
153			ustress(i,j,bi,bj)=-2.0D0
154			endif
155			enddo
156			enddo
157			do j = jmin,jmax
158			do i = imin,imax
159	heimbach	1.1	fu(i,j,bi,bj) = scal_ust*ustress(i,j,bi,bj)
160	heimbach	1.2	enddo
161			enddo
162	heimbach	1.1
163	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
164			CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
165			#endif
166			do j = jmin,jmax
167			do i = imin,imax
168	heimbach	1.1	c Meridional wind stress.
169	heimbach	1.2	if (vstress(i,j,bi,bj).gt.2.0D0) then
170			vstress(i,j,bi,bj)=2.0D0
171			endif
172			enddo
173			enddo
174			#ifdef ALLOW_AUTODIFF_TAMC
175			CADJ STORE vstress(:,:,bi,bj) = comlev1_bibj, key=ikey, byte=isbyte
176			#endif
177			do j = jmin,jmax
178			do i = imin,imax
179			if (vstress(i,j,bi,bj).lt.-2.0D0) then
180			vstress(i,j,bi,bj)=-2.0D0
181			endif
182			enddo
183			enddo
184			do j = jmin,jmax
185			do i = imin,imax
186	heimbach	1.1	fv(i,j,bi,bj) = scal_vst*vstress(i,j,bi,bj)
187	heimbach	1.2	enddo
188			enddo
189	heimbach	1.1
190	heimbach	1.2	#ifdef ALLOW_KPP \|\| \
191			(defined (ALLOW_BULKFORMULAE) && defined (ALLOW_ATM_TEMP)))
192	heimbach	1.1	c Short wave radiative flux.
193	heimbach	1.2	do j = jmin,jmax
194			do i = imin,imax
195	heimbach	1.1	qsw(i,j,bi,bj) = scal_swf*swflux(i,j,bi,bj)
196	heimbach	1.2	enddo
197			enddo
198	heimbach	1.1	#endif
199
200			#ifdef ALLOW_CLIMSST_RELAXATION
201	heimbach	1.2	do j = jmin,jmax
202			do i = imin,imax
203	heimbach	1.1	sst(i,j,bi,bj) = scal_sst*climsst(i,j,bi,bj)
204	heimbach	1.2	enddo
205			enddo
206	heimbach	1.1	#endif
207
208			#ifdef ALLOW_CLIMSSS_RELAXATION
209	heimbach	1.2	do j = jmin,jmax
210			do i = imin,imax
211	heimbach	1.1	sss(i,j,bi,bj) = scal_sss*climsss(i,j,bi,bj)
212	heimbach	1.2	enddo
213			enddo
214	heimbach	1.1	#endif
215
216	heimbach	1.2	#ifdef ATMOSPHERIC_LOADING
217			do j = jmin,jmax
218			do i = imin,imax
219			pload(i,j,bi,bj) = scal_apressure*apressure(i,j,bi,bj)
220	heimbach	1.1	enddo
221			enddo
222	heimbach	1.2	#endif
223
224
225	heimbach	1.1	enddo
226			enddo
227
228			c Update the tile edges.
229
230			_EXCH_XY_R4( qnet, mythid )
231			_EXCH_XY_R4( empmr, mythid )
232	cheisey	1.3	c _EXCH_XY_R4( fu, mythid )
233			c _EXCH_XY_R4( fv, mythid )
234			CALL EXCH_UV_XY_RS(fu, fv, .TRUE., myThid)
235	heimbach	1.1	#ifdef ALLOW_KPP
236			_EXCH_XY_R4( qsw, mythid )
237			#endif
238			#ifdef ALLOW_CLIMSST_RELAXATION
239			_EXCH_XY_R4( sst, mythid )
240			#endif
241			#ifdef ALLOW_CLIMSSS_RELAXATION
242			_EXCH_XY_R4( sss, mythid )
243	heimbach	1.2	#endif
244			#ifdef ATMOSPHERIC_LOADING
245			_EXCH_XY_R4( pload, mythid )
246	heimbach	1.1	#endif
247
248			end