! Module   : synspec_to_specint
! Purpose  : create a specint file from a synspec file
!
! Copyright 2021-2023 Rich Townsend & The MSG Team
!
! This file is part of MSG. MSG is free software: you can redistribute
! it and/or modify it under the terms of the GNU General Public
! License as published by the Free Software Foundation, version 3.
!
! MSG is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
! or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
! License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program.  If not, see <http://www.gnu.org/licenses/>.

#:include 'forum.inc'

program synspec_to_specint

   ! Uses

   use forum_m
   use math_m
   use msg_m

   use ISO_FORTRAN_ENV
   use IEEE_ARITHMETIC

   ! No implicit typing

   implicit none

   ! Variables

   character(:), allocatable :: synspec_file_name
   integer                   :: n_mu
   real(RD)                  :: mu_0
   real(RD)                  :: R
   real(RD)                  :: lam_min
   real(RD)                  :: lam_max
   character(:), allocatable :: law_str
   character(:), allocatable :: specint_file_name

   type(limb_t)              :: limb
   real(RD), allocatable     :: I_in(:,:)
   real(RD), allocatable     :: lam_in(:)
   real(RD)                  :: w_0
   real(RD)                  :: dw
   integer                   :: n_lam
   integer                   :: j
   real(RD), allocatable     :: mu(:)
   type(log_range_t)         :: range
   real(RD), allocatable     :: lam(:)
   real(RD), allocatable     :: I(:,:)
   type(limb_specint_t)      :: specint
   type(hdf5io_t)            :: hdf5io
   type(hdf5io_t)            :: hdf5io_labels
   character(:), allocatable :: label
   real(RD)                  :: value

   ! Read command-line arguments

   @:ASSERT(n_arg() >= 8 .AND. MOD(n_arg(), 2)==0, 'Syntax: synspec_to_specint synspec_file_name n_mu mu_0 lam_min lam_max R law_str specint_file_name [label value]')

   call get_arg(1, synspec_file_name)
   call get_arg(2, n_mu)
   call get_arg(3, mu_0)
   call get_arg(4, lam_min)
   call get_arg(5, lam_max)
   call get_arg(6, R)
   call get_arg(7, law_str)
   call get_arg(8, specint_file_name)

   ! Set up the limb-darkening law & angle axis

   if (n_mu >= 2) then
      limb = limb_t(law_str)
      mu = [((mu_0*(n_mu-j) + 1._RD*(j-1))/(n_mu-1), j=1,n_mu)]
   else
      limb = limb_t('CONST')
      n_mu = 1
      mu = [1._RD]
   end if

   ! Read data from the synspec file

   call read_data(synspec_file_name, n_mu, lam_in, I_in)

   @:ASSERT(lam_min >= lam_in(1),'out-of-bounds lam_min')
   @:ASSERT(lam_max <= lam_in(SIZE(lam_in)),'out-of-bounds lam_max')

   ! Set up the output wavelength axis (uniform resolution)

   dw = 1._RD/R
   w_0 = LOG(lam_min)
   n_lam = FLOOR((LOG(lam_max) - LOG(lam_min))/dw) + 1

   range = log_range_t(w_0, dw, n_lam)

   allocate(lam(n_lam))
   call range%unpack(lam)

   lam(1) = MAX(lam_in(1), lam_min)
   lam(n_lam) = MIN(lam_in(SIZE(lam_in)), lam(n_lam))

   write(OUTPUT_UNIT, *) 'output lam range:', lam(1), lam(n_lam)

   ! Bin the data onto this axis

   call bin_data(lam_in, I_in, lam, I)
 
   ! Create specint

   specint = limb_specint_t(I, mu, range, limb, precise=.FALSE.)

   ! Write it (together with labels)

   hdf5io = hdf5io_t(specint_file_name, CREATE_FILE)

   call specint%write(hdf5io)

   hdf5io_labels = hdf5io_t(hdf5io, 'labels')

   do j = 9, n_arg(), 2
      call get_arg(j, label)
      call get_arg(j+1, value)
      call hdf5io_labels%write_attr(label, value)
   end do

   call hdf5io_labels%final()

   call hdf5io%final()

   ! Finish

