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_matrix(T_file,Q_file,P_file,g_file,
     &     nu_file,ck_file,
     &     Nt,Nx,Np,Nb,Nq,T,P,logP,x,nu_lo,nu_hi,lambda_lo,lambda_hi,w,
     &     ka)
      implicit none
      include 'max.inc'
      include 'constants.inc'
      include 'formats.inc'
c
c     Purpose: to read correlated-k data from Benjamin Charnay (LMD), for 141 thermodynamic conditions sets
c
c     Input:
c       + T_file: file containing relevant temperature data
c       + Q_file: file containgin relevant concentration data
c       + P_file: file containing relevant pressure data
c       + g_file: file containing relevant quadrature weights
c       + nu_file: file containing relevant narrowband data
c       + ck_file: file containing the ck-matrix for the above files
c
c     Output:
c       + Nt: number of temperature levels
c       + Nx: number of concentration levels
c       + Np: number of pressure levels
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature order
c       + T: temperature of each level (K)
c       + P: pressure levels (Pa)
c       + logP: levels of log(pressure)
c       + x: concentrations levels
c       + nu_lo: lower limit of each narrowband (cm^-1)
c       + nu_hi: higher limit of each narrowband (cm^-1)
c       + lambda_lo: lower limit of each narrowband (Âµm)
c       + lambda_hi: higher limit of each narrowband (Âµm)
c       + w: quadrature weights
c       + ka: absorption coefficient (cm^2/molecule) for each thermodynamic condition set
c
c     I/O
      character*(Nchar_mx) T_file,Q_file,P_file,g_file,nu_file,ck_file
      integer Nt,Nx,Np,Nb,Nq
      double precision T(1:Nt_mx)
      double precision P(1:Np_mx)
      double precision logP(1:Np_mx)
      double precision x(1:Nx_mx)
      double precision nu_lo(1:Nb_mx)
      double precision nu_hi(1:Nb_mx)
      double precision lambda_lo(1:Nb_mx)
      double precision lambda_hi(1:Nb_mx)
      double precision w(1:Nq_mx)
      double precision ka(1:Nt_mx,1:Nx_mx,1:Np_mx,1:Nb_mx,1:Nq_mx)
c     temp
      integer it,ix,ip,band,quad
      integer Nmol,mol
      integer Nk,ik
      integer Nq_p1
      character*(Nchar_mx) mol_name(1:Nmol_mx)
      double precision sum_w
      double precision idx(1:Np_mx)
      double precision kbar(1:Nb_mx)
      double precision dt(1:Nt_mx*Nx_mx*Np_mx*Nb_mx*Nq_mx)
      integer ios
      character*(Nchar_mx) file
c     Debug
c      double precision t1,t2
      double precision k_abs
      double precision ka_bar
      double precision Tref,Pref
