pkg/ctrl/ctrl_mask_set_yz.F

7bfe6112e8 Jean*0001 #include "CTRL_OPTIONS.h"
5d5c0b0d52 Patr*0002
951926fb9b Jean*0003       subroutine ctrl_mask_set_yz(
de57a2ec4b Mart*0004      &     ip1, iNone, OB_I, nwetobcs, ymaskobcs, myThid )
5d5c0b0d52 Patr*0005
                0006 c     ==================================================================
                0007 c     SUBROUTINE ctrl_mask_set_yz
                0008 c     ==================================================================
                0009 c
                0010 c     o count sliced (yz) wet points and set yz 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 ip1, iNone
de57a2ec4b Mart*0032       integer OB_I     (1-OLy:sNy+OLy,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     maskyz   (1-OLy:sNy+OLy,Nr,nSx,nSy,nobcs)
                0048       _RL     gg       (1-OLy:sNy+OLy,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
                0068
7109a141b2 Patr*0069       do iobcs = 1,nobcs
                0070         do bj = jtlo,jthi
                0071           do bi = itlo,ithi
de57a2ec4b Mart*0072             do k = 1,Nr
                0073               do j = 1-OLy,sNy+OLy
5d5c0b0d52 Patr*0074                 maskyz(j,k,bi,bj,iobcs) = 0. _d 0
                0075               enddo
                0076             enddo
                0077           enddo
                0078         enddo
                0079       enddo
                0080
7109a141b2 Patr*0081       do iobcs = 1,nobcs
                0082         do bj = jtlo,jthi
                0083           do bi = itlo,ithi
de57a2ec4b Mart*0084             do k = 1,Nr
                0085               do j = 1,sNy
9fdf964eb3 Jean*0086                 i = OB_I(j,bi,bj)
                0087                 if ( i .NE. iNone ) then
7109a141b2 Patr*0088 c--               West mask for T, S, U on East/West boundaries.
                0089                   if(iobcs .eq.1 .or. iobcs .eq.2 .or. iobcs .eq.3) then
                0090                     if (maskW(i+ip1,j,k,bi,bj) .ne. 0.) then
                0091                       nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1
                0092                       maskyz(j,k,bi,bj,iobcs) = 1
                0093                     endif
5d5c0b0d52 Patr*0094                   endif
                0095 c--               South mask for V
7109a141b2 Patr*0096                   if (iobcs .eq. 4) then
                0097                     if (maskS(i,j,k,bi,bj) .eq. 1.) then
                0098                       nwetobcs(bi,bj,k,iobcs) =nwetobcs(bi,bj,k,iobcs)+1
                0099                       maskyz(j,k,bi,bj,iobcs) = 1
                0100                     endif
5d5c0b0d52 Patr*0101                   endif
                0102                 endif
7109a141b2 Patr*0103               enddo
5d5c0b0d52 Patr*0104             enddo
                0105           enddo
                0106         enddo
                0107       enddo
                0108
1c8d09be4c Gael*0109 #ifdef ALLOW_AUTODIFF
5d5c0b0d52 Patr*0110       il=ilnblnk( ymaskobcs )
de57a2ec4b Mart*0111       write(fname,'(a)') ymaskobcs
5d5c0b0d52 Patr*0112
                0113       do iobcs = 1,nobcs
                0114         do bj = jtlo,jthi
                0115           do bi = itlo,ithi
de57a2ec4b Mart*0116             do k = 1,Nr
                0117               do j = 1,sNy
5d5c0b0d52 Patr*0118                  gg(j,k,bi,bj) = maskyz(j,k,bi,bj,iobcs)
                0119               enddo
                0120             enddo
                0121           enddo
                0122         enddo
de57a2ec4b Mart*0123         call active_write_yz( fname, gg, iobcs, 0, myThid, dummy)
5d5c0b0d52 Patr*0124       enddo
1c8d09be4c Gael*0125 #endif
5d5c0b0d52 Patr*0126
de57a2ec4b Mart*0127       _END_MASTER( myThid )
5d5c0b0d52 Patr*0128
                0129       return
                0130       end