contains

   subroutine read_data (file_name, n_mu, lam, I)

      character(*), intent(in)           :: file_name
      integer, intent(in)                :: n_mu
      real(RD), allocatable, intent(out) :: lam(:)
      real(RD), allocatable, intent(out) :: I(:,:)

      integer, allocatable :: ind(:)
      integer              :: d_lam
      integer              :: n_lam
      integer              :: i_lam
      integer              :: n_dup

      ! Determine the type of file to read based on n_mu:
      !  n_mu >= 2 -- intensity (SYNSPEC fort.10/fort.18 files)
      !  n_mu < 2  -- flux (SYNSPEC fort.7 file)

      if (n_mu >= 2) then
         call read_data_int(file_name, n_mu, lam, I)
      else
         call read_data_flx(file_name, lam, I)
      end if

      ! Sort the data by wavelength

      ind = sort_indices(lam)

      lam = lam(ind)
      I = I(:,ind)

      ! Merge duplicate points

      n_lam = 1
      d_lam = SIZE(lam)

      n_dup = 0

      merge_loop : do i_lam = 2,d_lam

         if(lam(i_lam) == lam(n_lam)) then

            I(:,n_lam) = I(:,n_lam) + I(:,i_lam)
            n_dup = n_dup + 1

         else

            if(n_dup > 0) then

               I(:,n_lam) = I(:,n_lam)/(n_dup + 1)
               n_dup = 0

            endif

            n_lam = n_lam + 1

            lam(n_lam) = lam(i_lam)
            I(:,n_lam) = I(:,i_lam)

         endif

      end do merge_loop

      if(n_dup > 0) then
         I(:,n_lam) = I(:,n_lam)/(n_dup + 1)
      endif

      d_lam = n_lam

      call reallocate(lam, [d_lam])
      call reallocate(I, [n_mu,d_lam])

      write(OUTPUT_UNIT, *) 'n_lam (merged)  :', n_lam
      write(OUTPUT_UNIT, *) 'lam_min (read)  :', lam(1)
      write(OUTPUT_UNIT, *) 'lam_max (read)  :', lam(n_lam)

      ! Finish

      return

   end subroutine read_data

   !****

   subroutine read_data_int (file_name, n_mu, lam, I)

      character(*), intent(in)           :: file_name
      integer, intent(in)                :: n_mu
      real(RD), allocatable, intent(out) :: lam(:)
      real(RD), allocatable, intent(out) :: I(:,:)

      character(LEN=11) :: header
      character(LEN=11) :: form
      integer           :: unit
      real(RD)          :: H
      integer           :: d_lam
      integer           :: n_lam

      ! Determine the format of the input file

      open(NEWUNIT=unit, FILE=file_name, STATUS='OLD', FORM='UNFORMATTED')
      read(unit) header
      close(unit)

      if (header == 'SYNSPEC INT') then
         form = 'UNFORMATTED'
      else
         form = 'FORMATTED'
      end if

      ! Open the input file

      open(NEWUNIT=unit, FILE=file_name, STATUS='OLD', FORM=form)

      if (form == 'UNFORMATTED') then
         read(unit) header
      end if

      ! Read in the wavelength and intensity data

      d_lam = 1024

      allocate(lam(d_lam))
      allocate(I(n_mu,d_lam))

      n_lam = 0

      read_loop : do

         n_lam = n_lam + 1

         ! If necessary, expand arrays

         if(n_lam > d_lam) then
            d_lam = d_lam*2
            call reallocate(lam, [d_lam])
            call reallocate(I, [n_mu,d_lam])
         endif

         ! Read a block of data

         select case(form)
         case('UNFORMATTED')
            read(unit, END=100) lam(n_lam), H, I(:,n_lam)
         case('FORMATTED')
            read(unit, *, END=100) lam(n_lam), H
            read(unit,*) I(:,n_lam)
         end select

         ! Check for NaN intensities

         if (ANY(IEEE_IS_NAN(I(:,n_lam)))) then
            n_lam = n_lam - 1
            cycle read_loop
         end if

         ! Fix negative intensities

         I(:,n_lam) = MAX(I(:,n_lam), 0._RD)

         ! Reverse order

         I(:,n_lam) = I(n_mu:1:-1,n_lam)

         ! Convert from to ergs/s/cm**2/Hz/sr to ergs/s/cm**2/Angstrom/sr

         I(:,n_lam) = I(:,n_lam)*C_LIGHT/(lam(n_lam)*1E-8_RD)**2*1E-8_RD

      end do read_loop

