SUBROUTINE setstr( mptr ) 3,5
!
!  this subroutine sets the storage for a grid
!  by allocating space and setting the pointers for the
!  1d, 2d and 3d arrays in common block pntstr
!
  INCLUDE 'agrigrid.inc'
  INCLUDE 'nodal.inc'
  INCLUDE 'grddsc.inc'
  INCLUDE 'agricst.inc'
  DIMENSION isp(9)
!
!  get space for all the variables
!
  nx = node(5, mptr)
  ny = node(6, mptr)
  nz = node(14,mptr)
!
!  set the pointers into storage for this grid,
!  first, we'll set the pointers as if they started
!  from storage location zero, after all are set, we
!  save the size (for data dumps, etc...) and allocate the
!  actual storage (if we're not just checking memory size)
!
  IF( verbose4 ) WRITE(6,'('' IN SETSTR, NX,NY,NZ '',3I6)') nx,ny,nz
!
  inptr = 0
  ipint(mptr)    = inptr
  ipreal(mptr)   = ipint(mptr)    + nsint
  ips1d(mptr)    = ipreal(mptr)   + nsreal
  ipx(mptr)      = ips1d(mptr)    + ns1d
  ipy(mptr)      = ipx(mptr)      + nx1d*nx
  ipz(mptr)      = ipy(mptr)      + ny1d*ny
  ipxy(1,mptr)   = ipz(mptr)      + nz1d*nz
  IF( verbose4 ) WRITE(6,'(''  SETSTR POINT 1, IPXY(1,MPTR) = '',I6)')  &
      ipxy(1,mptr)
!
!  we must do a bit more work to figure out the size
!  of the storage for the possibly packed data
!
  IF (nxy2d >= 1) THEN
    DO ivar=2,nxy2d+1
      npk = ipkxy(ivar-1)
      IF ( npk == 1 ) THEN
        ipxy(ivar,mptr) = ipxy(ivar-1,mptr) +                           &
                            nx*ny
      ELSE
        ipxy(ivar,mptr) = ipxy(ivar-1,mptr) +                           &
                               3 + (nx*ny)/npk
      END IF
    END DO
  END IF
  ipxz(1,mptr) = ipxy(nxy2d+1,mptr)
  IF( verbose4 ) WRITE(6,'(''  SETSTR POINT 2, IPXZ(1,MPTR) = '',I6)')  &
      ipxz(1,mptr)
!
  IF (nxz2d >= 1) THEN
    DO ivar=2,nxz2d+1
      npk = ipkxz(ivar-1)
      IF ( npk == 1 ) THEN
        ipxz(ivar,mptr) = ipxz(ivar-1,mptr) +                           &
                            nx*nz
      ELSE
        ipxz(ivar,mptr) = ipxz(ivar-1,mptr) +                           &
                               3 + (nx*nz)/npk
      END IF
    END DO
  END IF
  ipyz(1,mptr) = ipxz(nxz2d+1,mptr)
  IF( verbose4 ) WRITE(6,'(''  SETSTR POINT 3, IPYZ(1,MPTR) = '',I6)')  &
      ipyz(1,mptr)
!
  IF (nyz2d >= 1) THEN
    DO ivar=2,nyz2d+1
      npk = ipkyz(ivar-1)
      IF ( npk == 1 ) THEN
        ipyz(ivar,mptr) = ipyz(ivar-1,mptr) +                           &
                            ny*nz
      ELSE
        ipyz(ivar,mptr) = ipyz(ivar-1,mptr) +                           &
                            3 + (ny*nz)/npk
      END IF
    END DO
  END IF
  ipxyz(1,mptr) = ipyz(nyz2d+1,mptr)
  IF( verbose4 ) WRITE(6,'(''  SETSTR POINT 4, IPXYZ(1,MPTR) = '',I6)') &
      ipxyz(1,mptr)

  IF (nxyz3d >= 1) THEN
    DO ivar=2,nxyz3d+1
      npk = ipkxyz(ivar-1)
      IF ( npk == 1 ) THEN
        ipxyz(ivar,mptr) = ipxyz(ivar-1,mptr) +                         &
                            nx*ny*nz
      ELSE
        ipxyz(ivar,mptr) = ipxyz(ivar-1,mptr) +                         &
                            (3 + (nx*ny)/npk)*nz
      END IF
      IF( verbose4 ) WRITE(6,'(''  SETSTR, POINT 5.1, IVAR, IP= '',2I9)') &
          ivar,ipxyz(ivar,mptr)
    END DO
  END IF
!
! we now know how much space we need
!
  IF ( mptr /= 1 ) THEN
    needsp = ipxyz(nxyz3d+1,mptr)
  ELSE IF ( lexbc == 1 ) THEN
!
!-----------------------------------------------------------------------
!
!  Set additional storage for arrays which contain external forced
!  boundary conditions for the base grid.
!
!-----------------------------------------------------------------------
!
    ipexbc(1,mptr) = ipxyz(nxyz3d+1,mptr)
    IF( verbose4 ) WRITE(6,'(''  SETSTR POINT 4, IPEXBC(1,MPTR) = '',I6)') &
        ipexbc(1,mptr)

    IF (nexbc3d >= 1) THEN
      DO ivar=2,nexbc3d+1
        npk = ipkexbc(ivar-1)
        IF ( npk == 1 ) THEN
          ipexbc(ivar,mptr) = ipexbc(ivar-1,mptr) +                     &
                              nx*ny*nz
        ELSE
          ipexbc(ivar,mptr) = ipexbc(ivar-1,mptr) +                     &
                              (3 + (nx*ny)/npk)*nz
        END IF
        IF( verbose4 ) WRITE(6,'(''  SETSTR, POINT 5.1, IVAR, IP= '',2I9)') &
            ivar,ipexbc(ivar,mptr)
      END DO
    END IF
    needsp = ipexbc(nexbc3d+1,mptr)
  ELSE
    needsp = ipxyz(nxyz3d+1,mptr)
  END IF

  inptr = igetsp( needsp )
!
!  reset pointers for starting location in the solution array
!
  ipint(mptr)  = ipint(mptr)  + inptr
  ipreal(mptr) = ipreal(mptr) + inptr
  ips1d(mptr)  = ips1d(mptr)  + inptr
  ipx(mptr)    = ipx(mptr)    + inptr
  ipy(mptr)    = ipy(mptr)    + inptr
  ipz(mptr)    = ipz(mptr)    + inptr

  DO i=1,nxy2d+1
    ipxy(i,mptr) = ipxy(i,mptr) + inptr
    IF((ipkxy(i) > 1) .AND. (i <= nxy2d)) THEN
      ispace = 3 + (nx*ny)/ipkxy(i)
      CALL setpck( ipxy(i,mptr),ispace )
    END IF
  END DO

  DO i=1,nxz2d+1
    ipxz(i,mptr) = ipxz(i,mptr) + inptr
    IF((ipkxz(i) > 1) .AND. (i <= nxz2d)) THEN
      ispace = 3 + (nx*nz)/ipkxz(i)
      CALL setpck( ipxz(i,mptr),ispace )
    END IF
  END DO

  DO i=1,nyz2d+1
    ipyz(i,mptr) = ipyz(i,mptr) + inptr
    IF((ipkyz(i) > 1) .AND. (i <= nyz2d)) THEN
      ispace = 3 + (ny*nz)/ipkyz(i)
      CALL setpck( ipyz(i,mptr),ispace )
    END IF
  END DO

  DO i=1,nxyz3d+1
    ipxyz(i,mptr) = ipxyz(i,mptr) + inptr
    IF((ipkxyz(i) > 1) .AND. (i <= nxyz3d)) THEN
      ispace= 3 + (nx*ny)/ipkxyz(i)
      DO k=1,nz
        ink = ipxyz(i,mptr) + (k-1)*ispace
        CALL setpck( ink,ispace )
      END DO
    END IF
  END DO

  IF ( mptr == 1 .AND. lexbc == 1 ) THEN
    DO i=1,nexbc3d+1
      ipexbc(i,mptr) = ipexbc(i,mptr) + inptr
      IF ( ipkexbc(i) > 1 .AND. i <= nexbc3d ) THEN
        ispace = 3 + (nx*ny)/ipkexbc(i)
        DO k=1,nz
          ink = ipexbc(k,mptr) + (k-1)*ispace
          CALL setpck( ink,ispace )
        END DO
      END IF
    END DO
  END IF

!
!  we're finished here
!
  RETURN
END SUBROUTINE setstr
!
!


SUBROUTINE setpck( in,NUMBER ) 5
  INCLUDE 'agrialloc.inc'
!
!  here we set the data in the array a for packing,
!  this allows us to use the igt* functions with packed data
!  before we actually put anything into the packed storage.
!  if we don't do tis the packing routines often croak
!
  a(in) = 100.
  a(in+1) = 100.
  DO i=2,NUMBER-1
    a(in+i) = 0.
  END DO
  RETURN
END SUBROUTINE setpck