c This program is to generate the Look-up table for grid information
c after reading com*.lga com*.srf c0m*.cco, and *.dwq 
c for water column and soil
c
      implicit none
c      
      integer,   allocatable :: lgrid(:,:)
      integer,   allocatable :: iwaq(:)
      integer,   allocatable :: iwaqcum(:)
      integer,   allocatable :: ised(:)
      integer,   allocatable :: isedcum(:)      
      integer                :: ised_base, iwaq_base, NoDmain, ierr_alloc, i
      integer                :: no, nmax, mmax, noseg, nolay
      integer                :: noq1, noq2, noq3, npart, nmmax, nmkmax
      integer                :: idum1, idum2, idum3
      integer                :: lmax, k, iseg, iactive, j, num_hydro
      real                   :: x0, y0, alpha
      real,      allocatable :: x_cord(:,:)
      real,      allocatable :: y_cord(:,:)
      real,      allocatable :: rdum(:)
      real,      allocatable :: surf(:)
c     
      character*256, allocatable :: nameDomain(:)
      character*256, filin, filout, fil1, fil2, fil3, fil4, fil5
c       
      call getarg(1,filin)
      if (filin .eq. ' ') then
         filin = 'domainlist.txt'
      end if
      write (*,*) 'Input file = ',trim(filin)      
      call getarg(2,filout)
      if (filin .eq. ' ') then
         filout = 'delwaq2lavegmod_lookup.txt'
      end if
      write (*,*) 'Output file = ',trim(filout)
c
c read input file 
      open(10,file=filin)      
      open(20,file=filout)
c      
      read(10,*) NoDmain
c      
      allocate(nameDomain(NoDmain),stat=ierr_alloc)
c      
      do i = 1,NoDmain
          read(10,*) nameDomain(i)
      end do
      close(10)      
c
c----------------------------------      
c lookup table for grid information      
c----------------------------------            
      num_hydro = 0
      iwaq_base = 0
      ised_base = 0      
c
      write(20,*) "Domain#  m   n   Hydro_cell  srf  X  Y  DWAQ  DWAQCUM  SEDCUM"
c          
      do no = 1,NoDmain
c read input files and                
          write(*,*) no, trim(nameDomain(no))
          
c read lga file       
          write(fil1,101) trim(nameDomain(no))
  101     format('./Input/com-',A,'.lga')
          open(11,file=fil1,form='unformatted', access='stream')
          read(11) nmax,mmax,noseg,nolay,noq1,noq2,noq3
c
          allocate(lgrid(nmax,mmax),stat=ierr_alloc)
          if ( ierr_alloc .ne. 0 ) then
              write(*,*) 'error allocating lgrid array:',ierr_alloc
              stop
          endif
          read(11) lgrid
          close(11)          
c          
c read cco file          
          write(fil2,102) trim(nameDomain(no))
  102     format('./Input/com-',A,'.cco')      
          open(12,file=fil2,form='unformatted', access='stream')
          read(12) mmax,nmax,x0,y0,alpha,npart,nolay
          lmax = 2*npart+9
          allocate(rdum(lmax),stat=ierr_alloc)      
          read(12) rdum
          allocate(x_cord(nmax,mmax),y_cord(nmax,mmax),stat=ierr_alloc)
          if ( ierr_alloc .ne. 0 ) then
              write(*,*) 'error allocating lgrid array:',ierr_alloc
              stop
          endif
          read(12) x_cord
          read(12) y_cord
          close(12)          
c          
c read srf file
          write(fil3,103) trim(nameDomain(no))          
  103     format('./Input/com-',A,'.srf')            
          open(13,file=fil3,form='unformatted', access='stream')       
          read(13) nmax,mmax,noseg,idum1,idum2,idum3
          allocate(surf(noseg),stat=ierr_alloc)          
          if ( ierr_alloc .ne. 0 ) then
              write(*,*) 'error allocating lgrid array:',ierr_alloc
              stop
          endif
          read(13) surf
          close(13)
c
c read dwq file for water column           
          write(fil4,104) trim(nameDomain(no))
  104     format('./Input/',A,'.dwq')            
          open(14,file=fil4)
          read(14,*) nmax,mmax,noseg,idum1,idum2
          allocate(iwaq(noseg),stat=ierr_alloc)                    
          allocate(iwaqcum(noseg),stat=ierr_alloc)                    
          nmmax = nmax*mmax
          if(noseg .gt. nmmax) then
              write(*,*) "Too many segments"
              stop
          endif
          read(14,*) (iwaq(k),k=1,noseg)
          close(14)
          iwaqcum(1:noseg) = iwaq(1:noseg) + iwaq_base
          iwaq_base = maxval(iwaqcum)
c
c read dwq file for layered sediment
          write(fil5,105) trim(nameDomain(no))                    
  105     format('./Input/',A,'_sed.dwq')            
          open(15,file=fil5)
          read(15,*) nmax,mmax,noseg,idum1,idum2
          allocate(ised(noseg),stat=ierr_alloc)                    
          allocate(isedcum(noseg),stat=ierr_alloc)                              
          if(noseg .gt. nmax*mmax) then
              write(*,*) "Too many segments"
              stop
          endif
          read(15,*) (ised(k),k=1,noseg)
          close(15)          
          isedcum(1:noseg) = ised(1:noseg) + ised_base
          ised_base = maxval(isedcum)
c          
c make lookup table for grid information      
          iseg = 0
          iactive = 0
c
          do j=1,mmax
              do i=1,nmax
                iseg = iseg + 1  
                if (lgrid(i,j) .gt. 0) then
                    iactive = iactive + 1
                    num_hydro = num_hydro + 1
                    write(20,201) no, j, i, num_hydro, surf(iactive), 
     *                      x_cord(i,j), y_cord(i,j), iwaq(iseg), iwaqcum(iseg), isedcum(iseg)
c                else
c                    num_hydro = num_hydro + 1
c                    write(20,201) no, j, i, num_hydro, 0.0, 
c     *                      x_cord(i,j), y_cord(i,j), 0, 0, 0
                endif
              end do
          end do
  201     format(I3,1X,I5,1X,I5,1X,I14,1X,F16.5,1X,
     *           F16.5,1X,F16.5,1X,I8,1X,I8,1X,I8)
c clean array           
          deallocate (lgrid)
          deallocate (rdum)          
          deallocate (x_cord)          
          deallocate (y_cord)                    
          deallocate (surf) 
          deallocate (iwaq)          
          deallocate (iwaqcum)          
          deallocate (ised)             
          deallocate (isedcum)                    
c           
c----------------------------------      
      end do
c----------------------------------                
c
c
      stop
      end