100   continue

      close(unit)

      n_lam = n_lam - 1
      d_lam = n_lam

      call reallocate(lam, [d_lam])
      call reallocate(I, [n_mu,d_lam])

      write(OUTPUT_UNIT, *) 'n_lam (as read) :', n_lam

      ! Finish

      return

   end subroutine read_data_int

   !****

   subroutine read_data_flx (file_name, lam, I)

      character(*), intent(in)           :: file_name
      real(RD), allocatable, intent(out) :: lam(:)
      real(RD), allocatable, intent(out) :: I(:,:)

      character(LEN=11) :: header
      character(LEN=11) :: form
      integer           :: unit
      integer           :: d_lam
      integer           :: n_lam
      real(RD)          :: H

      ! Determine the format of the input file

      open(NEWUNIT=unit, FILE=file_name, STATUS='OLD', FORM='UNFORMATTED')
      read(unit) header
      close(unit)

      if (header == 'SYNSPEC FLX') then
         form = 'UNFORMATTED'
      else
         form = 'FORMATTED'
      end if

      ! Open the input file

      open(NEWUNIT=unit, FILE=file_name, STATUS='OLD', FORM=form)

      if (form == 'UNFORMATTED') then
         read(unit) header
      end if

      ! Read in the wavelength and flux

      d_lam = 1024

      allocate(lam(d_lam))
      allocate(I(1,d_lam))

      n_lam = 0

      read_loop : do

         n_lam = n_lam + 1

         ! If necessary, expand arrays

         if(n_lam > d_lam) then
            d_lam = d_lam*2
            call reallocate(lam, [d_lam])
            call reallocate(I, [1,d_lam])
         endif

         ! Read a block of data

         select case(form)
         case('UNFORMATTED')
            read(unit, END=100) lam(n_lam), H
         case('FORMATTED')
            read(unit, *, END=100) lam(n_lam), H
         end select

         ! Check for NaN fluxes

         if (IEEE_IS_NAN(H)) then
            n_lam = n_lam - 1
            cycle read_loop
         end if

         ! Fix negative fluxes

         H = MAX(H, 0._RD)

         ! Convert from Eddington flux to equivalent intensity in ergs/s/cm**2/Angstrom/sr

         I(1,n_lam) = 4._RD*H

      end do read_loop

100   continue

      close(unit)

      n_lam = n_lam - 1
      d_lam = n_lam

      call reallocate(lam, [d_lam])
      call reallocate(I, [1,d_lam])

      write(OUTPUT_UNIT, *) 'n_lam (as read) :', n_lam

      ! Finish

      return

   end subroutine read_data_flx

   !****

   subroutine bin_data(lam_in, I_in, lam, I)

      real(RD), intent(in)               :: lam_in(:)
      real(RD), intent(in)               :: I_in(:,:)
      real(RD), intent(in)               :: lam(:)
      real(RD), allocatable, intent(out) :: I(:,:)

      integer  :: n_mu
      integer  :: n_lam
      integer  :: k
      integer  :: j

      @:CHECK_BOUNDS(SIZE(I_in, 2), SIZE(lam_in))

      ! Convert the piecewise-linear intensity data I_in(:,lam_in) to the binned data I(:,lam)

      n_mu = SIZE(I_in, 1)
      n_lam = SIZE(lam)

      ALLOCATE(I(n_mu,n_lam-1))

      mu_loop : do j = 1, n_mu

         lam_loop : do k = 1, n_lam-1
            I(j,k) = integrate_lin(lam_in, I_in(j,:), lam(k), lam(k+1))/(lam(k+1) - lam(k))
         end do lam_loop

      end do mu_loop

      ! Finish

   end subroutine bin_data

end program synspec_to_specint