c     Debug
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine read_ck_matrix'

      open(10,file=T_file(1:strlen(T_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) T_file(1:strlen(T_file))
         stop
      endif
      write(*,*) 'reading: ',T_file(1:strlen(T_file)),' ...'
      read(10,*) Nt
      if (Nt.gt.Nt_mx) then
         call error(label)
         write(*,*) 'Nt=',Nt
         write(*,*) 'while Nt_mx=',Nt_mx
         stop
      endif
      do it=1,Nt
         read(10,*) T(it) ! K
      enddo ! it
      close(10)
      write(*,*) '...done'
c     Debug
c      do it=1,Nt
c         write(*,*) it,T(it)
c      enddo
c      stop
c     Debug

      open(10,file=Q_file(1:strlen(Q_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) Q_file(1:strlen(Q_file))
         stop
      endif
      write(*,*) 'reading: ',Q_file(1:strlen(Q_file)),' ...'
      read(10,*) Nmol
      if (Nmol.gt.Nmol_mx) then
         call error(label)
         write(*,*) 'Nmol=',Nmol
         write(*,*) 'while Nmol_mx=',Nmol_mx
         stop
      endif
      do mol=1,Nmol
         read(10,10) mol_name(mol)
      enddo
      read(10,*) Nx
      if (Nx.gt.Nx_mx) then
         call error(label)
         write(*,*) 'Nx=',Nx
         write(*,*) 'while Nx_mx=',Nx_mx
         stop
      endif
      do ix=1,Nx
         read(10,*) x(ix)
      enddo
      close(10)
      write(*,*) '...done'

      open(10,file=P_file(1:strlen(P_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) P_file(1:strlen(P_file))
         stop
      endif
      write(*,*) 'reading: ',P_file(1:strlen(P_file)),' ...'
      read(10,*) Np
      if (Np.gt.Np_mx) then
         call error(label)
         write(*,*) 'Np=',Np
         write(*,*) 'while Np_mx=',Np_mx
         stop
      endif
      do ip=1,Np
         read(10,*) idx(ip)
      enddo ! ip
      do ip=1,Np
c         logP(ip)=idx(ip)-2.0D+0
         logP(ip)=idx(ip)
         P(ip)=10.0D+0**(logP(ip)) ! mb
c     Debug
c         write(*,*) logP(ip),P(ip)
c     Debug
c         P(ip)=P(ip)*1.013D+5 ! atm -> Pa
         P(ip)=P(ip)*1.0D+2 ! mb -> Pa
c     Debug
c         write(*,*) 'P(',ip,')=',P(ip),P(ip)/1013.0D+2
c     Debug
      enddo
      close(10)
      write(*,*) '...done'
c     Debug
c      do ip=1,Np
c         write(*,*) 'P(',ip,')=',P(ip),P(ip)/1013.0D+2
c      enddo                     ! ip
c      stop
c     Debug

      open(12,file=g_file(1:strlen(g_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) g_file(1:strlen(g_file))
         stop
      endif
      write(*,*) 'reading: ',g_file(1:strlen(g_file)),' ...'
      read(12,*) Nq_p1
      Nq=Nq_p1-1
      if (Nq.gt.Nq_mx) then
         call error(label)
         write(*,*) 'Nq=',Nq
         write(*,*) 'while Nq_mx=',Nq_mx
         stop
      endif
      do quad=1,Nq
         read(12,*) w(quad)
      enddo ! quad
      close(12)
      write(*,*) '...done'
c     Debug
c      do quad=1,Nq
c         write(*,*) quad,w(quad)
c      enddo ! quad
c     Debug
      sum_w=0.0D+0
      do quad=1,Nq
         sum_w=sum_w+w(quad)
      enddo ! quad
c     Debug
c      write(*,*) 'sum_w=',sum_w
c      stop
c     Debug

      open(13,file=nu_file(1:strlen(nu_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) nu_file(1:strlen(nu_file))
         stop
      endif
      write(*,*) 'reading: ',nu_file(1:strlen(nu_file)),' ...'
      read(13,*) Nb
      if (Nb.gt.Nb_mx) then
         call error(label)
         write(*,*) 'Nb=',Nb
         write(*,*) 'while Nb_mx=',Nb_mx
         stop
      endif
      do band=1,Nb
         read(13,*) nu_lo(band),nu_hi(band)
         lambda_lo(band)=1.0D+4/nu_hi(band)
         lambda_hi(band)=1.0D+4/nu_lo(band)
      enddo ! band
      close(13)
      write(*,*) '...done'
c     Debug
c      do band=1,Nb
c         write(*,*) band,nu_lo(band),nu_hi(band)
c      enddo
c      stop
c     Debug

      Nk=Nt*Nx*Np*Nb*Nq_p1
      if (Nk.gt.Nt_mx*Nx_mx*Np_mx*Nb_mx*Nq_mx) then
         call error(label)
         write(*,*) 'Nk=',Nk
         write(*,*) 'while Nt_mx*Nx_mx*Np_mx*Nb_mx*Nq_mx=',
     &        Nt_mx*Nx_mx*Np_mx*Nb_mx*Nq_mx
      endif
c     Debug
c      write(*,*) 'Nk=',Nk
c      write(*,*) 'Nq_p1=',Nq_p1
c      write(*,*) 'Nb=',Nb
c      write(*,*) 'Np=',Np
c      write(*,*) 'Nx=',Nx
c      write(*,*) 'Nt=',Nt
c      stop
c     Debug

      open(14,file=ck_file(1:strlen(ck_file)),
     &     status='old',iostat=ios)
      if (ios.ne.0) then        ! file not found
         call error(label)
         write(*,*) 'File could not be found:'
         write(*,*) ck_file(1:strlen(ck_file))
         stop
      endif
      write(*,*) 'reading: ',ck_file(1:strlen(ck_file)),' ...'
      read(14,49) (dt(ik),ik=1,Nk) ! cm^2/molec
      close(14)
      write(*,*) '...done'

      ik=0
      do quad=1,Nq_p1
         do band=1,Nb
            do ix=1,Nx
               do ip=1,Np
                  do it=1,Nt
                     ik=ik+1
                     ka(it,ix,ip,band,quad)=dt(ik) ! cm^2/molecule
                  enddo         ! it
               enddo            ! ix
            enddo               ! ip
         enddo                  ! quad
      enddo                     ! band
      
      return
      end

