hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F

C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F,v 1.4 2012/08/12 19:59:03 jmc Exp $
C $Name:  $

#include "CTRL_OPTIONS.h"

CBOP
C     !ROUTINE: CTRL_MAP_INI_GENARR
C     !INTERFACE:
      SUBROUTINE CTRL_MAP_INI_GENARR( myThid )

C     !DESCRIPTION: \bv
C     *=================================================================
C     | SUBROUTINE CTRL_MAP_INI_GENARR
C     | Add the generic arrays of the
C     | control vector to the model state 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 "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"
#include "CTRL_SIZE.h"
#include "ctrl.h"
#include "CTRL_GENARR.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_PTRACERS
# include "PTRACERS_SIZE.h"
c#include "PTRACERS_PARAMS.h"
# include "PTRACERS_FIELDS.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     == routine arguments ==
      INTEGER myThid

C     !FUNCTIONS:
      INTEGER  ILNBLNk
      EXTERNAL ILNBLNK

C     !LOCAL VARIABLES:
C     == local variables ==
      integer bi,bj
      integer i,j,k
      integer jmin,jmax
      integer imin,imax
      integer il
      integer iarr

      logical doglobalread
      logical ladinit
      character*(MAX_LEN_FNAM) fnamebase
      character*( 80)   fnamegeneric
      character*(MAX_LEN_MBUF) msgBuf
      _RL     fac
CEOP

      jmin = 1
      jmax = sNy
      imin = 1
      imax = sNx

      doglobalread = .false.
      ladinit      = .false.
      fac = 1. _d 0

#ifdef ALLOW_GENARR2D_CONTROL
C--   An example of connecting specific fields
C--   to 3 generic 2D control arrays
cc--->>>
cc--->>> COMPILE FAILURE IS DELIBERATE
cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
cc--->>>
C--   generic - user-defined control vars
      DO iarr = 1, maxCtrlArr2D

       fnamebase = xx_genarr2d_file(iarr)
       il=ILNBLNK( fnamebase )
       write(fnamegeneric(1:80),'(2a,i10.10)')
     &     fnamebase(1:il),'.',optimcycle
       CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
     &                      doglobalread, ladinit, optimcycle,
     &                      myThid, xx_genarr2d_dummy(iarr) )
       DO bj=myByLo(myThid), myByHi(myThid)
        DO bi=myBxLo(myThid), myBxHi(myThid)
          do j = jmin,jmax
            do i = imin,imax
#ifndef ALLOW_AUTODIFF_OPENAD
              if ( iarr .eq. 1 ) then
# ifdef ALLOW_BOTTOMDRAG_CONTROL
                bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
     &                                   + tmpfld2d(i,j,bi,bj)
# endif
              elseif ( iarr .eq. 2 ) then
                theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
     &                             + tmpfld2d(i,j,bi,bj)
              elseif ( iarr .eq. 3 ) then
                salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
     &                            + tmpfld2d(i,j,bi,bj)
              endif
#else
              if ( iarr .eq. 1 ) then
# ifdef ALLOW_BOTTOMDRAG_CONTROL
                bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
     &           + xx_genarr2d(i,j,bi,bj,iarr)
     &           + tmpfld2d(i,j,bi,bj)
# endif
              elseif ( iarr .eq. 2 ) then
                theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
     &           + xx_genarr2d(i,j,bi,bj,iarr)
     &           + tmpfld2d(i,j,bi,bj)
              elseif ( iarr .eq. 3 ) then
                salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
     &           + xx_genarr2d(i,j,bi,bj,iarr)
     &           + tmpfld2d(i,j,bi,bj)
              endif
#endif /* ALLOW_AUTODIFF_OPENAD */
            enddo
          enddo
        ENDDO
       ENDDO
C--   end iarr loop
      ENDDO
#ifdef ALLOW_BOTTOMDRAG_CONTROL
       _EXCH_XY_RL( bottomdragfld, myThid )
#endif
       _EXCH_XYZ_RL( theta, myThid )
       _EXCH_XYZ_RL( salt, myThid )

#endif /* ALLOW_GENARR2D_CONTROL */

#ifdef ALLOW_GENARR3D_CONTROL
C--   An example of connecting specific fields
C--   to 3 generic 3D control arrays
cc--->>>
cc--->>> COMPILE FAILURE IS DELIBERATE
cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
cc--->>>
C--   generic - user-defined control vars
      DO iarr = 1, maxCtrlArr3D

       fnamebase = xx_genarr3d_file(iarr)
       il=ILNBLNK( fnamebase )
       write(fnamegeneric(1:80),'(2a,i10.10)')
     &     fnamebase(1:il),'.',optimcycle
       CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
     &                       doglobalread, ladinit, optimcycle,
     &                       myThid, xx_genarr3d_dummy(iarr) )
       DO bj=myByLo(myThid), myByHi(myThid)
        DO bi=myBxLo(myThid), myBxHi(myThid)
          do k = 1,Nr
           do j = jmin,jmax
            do i = imin,imax
