hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F

C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_oad/ctrl_map_ini_genarr.F,v 1.1 2013/06/21 17:36:31 heimbach 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_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_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_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_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	C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_oad/ctrl_map_ini_genarr.F,v 1.1 2013/06/21 17:36:31 heimbach Exp $
2	C $Name: $
3
4	#include "CTRL_OPTIONS.h"
5
6	CBOP
7	C !ROUTINE: CTRL_MAP_INI_GENARR
8	C !INTERFACE:
9	SUBROUTINE CTRL_MAP_INI_GENARR( myThid )
10
11	C !DESCRIPTION: \bv
12	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	C \ev
19
20	C !USES:
21	IMPLICIT NONE
22
23	C == global variables ==
24	#include "SIZE.h"
25	#include "EEPARAMS.h"
26	#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	C == routine arguments ==
43	INTEGER myThid
44
45	C !FUNCTIONS:
46	INTEGER ILNBLNk
47	EXTERNAL ILNBLNK
48
49	C !LOCAL VARIABLES:
50	C == local variables ==
51	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	character*(MAX_LEN_FNAM) fnamebase
61	character*( 80) fnamegeneric
62	character*(MAX_LEN_MBUF) msgBuf
63	_RL fac
64	CEOP
65
66	jmin = 1
67	jmax = sNy
68	imin = 1
69	imax = sNx
70
71	doglobalread = .false.
72	ladinit = .false.
73	fac = 1. _d 0
74
75	#ifdef ALLOW_GENARR2D_CONTROL
76	C-- An example of connecting specific fields
77	C-- to 3 generic 2D control arrays
78	cc--->>>
79	cc--->>> COMPILE FAILURE IS DELIBERATE
80	cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
81	cc--->>>
82	C-- generic - user-defined control vars
83	DO iarr = 1, maxCtrlArr2D
84
85	fnamebase = xx_genarr2d_file(iarr)
86	il=ILNBLNK( fnamebase )
87	write(fnamegeneric(1:80),'(2a,i10.10)')
88	& fnamebase(1:il),'.',optimcycle
89	CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
90	& doglobalread, ladinit, optimcycle,
91	& 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	#ifndef ALLOW_OPENAD
97	if ( iarr .eq. 1 ) then
98	# ifdef ALLOW_BOTTOMDRAG_CONTROL
99	bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
100	& + tmpfld2d(i,j,bi,bj)
101	# endif
102	elseif ( iarr .eq. 2 ) then
103	theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
104	& + tmpfld2d(i,j,bi,bj)
105	elseif ( iarr .eq. 3 ) then
106	salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
107	& + tmpfld2d(i,j,bi,bj)
108	endif
109	#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_OPENAD */
126	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	#endif
135	_EXCH_XYZ_RL( theta, myThid )
136	_EXCH_XYZ_RL( salt, myThid )
137
138	#endif /* ALLOW_GENARR2D_CONTROL */
139
140	#ifdef ALLOW_GENARR3D_CONTROL
141	C-- An example of connecting specific fields
142	C-- to 3 generic 3D control arrays
143	cc--->>>
144	cc--->>> COMPILE FAILURE IS DELIBERATE
145	cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
146	cc--->>>
147	C-- generic - user-defined control vars
148	DO iarr = 1, maxCtrlArr3D
149
150	fnamebase = xx_genarr3d_file(iarr)
151	il=ILNBLNK( fnamebase )
152	write(fnamegeneric(1:80),'(2a,i10.10)')
153	& fnamebase(1:il),'.',optimcycle
154	CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
155	& doglobalread, ladinit, optimcycle,
156	& 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	#ifndef ALLOW_OPENAD
163	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	#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_OPENAD */
181	enddo
182	enddo
183	enddo
184	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
193	RETURN
194	END