subroutine bocov1(v,im,jm,nm) implicit none integer::im,jm,nm real,dimension(0:im+1,0:jm+1,nm)::v if(nm.eq.6)then call bocov1_cb(v,im,jm) else if(nm.eq.14)then call bocov1_oc(v,im,jm) endif end subroutine bocov1 !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Subroutine Bocov1_cb(H,im,jm) ! ****************************************************************** !c * * !c * Boundary Conditions for Height Points on cube * !c * * !c ****************************************************************** !c---------------------------------------------------------------------- !c------------------------------------------------------------------- implicit none integer::im,jm integer,parameter::nm=6 REAL :: H(0:im+1,0:jm+1,6) INTEGER :: n,nl,nr,i,j,im1,jm1 im1=im-1 jm1=jm-1 !c----------------------------------------------------------------------- !c Lateral Faces !c----------------------------------------------------------------------- !c !c Lateral Conditions !c Do n=1,4 nl=n-1+4*((5-n)/4) nr=n+1-4*(n/4) Do j=1,jm-1 H(0 ,j,n)=H(im1,j,nl) H(im,j,n)=H(1 ,j,nr) End Do End Do !c !c Lower and Upper Conditions !c Do i=1,im-1 H(i,jm,1)=H(i,1 ,5) ! Face 1 H(i,0 ,1)=H(i,jm1,6) ! H(i,jm,2)=H(im1,i ,5) ! Face 2 H(i,0 ,2)=H(im1,jm-i,6) ! H(i,jm,3)=H(im-i,jm1,5) ! Face 3 H(i,0 ,3)=H(im-i,1 ,6) ! H(i,jm,4)=H(1,jm-i,5) ! Face 4 H(i,0 ,4)=H(1,i ,6) ! End Do !c----------------------------------------------------------------------- !c Upper and Lower Faces !c----------------------------------------------------------------------- !c !c Lateral Conditions !c Do j=1,jm-1 H(0 ,j,5)=H(im-j,jm1,4) ! Face 5 H(im,j,5)=H(j ,jm1,2) ! H(0 ,j,6)=H(j ,1,4) ! Face 6 H(im,j,6)=H(im-j,1,2) ! End Do !c !c Lower and Upper Conditions !c Do i=1,im-1 H(i,jm,5)=H(im-i,jm1,3) ! Face 5 H(i,0 ,5)=H(i ,jm1,1) ! H(i,jm,6)=H(i ,1,1) ! Face 6 H(i,0 ,6)=H(im-i,1,3) ! End Do !c----------------------------------------------------------------------- !c corners !c h(0,0,:)=0. h(im,0,:)=0. h(0,jm,:)=0. h(im,jm,:)=0. Return END SUBROUTINE Bocov1_cb !&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& Subroutine Bocov1_oc(h,im,jm) ! ****************************************************************** ! * * ! * Boundary Conditions for sqv on v Points on Octacon * ! * * ! ****************************************************************** implicit none integer,Parameter::nm=14 integer::im,jm,lm,imp1,jmp1,im1,jm1,l !----------------------------------------------------------------------- real,Dimension(0:im+1,0:jm+1,nm)::h !----------------------------------------------------------------------- lm=im imp1=im jmp1=jm im1=im-1 jm1=jm-1 ! ! Domain 1 ! Do l=1,lm h(l ,0 , 1)=H(imp1-l,1, 7) H(l ,jmp1, 1)=H(l ,1, 3) H(0 ,l , 1)=H(l ,1, 8) H(imp1,l , 1)=H(imp1-l,1, 6) End Do H(0 ,0 , 1)=0. H(imp1,0 , 1)=0. H(0 ,jmp1, 1)=H(im1,1, 2) H(imp1,jmp1, 1)=H(1 ,1, 4) ! ! Domain 2 ! Do l=1,lm H(l ,0 , 2)=H(im1,jmp1-l, 8) H(l ,jmp1, 2)=H(im1,l ,14) H(0 ,l , 2)=H(im1,l ,11) H(imp1,l , 2)=H(1 ,l , 3) End Do H(0 ,0 , 2)=0. H(imp1,0 , 2)=H(1 ,jm1, 1) H(0 ,jmp1, 2)=0. H(imp1,jmp1, 2)=H(1 ,1 , 5) ! ! Domain 3 ! Do l=1,lm H(l ,0 , 3)=H(l ,jm1, 1) H(l ,jmp1, 3)=H(l ,1 , 5) H(0 ,l , 3)=H(im1,l , 2) H(imp1,l , 3)=H(1 ,l , 4) End Do H(0 ,0 , 3)=H(im1,1 , 8) H(imp1,0 , 3)=H(1 ,1 , 6) H(0 ,jmp1, 3)=H(im1,jm1,14) H(imp1,jmp1, 3)=H(1 ,jm1,12) ! ! Domain 4 ! Do l=1,lm H(l ,0 , 4)=H(1 ,l , 6) H(l ,jmp1, 4)=H(1 ,jmp1-l,12) H(0 ,l , 4)=H(im1,l , 3) H(imp1,l , 4)=H(1 ,l , 9) End Do H(0 ,0 , 4)=H(im1,jm1, 1) H(imp1,0 , 4)=0. H(0 ,jmp1, 4)=H(im1,1 , 5) H(imp1,jmp1, 4)=0. ! ! Domain 5 ! Do l=1,lm H(l ,0 , 5)=H(l ,jm1, 3) H(l ,jmp1, 5)=H(imp1-l,jm1,13) H(0 ,l , 5)=H(imp1-l,jm1,14) H(imp1,l , 5)=H(l ,jm1,12) End Do H(0 ,0 , 5)=H(im1,jm1, 2) H(imp1,0 , 5)=H(1 ,jm1, 4) H(0 ,jmp1, 5)=0. H(imp1,jmp1, 5)=0. ! ! Domain 6 ! Do l=1,lm H(l ,0 , 6)=H(im1,jmp1-l, 1) H(l ,jmp1, 6)=H(l ,1 , 9) H(0 ,l , 6)=H(l ,1 , 4) H(imp1,l , 6)=H(1 ,l , 7) End Do H(0 ,0 , 6)=H(im1,1, 3) H(imp1,0 , 6)=0. H(0 ,jmp1, 6)=0. H(imp1,jmp1, 6)=H(1 ,1,10) ! ! Domain 7 ! Do l=1,lm H(l ,0 , 7)=H(imp1-l,1, 1) H(l ,jmp1, 7)=H(l ,1,10) H(0 ,l , 7)=H(im1 ,l, 6) H(imp1,l , 7)=H(1 ,l, 8) End Do H(0 ,0 , 7)=0. H(imp1,0 , 7)=0. H(0 ,jmp1, 7)=H(im1,1, 9) H(imp1,jmp1, 7)=H(1 ,1,11) ! ! Domain 8 ! Do l=1,lm H(l ,0 , 8)=H(1 ,l, 1) H(l ,jmp1, 8)=H(l ,1,11) H(0 ,l , 8)=H(im1 ,l, 7) H(imp1,l , 8)=H(imp1-l,1, 2) End Do H(0 ,0 , 8)=0 H(imp1,0 , 8)=H(1 ,1, 3) H(0 ,jmp1, 8)=H(im1,1,10) H(imp1,jmp1, 8)=0. ! ! Domain 9 ! Do l=1,lm H(l ,0 , 9)=H(l ,jm1, 6) H(l ,jmp1, 9)=H(l ,1 ,12) H(0 ,l , 9)=H(im1,l , 4) H(imp1,l , 9)=H(1 ,l ,10) End Do H(0 ,0 , 9)=0 H(imp1,0 , 9)=H(1,jm1, 7) H(0 ,jmp1, 9)=0. H(imp1,jmp1, 9)=H(1,1 ,13) ! ! Domain 10 ! Do l=1,lm H(l ,0 ,10)=H(l ,jm1, 7) H(l ,jmp1,10)=H(l ,1 ,13) H(0 ,l ,10)=H(im1,l , 9) H(imp1,l ,10)=H(1 ,l ,11) End Do H(0 ,0 ,10)=H(im1,jm1, 6) H(imp1,0 ,10)=H(1 ,jm1, 8) H(0 ,jmp1,10)=H(im1,1 ,12) H(imp1,jmp1,10)=H(1 ,1 ,14) ! ! Domain 11 ! Do l=1,lm H(l ,0 ,11)=H(l ,jm1, 8) H(l ,jmp1,11)=H(l ,1 ,14) H(0 ,l ,11)=H(im1,l ,10) H(imp1,l ,11)=H(1 ,l , 2) End Do H(0 ,0 ,11)=H(im1,jm1, 7) H(imp1,0 ,11)=0. H(0 ,jmp1,11)=H(im1,1 ,13) H(imp1,jmp1,11)=0. ! ! Domain 12 ! Do l=1,lm H(l ,0 ,12)=H(l ,jm1, 9) H(l ,jmp1,12)=H(im1,l , 5) H(0 ,l ,12)=H(imp1-l,jm1, 4) H(imp1,l ,12)=H(1 ,l ,13) End Do H(0 ,0 ,12)=0. H(imp1,0 ,12)=H(1 ,jm1,10) H(0 ,jmp1,12)=H(im1,im1, 3) H(imp1,jmp1,12)=0. ! ! Domain 13 ! Do l=1,lm H(l ,0 ,13)=H(l ,jm1,10) H(l ,jmp1,13)=H(imp1-l,jm1, 5) H(0 ,l ,13)=H(im1 ,l ,12) H(imp1,l ,13)=H(1 ,l ,14) End Do H(0 ,0 ,13)=H(im1,jm1, 9) H(imp1,0 ,13)=H(1 ,jm1,11) H(0 ,jmp1,13)=0. H(imp1,jmp1,13)=0. ! ! Domain 14 ! Do l=1,lm H(l ,0 ,14)=H(l ,jm1,11) H(l ,jmp1,14)=H(1 ,jmp1-l, 5) H(0 ,l ,14)=H(im1 ,l ,13) H(imp1,l ,14)=H(l ,jm1, 2) End Do H(0 ,0 ,14)=H(im1,jm1,10) H(imp1,0 ,14)=0. H(0 ,jmp1,14)=0. H(imp1,jmp1,14)=H(1 ,jm1, 3) !----------------------------------------------------------------------- Return End