c     Copyright (C)
c     2010-2013 Université Bordeaux 1
c     2010-2013 Ecole des Mines d'Albi
c     2014-2018 - Mesostar
c     
c     This program is free software; you can redistribute it and/or modify
c     it under the terms of the GNU General Public License as published by
c     the Free Software Foundation; either version 2, or (at your option)
c     any later version.

c     This program is distributed in the hope that it will be useful,
c     but WITHOUT ANY WARRANTY; without even the implied warranty of
c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
c     GNU General Public License for more details.

c     You should have received a copy of the GNU General Public License
c     along with this program; if not, write to the Free Software
c     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
c     USA.
c
      subroutine read_ck(data_file,
     &     Nlay,Nb,Nq,
     &     lambda_lo,lambda_hi,
     &     w_quad,
     &     epsilon_ground,
     &     ck)
      implicit none
      include 'max.inc'
      include 'formats.inc'
c
c     Purpose: to read the CK data set
c
c     Input:
c       + data_file: input data file
c
c     Output:
c       + Nlay: number of atmospheric layers
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature index
c       + lamnda_lo: lower limit of each spectral band
c       + lamnda_hi: higher limit of each spectral band
c       + w_quad: quadrature weights
c       + epsilon_ground: ground emissivity for each spectral band
c       + ck: ck data set (inv. meters)
c
c     I/O
      character*(Nchar_mx) data_file
      integer Nlay,Nb
      integer Nq(1:Nb_mx)
      double precision lambda_lo(1:Nb_mx)
      double precision lambda_hi(1:Nb_mx)
      double precision w_quad(1:Nb_mx,1:Nq_mx)
      double precision epsilon_ground(1:Nb_mx)
      double precision ck(1:Nlay_mx,1:Nb_mx,1:Nq_mx)
c     temp
      integer ios
      integer lay,band,quad
      double precision nu_lo(1:Nb_mx)
      double precision nu_hi(1:Nb_mx)
      double precision sum_w
      double precision epsilon_ka
      parameter(epsilon_ka=1.0D-10)
c     Debug
      integer q
