pkg/ctrl/ctrl_map_forcing.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_forcing.F,v 1.11 2008/01/15 19:56:27 dfer Exp $
C $Name:  $

#include "CTRL_CPPOPTIONS.h"

CBOP
C     !ROUTINE: ctrl_map_ini
C     !INTERFACE:
      SUBROUTINE CTRL_MAP_FORCING(myThid)

C     !DESCRIPTION: \bv
c     *=================================================================
c     | SUBROUTINE CTRL_MAP_FORCING
c     | Add the surface flux anomalies of the control vector
c     | to the model flux fields 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 "FFIELDS.h"
#include "DYNVARS.h"
#include "GRID.h"
#include "ctrl.h"
#include "ctrl_dummy.h"
#include "optim.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine arguments ==
C     myThid - Thread number for this instance of the routine.
      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)   fnametauu
      character*( 80)   fnametauv
      character*( 80)   fnamesflux
      character*( 80)   fnamehflux
      character*( 80)   fnamesss
      character*( 80)   fnamesst
cHFLUXM_CONTROL
      character*( 80)   fnamehfluxm
cHFLUXM_CONTROL

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.

#ifdef ALLOW_TAUU0_CONTROL
c--   tauu0.
      il=ilnblnk( xx_tauu_file )
      write(fnametauu(1:80),'(2a,i10.10)')
     &     xx_tauu_file(1:il),'.',optimcycle
      call active_read_xy ( fnametauu, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauu_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_AUTODIFF_OPENAD
              fu(i,j,bi,bj) = fu(i,j,bi,bj) + 
     &                        xx_tauu0(i,j,bi,bj) +
     &                        tmpfld2d(i,j,bi,bj)
#else
              fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_TAUV0_CONTROL
c--   tauv0.
      il=ilnblnk( xx_tauv_file )
      write(fnametauv(1:80),'(2a,i10.10)')
     &     xx_tauv_file(1:il),'.',optimcycle
      call active_read_xy ( fnametauv, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_tauv_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_AUTODIFF_OPENAD
              fv(i,j,bi,bj) = fv(i,j,bi,bj) + 
     &                        xx_tauv0(i,j,bi,bj) +
     &                        tmpfld2d(i,j,bi,bj)
#else
              fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SFLUX0_CONTROL
c--   sflux0.
      il=ilnblnk( xx_sflux_file )
      write(fnamesflux(1:80),'(2a,i10.10)')
     &     xx_sflux_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_sflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_AUTODIFF_OPENAD
              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) +
     &                           xx_sflux0(i,j,bi,bj) + 
     &                           tmpfld2d(i,j,bi,bj)
#else
              empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_HFLUX0_CONTROL
c--   hflux0.
      il=ilnblnk( xx_hflux_file )
      write(fnamehflux(1:80),'(2a,i10.10)')
     &     xx_hflux_file(1:il),'.',optimcycle
      call active_read_xy ( fnamehflux, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_hflux_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
# ifdef ALLOW_AUTODIFF_OPENAD
              qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + 
     &                          xx_hflux0(i,j,bi,bj) + 
     &                          tmpfld2d(i,j,bi,bj)
#else
              qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
#endif
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SSS_CONTROL
c--   sss0.
      il=ilnblnk( xx_sss_file )
      write(fnamesss(1:80),'(2a,i10.10)')
     &     xx_sss_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesss, 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
              sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_SST_CONTROL
c--   sst0.
      il=ilnblnk( xx_sst_file )
      write(fnamesst(1:80),'(2a,i10.10)')
     &     xx_sst_file(1:il),'.',optimcycle
      call active_read_xy ( fnamesst, 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
              sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#ifdef ALLOW_HFLUXM_CONTROL
c--   hfluxm.
      il=ilnblnk( xx_hfluxm_file )
      write(fnamehfluxm(1:80),'(2a,i10.10)')
     &     xx_hfluxm_file(1:il),'.',optimcycle
      call active_read_xy ( fnamehfluxm, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      mythid, xx_hfluxm_dummy )
      do bj = jtlo,jthi
        do bi = itlo,ithi
          do j = jmin,jmax
            do i = imin,imax
              Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
            enddo
          enddo
        enddo
      enddo
#endif

#if (defined (ALLOW_TAUU0_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
       CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
#endif
#ifdef ALLOW_SFLUX0_CONTROL
       _EXCH_XY_R4(EmPmR, myThid )
#endif
#ifdef ALLOW_HFLUX0_CONTROL
       _EXCH_XY_R4(Qnet,  myThid )
#endif
#ifdef ALLOW_SST_CONTROL
       _EXCH_XY_R4(SST,   myThid )
#endif
#ifdef ALLOW_SSS_CONTROL
       _EXCH_XY_R4(SSS,   myThid )
#endif
#ifdef ALLOW_HFLUXM_CONTROL
       _EXCH_XY_R4(Qnetm, myThid )
#endif

      END
1	utke	1.12	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_forcing.F,v 1.11 2008/01/15 19:56:27 dfer Exp $
2	jmc	1.10	C $Name: $
3	heimbach	1.1
4			#include "CTRL_CPPOPTIONS.h"
5
6	heimbach	1.4	CBOP
7			C !ROUTINE: ctrl_map_ini
8			C !INTERFACE:
9	heimbach	1.1	SUBROUTINE CTRL_MAP_FORCING(myThid)
10	heimbach	1.4
11			C !DESCRIPTION: \bv
12			c *=================================================================
13	jmc	1.10	c \| SUBROUTINE CTRL_MAP_FORCING
14	heimbach	1.4	c \| Add the surface flux anomalies of the control vector
15			c \| to the model flux fields and update the tile halos.
16			c \| The control vector is defined in the header file "ctrl.h".
17			c *=================================================================
18			C \ev
19
20			C !USES:
21	heimbach	1.1	IMPLICIT NONE
22
23			C == Global variables ===
24			#include "SIZE.h"
25			#include "EEPARAMS.h"
26			#include "PARAMS.h"
27			#include "FFIELDS.h"
28	heimbach	1.3	#include "DYNVARS.h"
29	heimbach	1.1	#include "GRID.h"
30			#include "ctrl.h"
31			#include "ctrl_dummy.h"
32	heimbach	1.2	#include "optim.h"
33	heimbach	1.1
34	heimbach	1.4	C !INPUT/OUTPUT PARAMETERS:
35	heimbach	1.1	C == Routine arguments ==
36			C myThid - Thread number for this instance of the routine.
37			INTEGER myThid
38
39	heimbach	1.4	C !LOCAL VARIABLES:
40	heimbach	1.1	C == Local variables ==
41			integer bi,bj
42			integer i,j,k
43			integer itlo,ithi
44			integer jtlo,jthi
45			integer jmin,jmax
46			integer imin,imax
47			integer il
48
49			logical equal
50			logical doglobalread
51			logical ladinit
52
53			character*( 80) fnametauu
54			character*( 80) fnametauv
55			character*( 80) fnamesflux
56			character*( 80) fnamehflux
57			character*( 80) fnamesss
58			character*( 80) fnamesst
59	dfer	1.11	cHFLUXM_CONTROL
60			character*( 80) fnamehfluxm
61			cHFLUXM_CONTROL
62	heimbach	1.1
63			c == external ==
64			integer ilnblnk
65			external ilnblnk
66
67			c == end of interface ==
68	heimbach	1.4	CEOP
69	heimbach	1.1
70			jtlo = mybylo(mythid)
71			jthi = mybyhi(mythid)
72			itlo = mybxlo(mythid)
73			ithi = mybxhi(mythid)
74	heimbach	1.5	jmin = 1
75			jmax = sny
76			imin = 1
77			imax = snx
78	heimbach	1.1
79			doglobalread = .false.
80			ladinit = .false.
81
82			#ifdef ALLOW_TAUU0_CONTROL
83			c-- tauu0.
84			il=ilnblnk( xx_tauu_file )
85			write(fnametauu(1:80),'(2a,i10.10)')
86			& xx_tauu_file(1:il),'.',optimcycle
87	heimbach	1.9	call active_read_xy ( fnametauu, tmpfld2d, 1,
88	heimbach	1.1	& doglobalread, ladinit, optimcycle,
89			& mythid, xx_tauu_dummy )
90			do bj = jtlo,jthi
91			do bi = itlo,ithi
92			do j = jmin,jmax
93			do i = imin,imax
94	utke	1.12	# ifdef ALLOW_AUTODIFF_OPENAD
95			fu(i,j,bi,bj) = fu(i,j,bi,bj) +
96			& xx_tauu0(i,j,bi,bj) +
97			& tmpfld2d(i,j,bi,bj)
98			#else
99	heimbach	1.1	fu(i,j,bi,bj) = fu(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
100	utke	1.12	#endif
101	heimbach	1.1	enddo
102			enddo
103			enddo
104			enddo
105			#endif
106
107			#ifdef ALLOW_TAUV0_CONTROL
108			c-- tauv0.
109			il=ilnblnk( xx_tauv_file )
110			write(fnametauv(1:80),'(2a,i10.10)')
111			& xx_tauv_file(1:il),'.',optimcycle
112	heimbach	1.9	call active_read_xy ( fnametauv, tmpfld2d, 1,
113	heimbach	1.1	& doglobalread, ladinit, optimcycle,
114			& mythid, xx_tauv_dummy )
115			do bj = jtlo,jthi
116			do bi = itlo,ithi
117			do j = jmin,jmax
118			do i = imin,imax
119	utke	1.12	# ifdef ALLOW_AUTODIFF_OPENAD
120			fv(i,j,bi,bj) = fv(i,j,bi,bj) +
121			& xx_tauv0(i,j,bi,bj) +
122			& tmpfld2d(i,j,bi,bj)
123			#else
124	heimbach	1.1	fv(i,j,bi,bj) = fv(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
125	utke	1.12	#endif
126	heimbach	1.1	enddo
127			enddo
128			enddo
129			enddo
130			#endif
131
132			#ifdef ALLOW_SFLUX0_CONTROL
133			c-- sflux0.
134			il=ilnblnk( xx_sflux_file )
135			write(fnamesflux(1:80),'(2a,i10.10)')
136			& xx_sflux_file(1:il),'.',optimcycle
137	heimbach	1.9	call active_read_xy ( fnamesflux, tmpfld2d, 1,
138	heimbach	1.1	& doglobalread, ladinit, optimcycle,
139			& mythid, xx_sflux_dummy )
140			do bj = jtlo,jthi
141			do bi = itlo,ithi
142			do j = jmin,jmax
143			do i = imin,imax
144	utke	1.12	# ifdef ALLOW_AUTODIFF_OPENAD
145			empmr(i,j,bi,bj) = empmr(i,j,bi,bj) +
146			& xx_sflux0(i,j,bi,bj) +
147			& tmpfld2d(i,j,bi,bj)
148			#else
149	heimbach	1.1	empmr(i,j,bi,bj) = empmr(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
150	utke	1.12	#endif
151	heimbach	1.1	enddo
152			enddo
153			enddo
154			enddo
155			#endif
156
157			#ifdef ALLOW_HFLUX0_CONTROL
158			c-- hflux0.
159			il=ilnblnk( xx_hflux_file )
160			write(fnamehflux(1:80),'(2a,i10.10)')
161			& xx_hflux_file(1:il),'.',optimcycle
162	heimbach	1.9	call active_read_xy ( fnamehflux, tmpfld2d, 1,
163	heimbach	1.1	& doglobalread, ladinit, optimcycle,
164			& mythid, xx_hflux_dummy )
165			do bj = jtlo,jthi
166			do bi = itlo,ithi
167			do j = jmin,jmax
168			do i = imin,imax
169	utke	1.12	# ifdef ALLOW_AUTODIFF_OPENAD
170			qnet(i,j,bi,bj) = qnet(i,j,bi,bj) +
171			& xx_hflux0(i,j,bi,bj) +
172			& tmpfld2d(i,j,bi,bj)
173			#else
174	heimbach	1.1	qnet(i,j,bi,bj) = qnet(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
175	utke	1.12	#endif
176	heimbach	1.1	enddo
177			enddo
178			enddo
179			enddo
180			#endif
181
182	heimbach	1.7	#ifdef ALLOW_SSS_CONTROL
183	heimbach	1.1	c-- sss0.
184			il=ilnblnk( xx_sss_file )
185			write(fnamesss(1:80),'(2a,i10.10)')
186			& xx_sss_file(1:il),'.',optimcycle
187	heimbach	1.9	call active_read_xy ( fnamesss, tmpfld2d, 1,
188	heimbach	1.1	& doglobalread, ladinit, optimcycle,
189			& mythid, xx_sss_dummy )
190			do bj = jtlo,jthi
191			do bi = itlo,ithi
192			do j = jmin,jmax
193			do i = imin,imax
194			sss(i,j,bi,bj) = sss(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
195			enddo
196			enddo
197			enddo
198			enddo
199			#endif
200
201	heimbach	1.7	#ifdef ALLOW_SST_CONTROL
202	heimbach	1.1	c-- sst0.
203			il=ilnblnk( xx_sst_file )
204			write(fnamesst(1:80),'(2a,i10.10)')
205			& xx_sst_file(1:il),'.',optimcycle
206	heimbach	1.9	call active_read_xy ( fnamesst, tmpfld2d, 1,
207	heimbach	1.1	& doglobalread, ladinit, optimcycle,
208			& mythid, xx_sst_dummy )
209			do bj = jtlo,jthi
210			do bi = itlo,ithi
211			do j = jmin,jmax
212			do i = imin,imax
213			sst(i,j,bi,bj) = sst(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
214			enddo
215			enddo
216			enddo
217			enddo
218	heimbach	1.5	#endif
219
220	dfer	1.11	#ifdef ALLOW_HFLUXM_CONTROL
221			c-- hfluxm.
222			il=ilnblnk( xx_hfluxm_file )
223			write(fnamehfluxm(1:80),'(2a,i10.10)')
224			& xx_hfluxm_file(1:il),'.',optimcycle
225			call active_read_xy ( fnamehfluxm, tmpfld2d, 1,
226			& doglobalread, ladinit, optimcycle,
227			& mythid, xx_hfluxm_dummy )
228			do bj = jtlo,jthi
229			do bi = itlo,ithi
230			do j = jmin,jmax
231			do i = imin,imax
232			Qnetm(i,j,bi,bj) = Qnetm(i,j,bi,bj) + tmpfld2d(i,j,bi,bj)
233			enddo
234			enddo
235			enddo
236			enddo
237			#endif
238
239	heimbach	1.5	#if (defined (ALLOW_TAUU0_CONTROL) \|\| defined (ALLOW_TAUV0_CONTROL))
240			CALL EXCH_UV_XY_RS(fu,fv,.TRUE.,myThid)
241			#endif
242			#ifdef ALLOW_SFLUX0_CONTROL
243			_EXCH_XY_R4(EmPmR, myThid )
244			#endif
245			#ifdef ALLOW_HFLUX0_CONTROL
246			_EXCH_XY_R4(Qnet, myThid )
247			#endif
248	heimbach	1.8	#ifdef ALLOW_SST_CONTROL
249	heimbach	1.5	_EXCH_XY_R4(SST, myThid )
250			#endif
251	heimbach	1.8	#ifdef ALLOW_SSS_CONTROL
252	heimbach	1.5	_EXCH_XY_R4(SSS, myThid )
253	heimbach	1.1	#endif
254	dfer	1.11	#ifdef ALLOW_HFLUXM_CONTROL
255			_EXCH_XY_R4(Qnetm, myThid )
256			#endif
257	heimbach	1.1
258			END