pkg/exf/exf_getsurfacefluxes.F

C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_getsurfacefluxes.F,v 1.13 2010/07/13 00:02:10 gforget Exp $
C $Name:  $

#include "EXF_OPTIONS.h"

      subroutine exf_GetSurfaceFluxes(
     I                                 mytime,
     I                                 myiter,
     I                                 mythid
     &                               )

c     ==================================================================
c     SUBROUTINE exf_GetSurfaceFluxes
c     ==================================================================
c
c     o Mid-level routine for enabling the use of flux fields as control
c       variables.
c
c     started: Christian Eckert eckert@mit.edu  30-Jun-1999
c
c     changed: Christian Eckert eckert@mit.edu  14-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     mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
c
c     ==================================================================
c     SUBROUTINE exf_GetSurfaceFluxes
c     ==================================================================

      implicit none

c     == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"

#include "EXF_FIELDS.h"
#include "EXF_PARAM.h"
#ifdef ALLOW_AUTODIFF
# include "CTRL_SIZE.h"
# include "ctrl.h"
# include "ctrl_dummy.h"
#endif

c     == routine arguments ==

      _RL mytime
      integer myiter
      integer mythid

c     == global variables ==

#ifdef ALLOW_ROTATE_UV_CONTROLS
      _RL     tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      _RL     tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
      integer i,j,bi,bj
#endif


c     == end of interface ==

#ifdef ALLOW_HFLUX_CONTROL
      call ctrl_get_gen ( 
     &     xx_hflux_file, xx_hfluxstartdate, xx_hfluxperiod,
     &     maskc, hflux, xx_hflux0, xx_hflux1, xx_hflux_dummy,
     &     xx_hflux_remo_intercept, xx_hflux_remo_slope,
     &     mytime, myiter, mythid )
#endif

#ifdef ALLOW_SFLUX_CONTROL
      call ctrl_get_gen ( 
     &     xx_sflux_file, xx_sfluxstartdate, xx_sfluxperiod,
     &     maskc, sflux, xx_sflux0, xx_sflux1, xx_sflux_dummy,
     &     xx_sflux_remo_intercept, xx_sflux_remo_slope,
     &     mytime, myiter, mythid )
#endif

#ifndef ALLOW_ROTATE_UV_CONTROLS

#ifdef ALLOW_USTRESS_CONTROL
      call ctrl_get_gen ( 
     &     xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
     &     maskw, ustress, xx_tauu0, xx_tauu1, xx_tauu_dummy,
     &     xx_tauu_remo_intercept, xx_tauu_remo_slope,
     &     mytime, myiter, mythid )
#endif

#ifdef ALLOW_VSTRESS_CONTROL
      call ctrl_get_gen ( 
     &     xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
     &     masks, vstress, xx_tauv0, xx_tauv1, xx_tauv_dummy,
     &     xx_tauv_remo_intercept, xx_tauv_remo_slope,
     &     mytime, myiter, mythid )
#endif

#else

#if defined(ALLOW_USTRESS_CONTROL) && defined(ALLOW_VSTRESS_CONTROL)

        do bj = mybylo(mythid),mybyhi(mythid)
         do bi = mybxlo(mythid),mybxhi(mythid)
          do j = 1-oly,sny+oly
           do i = 1-olx,snx+olx
             tmpUE(i,j,bi,bj) = 0. _d 0
             tmpVN(i,j,bi,bj) = 0. _d 0
             tmpUX(i,j,bi,bj) = 0. _d 0
             tmpVY(i,j,bi,bj) = 0. _d 0
           enddo
          enddo
         enddo
        enddo

      call ctrl_get_gen ( 
     &     xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
     &     maskc, tmpUE, xx_tauu0, xx_tauu1, xx_tauu_dummy,
     &     xx_tauu_remo_intercept, xx_tauu_remo_slope,
     &     mytime, myiter, mythid )

      call ctrl_get_gen ( 
     &     xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
     &     maskc, tmpVN, xx_tauv0, xx_tauv1, xx_tauv_dummy,
     &     xx_tauv_remo_intercept, xx_tauv_remo_slope,
     &     mytime, myiter, mythid )

      _EXCH_XY_RL(tmpUE,myThid)
      _EXCH_XY_RL(tmpVN,myThid)

      call rotate_uv2en_rl(tmpUX,tmpVY,tmpUE,tmpVN,
     &     .FALSE.,stressIsOnCgrid,.TRUE.,1,mythid)

      IF ( stressIsOnCgrid ) THEN
        CALL EXCH_UV_XY_RL( tmpUX, tmpVY, .TRUE., myThid )
      ELSE
        CALL EXCH_UV_AGRID_3D_RL( tmpUX, tmpVY, .TRUE., 1, myThid)
      ENDIF  

        do bj = mybylo(mythid),mybyhi(mythid)
         do bi = mybxlo(mythid),mybxhi(mythid)
          do j = 1-oly,sny+oly
           do i = 1-olx,snx+olx
             ustress(i,j,bi,bj)=ustress(i,j,bi,bj)+tmpUX(i,j,bi,bj)
             vstress(i,j,bi,bj)=vstress(i,j,bi,bj)+tmpVY(i,j,bi,bj)
           enddo
          enddo
         enddo
        enddo

