SUBROUTINE fillngrd(levl,levd) 1,9
!
! this routine interpolates initial fields for the
! new grids at level levl
!
INTEGER :: levl,levd
INCLUDE 'nodal.inc'
INCLUDE 'agrialloc.inc'
INCLUDE 'agricst.inc'
LOGICAL :: sourced
!
! interp for all grids
!
IF( verbose6 ) WRITE(6,'('' IN INITGR, NEWSTL(LEVL) = '',I4)')newstl(levl)
WRITE(6,'('' LEVL = '',I4)') levl
!
mptr = newstl(levl)
5 IF (mptr == 0) GO TO 999
!
! set storage for the new grid
!
CALL resett
CALL setstr
( mptr )
CALL settmp
!
! first interp off of the coarse grids,
! then from grids at same level
!
!cc do 300 levint=max0(1,levl-2),levl
!
!?????
!
DO levint=MAX0(1,levl-1),levl
sourced = .false.
IF( levint >= levd ) sourced = .true.
msrc = lstart(levint)
10 IF( msrc == 0 ) CYCLE
!
IF( verbose6 ) WRITE(6,*) ' new fine grid interp ',mptr,msrc
!
! interp from grid msrc
!
IF ( sourced ) CALL addgrd
( msrc )
CALL filgrd
( mptr,msrc )
IF ( sourced ) CALL dmpgrd
( msrc,.false. )
!
! check for next source grid on level
!
msrc = node(10,msrc)
GO TO 10
!
END DO
!
! take care of next grid
!
CALL dmpgrd
( mptr,.true. )
mptr = node(10,mptr)
GO TO 5
999 CONTINUE
!
! now set all the constant arrays for the new grid
!
mptr = newstl(levl)
105 IF (mptr == 0) GO TO 9999
CALL addgrd
( mptr )
CALL flcnst
( mptr )
mptr = node(10,mptr)
GO TO 105
9999 CONTINUE
!
! we're finished here
!
! yuhe: level levl has been filled. Set lstart(levl) in order to use
! this level to source finer levels.
!
lstart(levl) = newstl(levl)
RETURN
END SUBROUTINE fillngrd