C $Header: /u/gcmpack/MITgcm/verification/halfpipe_streamice/code_oad/ctrl_map_ini_genarr.F,v 1.3 2015/01/30 19:19:19 heimbach Exp $
C $Name: $
#include "CTRL_OPTIONS.h"
#include "STREAMICE_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
#ifdef ALLOW_STREAMICE
# include "STREAMICE.h"
#endif
C !INPUT/OUTPUT PARAMETERS:
C == routine arguments ==
INTEGER myThid
C !FUNCTIONS:
INTEGER ILNBLNk
EXTERNAL
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
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
if ( iarr .eq. 2 ) then
H_streamice(i,j,bi,bj) =
& H_streamice(i,j,bi,bj)
& + tmpfld2d(i,j,bi,bj)
#ifdef ALLOW_OPENAD
cph & + xx_genarr2d(i,j,bi,bj,iarr)
#endif
elseif (iarr.eq.1) then
B_glen(i,j,bi,bj) =
& B_glen(i,j,bi,bj)
& + tmpfld2d(i,j,bi,bj)
#ifdef ALLOW_OPENAD
cph & + xx_genarr2d(i,j,bi,bj,iarr)
#endif
! elseif (iarr.eq.5) then
! BDOT_streamice(i,j,bi,bj) =
! & BDOT_streamice(i,j,bi,bj)
! & + tmpfld2d(i,j,bi,bj)
endif
enddo
enddo
ENDDO
ENDDO
C-- end iarr loop
ENDDO
_EXCH_XY_RL( H_streamice, myThid )
_EXCH_XY_RL( R_low_si, myThid )
_EXCH_XY_RL( C_basal_friction, myThid )
#endif /* ALLOW_GENARR2D_CONTROL */
#ifdef ALLOW_GENARR3D_CONTROL
C-- An example of connecting specific fields
C-- to 3 generic 3D control arrays
---
--- COMPILE FAILURE IS DELIBERATE
--- BE SURE WHAT YOU ARE DOING AND CUSTOMIZE ---
---
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
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)
elseif ( iarr .eq. 3 ) then
#ifdef ALLOW_DIFFKR_CONTROL
diffkr(i,j,k,bi,bj) = diffkr(i,j,k,bi,bj)
& + tmpfld3d(i,j,k,bi,bj)
#endif
endif
enddo
enddo
enddo
ENDDO
ENDDO
C-- end iarr loop
ENDDO
_EXCH_XYZ_RL( theta, myThid )
_EXCH_XYZ_RL( salt, myThid )
#ifdef ALLOW_DIFFKR_CONTROL
_EXCH_XYZ_RL( diffkr, myThid )
#endif
#endif /* ALLOW_GENARR3D_CONTROL */
RETURN
END