pkg/exf/exf_mapfields.F

c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_mapfields.F,v 1.3 2002/12/17 19:47:41 cheisey 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              Dimitris Menemenlis, menemenlis@jpl.nasa.gov 20-Dec-2002
c
c              - removed: empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)
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.
              empmr(i,j,bi,bj) = scal_sfl*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.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	dimitri	1.4	c $Header: /u/gcmpack/MITgcm/pkg/exf/exf_mapfields.F,v 1.3 2002/12/17 19:47:41 cheisey 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	dimitri	1.4	c Dimitris Menemenlis, menemenlis@jpl.nasa.gov 20-Dec-2002
53			c
54			c - removed: empmr(i,j,bi,bj) = scal_prc*precip(i,j,bi,bj)
55			c
56	heimbach	1.1	c ==================================================================
57	heimbach	1.2	c SUBROUTINE exf_mapfields
58	heimbach	1.1	c ==================================================================
59
60			implicit none
61
62			c == global variables ==
63
64			#include "EEPARAMS.h"
65			#include "SIZE.h"
66			#include "FFIELDS.h"
67	heimbach	1.2	#include "exf_param.h"
68	heimbach	1.1	#include "exf_constants.h"
69			#include "exf_fields.h"
70			#include "exf_clim_fields.h"
71	heimbach	1.2	#ifdef ALLOW_AUTODIFF_TAMC
72			# include "tamc.h"
73			# include "tamc_keys.h"
74			#endif
75	heimbach	1.1	c == routine arguments ==
76
77			c mythid - thread number for this instance of the routine.
78
79			integer mythid
80
81			c == local variables ==
82
83			integer bi,bj
84			integer i,j
85			integer jtlo
86			integer jthi
87			integer itlo
88			integer ithi
89			integer jmin
90			integer jmax
91			integer imin
92			integer imax
93
94			c == end of interface ==
95
96			jtlo = mybylo(mythid)
97			jthi = mybyhi(mythid)
98			itlo = mybxlo(mythid)
99			ithi = mybxhi(mythid)
100			jmin = 1-oly
101			jmax = sny+oly
102			imin = 1-olx
103			imax = snx+olx
104
105			do bj = jtlo,jthi
106			do bi = itlo,ithi
107	heimbach	1.2
108			#ifdef ALLOW_AUTODIFF_TAMC
109			act1 = bi - myBxLo(myThid)
110			max1 = myBxHi(myThid) - myBxLo(myThid) + 1
111			act2 = bj - myByLo(myThid)
112			max2 = myByHi(myThid) - myByLo(myThid) + 1
113			act3 = myThid - 1
114			max3 = nTx*nTy
115			act4 = ikey_dynamics - 1
116			ikey = (act1 + 1) + act2*max1
117			& + act3max1max2
118			& + act4max1max2*max3
119			#endif /* ALLOW_AUTODIFF_TAMC */
120
121	heimbach	1.1	do j = jmin,jmax
122			do i = imin,imax
123			c Heat flux.
124			qnet(i,j,bi,bj) = scal_hfl*hflux(i,j,bi,bj)
125	heimbach	1.2	enddo
126			enddo
127	heimbach	1.1
128	heimbach	1.2
129			do j = jmin,jmax
130			do i = imin,imax
131	heimbach	1.1	c Salt flux.
132			empmr(i,j,bi,bj) = scal_sfl*sflux(i,j,bi,bj)
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