module biooutput
  !-----------------------------------------------------------------------------
  ! stuff for output of ecomodel vars
  !-----------------------------------------------------------------------------

  use cmod_mem, only : cmi2

  implicit none 
  private

  integer(4),                 private, save :: lunbiodat, itempd
  type(cmi2),    allocatable, private       :: eco_i4(:)
  type(cmi2),    allocatable, private       :: ben_i4(:)
  character(40),              private, save :: tdnam

  logical, parameter :: bioncdf = .false.

  private :: wcompr_bio

  public  :: biofile_new, biofile_close, biofile_write, biofile_next
  public  :: write_bio_restart, val_benthos , diag_out, bioncdf

contains

  !=============================================================================

  subroutine biofile_new ( )

    use constants,     only : archive, aufdat
    use cmod_params,   only : narea, iw2, iw3
    use bioparam,      only : ntbio, ntben
    use io_subs,       only : io_new_unit
    use exits,         only : exitme
    use cmod_miscvars, only : ihour,ctim
  
    implicit none

    logical,       save :: FirstTime = .true.
    character(11), save :: aufdat_bio
    character(2)        :: ctmp
    integer(4)          :: ia, iben, ios

    !- allocate on first entry -------------------------------------------------
    if (FirstTime) then
      FirstTime = .false.

      allocate( eco_i4(narea), ben_i4(narea) )
      do ia=1,narea
        iben = iw2(ia)
        allocate( eco_i4(ia)%p(0:iw3(ia),1:ntbio),                             &
                  ben_i4(ia)%p(0:iben,1:ntben) )
      enddo

      itempd = 0
      if (archive) then
        tdnam = 'biodat'
      else
        write(ctmp,'(i2.2)') itempd
        tdnam = 'biodat.'//ctmp
      endif

      aufdat_bio(1:11) = aufdat(1:11)
    else
      itempd = itempd + 1
      write(ctmp,'(i2.2)') itempd
      tdnam = 'biodat.'//ctmp
    endif

    lunbiodat = io_new_unit()
    open(lunbiodat,file=tdnam,form='unformatted',status='replace',iostat=ios)
    if (ios /= 0) call exitme(1, 'Cannot open '//trim(tdnam))
    aufdat_bio(2:5)  = ctim(1:4)
    aufdat_bio(6:10) = ctim(6:10)
    write(aufdat_bio(11:11),'(I1.1)') ihour/3
    write(lunbiodat,iostat=ios) aufdat_bio
    if (ios /= 0) call exitme(1,'Could not write header in '//trim(tdnam))

  end subroutine biofile_new

  !=============================================================================

  subroutine biofile_close ()
    implicit none
    close (lunbiodat)
  end subroutine biofile_close

  !=============================================================================

  subroutine biofile_write (ia, iu06, mi, ni, ki, n2d, n3d, msrf, mcol, kh,    &
                            nl, ptc, benthos)

    use exits,         only : exitme
    use cmod_miscvars, only : ctim
    use constants,     only : tim

    implicit none

    real(8),    intent(in) :: ptc(0:,1:), benthos(0:,1:)
    integer(4), intent(in) :: ia, iu06, mi, ni, ki, n2d, n3d, nl
    integer(4), intent(in) :: msrf(0:,0:), mcol(0:), kh(0:)
    
    !- local vars --------------------------------------------------------------
    integer(4) :: ios

    if (ia == 1) then
      write(iu06,'(a9,a,a10,a19)') 'write on ',trim(tdnam),' at time: ',ctim

      write(lunbiodat,iostat=ios) ctim,tim
      if (ios /= 0) call exitme(1,'Could not write time stamp in '//trim(tdnam))
    endif

    call wcompr_bio(n2d, n3d, nl, ptc, benthos, mi, ni, ki, msrf, mcol, kh,    &
                   eco_i4(ia)%p, ben_i4(ia)%p)

    write(lunbiodat) eco_i4(ia)%p
    write(lunbiodat) ben_i4(ia)%p

  end subroutine biofile_write

  !=============================================================================

  subroutine biofile_next ( iu06 )
    implicit none

    integer(4), intent(in) :: iu06

    call biofile_close ()

    write(iu06,'(a22,a)') 'bio output stored on: ',trim(tdnam)

    call biofile_new ()

  end subroutine biofile_next

  !=============================================================================

  subroutine wcompr_bio(iw2, iw3, n, ptc, benthos, mmx, nmx, kmx, msrf, mcol,  &
                        kh, e_i, b_i)
  !----------------------------------------------------------------------------+
  ! Integer compression of biological fields
  !----------------------------------------------------------------------------+
    use bioparam,   only : Nnorm, Onorm,        &
                           idx_oxy            , &
                           ntbio, ntben
    use biopermute, only : bio_depermute, eco_o, ben_o

    implicit none
    
    integer(4), intent(in)  :: iw2, iw3, mmx, nmx, kmx, n
    integer(4), intent(in)  :: msrf(0:,0:)    ! (0:mmx,0:nmx)
    integer(4), intent(in)  :: mcol(0:)       ! (0:iw2)
    integer(4), intent(in)  :: kh(0:)       ! (0:iw2)
    real(8),    intent(in)  :: ptc(0:,1:)     ! (0:iw3,1:ntbio)
    real(8),    intent(in)  :: benthos(0:,1:) ! (0:iw2,1:ntben)
    integer(4), intent(out) :: e_i(0:,1:)     ! (0:iw3,ntbio)
    integer(4), intent(out) :: b_i(0:,1:)     ! (0:iw2,ntben)

    real(8), parameter :: onland    = 99.99e-2_8
    real(8), parameter :: scalebioN = 1.e4_8*Nnorm
    real(8), parameter :: scalebioO = 1.e4_8*Onorm

    integer(4) :: iw, isc

    !  de-permute eco and benthos, and scale before output:
    call bio_depermute( mmx,nmx,kmx,iw2,iw3,ntbio,ntben,n,msrf,mcol,kh,ptc,    &
                        benthos )

    isc = nint(onland*scalebioN,4)
    e_i(0,1:ntbio) = isc
    e_i(0,idx_oxy            )   = nint(onland*scalebioO,4)
    do iw=1,iw3
      e_i(iw,1:ntbio) = nint(eco_o(iw,1:ntbio)*scalebioN,4)
      e_i(iw,idx_oxy) = nint(eco_o(iw,idx_oxy)*scalebioO,4)
    enddo

    b_i(0,1:ntben) = isc
    do iw=1,iw2
      b_i(iw,1:ntben) = nint(ben_o(iw,1:ntben)*scalebioN,4)
    enddo

  end subroutine wcompr_bio

  !=============================================================================

  subroutine write_bio_restart(ia, iu06, doclose, mmx, nmx, kmx, iw2, iw3, nz, &
                               msrf, mcol, kh, nl, ptc, benthos, bndz)

    use bioparam,      only : Nnorm, Onorm, NOR,   &
                              idx_amm            , &
                              idx_nit            , &
                              idx_phos           , &
                              idx_sil            , &
                              idx_dia            , &
                              idx_flag           , &
                              idx_cyano          , &
                              idx_mez            , &
                              idx_miz            , &
                              idx_det            , &
                              idx_dets           , &
                              idx_ldon           , &
                              idx_oxy            , &
                              idx_amm_with_ship_N, &
                              idx_nit_with_ship_N, &
                              idx_dia_with_ship_N, &
                              idx_flag_with_ship_N, &
                              idx_cyano_with_ship_N, &
                              idx_mez_with_ship_N, &
                              idx_miz_with_ship_N, &
                              idx_det_with_ship_N, &
                              idx_ldon_with_ship_N, &
                              idx_amm_with_river_N, &
                              idx_nit_with_river_N, &
                              idx_dia_with_river_N, &
                              idx_flag_with_river_N, &
                              idx_cyano_with_river_N, &
                              idx_mez_with_river_N, &
                              idx_miz_with_river_N, &
                              idx_det_with_river_N, &
                              idx_ldon_with_river_N, &
                              ntbio, ntben, ntbio_notag, ntben_notag,          &
                              write_binary_restart_notag
    use biopermute,    only : bio_depermute, eco_o, ben_o
    use cmod_params,   only : mainarea
    use io_subs,       only : io_new_unit
    use exits,         only : exitme
    use constants,     only : aufdat
    use cmod_miscvars, only : ihour,ctim
 
    implicit none

    integer(4), intent(in) :: ia, iu06, iw2, iw3, mmx, nmx, kmx, nz
    integer(4), intent(in) :: msrf(0:,0:), mcol(0:), kh(0:)
    integer(4), intent(in) :: nl
    logical,    intent(in) :: doclose
    real(8),    intent(in) :: ptc(0:,1:)  
    real(8),    intent(in) :: benthos(0:,1:)
    real(8),    intent(in) :: bndz(:,:,0:)

    integer(4), save :: restartunit = 0
    integer(4), save :: nz_main, kmx_main
    integer(4)       :: ios
    character(11)    :: aufdat_bio

    !  on first entry, open the restart data file:
    if (ia == 1) then
      restartunit = io_new_unit()
      open(restartunit,file='bio_restart',form='unformatted',                  &
           action='write',asynchronous='yes',access='stream', iostat=ios)
      if (ios /= 0) call exitme (1, 'Could not open bio_restart' )
      aufdat_bio(1:11) = aufdat(1:11)
      aufdat_bio(2:5)  = ctim(1:4)
      aufdat_bio(6:10) = ctim(6:10)
      write(aufdat_bio(11:11),'(I1.1)') ihour/3
      write(iu06,'(a37,a11)') 'writing restart file bio_restart at: ',aufdat_bio
      write(restartunit) aufdat_bio
    endif

    !  de-permute eco and benthos before output:
    call bio_depermute( mmx,nmx,kmx,iw2,iw3,ntbio,ntben,nl,msrf,mcol,kh,ptc,   &
                        benthos )

    !  scale data before output:
    eco_o(0:iw3,1:ntbio) = eco_o(0:iw3,1:ntbio)*Nnorm
    eco_o(0:iw3,idx_oxy)     = eco_o(0:iw3,idx_oxy)/NOR
    ben_o(0:iw2,1:ntben)   = ben_o(0:iw2,1:ntben)*Nnorm

    !  write data to restart file:
    if (write_binary_restart_notag) then
      write(restartunit,iostat=ios) eco_o(0:iw3,1:ntbio_notag), ben_o(0:iw2,1:ntben_notag)
    else
      write(restartunit,iostat=ios) eco_o(0:iw3,1:ntbio), ben_o(0:iw2,1:ntben)
    endif
    if (ios /= 0) then
      write(iu06,*) 'I/O problem - iostat is:',ios
      write(iu06,*) '                   area:',ia
      call exitme (2, 'Could not write bio_restart' )
    endif

    if (ia == mainarea) then
      kmx_main = kmx
      nz_main  = nz
    endif

    if (doclose) then
      if (nz_main >= 1) then
        write(restartunit,iostat=ios) bndz(idx_amm+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_amm
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_nit+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_nit
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_phos+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_phos
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_sil+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_sil
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_dia+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_dia
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_flag+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_flag
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_cyano+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_cyano
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_mez+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_mez
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_miz+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_miz
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_det+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_det
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_dets+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_dets
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_ldon+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_ldon
          call exitme (4, 'Could not write bio sponges' )
        endif
        write(restartunit,iostat=ios) bndz(idx_oxy+2,1:kmx_main,0:)
        if (ios /= 0) then
          write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_oxy
          call exitme (4, 'Could not write bio sponges' )
        endif
        if (.not. write_binary_restart_notag) then
          write(restartunit,iostat=ios) bndz(idx_amm_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_amm_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_nit_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_nit_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_dia_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_dia_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_flag_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_flag_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_cyano_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_cyano_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_mez_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_mez_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_miz_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_miz_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_det_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_det_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_ldon_with_ship_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_ldon_with_ship_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_amm_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_amm_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_nit_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_nit_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_dia_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_dia_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_flag_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_flag_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_cyano_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_cyano_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_mez_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_mez_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_miz_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_miz_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_det_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_det_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
          write(restartunit,iostat=ios) bndz(idx_ldon_with_river_N+2,1:kmx_main,0:)
          if (ios /= 0) then
            write(iu06,*) 'I/O problem - ia, iostat and tracer index are:',mainarea,ios, idx_ldon_with_river_N
            call exitme (4, 'Could not write bio sponges' )
          endif
        endif
      endif

      !  on last entry, close restart data file:
      close(restartunit)
    endif

  end subroutine write_bio_restart

  !=============================================================================
  subroutine val_benthos(ia, iu06, n2d, benthos, ntben, header)

    use io_subs,   only : flush_unit
    use constants, only : zero, one

    implicit none

    integer(4), intent(in) :: ia, iu06, n2d, ntben
    real(8),    intent(in) :: benthos(0:,1:)
    logical,    intent(in) :: header

    integer(4) :: ib, iben
    real(8)    :: bmean, fac1, fac2

    if (header) write(iu06,'(a26)') 'Benthos validation prints:'
    write(iu06,'(a72)')                                                        &
      '------------------------------------------------------------------------'
    write(iu06,'(a33,i5)') 'Statistics for domain:           ', ia
    
    do iben=1,ntben
      write(iu06,'(a33,i5)') '  Benthos variable:              ', iben
      bmean = zero
      do ib=0,n2d-1
        fac2  = real(ib,8)
        fac1  = one/(fac2 + one)
        bmean = (bmean*fac2 + benthos(ib+1,iben))*fac1
      enddo
      write(iu06,'(a33,f16.10)')           '    Average value:               ',&
                                        bmean
      write(iu06,'(a33,f16.10,5x,f16.10)') '    Min and max:                 ',&
                  minval(benthos(1:,iben)), maxval(benthos(1:,iben))
    enddo
    write(iu06,'(a72)')                                                        &
    '------------------------------------------------------------------------'
    call flush_unit(iu06)

  end subroutine val_benthos
  !=============================================================================
  !----------------------------------------------------------------------------
  subroutine diag_out(ia,idiag,diag,msrf,mcol,kh,mmx,nmx,kmx)
    !subroutine to coordinate output of diagnostic variables
  
    implicit none
  
    integer(4), intent(in) :: ia
    integer(4), intent(in) :: idiag
    integer(4), intent(in) :: msrf(0:,0:),mcol(0:),kh(0:)
    integer(4), intent(in) :: mmx,nmx,kmx
    real(8),    intent(in) :: diag(1:) !(1:iw3)

    !---------------------------------------------------------------------------
    !
    ! Please note: This subroutine works only with netcdf output so far - using
    !              default output it is just an interface that enables 
    !              compilation of the source code. Therfore we will 
    !              allow unused variables to be present here as long IO is not 
    !              completely revised.
    !
    !---------------------------------------------------------------------------

  end subroutine diag_out 

end module biooutput
