! Horizontal basic numerical operations for 3-dimensional arrays.
! These are the basic building blocks for horizontal compact and
! conventional differencing, quadrature, midpoint interpolation
! and filtering.
!############# 3-dimensions, index-i active:
subroutine ud1c3i(c,d,bnd1, & 1
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: c
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(OUT ) :: d
real, INTENT(IN ) :: bnd1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
d(i,k,j)=bnd1*(c(i+1,k,j)-c(i-1,k,j))
enddo
enddo
enddo
end subroutine ud1c3i
subroutine ud2c3i(c,d,bnd1,bnd2, & 1
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: c
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(OUT ) :: d
real, INTENT(IN ) :: bnd1,bnd2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
d(i,k,j)=bnd1*(c(i+1,k,j)-c(i-1,k,j))+bnd2*(c(i+2,k,j)-c(i-2,k,j))
enddo
enddo
enddo
end subroutine ud2c3i
subroutine sa1a3i(a,bnm1, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnm1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=bnm1*(a(i,k,j)+a(i+1,k,j))
enddo
enddo
enddo
end subroutine sa1a3i
subroutine sq1a3i(a,bnq, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnq
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i-1,k,j)+bnq*a(i,k,j)
enddo
enddo
enddo
end subroutine sq1a3i
subroutine sd1b3i(a,bnqi, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnqi
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=bnqi*(a(i,k,j)-a(i-1,k,j))
enddo
enddo
enddo
end subroutine sd1b3i
subroutine ef1a3i(a,knq1, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i+1,k,j)
enddo
enddo
enddo
end subroutine ef1a3i
subroutine ef2a3i(a,knq1,knq2, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i+1,k,j)+knq2*a(i+2,k,j)
enddo
enddo
enddo
end subroutine ef2a3i
subroutine ef1b3i(a,knq1, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)+knq1*a(i-1,k,j)
enddo
enddo
enddo
end subroutine ef1b3i
subroutine ef2b3i(a,knq1,knq2, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)+knq1*a(i-1,k,j)+knq2*a(i-2,k,j)
enddo
enddo
enddo
end subroutine ef2b3i
subroutine rf1a3i(a,lnq1, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j)
enddo
enddo
enddo
end subroutine rf1a3i
subroutine rf2a3i(a,lnq1,lnq2, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j)-lnq2*a(i-2,k,j)
enddo
enddo
enddo
end subroutine rf2a3i
subroutine rf1b3i(a,lnq1, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j)
enddo
enddo
enddo
end subroutine rf1b3i
subroutine rf2b3i(a,lnq1,lnq2, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j)-lnq2*a(i+2,k,j)
enddo
enddo
enddo
end subroutine rf2b3i
subroutine ra1a3i(a,p,lnq1,fnq, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In rala3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite
p(1,k,j)=a(i,k,j)-lnq1*p(1,k,j)
enddo
enddo
enddo
end subroutine ra1a3i
subroutine ra2a3i(a,p,lnq1,lnq2,fnq, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ra2a3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ra2a3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite,2
p(2,k,j)=a(i, k,j)-lnq1*p(1,k,j)-lnq2*p(2,k,j)
p(1,k,j)=a(i+1,k,j)-lnq1*p(2,k,j)-lnq2*p(1,k,j)
enddo
enddo
enddo
end subroutine ra2a3i
subroutine ra1b3i(a,p,lnq1,fnq, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ralb3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-1
p(1,k,j)=a(i,k,j)-lnq1*p(1,k,j)
enddo
enddo
enddo
end subroutine ra1b3i
subroutine ra2b3i(a,p,lnq1,lnq2,fnq, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ra2b3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ra2b3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-2
p(2,k,j)=a(i ,k,j)-lnq1*p(1,k,j)-lnq2*p(2,k,j)
p(1,k,j)=a(i-1,k,j)-lnq1*p(2,k,j)-lnq2*p(1,k,j)
enddo
enddo
enddo
end subroutine ra2b3i
subroutine mf11a3i(a,lnq1,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j)+knq1*a(i+1,k,j)
enddo
enddo
enddo
end subroutine mf11a3i
subroutine mf12a3i(a,lnq1,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j) &
+knq1*a(i+1,k,j)+knq2*a(i+2,k,j)
enddo
enddo
enddo
end subroutine mf12a3i
subroutine mf21a3i(a,lnq1,lnq2,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j)-lnq2*a(i-2,k,j)+knq1*a(i+1,k,j)
enddo
enddo
enddo
end subroutine mf21a3i
subroutine mf22a3i(a,lnq1,lnq2,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i-1,k,j)-lnq2*a(i-2,k,j) &
+knq1*a(i+1,k,j)+knq2*a(i+2,k,j)
enddo
enddo
enddo
end subroutine mf22a3i
subroutine ma11a3i(a,p,lnq1,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme),&
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In mal1a3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite
p(1,k,j)=a(i,k,j)-lnq1*p(1,k,j)+knq1*a(i+1,k,j)
enddo
enddo
enddo
end subroutine ma11a3i
subroutine ma12a3i(a,p,lnq1,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ma12a3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite
p(1,k,j)=a(i,k,j)-lnq1*p(1, k,j) &
+knq1*a(i+1,k,j)+knq2*a(i+2,k,j)
enddo
enddo
enddo
end subroutine ma12a3i
subroutine ma21a3i(a,p,lnq1,lnq2,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ma21a3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma21a3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite,2
p(2,k,j)=a(i, k,j)-lnq1*p(1, k,j)-lnq2*p(2,k,j) &
+knq1*a(i+1,k,j)
p(1,k,j)=a(i+1,k,j)-lnq1*p(2, k,j)-lnq2*p(1,k,j) &
+knq1*a(i+2,k,j)
enddo
enddo
enddo
end subroutine ma21a3i
subroutine ma22a3i(a,p,lnq1,lnq2,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ma22a3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma22a3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=ite+1-fnq,ite,2
p(2,k,j)=a(i, k,j)-lnq1*p(1, k,j)-lnq2*p(2, k,j) &
+knq1*a(i+1,k,j)+knq2*a(i+2,k,j)
p(1,k,j)=a(i+1,k,j)-lnq1*p(2, k,j)-lnq2*p(1, k,j) &
+knq1*a(i+2,k,j)+knq2*a(i+3,k,j)
enddo
enddo
enddo
end subroutine ma22a3i
subroutine mf11b3i(a,lnq1,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j)+knq1*a(i-1,k,j)
enddo
enddo
enddo
end subroutine mf11b3i
subroutine mf12b3i(a,lnq1,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j) &
+knq1*a(i-1,k,j)+knq2*a(i-2,k,j)
enddo
enddo
enddo
end subroutine mf12b3i
subroutine mf21b3i(a,lnq1,lnq2,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j)-lnq2*a(i+2,k,j)+knq1*a(i-1,k,j)
enddo
enddo
enddo
end subroutine mf21b3i
subroutine mf22b3i(a,lnq1,lnq2,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=ite,its,-1
a(i,k,j)=a(i,k,j)-lnq1*a(i+1,k,j)-lnq2*a(i+2,k,j) &
+knq1*a(i-1,k,j)+knq2*a(i-2,k,j)
enddo
enddo
enddo
end subroutine mf22b3i
subroutine ma11b3i(a,p,lnq1,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme),&
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In mal1b3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-1
p(1,k,j)=a(i,k,j)-lnq1*p(1,k,j)+knq1*a(i-1,k,j)
enddo
enddo
enddo
end subroutine ma11b3i
subroutine ma12b3i(a,p,lnq1,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(1, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In mal2b3i; fnq exceeds tile width'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-1
p(1,k,j)=a(i,k,j)-lnq1*p(1, k,j) &
+knq1*a(i-1,k,j)+knq2*a(i-2,k,j)
enddo
enddo
enddo
end subroutine ma12b3i
subroutine ma21b3i(a,p,lnq1,lnq2,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ma21b3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma21b3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-2
p(2,k,j)=a(i, k,j)-lnq1*p(1, k,j)-lnq2*p(2,k,j) &
+knq1*a(i-1,k,j)
p(1,k,j)=a(i-1,k,j)-lnq1*p(2, k,j)-lnq2*p(1,k,j) &
+knq1*a(i-2,k,j)
enddo
enddo
enddo
end subroutine ma21b3i
subroutine ma22b3i(a,p,lnq1,lnq2,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(2, kms:kme, jms:jme), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > ite+1-its)stop 'In ma22b3i; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma22b3i; fnq is not even'
do j=jts,jte
do k=kts,kte
p(1,k,j)=0.
p(2,k,j)=0.
enddo
enddo
do j=jts,jte
do k=kts,kte
do i=its-1+fnq,its,-2
p(2,k,j)=a(i, k,j)-lnq1*p(1, k,j)-lnq2*p(2, k,j) &
+knq1*a(i-1,k,j)+knq2*a(i-2,k,j)
p(1,k,j)=a(i-1,k,j)-lnq1*p(2, k,j)-lnq2*p(1, k,j) &
+knq1*a(i-2,k,j)+knq2*a(i-3,k,j)
enddo
enddo
enddo
end subroutine ma22b3i
!############# 3-dimensions, index-j active:
subroutine ud1c3j(c,d,bnd1, & 1
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: c
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(OUT ) :: d
real, INTENT(IN ) :: bnd1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
d(i,k,j)=bnd1*(c(i,k,j+1)-c(i,k,j-1))
enddo
enddo
enddo
end subroutine ud1c3j
subroutine ud2c3j(c,d,bnd1,bnd2, & 1
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: c
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(OUT ) :: d
real, INTENT(IN ) :: bnd1,bnd2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
d(i,k,j)=bnd1*(c(i,k,j+1)-c(i,k,j-1))+bnd2*(c(i,k,j+2)-c(i,k,j-2))
enddo
enddo
enddo
end subroutine ud2c3j
subroutine sa1a3j(a,bnm1, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnm1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=bnm1*(a(i,k,j)+a(i,k,j+1))
enddo
enddo
enddo
end subroutine sa1a3j
subroutine sq1a3j(a,bnq, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnq
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j-1)+bnq*a(i,k,j)
enddo
enddo
enddo
end subroutine sq1a3j
subroutine sd1b3j(a,bnqi, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: bnqi
integer :: i,j,k
do j=jte,jts-1,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=bnqi*(a(i,k,j)-a(i,k,j-1))
enddo
enddo
enddo
end subroutine sd1b3j
subroutine ef1a3j(a,knq1, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i,k,j+1)
enddo
enddo
enddo
end subroutine ef1a3j
subroutine ef2a3j(a,knq1,knq2, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i,k,j+1)+knq2*a(i,k,j+2)
enddo
enddo
enddo
end subroutine ef2a3j
subroutine ef1b3j(a,knq1, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1
integer :: i,j,k
do j=jte,jts-1,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i,k,j-1)
enddo
enddo
enddo
end subroutine ef1b3j
subroutine ef2b3j(a,knq1,knq2, & 4
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: knq1,knq2
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)+knq1*a(i,k,j-1)+knq2*a(i,k,j-2)
enddo
enddo
enddo
end subroutine ef2b3j
subroutine rf1a3j(a,lnq1, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1)
enddo
enddo
enddo
end subroutine rf1a3j
subroutine rf2a3j(a,lnq1,lnq2, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1)-lnq2*a(i,k,j-2)
enddo
enddo
enddo
end subroutine rf2a3j
subroutine rf1b3j(a,lnq1, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1)
enddo
enddo
enddo
end subroutine rf1b3j
subroutine rf2b3j(a,lnq1,lnq2, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1)-lnq2*a(i,k,j+2)
enddo
enddo
enddo
end subroutine rf2b3j
subroutine ra1a3j(a,p,lnq1,fnq, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In rala3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(i,k,1)=0.
enddo
enddo
do j=jte+1-fnq,jte,2
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1)
enddo
enddo
enddo
end subroutine ra1a3j
subroutine ra2a3j(a,p,lnq1,lnq2,fnq, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ra2a3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ra2a3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jte+1-fnq,jte,2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1)-lnq2*p(i,k,2)
p(i,k,1)=a(i,k,j+1)-lnq1*p(i,k,2)-lnq2*p(i,k,1)
enddo
enddo
enddo
end subroutine ra2a3j
subroutine ra1b3j(a,p,lnq1,fnq, & 8
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ralb3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(k,j,1)=0.
enddo
enddo
do j=jts-1+fnq,jts,-1
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1)
enddo
enddo
enddo
end subroutine ra1b3j
subroutine ra2b3j(a,p,lnq1,lnq2,fnq, & 6
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ra2b3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ra2b3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jts-1+fnq,jts,-2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1)-lnq2*p(i,k,2)
p(i,k,1)=a(i,k,j-1)-lnq1*p(i,k,2)-lnq2*p(i,k,1)
enddo
enddo
enddo
end subroutine ra2b3j
subroutine mf11a3j(a,lnq1,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1)+knq1*a(i,k,j+1)
enddo
enddo
enddo
end subroutine mf11a3j
subroutine mf12a3j(a,lnq1,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1) &
+knq1*a(i,k,j+1)+knq2*a(i,k,j+2)
enddo
enddo
enddo
end subroutine mf12a3j
subroutine mf21a3j(a,lnq1,lnq2,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1)-lnq2*a(i,k,j-2)+knq1*a(i,k,j+1)
enddo
enddo
enddo
end subroutine mf21a3j
subroutine mf22a3j(a,lnq1,lnq2,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer :: i,j,k
do j=jts,jte
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j-1)-lnq2*a(i,k,j-2) &
+knq1*a(i,k,j+1)+knq2*a(i,k,j+2)
enddo
enddo
enddo
end subroutine mf22a3j
subroutine ma11a3j(a,p,lnq1,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In mal1a3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(i,k,1)=0.
enddo
enddo
do j=jte+1-fnq,jte
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1)+knq1*a(i,k,j+1)
enddo
enddo
enddo
end subroutine ma11a3j
subroutine ma12a3j(a,p,lnq1,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ma12a3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(i,k,1)=0.
enddo
enddo
do j=jte+1-fnq,jte
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1) &
+knq1*a(i,k,j+1)+knq2*a(i,k,j+2)
enddo
enddo
enddo
end subroutine ma12a3j
subroutine ma21a3j(a,p,lnq1,lnq2,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ma21a3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma21a3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jte+1-fnq,jte,2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1)-lnq2*p(i,k,2) &
+knq1*a(i,k,j+1)
p(i,k,1)=a(i,k,j+1)-lnq1*p(i,k,2)-lnq2*p(i,k,1) &
+knq1*a(i,k,j+2)
enddo
enddo
enddo
end subroutine ma21a3j
subroutine ma22a3j(a,p,lnq1,lnq2,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ma22a3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma22a3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jte+1-fnq,jte,2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1 )-lnq2*p(i,k,2 ) &
+knq1*a(i,k,j+1)+knq2*a(i,k,j+2)
p(i,k,1)=a(i,k,j+1)-lnq1*p(i,k,2 )-lnq2*p(i,k,1 ) &
+knq1*a(i,k,j+2)+knq2*a(i,k,j+3)
enddo
enddo
enddo
end subroutine ma22a3j
subroutine mf11b3j(a,lnq1,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1)+knq1*a(i,k,j-1)
enddo
enddo
enddo
end subroutine mf11b3j
subroutine mf12b3j(a,lnq1,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,knq1,knq2
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1) &
+knq1*a(i,k,j-1)+knq2*a(i,k,j-2)
enddo
enddo
enddo
end subroutine mf12b3j
subroutine mf21b3j(a,lnq1,lnq2,knq1, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1)-lnq2*a(i,k,j+2)+knq1*a(i,k,j-1)
enddo
enddo
enddo
end subroutine mf21b3j
subroutine mf22b3j(a,lnq1,lnq2,knq1,knq2, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(INOUT) :: a
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer :: i,j,k
do j=jte,jts,-1
do k=kts,kte
do i=its,ite
a(i,k,j)=a(i,k,j)-lnq1*a(i,k,j+1)-lnq2*a(i,k,j+2) &
+knq1*a(i,k,j-1)+knq2*a(i,k,j-2)
enddo
enddo
enddo
end subroutine mf22b3j
subroutine ma11b3j(a,p,lnq1,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1),&
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In mal1b3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(i,k,1)=0.
enddo
enddo
do j=jts-1+fnq,jts,-1
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1)+knq1*a(i,k,j-1)
enddo
enddo
enddo
end subroutine ma11b3j
subroutine ma12b3j(a,p,lnq1,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 1), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In mal2b3j; fnq exceeds tile width'
do k=kts,kte
do i=its,ite
p(i,k,1)=0.
enddo
enddo
do j=jts-1+fnq,jts,-1
do k=kts,kte
do i=its,ite
p(i,k,1)=a(i,k,j)-lnq1*p(i,k,1 ) &
+knq1*a(i,k,j-1)+knq2*a(i,k,j-2)
enddo
enddo
enddo
end subroutine ma12b3j
subroutine ma21b3j(a,p,lnq1,lnq2,knq1,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime , kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ma21b3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma21b3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jts-1+fnq,jts,-2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1 )-lnq2*p(i,k,2) &
+knq1*a(i,k,j-1)
p(i,k,1)=a(i,k,j-1)-lnq1*p(i,k,2 )-lnq2*p(i,k,1) &
+knq1*a(i,k,j-2)
enddo
enddo
enddo
end subroutine ma21b3j
subroutine ma22b3j(a,p,lnq1,lnq2,knq1,knq2,fnq, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte)
implicit none
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde
INTEGER, INTENT(IN ) :: ims,ime, jms,jme, kms,kme
INTEGER, INTENT(IN ) :: its,ite, jts,jte, kts,kte
real, dimension(ims:ime , kms:kme, jms:jme), &
INTENT(IN ) :: a
real, dimension(ims:ime, kms:kme, 2), &
INTENT(INOUT) :: p
real, INTENT(IN ) :: lnq1,lnq2,knq1,knq2
integer, INTENT(IN ) :: fnq
integer :: i,j,k
if(fnq > jte+1-jts)stop 'In ma22b3j; fnq exceeds tile width'
if(mod(fnq,2)/=0) stop 'In ma22b3j; fnq is not even'
do j=1,2
do k=kts,kte
do i=its,ite
p(i,k,j)=0.
enddo
enddo
enddo
do j=jts-1+fnq,jts,-2
do k=kts,kte
do i=its,ite
p(i,k,2)=a(i,k,j )-lnq1*p(i,k,1 )-lnq2*p(i,k,2 ) &
+knq1*a(i,k,j-1)+knq2*a(i,k,j-2)
p(i,k,1)=a(i,k,j-1)-lnq1*p(i,k,2 )-lnq2*p(i,k,1 ) &
+knq1*a(i,k,j-2)+knq2*a(i,k,j-3)
enddo
enddo
enddo
end subroutine ma22b3j