examples/smpi/NAS/LU/setiv.f

   1
   2 c---------------------------------------------------------------------
   3 c---------------------------------------------------------------------
   4       subroutine setiv
   5
   6 c---------------------------------------------------------------------
   7 c---------------------------------------------------------------------
   8
   9 c---------------------------------------------------------------------
  10 c
  11 c   set the initial values of independent variables based on tri-linear
  12 c   interpolation of boundary values in the computational space.
  13 c
  14 c---------------------------------------------------------------------
  15
  16       implicit none
  17
  18       include 'applu.incl'
  19
  20 c---------------------------------------------------------------------
  21 c  local variables
  22 c---------------------------------------------------------------------
  23       integer i, j, k, m
  24       integer iglob, jglob
  25       double precision  xi, eta, zeta
  26       double precision  pxi, peta, pzeta
  27       double precision  ue_1jk(5),ue_nx0jk(5),ue_i1k(5),
  28      >        ue_iny0k(5),ue_ij1(5),ue_ijnz(5)
  29
  30
  31       do k = 2, nz - 1
  32          zeta = ( dble (k-1) ) / (nz-1)
  33          do j = 1, ny
  34           jglob = jpt + j
  35           IF (jglob.ne.1.and.jglob.ne.ny0) then
  36             eta = ( dble (jglob-1) ) / (ny0-1)
  37             do i = 1, nx
  38               iglob = ipt + i
  39               IF (iglob.ne.1.and.iglob.ne.nx0) then
  40                xi = ( dble (iglob-1) ) / (nx0-1)
  41                call exact (1,jglob,k,ue_1jk)
  42                call exact (nx0,jglob,k,ue_nx0jk)
  43                call exact (iglob,1,k,ue_i1k)
  44                call exact (iglob,ny0,k,ue_iny0k)
  45                call exact (iglob,jglob,1,ue_ij1)
  46                call exact (iglob,jglob,nz,ue_ijnz)
  47                do m = 1, 5
  48                   pxi =   ( 1.0d+00 - xi ) * ue_1jk(m)
  49      >                              + xi   * ue_nx0jk(m)
  50                   peta =  ( 1.0d+00 - eta ) * ue_i1k(m)
  51      >                              + eta   * ue_iny0k(m)
  52                   pzeta = ( 1.0d+00 - zeta ) * ue_ij1(m)
  53      >                              + zeta   * ue_ijnz(m)
  54
  55                   u( m, i, j, k ) = pxi + peta + pzeta
  56      >                 - pxi * peta - peta * pzeta - pzeta * pxi
  57      >                 + pxi * peta * pzeta
  58
  59                end do
  60               END IF
  61             end do
  62           END IF
  63          end do
  64       end do
  65
  66       return
  67       end