C $Header: /u/gcmpack/MITgcm/pkg/grdchk/grdchk_init.F,v 1.14 2014/10/09 00:50:54 gforget Exp $
C $Name: $
#include "GRDCHK_OPTIONS.h"
#ifdef ALLOW_CTRL
# include "CTRL_OPTIONS.h"
#endif
subroutine GRDCHK_INIT( mythid )
c ==================================================================
c SUBROUTINE grdchk_init
c ==================================================================
c
c o Get the location of a given component of the control vector for
c the current process.
c
c started: Christian Eckert eckert@mit.edu 04-Apr-2000
c continued: heimbach@mit.edu: 13-Jun-2001
c
c ==================================================================
c SUBROUTINE grdchk_init
c ==================================================================
implicit none
c == global variables ==
#include "EEPARAMS.h"
#include "SIZE.h"
#include "GRID.h"
#include "ctrl.h"
#include "CTRL_OBCS.h"
#include "grdchk.h"
c == routine arguments ==
integer mythid
#ifdef ALLOW_GRDCHK
c == local variables ==
integer bi,bj
integer i,j,k
integer irec
integer itlo,ithi
integer jtlo,jthi
integer jmin,jmax
integer imin,imax
integer itest,iobcs
integer icomptest
c == end of interface ==
jtlo = 1
jthi = nsy
itlo = 1
ithi = nsx
jmin = 1
jmax = sny
imin = 1
imax = snx
_BEGIN_MASTER( mythid )
c-- initialise
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
do iobcs = 1, nobcs
nwettile(bi,bj,k,iobcs) = 0
enddo
enddo
enddo
enddo
c-- Determine the number of components of the given
c-- control variable on the current tile.
if ( ncvargrd(grdchkvarindex) .eq. 'c' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
nwettile(bi,bj,k,1) = nwetctile(bi,bj,k)
enddo
enddo
enddo
else if ( ncvargrd(grdchkvarindex) .eq. 's' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
nwettile(bi,bj,k,1) = nwetstile(bi,bj,k)
enddo
enddo
enddo
else if ( ncvargrd(grdchkvarindex) .eq. 'w' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
nwettile(bi,bj,k,1) = nwetwtile(bi,bj,k)
enddo
enddo
enddo
else if ( ncvargrd(grdchkvarindex) .eq. 'v' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
nwettile(bi,bj,k,1) = nwetvtile(bi,bj,k)
enddo
enddo
enddo
#ifdef ALLOW_SHIFWFLX_CONTROL
else if ( ncvargrd(grdchkvarindex) .eq. 'i' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
nwettile(bi,bj,k,1) = nwetitile(bi,bj,k)
enddo
enddo
enddo
#endif /* ALLOW_SHIFWFLX_CONTROL */
else if ( ncvargrd(grdchkvarindex) .eq. 'm' ) then
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
do iobcs = 1, nobcs
if ( grdchkvarindex .eq. 11 ) then
#ifdef ALLOW_OBCSN_CONTROL
nwettile(bi,bj,k,iobcs) =
& nwetobcsn(bi,bj,k,iobcs)
#endif
else if ( grdchkvarindex .eq. 12 ) then
#ifdef ALLOW_OBCSS_CONTROL
nwettile(bi,bj,k,iobcs) =
& nwetobcss(bi,bj,k,iobcs)
#endif
else if ( grdchkvarindex .eq. 13 ) then
#ifdef ALLOW_OBCSW_CONTROL
nwettile(bi,bj,k,iobcs) =
& nwetobcsw(bi,bj,k,iobcs)
#endif
else if ( grdchkvarindex .eq. 14 ) then
#ifdef ALLOW_OBCSE_CONTROL
nwettile(bi,bj,k,iobcs) =
& nwetobcse(bi,bj,k,iobcs)
#endif
endif
enddo
enddo
enddo
enddo
else
ce --> wrong grid specification for the control variable.
endif
c-- get mask file for obcs
#ifdef ALLOW_OBCS_CONTROL
call GRDCHK_GET_OBCS_MASK ( mythid )
#endif
c ----------------------------------------------------------------
c-- Determine the actual and the maximum possible number of
c-- components of the given control variable.
ncvarcomp = 0
maxncvarcomps = 0
do bj = jtlo,jthi
do bi = itlo,ithi
do k = 1,ncvarnrmax(grdchkvarindex)
do iobcs = 1, nobcs
ncvarcomp = ncvarcomp + nwettile(bi,bj,k,iobcs)
maxncvarcomps = maxncvarcomps +
& ncvarxmax(grdchkvarindex)*
& ncvarymax(grdchkvarindex)
enddo
enddo
enddo
enddo
ncvarcomp = ncvarcomp*ncvarrecs(grdchkvarindex)
maxncvarcomps = maxncvarcomps*ncvarrecs(grdchkvarindex)
do bj = jtlo,jthi
do bi = itlo,ithi
iwetsum(bi,bj,0) = 0
do k = 1,ncvarnrmax(grdchkvarindex)
iwetsum(bi,bj,k) = iwetsum(bi,bj,k-1) +
& nwettile(bi,bj,k,1)
enddo
enddo
enddo
_END_MASTER( mythid )
_BARRIER
#endif /* ALLOW_GRDCHK */
return
end