pkg/grdchk/grdchk_get_obcs_mask.F

9c7e07a4e1 Jean*0001 #include "GRDCHK_OPTIONS.h"
a7eff9e819 Jean*0002 #ifdef ALLOW_CTRL
                0003 # include "CTRL_OPTIONS.h"
                0004 #endif
7109a141b2 Patr*0005
                0006       subroutine grdchk_get_obcs_mask( mythid )
                0007
                0008 c     ==================================================================
                0009 c     SUBROUTINE grdchk_get_obcs_mask
                0010 c     ==================================================================
                0011 c
                0012 c     o Get obcs masks from file
                0013 c
                0014 c     started: heimbach@mit.edu: 22-Apr-2003
                0015 c
                0016 c     ==================================================================
                0017 c     SUBROUTINE grdchk_get_obcs_mask
                0018 c     ==================================================================
                0019
5cf4364659 Mart*0020       IMPLICIT NONE
7109a141b2 Patr*0021
                0022 c     == global variables ==
                0023
                0024 #include "EEPARAMS.h"
                0025 #include "SIZE.h"
                0026 #include "GRID.h"
5cf4364659 Mart*0027 #include "CTRL_SIZE.h"
4d72283393 Mart*0028 #include "CTRL.h"
444da61630 Mart*0029 #ifdef ALLOW_OBCS_CONTROL
                0030 C     CTRL_OBCS.h must be included before GRDCHK.h
                0031 # include "CTRL_OBCS.h"
                0032 #endif
                0033 #include "GRDCHK.h"
7109a141b2 Patr*0034
                0035 c     == routine arguments ==
                0036       integer mythid
                0037
444da61630 Mart*0038 #if (defined ALLOW_GRDCHK && defined ALLOW_OBCS_CONTROL)
7109a141b2 Patr*0039 c     == local variables ==
                0040       integer bi,bj
                0041       integer i,j,k
9f5240b52a Jean*0042       integer iobcs
7109a141b2 Patr*0043       integer itlo,ithi
                0044       integer jtlo,jthi
                0045       integer jmin,jmax
                0046       integer imin,imax
                0047       _RL dummy
7aa90384e1 Mart*0048 #if (defined ALLOW_OBCSN_CONTROL || defined ALLOW_OBCSS_CONTROL)
                0049       _RL tmpfldxz (1-olx:snx+olx,nr,nsx,nsy)
9c7e07a4e1 Jean*0050 #endif
7aa90384e1 Mart*0051 #if (defined ALLOW_OBCSE_CONTROL || defined ALLOW_OBCSW_CONTROL)
                0052       _RL tmpfldyz (1-oly:sny+oly,nr,nsx,nsy)
                0053 #endif
de57a2ec4b Mart*0054       character*(MAX_LEN_FNAM) fname
7109a141b2 Patr*0055
                0056 c     == end of interface ==
                0057
                0058       jtlo = 1
                0059       jthi = nsy
                0060       itlo = 1
                0061       ithi = nsx
                0062       jmin = 1
                0063       jmax = sny
                0064       imin = 1
                0065       imax = snx
                0066
                0067       _BEGIN_MASTER( mythid )
                0068
5cf4364659 Mart*0069       IF ( ncvargrd(grdchkvarindex) .EQ. 'm' ) THEN
                0070        IF ( ncvarindex(grdchkvarindex).EQ.1 ) THEN
7109a141b2 Patr*0071 #ifdef ALLOW_OBCSN_CONTROL
5cf4364659 Mart*0072         write(fname,'(a)') 'maskobcsn'
                0073         do iobcs = 1,nobcs
7e8f0fc151 Patr*0074          call active_read_xz(  fname, tmpfldxz, iobcs,
7109a141b2 Patr*0075      &        .false., .false., 0, mythid, dummy)
                0076          do bj = jtlo,jthi
5cf4364659 Mart*0077           do bi = itlo,ithi
                0078            do k = 1,nr
                0079             do i = imin,imax
                0080               grdchk_maskxz(i,k,bi,bj,iobcs) = tmpfldxz(i,k,bi,bj)
