C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_mask_set_xz.F,v 1.11 2015/03/23 21:07:37 gforget Exp $ C $Name: $ #include "CTRL_OPTIONS.h" subroutine CTRL_MASK_SET_XZ( & jp1, jNone, OB_J, nwetobcs, ymaskobcs, mythid ) c ================================================================== c SUBROUTINE ctrl_mask_set_xz c ================================================================== c c o count sliced (xz) wet points and set xz masks c c heimbach@mit.edu, 30-Aug-2001 c gebbie@mit.edu, corrected array bounds c c ================================================================== implicit none c == global variables == #include "EEPARAMS.h" #include "SIZE.h" #include "PARAMS.h" #include "GRID.h" #include "ctrl.h" #include "CTRL_OBCS.h" c == routine arguments == integer jp1, jNone integer OB_J (1-olx:snx+olx,nsx,nsy) integer nwetobcs (nsx,nsy,nr,nobcs) character*(80) ymaskobcs integer mythid c == local variables == integer bi,bj integer i,j,k integer itlo,ithi integer jtlo,jthi integer jmin,jmax integer imin,imax integer ntmp integer ivarindex integer iobcs integer il integer errio integer startrec integer endrec integer difftime(4) _RL diffsecs _RL dummy _RL maskxz (1-olx:snx+olx,nr,nsx,nsy,nobcs) _RL gg (1-olx:snx+olx,nr,nsx,nsy) character*( 80) fname c == external == integer ilnblnk external c == end of interface == jtlo = mybylo(mythid) jthi = mybyhi(mythid) itlo = mybxlo(mythid) ithi = mybxhi(mythid) jmin = 1 jmax = sny imin = 1 imax = snx _BEGIN_MASTER( myThid ) c-- Count wet points at Northern boundary. c-- mask conventions are adopted from obcs_apply_ts, obcs_apply_uv do iobcs = 1,nobcs do bj = jtlo,jthi do bi = itlo,ithi do k = 1,nr do i = 1-olx,snx+olx maskxz(i,k,bi,bj,iobcs) = 0. _d 0 enddo enddo enddo enddo enddo do iobcs = 1,nobcs do bj = jtlo,jthi do bi = itlo,ithi do k = 1,nr do i = imin,imax j = OB_J(i,bi,bj) if ( j .NE. jNone ) then c-- South mask for T, S, V if (iobcs.eq.1 .or. iobcs .eq.2 .or. iobcs.eq.3) then if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1 maskxz(i,k,bi,bj,iobcs) = 1 endif endif c-- West mask for U if (iobcs .eq. 4) then if (maskW(i,j,k,bi,bj) .eq. 1.) then nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1 maskxz(i,k,bi,bj,iobcs) = 1 endif endif endif enddo enddo enddo enddo enddo #ifdef ALLOW_AUTODIFF il=ilnblnk( ymaskobcs ) write(fname(1:80),'(80a)') ' ' write(fname(1:80),'(a)') ymaskobcs do iobcs = 1,nobcs do bj = jtlo,jthi do bi = itlo,ithi do k = 1,nr do i = imin,imax gg(i,k,bi,bj) = maskxz(i,k,bi,bj,iobcs) enddo enddo enddo enddo call ACTIVE_WRITE_XZ( fname, gg, iobcs, 0, mythid, dummy ) enddo #endif _END_MASTER( mythid ) return end