00001 !
00002 ! $Id: exchange_3d_tile.h,v 1.2 2003/12/17 13:56:01 pmarches Exp $
00003 !
00004 subroutine exchange_3d_tile (Istr,Iend,Jstr,Jend, A)
00005 !
00006 ! Set periodic boundary conditions (if any) for a three-dimensional
00007 ! field A of RHO-, U-, V- or PSI-type. This file is designed to
00008 ! generate five different subroutines, by redefining (via CPP) the
00009 ! name of the subroutine exchange_2d_tile above and the starting
00010 ! indices ISTART = [Istr for U-,PSI-type; IstrR for V-,RHO-type]
00011 ! and JSTART = [Jstr for V-,PSI-type; JstrR for U-,RHO-type] below,
00012 ! as well as macro KSTART for the vertical RHO- and W-types. See
00013 ! also mounting file exchange.F
00014 !
00015 implicit none
00016 #include "param.h"
00017 #include "scalars.h"
00018 real A(GLOBAL_2D_ARRAY,KSTART:N)
00019 integer Istr,Iend,Jstr,Jend, i,j,k
00020 !
00021 #include "compute_auxiliary_bounds.h"
00022 !
00023 #ifdef EW_PERIODIC
00024 # ifdef NS_PERIODIC
00025 # define J_RANGE Jstr,Jend
00026 # else
00027 # define J_RANGE JSTART,JendR
00028 # endif
00029 # ifdef MPI
00030 if (NP_XI.eq.1) then
00031 # endif
00032 if (WESTERN_EDGE) then
00033 do k=KSTART,N
00034 do j=J_RANGE
00035 A(Lm+1,j,k)=A(1,j,k)
00036 A(Lm+2,j,k)=A(2,j,k)
00037 enddo
00038 enddo
00039 endif
00040 if (EASTERN_EDGE) then
00041 do k=KSTART,N
00042 do j=J_RANGE
00043 A(-1,j,k)=A(Lm-1,j,k)
00044 A( 0,j,k)=A(Lm ,j,k)
00045 enddo
00046 enddo
00047 endif
00048 # ifdef MPI
00049 endif
00050 # endif
00051 # undef J_RANGE
00052 #endif
00053
00054 #ifdef NS_PERIODIC
00055 # ifdef EW_PERIODIC
00056 # define I_RANGE Istr,Iend
00057 # else
00058 # define I_RANGE ISTART,IendR
00059 # endif
00060 # ifdef MPI
00061 if (NP_ETA.eq.1) then
00062 # endif
00063 if (SOUTHERN_EDGE) then
00064 do k=KSTART,N
00065 do i=I_RANGE
00066 A(i,Mm+1,k)=A(i,1,k)
00067 A(i,Mm+2,k)=A(i,2,k)
00068 enddo
00069 enddo
00070 endif
00071 if (NORTHERN_EDGE) then
00072 do k=KSTART,N
00073 do i=I_RANGE
00074 A(i,-1,k)=A(i,Mm-1,k)
00075 A(i, 0,k)=A(i,Mm ,k)
00076 enddo
00077 enddo
00078 endif
00079 # ifdef MPI
00080 endif
00081 # endif
00082 # undef I_RANGE
00083 #endif
00084
00085 #if defined EW_PERIODIC && defined NS_PERIODIC
00086 # ifdef MPI
00087 if (NP_XI.eq.1 .and. NP_ETA.eq.1) then
00088 # endif
00089 if (WESTERN_EDGE .and. SOUTHERN_EDGE) then
00090 do k=KSTART,N
00091 A(Lm+1,Mm+1,k)=A(1,1,k)
00092 A(Lm+1,Mm+2,k)=A(1,2,k)
00093 A(Lm+2,Mm+1,k)=A(2,1,k)
00094 A(Lm+2,Mm+2,k)=A(2,2,k)
00095 enddo
00096 endif
00097 if (EASTERN_EDGE .and. SOUTHERN_EDGE) then
00098 do k=KSTART,N
00099 A(-1,Mm+1,k)=A(Lm-1,1,k)
00100 A( 0,Mm+1,k)=A(Lm ,1,k)
00101 A(-1,Mm+2,k)=A(Lm-1,2,k)
00102 A( 0,Mm+2,k)=A(Lm ,2,k)
00103 enddo
00104 endif
00105 if (WESTERN_EDGE .and. NORTHERN_EDGE) then
00106 do k=KSTART,N
00107 A(Lm+1,-1,k)=A(1,Mm-1,k)
00108 A(Lm+1, 0,k)=A(1,Mm ,k)
00109 A(Lm+2,-1,k)=A(2,Mm-1,k)
00110 A(Lm+2, 0,k)=A(2,Mm ,k)
00111 enddo
00112 endif
00113 if (EASTERN_EDGE .and. NORTHERN_EDGE) then
00114 do k=KSTART,N
00115 A(-1,-1,k)=A(Lm-1,Mm-1,k)
00116 A( 0,-1,k)=A(Lm ,Mm-1,k)
00117 A(-1, 0,k)=A(Lm-1,Mm ,k)
00118 A( 0, 0,k)=A(Lm ,Mm ,k)
00119 enddo
00120 endif
00121 # ifdef MPI
00122 endif
00123 # endif
00124 #endif
00125 #ifdef MPI
00126 k=N-KSTART+1
00127 call MessPass3D_tile (Istr,Iend,Jstr,Jend, A,k)
00128 #endif
00129 return
00130 end
