     1  c
     2         program hwave3
     3  c
     4  cc     hwave3.f  main program of 3-dimensional wave equtaion
     5  c      modified leap-frog method  2000.06.17
     6         implicit real*8 (a-h,o-z)
     7         parameter(npe=2)
     8  !hpf$  processors pe(npe)
     9         parameter(nx=100,ny=100,nz=100)
    10         parameter(nb=4,iip0=8,iiq0=1,iir0=1,last=4)
    11         parameter(nx1=nx+1,nx2=nx+2,ny1=ny+1,ny2=ny+2)
    12         parameter(nz1=nz+1,nz2=nz+2)
    13         parameter(n1=nx2,n2=n1*ny2,n3=n2*nz2,noinp=30)
    14         parameter(n4=n3*nb)
    15         parameter(thx=0.5,tam=0.5,vis0=0.10)
    16  c
    17         dimension f(nx2,ny2,nz2,nb),u(nx2,ny2,nz2,nb)
    18  c      dimension gf(nx2,ny2,nz2,nb),gu(nx2,ny2,nz2,nb)
    19         dimension v(nx2,ny2,nz2,nb),p(nb)
    20         dimension ppin(10)
    21  c      real*8 zt0,zt1,zt2,zt
    22  !hpf$  distribute f(*,*,block,*) onto pe
    23  !hpf$  distribute u(*,*,block,*) onto pe
    24  !hpf$  distribute v(*,*,block,*) onto pe
    25  !hpf$  shadow     f(0,0,1:1,0)
    26  !hpf$  shadow     u(0,0,1:1,0)
    27  !hpf$  shadow     v(0,0,1:1,0)
    28  !hpf$  asyncid id1
    29  c      !hpf$ global gf,gu
    30  c      equivalence (gf,f),(gu,u)
    31         common /blk/f
    32  c
    33  c           ppin xl   yl   zl   dxl  dyl  dzl  dn  dv   9  10
    34         data ppin/62.0,62.0,62.0,10.0,10.0,10.0,1.0,0.0, 9, 10/
    35  c

    58  c      initial parameters
    59  c
    60         write(6,122) nx,ny,nz,last,nx2,ny2,nz2
    61         write(6,124) t1,hx,hy,hz,dx1,dy1,dz1
    62    122  format(1h ,10i8)
    63    124  format(1h ,8(1pe10.3))
    64  c
    65  c      initial conditions
    66         call ainit1(ppin)
    67  c
    68  c      start of calculation
    69         call clock(zt0)
    70  c
    71         do 500 ii=1,last
    72         call clock(zt1)
    73         do 300 iir=1,iir0
    74         do 200 iiq=1,iiq0
    75         do 100 iip=1,iip0
    76  c
    77  c      boundary conditions
    78  c
    79  !hpf$  independent,new(i,j,k)
    80         do 22 k=2,nz1
    81  !hpf$  on home(f(:,:,k,:)),local(f,i,j,m) begin
    82  c
    83         do 222 m=1,nb
    84         do 221 j=2,ny1
    85         f(1,j,k,m)=f(nx1,j,k,m)
    86         f(nx2,j,k,m)=f(2,j,k,m)
    87    221  continue
    88  c
    89         do 222 i=1,nx2
    90         f(i,1,k,m)=f(i,ny1,k,m)
    91         f(i,ny2,k,m)=f(i,2,k,m)
    92    222  continue
    93  !hpf$  end on
    94     22  continue
    95  c
    96  !hpf$  asynchronous(id1),nobuffer begin
    97         f(1:nx2,1:ny2,  1,1:nb) = f(1:nx2,1:ny2,nz1,1:nb)
    98         f(1:nx2,1:ny2,nz2,1:nb) = f(1:nx2,1:ny2,  2,1:nb)
    99  !hpf$  end asynchronous
   100  !hpf$  asyncwait(id1)
   101  c
   102  c      case of iip=1  2-step Lax-Wendroff method
   103         if(iip.eq.1) then
   104         t=0.5*t1
   105         dx=0.5*dx1
   106         dy=0.5*dy1
   107         dz=0.5*dz1
   108  !hpf$  reflect f
   109  !hpf$  independent,new(i,j)
   110         do 32 k=1,nz1
   111  !hpf$  on home(u(:,:,k,:)),local(f,u,i,j,m) begin
   112         do 321 m=1,nb
   113         do 321 j=1,ny1
   114         do 321 i=1,nx1
   115         u(i,j,k,m)=0.125*(f(i,j,k,m)+f(i+1,j,k,m)+

   119    321  continue
   120  !hpf$  end on
   121     32  continue
   122  c
   123         else
   124         t=t1
   125         dx=dx1
   126         dy=dy1
   127         dz=dz1
   128         endif
   129  c
   130  c
   131  c      first step
   132  c
   133  c      !hpf$  reflect f
   134  !hpf$  independent,new(i,j)
   135         do 40 k=1,nz1
   136  !hpf$  on home(u(:,:,k,:)),local(f,u,p,i,j,m,dx,dy,dz) begin
   137         do 401 j=1,ny1
   138         do 401 i=1,nx1
   139  c
   140         p(1)=0.125*(f(i,j,k,1)+f(i+1,j,k,1)+

   186    401  continue
   187  !hpf$  end on
   188     40  continue
   189  c
   190  c      preparation of second step
   191  c      second step
   192  c
   193  !hpf$  independent,new(i,j,m)
   194         do 62 k=1,nz2
   195  !hpf$  on home(v(:,:,k,:)),local(f,v,m,i,j) begin
   196         do 621 m=1,nb
   197         do 621 j=1,ny2
   198         do 621 i=1,nx2
   199         v(i,j,k,m)=f(i,j,k,m)
   200    621  continue
   201  !hpf$  end on
   202     62  continue
   203  c
   204  !hpf$  reflect u
   205  !hpf$  reflect v
   206  !hpf$  independent,new(i,j,k)
   207         do 60 k=2,nz1
   208  !hpf$  on home(f(:,:,k,:)),local(f,u,v,p,i,j,m,dx,dy,dz,
   209  !hpf$*    dx1,dy1,dz1,dx2,dy2,dz2) begin
   210         do 601 j=2,ny1
   211         do 601 i=2,nx1
   212  c
   213         p(1)=0.125*(u(i,j,k,1)+u(i-1,j,k,1)+

   271    601  continue
   272  !hpf$  end on
   273     60  continue
   274  c
   275  c      end of 1 time step advance
   276  c
   277    100  continue
   278    200  continue
   279    300  continue
   280  c
   281         call clock(zt2)
   282         zt1=zt1-zt0
   283         zt2=zt2-zt0
   284         zt=zt2-zt1
   285         write(6,402) ii,zt0,zt1,zt2,zt
   286    402  format(1h , i6,1pe12.3,3(0pf12.5))
   287  c
   288  c      write the output data
   289  c
   290    500  continue
   291      9  continue
   292  c
   293         stop
   294         end
   295         subroutine clock(ti)
   296         implicit real*8 (a-h,o-z)
   297  c      real*8 ti,ti1
   298         ti=1.0d0
   299         ti1=1.0d0
   300  c      call gettod(ti1)
   301         call fjhpf_gettod(ti1)
   302         ti=1.0d-6*ti1
   303  c      x=0.0
   304  c      y=secnds(x)
   305  c      ti=1.0d0*y
   306         return
   307         end
   308         subroutine ainit1(ppin)
   309         implicit real*8 (a-h,o-z)
   310         parameter(npe=2)
   311  !hpf$  processors pe(npe)
   312         parameter(nx=100,ny=100,nz=100)
   313         parameter(nb=4,iip0=8,iiq0=1,iir0=1,last=4)
   314         parameter(nx1=nx+1,nx2=nx+2,ny1=ny+1,ny2=ny+2)
   315         parameter(nz1=nz+1,nz2=nz+2)
   316         parameter(n1=nx2,n2=n1*ny2,n3=n2*nz2,noinp=30)
   317         parameter(n4=n3*nb)
   318  c
   319         dimension f(nx2,ny2,nz2,nb)
   320  c      dimension gf(nx2,ny2,nz2,nb)
   321         dimension ppin(10)
   322  !hpf$  distribute f(*,*,block,*) onto pe
   323  !hpf$  shadow     f(0,0,1:1,0)
   324  c      equivalence (gf,f)
   325         common /blk/f
   326  c

   339  !hpf$  independent,new(i,j,k)
   340         do 10 k=1,nz2
   341  !hpf$  on home(f(:,:,k,:)),local(f,i,j,m,x,y,z,dn1,dv1,ax1,
   342  !hpf$*        hx,hy,hz,dn) begin
   343         z=0.5*hz*(2*k-nz2-1)
   344         do 101 j=1,ny2
   345         y=0.5*hy*(2*j-ny2-1)
   346         do 101 i=1,nx2

   356    101  continue
   357  !hpf$  end on
   358     10  continue
   359         return
   360         end