#endif
#endif /* ALLOW_ROTATE_UV_CONTROLS */


      end
1	heimbach	1.14	C $Header: /u/gcmpack/MITgcm/pkg/exf/exf_getsurfacefluxes.F,v 1.13 2010/07/13 00:02:10 gforget Exp $
2	heimbach	1.8	C $Name: $
3	heimbach	1.1
4	edhill	1.6	#include "EXF_OPTIONS.h"
5	heimbach	1.1
6			subroutine exf_GetSurfaceFluxes(
7			I mytime,
8			I myiter,
9			I mythid
10			& )
11
12			c ==================================================================
13			c SUBROUTINE exf_GetSurfaceFluxes
14			c ==================================================================
15			c
16			c o Mid-level routine for enabling the use of flux fields as control
17			c variables.
18			c
19			c started: Christian Eckert eckert@mit.edu 30-Jun-1999
20			c
21			c changed: Christian Eckert eckert@mit.edu 14-Jan-2000
22			c - Restructured the code in order to create a package
23			c for the MITgcmUV.
24			c
25			c Christian Eckert eckert@mit.edu 12-Feb-2000
26	dimitri	1.4	c - Changed Routine names (package prefix: exf_)
27	heimbach	1.1	c
28	dimitri	1.4	c mods for pkg/seaice: menemenlis@jpl.nasa.gov 20-Dec-2002
29	heimbach	1.1	c
30			c ==================================================================
31			c SUBROUTINE exf_GetSurfaceFluxes
32			c ==================================================================
33
34			implicit none
35
36	heimbach	1.5	c == global variables ==
37			#include "EEPARAMS.h"
38			#include "SIZE.h"
39			#include "PARAMS.h"
40			#include "GRID.h"
41
42	jmc	1.12	#include "EXF_FIELDS.h"
43	gforget	1.13	#include "EXF_PARAM.h"
44	heimbach	1.8	#ifdef ALLOW_AUTODIFF
45	heimbach	1.14	# include "CTRL_SIZE.h"
46	heimbach	1.5	# include "ctrl.h"
47			# include "ctrl_dummy.h"
48			#endif
49
50	heimbach	1.1	c == routine arguments ==
51
52			_RL mytime
53			integer myiter
54			integer mythid
55
56			c == global variables ==
57
58	gforget	1.13	#ifdef ALLOW_ROTATE_UV_CONTROLS
59			_RL tmpUE(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
60			_RL tmpVN(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
61			_RL tmpUX(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
62			_RL tmpVY(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
63			integer i,j,bi,bj
64			#endif
65
66
67	heimbach	1.1	c == end of interface ==
68
69			#ifdef ALLOW_HFLUX_CONTROL
70	heimbach	1.5	call ctrl_get_gen (
71			& xx_hflux_file, xx_hfluxstartdate, xx_hfluxperiod,
72			& maskc, hflux, xx_hflux0, xx_hflux1, xx_hflux_dummy,
73	heimbach	1.11	& xx_hflux_remo_intercept, xx_hflux_remo_slope,
74	heimbach	1.5	& mytime, myiter, mythid )
75	heimbach	1.1	#endif
76
77			#ifdef ALLOW_SFLUX_CONTROL
78	heimbach	1.5	call ctrl_get_gen (
79			& xx_sflux_file, xx_sfluxstartdate, xx_sfluxperiod,
80			& maskc, sflux, xx_sflux0, xx_sflux1, xx_sflux_dummy,
81	heimbach	1.11	& xx_sflux_remo_intercept, xx_sflux_remo_slope,
82	heimbach	1.5	& mytime, myiter, mythid )
83	heimbach	1.1	#endif
84
85	gforget	1.13	#ifndef ALLOW_ROTATE_UV_CONTROLS
86
87	heimbach	1.1	#ifdef ALLOW_USTRESS_CONTROL
88	heimbach	1.5	call ctrl_get_gen (
89			& xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
90			& maskw, ustress, xx_tauu0, xx_tauu1, xx_tauu_dummy,
91	heimbach	1.11	& xx_tauu_remo_intercept, xx_tauu_remo_slope,
92	heimbach	1.5	& mytime, myiter, mythid )
93	heimbach	1.1	#endif
94
95			#ifdef ALLOW_VSTRESS_CONTROL
96	heimbach	1.5	call ctrl_get_gen (
97			& xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
98			& masks, vstress, xx_tauv0, xx_tauv1, xx_tauv_dummy,
99	heimbach	1.11	& xx_tauv_remo_intercept, xx_tauv_remo_slope,
100	heimbach	1.5	& mytime, myiter, mythid )
101	heimbach	1.1	#endif
102
103	gforget	1.13	#else
104
105			#if defined(ALLOW_USTRESS_CONTROL) && defined(ALLOW_VSTRESS_CONTROL)
106
107			do bj = mybylo(mythid),mybyhi(mythid)
108			do bi = mybxlo(mythid),mybxhi(mythid)
109			do j = 1-oly,sny+oly
110			do i = 1-olx,snx+olx
111			tmpUE(i,j,bi,bj) = 0. _d 0
112			tmpVN(i,j,bi,bj) = 0. _d 0
113			tmpUX(i,j,bi,bj) = 0. _d 0
114			tmpVY(i,j,bi,bj) = 0. _d 0
115			enddo
116			enddo
117			enddo
118			enddo
119
120			call ctrl_get_gen (
121			& xx_tauu_file, xx_tauustartdate, xx_tauuperiod,
122			& maskc, tmpUE, xx_tauu0, xx_tauu1, xx_tauu_dummy,
123			& xx_tauu_remo_intercept, xx_tauu_remo_slope,
124			& mytime, myiter, mythid )
125
126			call ctrl_get_gen (
127			& xx_tauv_file, xx_tauvstartdate, xx_tauvperiod,
128			& maskc, tmpVN, xx_tauv0, xx_tauv1, xx_tauv_dummy,
129			& xx_tauv_remo_intercept, xx_tauv_remo_slope,
130			& mytime, myiter, mythid )
131
132			_EXCH_XY_RL(tmpUE,myThid)
133			_EXCH_XY_RL(tmpVN,myThid)
134
135			call rotate_uv2en_rl(tmpUX,tmpVY,tmpUE,tmpVN,
136			& .FALSE.,stressIsOnCgrid,.TRUE.,1,mythid)
137
138			IF ( stressIsOnCgrid ) THEN
139			CALL EXCH_UV_XY_RL( tmpUX, tmpVY, .TRUE., myThid )
140			ELSE
141			CALL EXCH_UV_AGRID_3D_RL( tmpUX, tmpVY, .TRUE., 1, myThid)
142			ENDIF
143
144			do bj = mybylo(mythid),mybyhi(mythid)
145			do bi = mybxlo(mythid),mybxhi(mythid)
146			do j = 1-oly,sny+oly
147			do i = 1-olx,snx+olx
148			ustress(i,j,bi,bj)=ustress(i,j,bi,bj)+tmpUX(i,j,bi,bj)
149			vstress(i,j,bi,bj)=vstress(i,j,bi,bj)+tmpVY(i,j,bi,bj)
150			enddo
151			enddo
152			enddo
153			enddo
154
155			#endif
156			#endif /* ALLOW_ROTATE_UV_CONTROLS */
157
158
159
160	heimbach	1.1	end