hs94.1x64x5/code_ad/ctrl_map_ini_genarr.F

C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_genarr.F,v 1.3 2012/08/10 19:38:57 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*( 80)   fnamegeneric
      _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

       il=ILNBLNK( xx_genarr2d_file(iarr) )
       write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_genarr2d_file(iarr)(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
              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
            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

       il=ILNBLNK( xx_genarr3d_file(iarr) )
       write(fnamegeneric(1:80),'(2a,i10.10)')
     &     xx_genarr3d_file(iarr)(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
              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
            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	jmc	1.4	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_genarr.F,v 1.3 2012/08/10 19:38:57 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			character*( 80) fnamegeneric
61			_RL fac
62			CEOP
63
64			jmin = 1
65	jmc	1.4	jmax = sNy
66	heimbach	1.1	imin = 1
67	jmc	1.4	imax = sNx
68	heimbach	1.1
69			doglobalread = .false.
70			ladinit = .false.
71	jmc	1.4	fac = 1. _d 0
72	heimbach	1.1
73			#ifdef ALLOW_GENARR2D_CONTROL
74	jmc	1.4	C-- An example of connecting specific fields
75			C-- to 3 generic 2D control arrays
76	heimbach	1.1	cc--->>>
77			cc--->>> COMPILE FAILURE IS DELIBERATE
78			cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
79			cc--->>>
80	jmc	1.4	C-- generic - user-defined control vars
81			DO iarr = 1, maxCtrlArr2D
82
83			il=ILNBLNK( xx_genarr2d_file(iarr) )
84	heimbach	1.1	write(fnamegeneric(1:80),'(2a,i10.10)')
85			& xx_genarr2d_file(iarr)(1:il),'.',optimcycle
86	jmc	1.4	CALL ACTIVE_READ_XY ( fnamegeneric, tmpfld2d, 1,
87	heimbach	1.1	& doglobalread, ladinit, optimcycle,
88	jmc	1.4	& myThid, xx_genarr2d_dummy(iarr) )
89			DO bj=myByLo(myThid), myByHi(myThid)
90			DO bi=myBxLo(myThid), myBxHi(myThid)
91			do j = jmin,jmax
92			do i = imin,imax
93	heimbach	1.1	if ( iarr .eq. 1 ) then
94	jmc	1.4	#ifdef ALLOW_BOTTOMDRAG_CONTROL
95	heimbach	1.1	bottomdragfld(i,j,bi,bj) = bottomdragfld(i,j,bi,bj)
96	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
97			#endif
98	heimbach	1.1	elseif ( iarr. eq. 2 ) then
99			theta(i,j,1,bi,bj) = theta(i,j,1,bi,bj)
100	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
101	heimbach	1.1	elseif ( iarr .eq. 3 ) then
102			salt(i,j,1,bi,bj) = salt(i,j,1,bi,bj)
103	jmc	1.4	& + tmpfld2d(i,j,bi,bj)
104	heimbach	1.1	endif
105	jmc	1.4	enddo
106			enddo
107			ENDDO
108			ENDDO
109			C-- end iarr loop
110			ENDDO
111			#ifdef ALLOW_BOTTOMDRAG_CONTROL
112			_EXCH_XY_RL( bottomdragfld, myThid )
113	heimbach	1.1	#endif
114	jmc	1.4	_EXCH_XYZ_RL( theta, myThid )
115			_EXCH_XYZ_RL( salt, myThid )
116
117			#endif /* ALLOW_GENARR2D_CONTROL */
118	heimbach	1.1
119			#ifdef ALLOW_GENARR3D_CONTROL
120	jmc	1.4	C-- An example of connecting specific fields
121			C-- to 3 generic 3D control arrays
122	heimbach	1.1	cc--->>>
123			cc--->>> COMPILE FAILURE IS DELIBERATE
124			cc--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
125			cc--->>>
126	jmc	1.4	C-- generic - user-defined control vars
127			DO iarr = 1, maxCtrlArr3D
128
129			il=ILNBLNK( xx_genarr3d_file(iarr) )
130	heimbach	1.1	write(fnamegeneric(1:80),'(2a,i10.10)')
131			& xx_genarr3d_file(iarr)(1:il),'.',optimcycle
132	jmc	1.4	CALL ACTIVE_READ_XYZ( fnamegeneric, tmpfld3d, 1,
133	heimbach	1.1	& doglobalread, ladinit, optimcycle,
134	jmc	1.4	& myThid, xx_genarr3d_dummy(iarr) )
135			DO bj=myByLo(myThid), myByHi(myThid)
136			DO bi=myBxLo(myThid), myBxHi(myThid)
137			do k = 1,Nr
138			do j = jmin,jmax
139			do i = imin,imax
140			if ( iarr .eq. 1 ) then
141			theta(i,j,k,bi,bj) = theta(i,j,k,bi,bj)
142			& + fac*tmpfld3d(i,j,k,bi,bj)
143			elseif ( iarr .eq. 2 ) then
144			salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
145			& + fac*tmpfld3d(i,j,k,bi,bj)
146			endif
147	heimbach	1.1	enddo
148	jmc	1.4	enddo
149	heimbach	1.1	enddo
150	jmc	1.4	ENDDO
151			ENDDO
152			C-- end iarr loop
153			ENDDO
154			_EXCH_XYZ_RL( theta, myThid )
155			_EXCH_XYZ_RL( salt, myThid )
156
157			#endif /* ALLOW_GENARR3D_CONTROL */
158	heimbach	1.1
159	jmc	1.4	RETURN
160			END