c     Debug
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine read_ck'

      write(*,*) 'Opening file: ',trim(data_file)
      open(10,file=data_file(1:strlen(data_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) data_file(1:strlen(data_file))
         stop
      endif
c     Read the data
      read(10,*) Nlay
      read(10,*) Nb
      do band=1,Nb
         read(10,*) Nq(band)
         read(10,*) lambda_lo(band),
     &        lambda_hi(band),
     &        epsilon_ground(band)
         read(10,48) (w_quad(band,quad),quad=1,Nq(band))
         do quad=1,Nq(band)
            read(10,48) (ck(lay,band,quad),lay=1,Nlay) ! m^-1
         enddo                  ! quad
      enddo                     ! band
      close(10)
c     Consistency check
      if (Nlay.lt.1) then
         call error(label)
         write(*,*) 'Nlay=',Nlay
         write(*,*) 'is < 1'
         stop
      endif
      if (Nb.lt.1) then
         call error(label)
         write(*,*) 'Nb=',Nb
         write(*,*) 'is < 1'
         stop
      endif                     !
      if (Nlay.gt.Nlay_mx) then
         call error(label)
         write(*,*) 'Nlay=',Nlay
         write(*,*) 'is > Nlay_mx=',Nlay_mx
         stop
      endif
      if (Nb.gt.Nb_mx) then
         call error(label)
         write(*,*) 'Nb=',Nb
         write(*,*) 'is > Nb_mx=',Nb_mx
         stop
      endif
      do band=1,Nb
         if (Nq(band).lt.1) then
            call error(label)
            write(*,*) 'Nq=',Nq
            write(*,*) 'is < 1'
            stop
         endif
         if (Nq(band).gt.Nq_mx) then
            call error(label)
            write(*,*) 'Nq(',band,')=',Nq(band)
            write(*,*) 'is > Nq_mx=',Nq_mx
            stop
         endif
      enddo                     ! band
      do band=1,Nb
         if (epsilon_ground(band).lt.0.0D+0) then
            call error(label)
            write(*,*) 'epsilon_ground(',band,')=',
     &           epsilon_ground(band)
            write(*,*) 'is < 0'
            stop
         endif
         if (epsilon_ground(band).gt.1.0D+0) then
            call error(label)
            write(*,*) 'epsilon_ground(',band,')=',
     &           epsilon_ground(band)
            write(*,*) 'is > 1'
            stop
         endif
         sum_w=0.0D+0
         do quad=1,Nq(band)
            sum_w=sum_w+w_quad(band,quad)
         enddo                  ! quad
         if (dabs(sum_w-1.0D+0).gt.1.0D-5) then
            call error(label)
            write(*,*) 'Sum of quadrature weights=',sum_w
            write(*,*) 'for band=',band
            write(*,*) 'lambda_lo=',lambda_lo(band)
            write(*,*) 'lambda_hi=',lambda_hi(band)
            do quad=1,Nq(band)
               write(*,*) 'w_quad(',quad,')=',w_quad(band,quad)
            enddo               ! quad
            stop
         endif
      enddo                     ! band
      do band=1,Nb-1
         if (lambda_hi(band).ne.lambda_lo(band+1)) then
            call error(label)
            write(*,*) 'lambda_hi(',band,')=',
     &           lambda_hi(band)
            write(*,*) 'is not = lambda_lo(',band+1,')=',
     &           lambda_lo(band+1)
            stop
         endif
      enddo                     ! band
      do lay=1,Nlay
         do band=1,Nb
            do quad=1,Nq(band)
               if (ck(lay,band,quad).lt.0.0D+0) then
                  call error(label)
                  write(*,*) 'ck(',lay,',',band,',',quad,')=',
     &                 ck(lay,band,quad)
                  write(*,*) 'MUST BE POSITIVE'
                  write(*,*) 'otherwise computation will fail'
                  stop
               endif
               if (dabs(ck(lay,band,quad)).eq.0.0D+0) then
                  ck(lay,band,quad)=epsilon_ka
               endif
            enddo               ! quad
         enddo                  ! band
      enddo                     ! lay
c     Consistency check

      return
      end



      subroutine read_dkdT(data_file,
     &     Nlay,Nb,Nq,
     &     dka_dT)
      implicit none
      include 'max.inc'
      include 'formats.inc'
c
c     Purpose: to read the d(k)/d(T) data set
c
c     Input:
c       + data_file: input data file
c       + Nlay: number of atmospheric layers
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature index
c
c     Output:
c       + dka_dT: d(k)/d(T) data set (m^-1/K)
c
c     I/O
      character*(Nchar_mx) data_file
      integer Nlay,Nb,Nq
      double precision dka_dT(1:Nlay_mx,1:Nb_mx,1:Nq_mx)
c     temp
      integer ios
      integer lay,band,quad
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine read_dkdT'

      open(10,file=data_file(1:strlen(data_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) data_file(1:strlen(data_file))
         stop
      else
c     Read the data
         do band=1,Nb
            do quad=1,Nq
c     dka_dT(lay,band,quad) is the sensitivity of ka(lay,band,quad) to
c     temperature in layer index "lay" T(lay)
               read(10,48) (dka_dT(lay,band,quad),lay=1,Nlay)
            enddo               ! quad
         enddo                  ! band
      endif
      close(10)

      return
      end



      subroutine read_dkdX(data_file,
     &     Nlay,Nb,Nq,
     &     Nx,dka_dX)
      implicit none
      include 'max.inc'
      include 'formats.inc'
c
c     Purpose: to read the d(k)/d(X) data set
c
c     Input:
c       + data_file: input data file
c       + Nlay: number of atmospheric layers
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature index
c
c     Output:
c       + Nx: number of molecular species
c       + dka_dX: d(k)/d(X) data set (m^-1/[x])
c
c     I/O
      character*(Nchar_mx) data_file
      integer Nlay,Nb,Nq
      integer Nx
      double precision dka_dX(1:Nlay_mx,1:Nb_mx,1:Nq_mx,1:Nx_mx)
c     temp
      integer ios
      integer lay,band,quad,ix
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine read_dkdX'

      open(10,file=data_file(1:strlen(data_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) data_file(1:strlen(data_file))
         stop
      else
c     Read the data
         read(10,*) Nx
         if (Nx.gt.Nx_mx) then
            call error(label)
            write(*,*) 'Nx=',Nx
            write(*,*) 'while Nx_mx=',Nx_mx
            stop
         endif
         do band=1,Nb
            do quad=1,Nq
c     dka_dX(lay,band,quad,ix) is the sensitivity of ka(lay,band,quad) to
c     the concentration of species index "ix", X(ix)
               do ix=1,Nx
                  read(10,48) (dka_dX(lay,band,quad,ix),lay=1,Nlay)
               enddo            ! ix
            enddo               ! quad
         enddo                  ! band
      endif
      close(10)

      return
      end
