pkg/ctrl/ctrl_mask_set_xz.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
951926fb9b Jean*0003       subroutine ctrl_mask_set_xz(
de57a2ec4b Mart*0004      &     jp1, jNone, OB_J, nwetobcs, ymaskobcs, myThid )
5d5c0b0d52 Patr*0005
                0006 c     ==================================================================
                0007 c     SUBROUTINE ctrl_mask_set_xz
                0008 c     ==================================================================
                0009 c
                0010 c     o count sliced (xz) wet points and set xz masks
951926fb9b Jean*0011 c
5d5c0b0d52 Patr*0012 c     heimbach@mit.edu, 30-Aug-2001
                0013 c     gebbie@mit.edu, corrected array bounds
                0014 c
                0015 c     ==================================================================
                0016
                0017       implicit none
                0018
                0019 c     == global variables ==
                0020
                0021 #include "EEPARAMS.h"
                0022 #include "SIZE.h"
                0023 #include "PARAMS.h"
                0024 #include "GRID.h"
5cf4364659 Mart*0025 #include "CTRL_SIZE.h"
4d72283393 Mart*0026 #include "CTRL.h"
e612621177 Gael*0027 #include "CTRL_OBCS.h"
5d5c0b0d52 Patr*0028
                0029 c     == routine arguments ==
                0030
9fdf964eb3 Jean*0031       integer jp1, jNone
de57a2ec4b Mart*0032       integer OB_J     (1-OLx:sNx+OLx,nSx,nSy)
                0033       integer nwetobcs (nSx,nSy,Nr,nobcs)
                0034       character*(MAX_LEN_FNAM)   ymaskobcs
                0035       integer myThid
5d5c0b0d52 Patr*0036
                0037 c     == local variables ==
                0038
                0039       integer bi,bj
                0040       integer i,j,k
                0041       integer itlo,ithi
                0042       integer jtlo,jthi
                0043
                0044       integer iobcs
                0045       integer il
                0046       _RL     dummy
de57a2ec4b Mart*0047       _RL     maskxz   (1-OLx:sNx+OLx,Nr,nSx,nSy,nobcs)
                0048       _RL     gg       (1-OLx:sNx+OLx,Nr,nSx,nSy)
5d5c0b0d52 Patr*0049
de57a2ec4b Mart*0050       character*(MAX_LEN_FNAM)   fname
5d5c0b0d52 Patr*0051
                0052 c     == external ==
                0053
                0054       integer  ilnblnk
                0055       external ilnblnk
                0056
                0057 c     == end of interface ==
                0058
de57a2ec4b Mart*0059       jtlo = myByLo(myThid)
                0060       jthi = myByHi(myThid)
                0061       itlo = myBxLo(myThid)
                0062       ithi = myBxHi(myThid)
5d5c0b0d52 Patr*0063
                0064       _BEGIN_MASTER( myThid )
                0065
                0066 c--   Count wet points at Northern boundary.
                0067 c--   mask conventions are adopted from obcs_apply_ts, obcs_apply_uv
7109a141b2 Patr*0068       do iobcs = 1,nobcs
                0069         do bj = jtlo,jthi
7c50f07931 Mart*0070           do bi = itlo,ithi
de57a2ec4b Mart*0071             do k = 1,Nr
                0072               do i = 1-OLx,sNx+OLx
5d5c0b0d52 Patr*0073                 maskxz(i,k,bi,bj,iobcs) = 0. _d 0
                0074               enddo
                0075             enddo
                0076           enddo
                0077         enddo
                0078       enddo
                0079
7109a141b2 Patr*0080       do iobcs = 1,nobcs
                0081         do bj = jtlo,jthi
                0082           do bi = itlo,ithi
de57a2ec4b Mart*0083             do k = 1,Nr
                0084               do i = 1,sNx
9fdf964eb3 Jean*0085                 j = OB_J(i,bi,bj)
                0086                 if ( j .NE. jNone ) then
7109a141b2 Patr*0087 c--               South mask for T, S, V
                0088                   if (iobcs.eq.1 .or. iobcs .eq.2 .or. iobcs.eq.3) then
                0089                     if (maskS(i,j+jp1,k,bi,bj) .ne. 0.) then
                0090                       nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1
                0091                       maskxz(i,k,bi,bj,iobcs) = 1
                0092                     endif
5d5c0b0d52 Patr*0093                   endif
                0094 c--               West mask for U
7109a141b2 Patr*0095                   if (iobcs .eq. 4) then
                0096                     if (maskW(i,j,k,bi,bj) .eq. 1.) then
                0097                       nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1
                0098                       maskxz(i,k,bi,bj,iobcs) = 1
                0099                     endif
5d5c0b0d52 Patr*0100                   endif
                0101                 endif
7109a141b2 Patr*0102               enddo
5d5c0b0d52 Patr*0103             enddo
                0104           enddo
                0105         enddo
                0106       enddo
                0107
1c8d09be4c Gael*0108 #ifdef ALLOW_AUTODIFF
5d5c0b0d52 Patr*0109       il=ilnblnk( ymaskobcs )
de57a2ec4b Mart*0110       write(fname,'(a)') ymaskobcs
5d5c0b0d52 Patr*0111
                0112       do iobcs = 1,nobcs
                0113         do bj = jtlo,jthi
                0114           do bi = itlo,ithi
de57a2ec4b Mart*0115             do k = 1,Nr
                0116               do i = 1,sNx
5d5c0b0d52 Patr*0117                  gg(i,k,bi,bj) = maskxz(i,k,bi,bj,iobcs)
                0118               enddo
                0119             enddo
                0120           enddo
                0121         enddo
de57a2ec4b Mart*0122         call active_write_xz( fname, gg, iobcs, 0, myThid, dummy )
5d5c0b0d52 Patr*0123       enddo
1c8d09be4c Gael*0124 #endif
5d5c0b0d52 Patr*0125
de57a2ec4b Mart*0126       _END_MASTER( myThid )
5d5c0b0d52 Patr*0127
                0128       return
                0129       end