#ifndef ALLOW_AUTODIFF_OPENAD
              if ( iarr .eq. 1 ) then
                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
     &                             + fac*tmpfld3d(i,j,k,bi,bj)
              elseif ( iarr .eq. 2 ) then
                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
     &                            + fac*tmpfld3d(i,j,k,bi,bj)
              endif
#else
              if ( iarr .eq. 1 ) then
                theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
     &           + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
     &           + fac*tmpfld3d(i,j,k,bi,bj)
              elseif ( iarr .eq. 2 ) then
                salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
     &           + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
     &           + fac*tmpfld3d(i,j,k,bi,bj)
              endif
#endif /* ALLOW_AUTODIFF_OPENAD */
            enddo
           enddo
          enddo
        ENDDO
       ENDDO
C--   end iarr loop
      ENDDO
       _EXCH_XYZ_RL( theta, myThid )
       _EXCH_XYZ_RL( salt, myThid )

#endif /* ALLOW_GENARR3D_CONTROL */

      RETURN
      END
1	heimbach	1.5	C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F,v 1.4 2012/08/12 19:59:03 jmc Exp $
2	heimbach	1.1	C $Name: $
3
4	jmc	1.3	#include "CTRL_OPTIONS.h"
5	heimbach	1.1
6			CBOP
7	jmc	1.4	C !ROUTINE: CTRL_MAP_INI_GENARR
8	heimbach	1.1	C !INTERFACE:
9	jmc	1.4	SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
10	heimbach	1.1
11			C !DESCRIPTION: \bv
12	jmc	1.4	C *=================================================================
13			C \| SUBROUTINE CTRL_MAP_INI_GENARR
14			C \| Add the generic arrays of the
15			C \| control vector to the model state and update the tile halos.
16			C \| The control vector is defined in the header file "ctrl.h".
17			C *=================================================================
18	heimbach	1.1	C \ev
19
20			C !USES:
21	jmc	1.4	IMPLICIT NONE
22	heimbach	1.1
23	jmc	1.4	C == global variables ==
24	heimbach	1.1	#include "SIZE.h"
25	jmc	1.2	#include "EEPARAMS.h"
26	heimbach	1.1	#include "PARAMS.h"
27			#include "GRID.h"
28			#include "DYNVARS.h"
29			#include "FFIELDS.h"
30			#include "CTRL_SIZE.h"
31			#include "ctrl.h"
32			#include "CTRL_GENARR.h"
33			#include "ctrl_dummy.h"
34			#include "optim.h"
35			#ifdef ALLOW_PTRACERS
36			# include "PTRACERS_SIZE.h"
37			c#include "PTRACERS_PARAMS.h"
38			# include "PTRACERS_FIELDS.h"
39			#endif
40
41			C !INPUT/OUTPUT PARAMETERS:
42	jmc	1.4	C == routine arguments ==
43			INTEGER myThid
44
45			C !FUNCTIONS:
46			INTEGER ILNBLNk
47			EXTERNAL ILNBLNK
48	heimbach	1.1
49			C !LOCAL VARIABLES:
50	jmc	1.4	C == local variables ==
51	heimbach	1.1	integer bi,bj
52			integer i,j,k
53			integer jmin,jmax
54			integer imin,imax
55			integer il
56			integer iarr
57
58			logical doglobalread
59			logical ladinit
60	heimbach	1.6	character*(MAX_LEN_FNAM) fnamebase
61	heimbach	1.1	character*( 80) fnamegeneric
62	heimbach	1.6	character*(MAX_LEN_MBUF) msgBuf
63	heimbach	1.1	_RL fac
64			CEOP
65
66			jmin = 1
67	jmc	1.4	jmax = sNy
68	heimbach	1.1	imin = 1
69	jmc	1.4	imax = sNx
70	heimbach	1.1
71			doglobalread = .false.
72			ladinit = .false.
73	jmc	1.4	fac = 1. _d 0
74	heimbach	1.1
75			#ifdef ALLOW_GENARR2D_CONTROL
76	jmc	1.4	C-- An example of connecting specific fields
77			C-- to 3 generic 2D control arrays
78	heimbach	1.1	cc--->>>
79			cc--->>> COMPILE FAILURE IS DELIBERATE
80			cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
81			cc--->>>
82	jmc	1.4	C-- generic - user-defined control vars
83			DO iarr = 1, maxCtrlArr2D
84
85	heimbach	1.6	fnamebase = xx_genarr2d_file(iarr)
86			il=ILNBLNK( fnamebase )
87	heimbach	1.1	write(fnamegeneric(1:80),'(2a,i10.10)')
88	heimbach	1.6	& fnamebase(1:il),'.',optimcycle
89	jmc	1.4	CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
90	heimbach	1.1	& doglobalread, ladinit, optimcycle,
91	jmc	1.4	& myThid, xx_genarr2d_dummy(iarr) )
92			DO bj=myByLo(myThid), myByHi(myThid)
93			DO bi=myBxLo(myThid), myBxHi(myThid)
94			do j = jmin,jmax
95			do i = imin,imax
96	heimbach	1.6	#ifndef ALLOW_AUTODIFF_OPENAD
97	heimbach	1.1	if ( iarr .eq. 1 ) then
98	heimbach	1.6	# ifdef ALLOW_BOTTOMDRAG_CONTROL
99	heimbach	1.1	bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
100	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
101	heimbach	1.6	# endif
102	heimbach	1.5	elseif ( iarr .eq. 2 ) then
103	heimbach	1.1	theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
104	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
105	heimbach	1.1	elseif ( iarr .eq. 3 ) then
106			salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
107	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
108	heimbach	1.1	endif
109	heimbach	1.6	#else
110			if ( iarr .eq. 1 ) then
111			# ifdef ALLOW_BOTTOMDRAG_CONTROL
112			bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
113			& + xx_genarr2d(i,j,bi,bj,iarr)
114			& + tmpfld2d(i,j,bi,bj)
115			# endif
116			elseif ( iarr .eq. 2 ) then
117			theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
118			& + xx_genarr2d(i,j,bi,bj,iarr)
119			& + tmpfld2d(i,j,bi,bj)
120			elseif ( iarr .eq. 3 ) then
121			salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
122			& + xx_genarr2d(i,j,bi,bj,iarr)
123			& + tmpfld2d(i,j,bi,bj)
124			endif
125			#endif /* ALLOW_AUTODIFF_OPENAD */
126	jmc	1.4	enddo
127			enddo
128			ENDDO
129			ENDDO
130			C-- end iarr loop
131			ENDDO
132			#ifdef ALLOW_BOTTOMDRAG_CONTROL
133			_EXCH_XY_RL( bottomdragfld, myThid )
134	heimbach	1.1	#endif
135	jmc	1.4	_EXCH_XYZ_RL( theta, myThid )
136			_EXCH_XYZ_RL( salt, myThid )
137
138			#endif /* ALLOW_GENARR2D_CONTROL */
139	heimbach	1.1
140			#ifdef ALLOW_GENARR3D_CONTROL
141	jmc	1.4	C-- An example of connecting specific fields
142			C-- to 3 generic 3D control arrays
143	heimbach	1.1	cc--->>>
144			cc--->>> COMPILE FAILURE IS DELIBERATE
145			cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
146			cc--->>>
147	jmc	1.4	C-- generic - user-defined control vars
148			DO iarr = 1, maxCtrlArr3D
149
150	heimbach	1.6	fnamebase = xx_genarr3d_file(iarr)
151			il=ILNBLNK( fnamebase )
152	heimbach	1.1	write(fnamegeneric(1:80),'(2a,i10.10)')
153	heimbach	1.6	& fnamebase(1:il),'.',optimcycle
154	jmc	1.4	CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
155	heimbach	1.1	& doglobalread, ladinit, optimcycle,
156	jmc	1.4	& myThid, xx_genarr3d_dummy(iarr) )
157			DO bj=myByLo(myThid), myByHi(myThid)
158			DO bi=myBxLo(myThid), myBxHi(myThid)
159			do k = 1,Nr
160			do j = jmin,jmax
161			do i = imin,imax
162	heimbach	1.6	#ifndef ALLOW_AUTODIFF_OPENAD
163	jmc	1.4	if ( iarr .eq. 1 ) then
164			theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
165			& + fac*tmpfld3d(i,j,k,bi,bj)
166			elseif ( iarr .eq. 2 ) then
167			salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
168			& + fac*tmpfld3d(i,j,k,bi,bj)
169			endif
170	heimbach	1.6	#else
171			if ( iarr .eq. 1 ) then
172			theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
173			& + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
174			& + fac*tmpfld3d(i,j,k,bi,bj)
175			elseif ( iarr .eq. 2 ) then
176			salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
177			& + fac*xx_genarr3d(i,j,k,bi,bj,iarr)
178			& + fac*tmpfld3d(i,j,k,bi,bj)
179			endif
180			#endif /* ALLOW_AUTODIFF_OPENAD */
181	heimbach	1.1	enddo
182	jmc	1.4	enddo
183	heimbach	1.1	enddo
184	jmc	1.4	ENDDO
185			ENDDO
186			C-- end iarr loop
187			ENDDO
188			_EXCH_XYZ_RL( theta, myThid )
189			_EXCH_XYZ_RL( salt, myThid )
190
191			#endif /* ALLOW_GENARR3D_CONTROL */
192	heimbach	1.1
193	jmc	1.4	RETURN
194			END