7109a141b2 Patr*0081             enddo
5cf4364659 Mart*0082            enddo
                0083           enddo
7109a141b2 Patr*0084          enddo
5cf4364659 Mart*0085         enddo
7109a141b2 Patr*0086 #endif
                0087
5cf4364659 Mart*0088        ELSEIF ( ncvarindex(grdchkvarindex).EQ.2 ) THEN
7109a141b2 Patr*0089 #ifdef ALLOW_OBCSS_CONTROL
5cf4364659 Mart*0090         write(fname,'(a)') 'maskobcss'
7109a141b2 Patr*0091 c
5cf4364659 Mart*0092         do iobcs = 1,nobcs
7e8f0fc151 Patr*0093          call active_read_xz(  fname, tmpfldxz, iobcs,
7109a141b2 Patr*0094      &        .false., .false., 0, mythid, dummy)
                0095          do bj = jtlo,jthi
5cf4364659 Mart*0096           do bi = itlo,ithi
                0097            do k = 1,nr
                0098             do i = imin,imax
                0099               grdchk_maskxz(i,k,bi,bj,iobcs) = tmpfldxz(i,k,bi,bj)
7109a141b2 Patr*0100             enddo
5cf4364659 Mart*0101            enddo
                0102           enddo
7109a141b2 Patr*0103          enddo
5cf4364659 Mart*0104         enddo
7109a141b2 Patr*0105 #endif
                0106
5cf4364659 Mart*0107        ELSEIF ( ncvarindex(grdchkvarindex).EQ.3 ) THEN
                0108 #ifdef ALLOW_OBCSE_CONTROL
                0109         write(fname,'(a)') 'maskobcse'
                0110         do iobcs = 1,nobcs
7e8f0fc151 Patr*0111          call active_read_yz(  fname, tmpfldyz, iobcs,
7109a141b2 Patr*0112      &        .false., .false., 0, mythid, dummy)
                0113          do bj = jtlo,jthi
5cf4364659 Mart*0114           do bi = itlo,ithi
                0115            do k = 1,nr
                0116             do j = jmin,jmax
                0117                grdchk_maskyz(j,k,bi,bj,iobcs) = tmpfldyz(j,k,bi,bj)
7109a141b2 Patr*0118             enddo
5cf4364659 Mart*0119            enddo
                0120           enddo
7109a141b2 Patr*0121          enddo
5cf4364659 Mart*0122         enddo
7109a141b2 Patr*0123 #endif
                0124
5cf4364659 Mart*0125        ELSEIF ( ncvarindex(grdchkvarindex).EQ.4 ) THEN
                0126 #ifdef ALLOW_OBCSW_CONTROL
                0127         write(fname,'(a)') 'maskobcsw'
                0128         do iobcs = 1,nobcs
7e8f0fc151 Patr*0129          call active_read_yz(  fname, tmpfldyz, iobcs,
7109a141b2 Patr*0130      &        .false., .false., 0, mythid, dummy)
                0131          do bj = jtlo,jthi
5cf4364659 Mart*0132           do bi = itlo,ithi
                0133            do k = 1,nr
                0134             do j = jmin,jmax
                0135               grdchk_maskyz(j,k,bi,bj,iobcs) = tmpfldyz(j,k,bi,bj)
7109a141b2 Patr*0136             enddo
5cf4364659 Mart*0137            enddo
                0138           enddo
7109a141b2 Patr*0139          enddo
5cf4364659 Mart*0140         enddo
7109a141b2 Patr*0141 #endif
5cf4364659 Mart*0142
                0143        ENDIF
                0144       ENDIF
7109a141b2 Patr*0145
                0146       _END_MASTER( mythid )
                0147
                0148       _BARRIER
                0149
edd57506ae Patr*0150 #endif /* ALLOW_GRDCHK */
7109a141b2 Patr*0151
5cf4364659 Mart*0152       RETURN
                0153       END