C $Header: /u/gcmpack/MITgcm/verification/halfpipe_streamice/code_ad/ctrl_map_gentim2d.F,v 1.2 2015/01/30 21:45:13 heimbach Exp $
C $Name: $
#include "CTRL_OPTIONS.h"
#include "STREAMICE_OPTIONS.h"
CBOP
C !ROUTINE: CTRL_MAP_GENTIM2D
C !INTERFACE:
SUBROUTINE CTRL_MAP_GENTIM2D(
I myTime, myIter, myThid )
C !DESCRIPTION: \bv
C *=============================================================*
C | S/R CTRL_MAP_GENTIM2D
C *=============================================================*
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_SIZE.h"
#include "ctrl.h"
#include "CTRL_GENARR.h"
#include "ctrl_dummy.h"
#include "optim.h"
#ifdef ALLOW_AUTODIFF
#include "AUTODIFF_MYFIELDS.h"
#endif
#ifdef ALLOW_STREAMICE
#include "STREAMICE.h"
#endif
C !INPUT/OUTPUT PARAMETERS:
C === Routine arguments ===
C myIter :: iteration counter for this thread
C myTime :: time counter for this thread
C myThid :: thread number for this instance of the routine.
_RL myTime
INTEGER myIter
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
integer iarr
logical equal
logical doglobalread
logical ladinit
character*(MAX_LEN_FNAM) fnamebase
character*( 80) fnamegeneric
_RL fac
_RL xx_gentim2d_loc(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
_RL genweight(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
c == external ==
integer ilnblnk
external
CEOP
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#ifdef ALLOW_GENTIM2D_CONTROL
C-- An example of connecting specific fields
C-- to generic time-varying 2D control arrays
cph--->>>
cph--->>> COMPILE FAILURE IS DELIBERATE
cph--->>> BE SURE WHAT YOU ARE DOING AND CUSTOMIZE <<<---
cph--->>>
C-- generic - user-defined control vars
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO J = 1-Oly,sNy+Oly
DO I = 1-Olx,sNx+Olx
bdot_streamice(i,j,bi,bj) = 0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
DO iarr = 1, maxCtrlTim2D
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO J = 1-Oly,sNy+Oly
DO I = 1-Olx,sNx+Olx
xx_gentim2d_loc(I,J,bi,bj) = 0. _d 0
! bdot_streamice(i,j,bi,bj) = 0. _d 0
ENDDO
ENDDO
ENDDO
ENDDO
C
! CALL CTRL_GET_GEN (
! I xx_gentim2d_file(iarr)(1:MAX_LEN_FNAM),
! I xx_gentim2d_startdate(1,iarr),
! I xx_gentim2d_period(iarr),
! I maskC,
! O xx_gentim2d_loc,
! I xx_gentim2d0(1-Olx,1-Oly,1,1,iarr),
! I xx_gentim2d1(1-Olx,1-Oly,1,1,iarr),
! I xx_gentim2d_dummy(iarr),
! I zeroRL, zeroRL,
! I mytime, myiter, mythid )
! CALL CTRL_GET_GEN (
! I xx_gentim2d_file(iarr)(1:MAX_LEN_FNAM),
! I xx_gentim2d_startdate(1,iarr),
! I xx_gentim2d_period(iarr),
! I maskC,
! O xx_gentim2d_loc,
! I xx_gentim2d0(1-Olx,1-Oly,1,1,iarr),
! I xx_gentim2d1(1-Olx,1-Oly,1,1,iarr),
! I xx_gentim2d_dummy(iarr),
! I zeroRL, zeroRL, genweight,
! I mytime, myiter, mythid )
fnamebase = xx_gentim2d_file(iarr)
CALL CTRL_GET_GEN (
I xx_gentim2d_file(iarr),
I xx_gentim2d_startdate(1,iarr),
I xx_gentim2d_period(iarr),
I maskC,
O xx_gentim2d_loc,
I xx_gentim2d0(1-Olx,1-Oly,1,1,iarr),
I xx_gentim2d1(1-Olx,1-Oly,1,1,iarr),
I xx_gentim2d_dummy(iarr),
I zeroRL, zeroRL,
I wgentim2d(1-Olx,1-Oly,1,1,iarr),
I mytime, myiter, mythid )
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
do j = 1,sNy
do i = 1,sNx
xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
enddo
enddo
enddo
enddo
C
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO J = 1,sNy
DO I = 1,sNx
if ( iarr .eq. 1 ) then
bdot_streamice(i,j,bi,bj) =
& bdot_streamice(i,j,bi,bj)+
& xx_gentim2d(i,j,bi,bj,iarr)
endif
enddo
enddo
enddo
enddo
c--
! CALL EXCH_XY_RL
! & (streamice_v_shear_pert, myThid)
! CALL EXCH_XY_RL
! & (streamice_u_shear_pert, myThid)
! CALL EXCH_XY_RL
! & (streamice_v_normal_pert, myThid)
! CALL EXCH_XY_RL
! & (streamice_u_normal_pert, myThid)
_EXCH_XY_RL(bdot_streamice, mythid )
c--
ENDDO ! iarr
#endif /* ALLOW_GENTIM2D_CONTROL */
RETURN
END