mod_obcs2.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

MODULE mod_obcs2

   USE all_vars
   USE mod_prec
   USE mod_obcs
   USE mod_types
   USE bcs

   USE mod_meanflow

   IMPLICIT NONE
   SAVE

   INTEGER              :: nobe,nobcv
   INTEGER,ALLOCATABLE  :: nobedge_lst(:),cobedge_lst(:)
   INTEGER,ALLOCATABLE  :: i_obc_cell(:),i_obc_node(:),i_obc_cell2(:),i_obc_node2(:)
   REAL(sp),ALLOCATABLE :: uatts(:,:),vatts(:,:),utts(:,:,:),vtts(:,:,:),eltts(:,:)

   REAL(sp),ALLOCATABLE :: elt(:), eltf(:), elrkt(:), eltdt(:)
   REAL(sp),ALLOCATABLE :: elp(:), elpf(:), elrkp(:)
   REAL(sp),ALLOCATABLE :: uat(:), vat(:), uatf(:), vatf(:)
   REAL(sp),ALLOCATABLE :: uap(:), vap(:)

   REAL(sp),ALLOCATABLE :: uant (:), vant (:), uan (:), van (:)
   REAL(sp),ALLOCATABLE :: uanp (:), vanp (:)

   REAL(sp),ALLOCATABLE :: ut(:,:),   vt(:,:)
   REAL(sp),ALLOCATABLE :: unt(:,:),  vnt(:,:),  un(:,:),  vn(:,:)

   REAL(sp),ALLOCATABLE :: uapf  (:), vapf  (:)
   REAL(sp),ALLOCATABLE :: uantf (:), vantf (:), uanf (:), vanf (:)
   REAL(sp),ALLOCATABLE :: uanpf (:), vanpf (:)
   REAL(sp),ALLOCATABLE :: uarknt(:), varknt(:), uarkn(:), varkn(:)
   REAL(sp),ALLOCATABLE :: untb(:,:), vntb(:,:), unb(:,:), vnb(:,:)

   INTEGER              :: ntidecell_gl, ntidecell, ntidecell_i
   INTEGER              :: ntidenode_gl, ntidenode, ntidenode_i
   INTEGER, ALLOCATABLE :: i_tidenode_gl(:),i_tidenode_n(:)
   INTEGER, ALLOCATABLE :: i_tidecell_gl(:),i_tidecell_n(:)

   REAL(sp),ALLOCATABLE :: dltn(:)
   INTEGER :: ios
   CONTAINS

!=========================================================================|
   SUBROUTINE alloc_obc2_data

   IMPLICIT NONE

   ALLOCATE(elt(0:ntidenode));                 elt           = zero
   ALLOCATE(eltf(0:ntidenode));                 eltf          = zero
   ALLOCATE(elrkt(0:ntidenode));                 elrkt         = zero
   ALLOCATE(eltdt(0:ntidenode));                 eltdt         = zero
   ALLOCATE(elp(0:ntidenode));                 elp           = zero
   ALLOCATE(elpf(0:ntidenode));                 elpf          = zero
   ALLOCATE(elrkp(0:ntidenode));                 elrkp         = zero
   ALLOCATE(uat(0:ntidecell));                 uat           = zero
   ALLOCATE(vat(0:ntidecell));                 vat           = zero
   ALLOCATE(uatf(0:ntidecell));                 uatf          = zero
   ALLOCATE(vatf(0:ntidecell));                 vatf          = zero
   ALLOCATE(uap(0:ntidecell));                 uap           = zero
   ALLOCATE(vap(0:ntidecell));                 vap           = zero
   ALLOCATE(uant(0:  nmfcell));                 uant          = zero
   ALLOCATE(vant(0:  nmfcell));                 vant          = zero
   ALLOCATE(uan(0:  nmfcell));                 uan           = zero
   ALLOCATE(van(0:  nmfcell));                 van           = zero
   ALLOCATE(uanp(0:  nmfcell));                 uanp          = zero
   ALLOCATE(vanp(0:  nmfcell));                 vanp          = zero
   ALLOCATE(ut(0:ntidecell,1:kbm1));          ut            = zero
   ALLOCATE(vt(0:ntidecell,1:kbm1));          vt            = zero
   ALLOCATE(unt(0:  nmfcell,1:kbm1));          unt           = zero
   ALLOCATE(vnt(0:  nmfcell,1:kbm1));          vnt           = zero
   ALLOCATE(un(0:  nmfcell,1:kbm1));          un            = zero
   ALLOCATE(vn(0:  nmfcell,1:kbm1));          vn            = zero

   ALLOCATE(uapf(0:ntidecell));                 uapf          = zero
   ALLOCATE(vapf(0:ntidecell));                 vapf          = zero
   ALLOCATE(uantf(0:  nmfcell));                 uantf         = zero
   ALLOCATE(vantf(0:  nmfcell));                 vantf         = zero
   ALLOCATE(uanf(0:  nmfcell));                 uanf          = zero
   ALLOCATE(vanf(0:  nmfcell));                 vanf          = zero
   ALLOCATE(uanpf(0:  nmfcell));                 uanpf         = zero
   ALLOCATE(vanpf(0:  nmfcell));                 vanpf         = zero
   ALLOCATE(uarknt(0:  nmfcell));               uarknt        = zero
   ALLOCATE(varknt(0:  nmfcell));               varknt        = zero
   ALLOCATE(uarkn(0:  nmfcell));               uarkn         = zero
   ALLOCATE(varkn(0:  nmfcell));               varkn         = zero
   ALLOCATE(untb(0:  nmfcell,1:kbm1));          untb          = zero
   ALLOCATE(vntb(0:  nmfcell,1:kbm1));          vntb          = zero
   ALLOCATE(unb(0:  nmfcell,1:kbm1));          unb           = zero
   ALLOCATE(vnb(0:  nmfcell,1:kbm1));          vnb           = zero

   RETURN
   END SUBROUTINE alloc_obc2_data
