MODULE bc_3d_mod ! !svn $Id: bc_3d.F 294 2009-01-09 21:37:26Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2009 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This package applies gradient or periodic boundary conditions for ! ! generic 3D fields. ! ! ! ! Routines: ! ! ! ! bc_r3d_tile Boundary conditions for field at RHO-points ! ! bc_u3d_tile Boundary conditions for field at U-points ! ! bc_v3d_tile Boundary conditions for field at V-points ! ! bc_w3d_tile Boundary conditions for field at W-points ! ! ! !======================================================================= ! implicit none CONTAINS ! !*********************************************************************** SUBROUTINE bc_r3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, LBk, UBk, & & A) !*********************************************************************** ! USE mod_param ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk ! real(r8), intent(inout) :: A(LBi:,LBj:,LBk:) ! ! Local variable declarations. ! integer :: i, j, k ! !----------------------------------------------------------------------- ! Set lower and upper tile bounds and staggered variables bounds for ! this horizontal domain partition. Notice that if tile=-1, it will ! set the values for the global grid. !----------------------------------------------------------------------- ! integer :: Istr, IstrR, IstrT, IstrU, Iend, IendR, IendT integer :: Jstr, JstrR, JstrT, JstrV, Jend, JendR, JendT ! Istr =BOUNDS(ng)%Istr (tile) IstrR=BOUNDS(ng)%IstrR(tile) IstrT=BOUNDS(ng)%IstrT(tile) IstrU=BOUNDS(ng)%IstrU(tile) Iend =BOUNDS(ng)%Iend (tile) IendR=BOUNDS(ng)%IendR(tile) IendT=BOUNDS(ng)%IendT(tile) Jstr =BOUNDS(ng)%Jstr (tile) JstrR=BOUNDS(ng)%JstrR(tile) JstrT=BOUNDS(ng)%JstrT(tile) JstrV=BOUNDS(ng)%JstrV(tile) Jend =BOUNDS(ng)%Jend (tile) JendR=BOUNDS(ng)%JendR(tile) JendT=BOUNDS(ng)%JendT(tile) ! !----------------------------------------------------------------------- ! East-West gradient boundary conditions. !----------------------------------------------------------------------- ! IF (Iend.eq.Lm(ng)) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Iend+1,j,k)=A(Iend,j,k) END DO END DO END IF IF (Istr.eq.1) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Istr-1,j,k)=A(Istr,j,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! North-South gradient boundary conditions. !----------------------------------------------------------------------- ! IF (Jend.eq.Mm(ng)) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jend+1,k)=A(i,Jend,k) END DO END DO END IF IF (Jstr.eq.1) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jstr-1,k)=A(i,Jstr,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! Boundary corners. !----------------------------------------------------------------------- ! IF ((Jstr.eq.1).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jstr-1,k)=0.5_r8*(A(Istr ,Jstr-1,k)+ & & A(Istr-1,Jstr ,k)) END DO END IF IF ((Jstr.eq.1).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jstr-1,k)=0.5_r8*(A(Iend ,Jstr-1,k)+ & & A(Iend+1,Jstr ,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jend+1,k)=0.5_r8*(A(Istr-1,Jend ,k)+ & & A(Istr ,Jend+1,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jend+1,k)=0.5_r8*(A(Iend+1,Jend ,k)+ & & A(Iend ,Jend+1,k)) END DO END IF RETURN END SUBROUTINE bc_r3d_tile ! !*********************************************************************** SUBROUTINE bc_u3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, LBk, UBk, & & A) !*********************************************************************** ! USE mod_param USE mod_grid USE mod_scalars ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk ! real(r8), intent(inout) :: A(LBi:,LBj:,LBk:) ! ! Local variable declarations. ! integer :: i, j, k ! !----------------------------------------------------------------------- ! Set lower and upper tile bounds and staggered variables bounds for ! this horizontal domain partition. Notice that if tile=-1, it will ! set the values for the global grid. !----------------------------------------------------------------------- ! integer :: Istr, IstrR, IstrT, IstrU, Iend, IendR, IendT integer :: Jstr, JstrR, JstrT, JstrV, Jend, JendR, JendT ! Istr =BOUNDS(ng)%Istr (tile) IstrR=BOUNDS(ng)%IstrR(tile) IstrT=BOUNDS(ng)%IstrT(tile) IstrU=BOUNDS(ng)%IstrU(tile) Iend =BOUNDS(ng)%Iend (tile) IendR=BOUNDS(ng)%IendR(tile) IendT=BOUNDS(ng)%IendT(tile) Jstr =BOUNDS(ng)%Jstr (tile) JstrR=BOUNDS(ng)%JstrR(tile) JstrT=BOUNDS(ng)%JstrT(tile) JstrV=BOUNDS(ng)%JstrV(tile) Jend =BOUNDS(ng)%Jend (tile) JendR=BOUNDS(ng)%JendR(tile) JendT=BOUNDS(ng)%JendT(tile) ! !----------------------------------------------------------------------- ! East-West boundary conditions: Closed or gradient. !----------------------------------------------------------------------- ! IF (Iend.eq.Lm(ng)) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Iend+1,j,k)=A(Iend,j,k) END DO END DO END IF IF (Istr.eq.1) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Istr,j,k)=A(Istr+1,j,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! North-South boundary conditions: Closed (free-slip/no-slip) or ! gradient. !----------------------------------------------------------------------- ! IF (Jend.eq.Mm(ng)) THEN DO k=LBk,UBk DO i=Istr,IendR A(i,Jend+1,k)=gamma2(ng)*A(i,Jend,k) A(i,Jend+1,k)=A(i,Jend+1,k)*GRID(ng)%umask(i,Jend+1) END DO END DO END IF IF (Jstr.eq.1) THEN DO k=LBk,UBk DO i=IstrU,Iend A(i,Jstr-1,k)=A(i,Jstr,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! Boundary corners. !----------------------------------------------------------------------- ! IF ((Jstr.eq.1).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr ,Jstr-1,k)=0.5_r8*(A(Istr+1,Jstr-1,k)+ & & A(Istr ,Jstr ,k)) END DO END IF IF ((Jstr.eq.1).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jstr-1,k)=0.5_r8*(A(Iend ,Jstr-1,k)+ & & A(Iend+1,Jstr ,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr ,Jend+1,k)=0.5_r8*(A(Istr ,Jend ,k)+ & & A(Istr+1,Jend+1,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jend+1,k)=0.5_r8*(A(Iend+1,Jend ,k)+ & & A(Iend ,Jend+1,k)) END DO END IF RETURN END SUBROUTINE bc_u3d_tile ! !*********************************************************************** SUBROUTINE bc_v3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, LBk, UBk, & & A) !*********************************************************************** ! USE mod_param USE mod_grid USE mod_scalars ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk ! real(r8), intent(inout) :: A(LBi:,LBj:,:) ! ! Local variable declarations. ! integer :: i, j, k ! !----------------------------------------------------------------------- ! Set lower and upper tile bounds and staggered variables bounds for ! this horizontal domain partition. Notice that if tile=-1, it will ! set the values for the global grid. !----------------------------------------------------------------------- ! integer :: Istr, IstrR, IstrT, IstrU, Iend, IendR, IendT integer :: Jstr, JstrR, JstrT, JstrV, Jend, JendR, JendT ! Istr =BOUNDS(ng)%Istr (tile) IstrR=BOUNDS(ng)%IstrR(tile) IstrT=BOUNDS(ng)%IstrT(tile) IstrU=BOUNDS(ng)%IstrU(tile) Iend =BOUNDS(ng)%Iend (tile) IendR=BOUNDS(ng)%IendR(tile) IendT=BOUNDS(ng)%IendT(tile) Jstr =BOUNDS(ng)%Jstr (tile) JstrR=BOUNDS(ng)%JstrR(tile) JstrT=BOUNDS(ng)%JstrT(tile) JstrV=BOUNDS(ng)%JstrV(tile) Jend =BOUNDS(ng)%Jend (tile) JendR=BOUNDS(ng)%JendR(tile) JendT=BOUNDS(ng)%JendT(tile) ! !----------------------------------------------------------------------- ! East-West boundary conditions: Closed (free-slip/no-slip) or ! gradient. !----------------------------------------------------------------------- ! IF (Iend.eq.Lm(ng)) THEN DO k=LBk,UBk DO j=JstrV,Jend A(Iend+1,j,k)=A(Iend,j,k) END DO END DO END IF IF (Istr.eq.1) THEN DO k=LBk,UBk DO j=JstrV,Jend A(Istr-1,j,k)=A(Istr,j,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! North-South boundary conditions: Closed or gradient. !----------------------------------------------------------------------- ! IF (Jend.eq.Mm(ng)) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jend+1,k)=0.0_r8 END DO END DO END IF IF (Jstr.eq.1) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jstr,k)=A(i,Jstr+1,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! Boundary corners. !----------------------------------------------------------------------- ! IF ((Jstr.eq.1).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jstr ,k)=0.5_r8*(A(Istr ,Jstr ,k)+ & & A(Istr-1,Jstr+1,k)) END DO END IF IF ((Jstr.eq.1).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jstr ,k)=0.5_r8*(A(Iend ,Jstr ,k)+ & & A(Iend+1,Jstr+1,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jend+1,k)=0.5_r8*(A(Istr-1,Jend ,k)+ & & A(Istr ,Jend+1,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jend+1,k)=0.5_r8*(A(Iend+1,Jend ,k)+ & & A(Iend ,Jend+1,k)) END DO END IF RETURN END SUBROUTINE bc_v3d_tile ! !*********************************************************************** SUBROUTINE bc_w3d_tile (ng, tile, & & LBi, UBi, LBj, UBj, LBk, UBk, & & A) !*********************************************************************** ! USE mod_param ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk ! real(r8), intent(inout) :: A(LBi:,LBj:,LBk:) ! ! Local variable declarations. ! integer :: i, j, k ! !----------------------------------------------------------------------- ! Set lower and upper tile bounds and staggered variables bounds for ! this horizontal domain partition. Notice that if tile=-1, it will ! set the values for the global grid. !----------------------------------------------------------------------- ! integer :: Istr, IstrR, IstrT, IstrU, Iend, IendR, IendT integer :: Jstr, JstrR, JstrT, JstrV, Jend, JendR, JendT ! Istr =BOUNDS(ng)%Istr (tile) IstrR=BOUNDS(ng)%IstrR(tile) IstrT=BOUNDS(ng)%IstrT(tile) IstrU=BOUNDS(ng)%IstrU(tile) Iend =BOUNDS(ng)%Iend (tile) IendR=BOUNDS(ng)%IendR(tile) IendT=BOUNDS(ng)%IendT(tile) Jstr =BOUNDS(ng)%Jstr (tile) JstrR=BOUNDS(ng)%JstrR(tile) JstrT=BOUNDS(ng)%JstrT(tile) JstrV=BOUNDS(ng)%JstrV(tile) Jend =BOUNDS(ng)%Jend (tile) JendR=BOUNDS(ng)%JendR(tile) JendT=BOUNDS(ng)%JendT(tile) ! !----------------------------------------------------------------------- ! East-West gradient boundary conditions. !----------------------------------------------------------------------- ! IF (Iend.eq.Lm(ng)) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Iend+1,j,k)=A(Iend,j,k) END DO END DO END IF IF (Istr.eq.1) THEN DO k=LBk,UBk DO j=Jstr,Jend A(Istr-1,j,k)=A(Istr,j,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! North-South gradient boundary conditions. !----------------------------------------------------------------------- ! IF (Jend.eq.Mm(ng)) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jend+1,k)=A(i,Jend,k) END DO END DO END IF IF (Jstr.eq.1) THEN DO k=LBk,UBk DO i=Istr,Iend A(i,Jstr-1,k)=A(i,Jstr,k) END DO END DO END IF ! !----------------------------------------------------------------------- ! Boundary corners. !----------------------------------------------------------------------- ! IF ((Jstr.eq.1).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jstr-1,k)=0.5_r8*(A(Istr ,Jstr-1,k)+ & & A(Istr-1,Jstr ,k)) END DO END IF IF ((Jstr.eq.1).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jstr-1,k)=0.5_r8*(A(Iend ,Jstr-1,k)+ & & A(Iend+1,Jstr ,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Istr.eq.1)) THEN DO k=LBk,UBk A(Istr-1,Jend+1,k)=0.5_r8*(A(Istr-1,Jend ,k)+ & & A(Istr ,Jend+1,k)) END DO END IF IF ((Jend.eq.Mm(ng)).and.(Iend.eq.Lm(ng))) THEN DO k=LBk,UBk A(Iend+1,Jend+1,k)=0.5_r8*(A(Iend+1,Jend ,k)+ & & A(Iend ,Jend+1,k)) END DO END IF RETURN END SUBROUTINE bc_w3d_tile END MODULE bc_3d_mod