C $Header: /u/gcmpack/MITgcm/verification/hs94.1x64x5/code_oad/ctrl_map_gentim2d.F,v 1.4 2015/02/18 20:47:01 heimbach Exp $
C $Name: $
#include "CTRL_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
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)
CHARACTER*(MAX_LEN_MBUF) msgBuf
_RL LOCsumTile(nSx,nSy), LOCsumGlob
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 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
ENDDO
ENDDO
ENDDO
ENDDO
C
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 )
C
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
do j = 1,sNy
do i = 1,sNx
if (xx_gentim2d_cumsum(iarr)) then
xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d(i,j,bi,bj,iarr)
& +xx_gentim2d_loc(i,j,bi,bj)
else
xx_gentim2d(i,j,bi,bj,iarr)=xx_gentim2d_loc(i,j,bi,bj)
endif
enddo
enddo
enddo
enddo
C
if (xx_gentim2d_glosum(iarr)) then
LOCsumGlob=0. _d 0
DO bj=myByLo(myThid),myByHi(myThid)
DO bi=myBxLo(myThid),myBxHi(myThid)
LOCsumTile(bi,bj)=0. _d 0
do j = 1,sNy
do i = 1,sNx
LOCsumTile(bi,bj)=LOCsumTile(bi,bj)+
& maskC(i,j,1,bi,bj)*rA(i,j,bi,bj)
& *xx_gentim2d(i,j,bi,bj,iarr)
enddo
enddo
enddo
enddo
CALL GLOBAL_SUM_TILE_RL( LOCsumTile, LOCsumGlob, myThid )
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(I,J,bi,bj,iarr) =
& LOCsumGlob/globalArea*maskC(i,j,1,bi,bj)
ENDDO
ENDDO
ENDDO
ENDDO
WRITE(msgBuf,'(A,I6,A,I6,A,1PE21.14)') ' xx_gentim2d ',
& iarr,' : iter=', myiter, ' ; global sum = ', LOCsumGlob
CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
& SQUEEZE_RIGHT, myThid )
endif
DO bj = myByLo(myThid), myByHi(myThid)
DO bi = myBxLo(myThid), myBxHi(myThid)
DO J = 1-Oly,sNy+Oly
DO I = 1-Olx,sNx+Olx
if (iarr.EQ.1) then
theta(I,J,1,bi,bj) = theta(I,J,1,bi,bj)
& + xx_gentim2d(I,J,bi,bj,iarr)
endif
ENDDO
ENDDO
ENDDO
ENDDO
ENDDO
#endif /* ALLOW_GENTIM2D_CONTROL */
RETURN
END