!==========================================================================|

!========================================================================
     SUBROUTINE find_obside
     USE all_vars
     IMPLICIT NONE
     INTEGER :: I,ITMP,J,J1,I1,IERR
     INTEGER :: IA,IB
     INTEGER,ALLOCATABLE :: TEMP(:)
     INTEGER,ALLOCATABLE :: NODE_OB(:),CELL_OB(:)
     INTEGER              :: k,NCNT,itemp
     INTEGER, ALLOCATABLE :: temp1(:)
     REAL(SP),ALLOCATABLE :: RTEMP1(:,:),RTEMP2(:,:),RTEMP3(:,:,:),RTEMP4(:,:,:)
     INTEGER              :: i2,i3,ii,JN
     REAL(SP):: DELTX,DELTY,XTMP1,YTMP1,AA1,BB1,CC1,AA2,BB2,CC2
     REAL(SP)::TTIME
     ALLOCATE(node_ob(0:mt)); node_ob = 0
     ALLOCATE(cell_ob(0:nt)); cell_ob = 0
!-----------------------------------Jianzhong-------------------------!
!     DO I1=1,IOBCN
!       J=I_OBC_N(I1)
!       J1=NEXT_OBC(I1)
!       NODE_OB(J) = 1
!       DO I=1,NTVE(J)
!         CELL_OB(NBVE(J,I)) = 1
!       END DO
!     END DO  
     DO i1=1,ibcn(2)
       jn = obc_lst(2,i1)
       j=i_obc_n(jn)
       node_ob(j) = 1
       DO i=1,ntve(j)
         cell_ob(nbve(j,i)) = 1
       END DO
     END DO 
!---------------------------------------------------------------------! 

     ALLOCATE(temp(ne));  temp = zero
     nobe = 0
     
     DO i=1,ne
       ia = iec(i,1)
       ib = iec(i,2)
       IF(cell_ob(ia) == 1 .OR. cell_ob(ib) == 1)THEN
         nobe = nobe + 1
     temp(nobe) = i
       END IF
     END DO
     
     ALLOCATE(cobedge_lst(nobe))
     cobedge_lst(1:nobe) = temp(1:nobe)
     DEALLOCATE(temp)
     
     ALLOCATE(temp(ncv));  temp = zero
     nobcv = 0
     
     DO i=1,ncv
       ia = niec(i,1)
       ib = niec(i,2)
       IF(node_ob(ia) == 1 .OR. node_ob(ib) == 1)THEN
         nobcv = nobcv + 1
     temp(nobcv) = i
       END IF
     END DO
     
     ALLOCATE(nobedge_lst(nobcv))
     nobedge_lst(1:nobcv) = temp(1:nobcv)
     DEALLOCATE(temp)
     
     DEALLOCATE(node_ob)
     DEALLOCATE(cell_ob)

     inmf    =45
     intcell =46
     intnode =47
     intelel =48
     intuv   =49
     CALL fopen(inmf,   trim(input_dir)//trim(casename)//'_meanflow.dat'  ,"cfr")
     CALL fopen(intcell,trim(input_dir)//trim(casename)//'_tide_cell.dat' ,"cfr")
     CALL fopen(intnode,trim(input_dir)//trim(casename)//'_tide_node.dat' ,"cfr")
     CALL fopen(intelel,trim(input_dir)//trim(casename)//'_tide_el.dat'   ,"cfr")
     CALL fopen(intuv,  trim(input_dir)//trim(casename)//'_tide_uv.dat'   ,"cfr")

!-------------------------------------------------------------------
!
!----Read in Tidal Current Time Series Data----------------------------------
!

     rewind(intcell)
     READ(intcell,*) ntidecell_gl

     ntidecell   = 0
     ntidecell_i = 0
  IF (ntidecell_gl > 0) THEN

     ALLOCATE(i_tidecell_gl(ntidecell_gl))
     DO i=1,ntidecell_gl
        READ(intcell,*)i_tidecell_gl(i)
     ENDDO
     CLOSE(intcell)

!     IF(ntidecell_GL > 300) THEN
!       WRITE(*,*)'CHANGE FORMAT STATEMENT BELOW TO ACCOMODATE ntidecell_GL='
!       WRITE(*,*)ntidecell_GL,' NUMBER OF TIDAL OPEN BOUNDARY CELLS AND RECOMPILE'
!       CALL PSTOP
!     END IF

     rewind(intuv)

!------------------determine the julian forcing counting-------------------------
     IF(msr)THEN
       CALL fopen(111,trim(input_dir)//trim(casename)//'_elj_obc.dat',"cfr")
       ncnt = 0
       READ(111,*)
       READ(111,*)
       DO WHILE(.true.)
         READ(111,*,iostat=ios)
         IF(ios < 0)EXIT
         ncnt = ncnt + 1
       END DO
       IF(ncnt == 0)CALL fatal_error("JULIAN TIDE SELECTED BUT NO DATA IN FILE")
     END IF
     elo_tm%NTIMES = ncnt
     ALLOCATE(elo_tm%TIMES(ncnt))
     ttime = 0.0_sp
     DO i=1,ncnt
       elo_tm%TIMES(i) = ttime
       ttime = ttime + 720 ! TTIME+DELTT
     END DO
!--------------------------------------------------------------------------------
     ALLOCATE(rtemp1(ntidecell_gl,elo_tm%NTIMES))   ! assumig we've known ELO_TM
     ALLOCATE(rtemp2(ntidecell_gl,elo_tm%NTIMES))
     ALLOCATE(rtemp3(ntidecell_gl,kbm1,elo_tm%NTIMES))
     ALLOCATE(rtemp4(ntidecell_gl,kbm1,elo_tm%NTIMES))
     rtemp1 = 0.0_sp
     rtemp2 = 0.0_sp
     rtemp3 = 0.0_sp
     rtemp4 = 0.0_sp

     IF(msr)THEN
       DO i=1,elo_tm%NTIMES
         READ(intuv,'(I7,300f8.4)') itemp,(rtemp1(j,i),j=1,ntidecell_gl)
         READ(intuv,'(I7,300f8.4)') itemp,(rtemp2(j,i),j=1,ntidecell_gl)
         DO k = 1,kbm1
            READ(intuv,'(I7,300f8.4)') itemp,(rtemp3(j,k,i),j=1,ntidecell_gl)
            READ(intuv,'(I7,300f8.4)') itemp,(rtemp4(j,k,i),j=1,ntidecell_gl)
         ENDDO
       END DO
     END IF

     close(intuv)

!
!---Map to Local Domain----------------------------------------
!
     IF(serial) THEN
        ntidecell   = ntidecell_gl
        ntidecell_i = ntidecell_gl
        ALLOCATE(i_tidecell_n(ntidecell))
        i_tidecell_n(:) = i_tidecell_gl(:)
        ALLOCATE(uatts(ntidecell,elo_tm%NTIMES))
        ALLOCATE(vatts(ntidecell,elo_tm%NTIMES))
        ALLOCATE(utts(ntidecell,kbm1,elo_tm%NTIMES))
        ALLOCATE(vtts(ntidecell,kbm1,elo_tm%NTIMES))
        uatts = rtemp1
        vatts = rtemp2
        utts  = rtemp3
        vtts  = rtemp4
     ENDIF


     DEALLOCATE(rtemp1,rtemp2,rtemp3,rtemp4)

  
  ELSE ! if statement end for ntidecell_GL > 0
    close(intcell)
  END IF
!-------------------------------------------------------------------
!
!----Read in Tidal Elevation Time Series Data----------------------------------
!

     rewind(intnode)
     READ(intnode,*) ntidenode_gl

     ntidenode   = 0
     ntidenode_i = 0
  IF (ntidenode_gl > 0) THEN

     ALLOCATE(i_tidenode_gl(ntidenode_gl))
     DO i=1,ntidenode_gl
        READ(intnode,*)i_tidenode_gl(i)
     ENDDO
     CLOSE(intnode)

!     IF(ntidenode_GL > 300 ) THEN
!       WRITE(*,*)'CHANGE FORMAT STATEMENT BELOW TO ACCOMODATE ntidenode_GL=',ntidenode_GL
!       WRITE(*,*)' NUMBER OF TIDAL OPEN BOUNDARY NODES AND RECOMPILE'
!       CALL PSTOP
!     END IF

     ALLOCATE(rtemp1(ntidenode_gl, elo_tm%NTIMES))
     rtemp1 = 0.0_sp

     rewind(intelel)
     IF(msr)THEN
       DO i=1,elo_tm%NTIMES
         READ(intelel,'(I7,300f8.4)') itemp,(rtemp1(j,i),j=1,ntidenode_gl)
       END DO
     END IF
     CLOSE(intelel)


!
!---Map to Local Domain----------------------------------------
!
     IF(serial) THEN
        ntidenode    = ntidenode_gl
        ntidenode_i  = ntidenode_gl
        ALLOCATE(i_tidenode_n(ntidenode))
        i_tidenode_n = i_tidenode_gl
        ALLOCATE(eltts(ntidenode,elo_tm%NTIMES)); eltts = zero
        eltts = rtemp1
     ENDIF


     DEALLOCATE(rtemp1)


  ELSE    ! if statement end for ntidenode_GL > 0
    close(intnode)
  END IF

   CALL read_meanflow
   CALL set_bndry_meanflow

!
!--- calculate mapping function
!
   ALLOCATE(i_obc_cell(0:nt),i_obc_node(0:mt),i_obc_cell2(0:nt),i_obc_node2(0:mt))

      i_obc_node = 0   
! I_OBC_NODE is the mapping from local domain node index j(MT) to tidal open 
! bndy node index i. If not a tidal open bndy node, I_OBC_NODE(j)=0
    if(ntidenode > 0)then
        do j = 1, mt
        do i = 1, ntidenode
           i1 = i_tidenode_n(i)
           if (i1 == j) then
              i_obc_node(j) = i
           endif
        enddo
        enddo
    endif

      i_obc_node2 = 0   
! I_OBC_NODE2 is the mapping from local domain node index j(MT) to open 
! bndy node index i. If not a open bndy node, I_OBC_NODE2(j)=0
!-------------------------------Jianzhong----------------------------!
!    if(iobcn > 0)then
!        do j = 1, MT
!        do i = 1, iobcn
!           I1 = I_OBC_N(i)
!           if (I1 == j) then
!              I_OBC_NODE2(J) = i
!           endif
!        enddo
!        enddo
!    endif
    if(ibcn(2) > 0)then
        do j = 1, mt
        do i = 1, ibcn(2)
           jn=obc_lst(2,i)
           i1 = i_obc_n(jn)
           if (i1 == j) then
              i_obc_node2(j) = i
           endif
        enddo
        enddo
    endif
!--------------------------------------------------------------------!

     i_obc_cell = 0   
! I_OBC_CELL is the mapping from local domain cell index j(NT) to tidal open 
! bndy cell index i. if not a tidal open bndy cell, I_OBC_CELL(j)=0
     if(ntidecell > 0)then
        do j = 1, nt
        do i = 1, ntidecell            
           i1 = i_tidecell_n(i)        
           if (i1 == j) then
              i_obc_cell(j) = i
           endif
        enddo
        enddo
     endif

     i_obc_cell2 = 0   
! I_OBC_CELL2 is the mapping from local domain cell index j(NT) to mean flow open 
! bndy cell index i. if not a mean flow open bndy cell, I_OBC_CELL2(j)=0
     if(nmfcell > 0)then
        do j = 1, nt
        do i = 1, nmfcell            
           i1 = i_mfcell_n(i)        
           if (i1 == j) then
              i_obc_cell2(j) = i
           endif
        enddo
        enddo
     endif


  IF(nmfcell > 0)THEN
     ALLOCATE (dltn(nmfcell))
  DO i = 1,nmfcell
     ii = i_mfcell_n(i) 
     IF(nbe(ii,1) == 0 .and. isonb(nv(ii,1)) /= 2) THEN
       deltx = vx(nv(ii,2))-vx(nv(ii,3))
       delty = vy(nv(ii,2))-vy(nv(ii,3))
       aa1 = -delty
       bb1 = deltx
       cc1 = -aa1*vx(nv(ii,2))-bb1*vy(nv(ii,2))
     ELSE IF(nbe(ii,2) == 0 .and. isonb(nv(ii,2)) /= 2) THEN
       deltx = vx(nv(ii,3))-vx(nv(ii,1))
       delty = vy(nv(ii,3))-vy(nv(ii,1))
       aa1 = -delty
       bb1 = deltx
       cc1 = -aa1*vx(nv(ii,3))-bb1*vy(nv(ii,3))
     ELSE IF(nbe(ii,3) == 0 .and. isonb(nv(ii,3)) /= 2) THEN
       deltx = vx(nv(ii,1))-vx(nv(ii,2))
       delty = vy(nv(ii,1))-vy(nv(ii,2))
       aa1 = -delty
       bb1 = deltx
       cc1 = -aa1*vx(nv(ii,1))-bb1*vy(nv(ii,1))
     ELSE
       print*,'something is wrong here 1'
       CALL pstop
     END IF

     aa2 = bb1
     bb2 = -aa1
     cc2 = -aa2*xc(ii)-bb2*yc(ii)

     xtmp1 = -(cc1*bb2-cc2*bb1)/(aa1*bb2-aa2*bb1)
     ytmp1 = -(cc1*aa2-cc2*aa1)/(bb1*aa2-bb2*aa1)
     
     dltn(i) = sqrt((xc(ii)-xtmp1)**2+(yc(ii)-ytmp1)**2)
  END DO
  END IF

     RETURN
     END SUBROUTINE find_obside


!==============================================================================|
!  INTERPOLATION of VARIOUS TIME SERIES                                        |
!==============================================================================|

   SUBROUTINE bcond_tide_2d
   USE control
   USE bcs
   USE mod_obcs
   INTEGER  L1,L2,IERR
   REAL(SP) :: FACT,UFACT,TIME1
   REAL(SP) :: TIMERK
   
   timerk = seconds(rktime-starttime)
!   TIME1 = TIMERK * 86400.0_SP
   time1 = timerk

   CALL bracket(elo_tm,time1,l1,l2,fact,ufact,ierr)
   IF(ntidecell > 0)THEN
     uatf(1:ntidecell) = ufact*uatts(1:ntidecell,l1) + fact*uatts(1:ntidecell,l2)
     vatf(1:ntidecell) = ufact*vatts(1:ntidecell,l1) + fact*vatts(1:ntidecell,l2)
     uatf(1:ntidecell) = uatf(1:ntidecell) * ramp
     vatf(1:ntidecell) = vatf(1:ntidecell) * ramp
   END IF

   IF(ntidenode > 0)THEN
     eltf(1:ntidenode) = ufact*eltts(1:ntidenode,l1) + fact*eltts(1:ntidenode,l2)
     eltf(1:ntidenode) = eltf(1:ntidenode) * ramp
   END IF

   RETURN
   END SUBROUTINE bcond_tide_2d

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

   SUBROUTINE bcond_tide_3d
   USE bcs
   USE mod_obcs
   INTEGER  L1,L2,IERR
   REAL(SP) :: FACT,UFACT,TIME1

!   TIME1 = TIME * 86400.0_SP - dti     ! pay attention to this TIME (different between 2D and 3D)
   time1=seconds(inttime-starttime)-dti
   IF(ntidecell > 0)THEN
     CALL bracket(elo_tm,time1,l1,l2,fact,ufact,ierr)
     ut(1:ntidecell,:) = ufact*utts(1:ntidecell,:,l1) + fact*utts(1:ntidecell,:,l2)
     vt(1:ntidecell,:) = ufact*vtts(1:ntidecell,:,l1) + fact*vtts(1:ntidecell,:,l2)
     ut(1:ntidecell,:) = ut(1:ntidecell,:) * ramp
     vt(1:ntidecell,:) = vt(1:ntidecell,:) * ramp
   END IF

   RETURN
   END SUBROUTINE bcond_tide_3d


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

!==========================================================================|
   SUBROUTINE bcond_ng_2d

!--------------------------------------------------------------------------|
!  NON-Gradient Open Boundary Condition (2-D)                              |
!--------------------------------------------------------------------------|

   USE all_vars
   IMPLICIT NONE

   INTEGER :: I,J,J1

   IF(ntidecell > 0)THEN
   DO i = 1, ntidecell
      j = i_tidecell_n(i)
          uap(i) = ua(j) - uat(i)
          vap(i) = va(j) - vat(i)
   END DO
   END IF

   IF(nmfcell > 0)THEN
   DO i = 1, nmfcell
      j = i_mfcell_n(i)
      j1= i_obc_cell(j)
      uant(i) = uat(j1)
      vant(i) = vat(j1)
      uan(i) = ua(j )
      van(i) = va(j )
      uanp(i) = uap(j1)
      vanp(i) = vap(j1)
   END DO
   END IF

   RETURN
   END SUBROUTINE bcond_ng_2d
!==========================================================================|

!==========================================================================|
   SUBROUTINE bcond_ng_3d

!--------------------------------------------------------------------------|
!  NON-Gradient Open Boundary Condition (3-D)                              |
!--------------------------------------------------------------------------|

   USE all_vars
   IMPLICIT NONE

   INTEGER :: I,J,J1,K

   IF(nmfcell > 0)THEN
   DO i = 1, nmfcell
      j = i_mfcell_n(i)
      j1= i_obc_cell(j)
      DO k = 1,kbm1
         unt(i,k) = ut(j1,k)
         vnt(i,k) = vt(j1,k)
         un(i,k) = u(j ,k)
         vn(i,k) = v(j ,k)
     END DO
   END DO
   END IF

   RETURN
   END SUBROUTINE bcond_ng_3d
!==========================================================================|

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

!==========================================================================|
   SUBROUTINE bcond_bki_2d(KTT)

!--------------------------------------------------------------------------|
!  BLUMBERG AND KANTHA IMPLICIT OPEN BOUNDARY CONDITION (BKI)              |
!--------------------------------------------------------------------------|

   USE all_vars
   IMPLICIT NONE

   INTEGER, INTENT(IN)  :: KTT
   INTEGER :: I,II,J1,J
   REAL(SP):: CC,CP
   REAL(SP):: coef


   coef = 10800.00_sp

   IF(ntidecell > 0)THEN
   DO i = 1, ntidecell
      j = i_tidecell_n(i)
          uapf(i) = uaf(j) - uatf(i)
          vapf(i) = vaf(j) - vatf(i)
          uap(i)  = uapf(i)
          vap(i)  = vapf(i)
   END DO
   END IF

  IF(nmfcell > 0)THEN
  DO i = 1,nmfcell
     ii = i_mfcell_n(i) 
     j1= i_obc_cell(ii)

     cc = sqrt(grav_e(ii)*d1(ii))*alpha_rk(ktt)*dte/dltn(i)
     cp = cc + 1.0_sp
       uantf(i) = (cc*uatf(j1) + uarknt(i)*(1.0_sp-alpha_rk(ktt)*dte/coef))/cp
       vantf(i) = (cc*vatf(j1) + varknt(i)*(1.0_sp-alpha_rk(ktt)*dte/coef))/cp
!       UANF (I) = (CC*UAF (II) + UARKN(I) *(1.0_SP-ALPHA_RK(KTT)*DTE/coef))/CP
!       VANF (I) = (CC*VAF (II) + VARKN(I) *(1.0_SP-ALPHA_RK(KTT)*DTE/coef))/CP
       uanf(i) = 0.0_sp
       vanf(i) = 0.0_sp

       uanpf(i) = uanf(i) - uantf(i)
       vanpf(i) = vanf(i) - vantf(i)
       uant(i) = uantf(i)
       vant(i) = vantf(i)
       uan(i) = uanf(i)
       van(i) = vanf(i)
       uanp(i) = uanpf(i)
       vanp(i) = vanpf(i)
  END DO
  END IF

   RETURN
   END SUBROUTINE bcond_bki_2d
!==========================================================================|

!==========================================================================|
   SUBROUTINE bcond_bki_3d(KTT)

!--------------------------------------------------------------------------|
!  BLUMBERG AND KANTHA IMPLICIT OPEN BOUNDARY CONDITION (BKI)              |
!--------------------------------------------------------------------------|

   USE all_vars
   IMPLICIT NONE

   INTEGER, INTENT(IN)  :: KTT
   INTEGER :: I,II,K,J1
   REAL(SP):: CC,CP
   REAL(SP):: coef

   coef = 10800.00_sp

  IF(nmfcell > 0)THEN
  DO i = 1,nmfcell
     ii = i_mfcell_n(i) 
     j1= i_obc_cell(ii)

     cc = sqrt(grav_e(ii)*d1(ii))*dti/dltn(i)
     cp = cc + 1.0_sp
     DO k=1,kbm1
       unt(i,k)  = (cc*ut(j1,k) + untb(i,k)*(1.0_sp-dti/coef))/cp
       vnt(i,k)  = (cc*vt(j1,k) + vntb(i,k)*(1.0_sp-dti/coef))/cp
!       UN (I,K)  = (CC*U (II,K) + UNB (I,K)*(1.0_SP-DTI/coef))/CP
!       VN (I,K)  = (CC*V (II,K) + VNB (I,K)*(1.0_SP-DTI/coef))/CP
       un(i,k)  = 0.0_sp
       vn(i,k)  = 0.0_sp
       IF (ktt == 2) THEN
          untb(i,k) = unt(i,k)
          vntb(i,k) = vnt(i,k)
          unb(i,k) = un(i,k)
          vnb(i,k) = vn(i,k)
       END IF
     END DO
  END DO
  END IF

   RETURN
   END SUBROUTINE bcond_bki_3d
!==========================================================================|

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|
!--------------------------------------------------------------------------|
!               TEST WHETHER THE TWO BOUNDARY CONDITION WORK               |
!--------------------------------------------------------------------------|
   SUBROUTINE test_cell(INDEX,MSG)
   USE all_vars

   IMPLICIT NONE

   CHARACTER(LEN=*)             :: MSG
   INTEGER                      :: INDEX
   INTEGER,PARAMETER            :: CELL1=59     ! IN TAIWAN STRAIT
   INTEGER,PARAMETER            :: CELL2=229    ! IN SECOND OPEN BOUNDARY



!   IF(CELL1==EGID(INDEX))THEN
!     WRITE(IPT_P,*)'IN '//MSG//' CELL OF TAIWAN STARIT  IN',MYID
!     write(ipt_p,*) "INDEX:",index,"egid(index)",egid(index),"; msg="//TRIM(MSG)//"; CELLS:",CELL1,CELL2
!   END IF
!   IF(CELL2==EGID(INDEX))THEN
!     WRITE(IPT_P,*)'IN '//MSG//' CELL OF PACIFIC BOUNDARY IN',MYID
!     write(ipt_p,*) "INDEX:",index,"egid(index)",egid(index),"; msg="//TRIM(MSG)//"; CELLS:",CELL1,CELL2
!   END IF

   RETURN
   END SUBROUTINE test_cell
!==========================================================================|

   SUBROUTINE test_node(INDEX,MSG)
   USE all_vars
   IMPLICIT NONE

   CHARACTER(LEN=*)             :: MSG
   INTEGER                      :: INDEX
   INTEGER,PARAMETER            :: NODE1=30     ! IN TAIWAN STRAIT
   INTEGER,PARAMETER            :: NODE2=115    ! IN SECOND OPEN BOUNDARY


!   IF(NODE1==NGID(INDEX))THEN
!     WRITE(IPT_P,*)'IN '//MSG//' NODE OF TAIWAN STARIT IN',MYID
!     write(ipt_p,*) "INDEX:",index,"ngid(index)",NGID(index),"; msg="//TRIM(MSG)//"; NODES:",NODE1,NODE2
!   END IF
!   IF(NODE2==NGID(INDEX))THEN
!     WRITE(IPT_P,*)'IN '//MSG//' NODE OF PACIFIC BOUNDARY IN',MYID
!     write(ipt_p,*) "INDEX:",index,"ngid(index)",NGID(index),"; msg="//TRIM(MSG)//"; NODES:",NODE1,NODE2
!   END IF

   RETURN
   END SUBROUTINE test_node
!==========================================================================|


!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%|

END MODULE mod_obcs2