source: trunk/LMDZ.GENERIC/libf/phystd/interpolateH2O_self_foreign.F90 @ 2613

     subroutine interpolateH2O_self_foreign(wn,temp,presS,presF,abcoef,firstcall,ind)

!==================================================================
!     
!     Purpose
!     -------
!     Calculates the H2O continuum self and foreign opacity
!     using lookup tables from MT_CKD version 3.3
!
!     Authors
!     -------
!     M. Turbet (2020)
!     Adapted from the file of R. Wordsworth
!     
!==================================================================

      use datafile_mod, only: datadir
      implicit none

      ! input
      double precision wn                 ! wavenumber             (cm^-1)
      double precision temp               ! temperature            (Kelvin)
      double precision presS              ! self-pressure          (Pascals)
      double precision presF              ! foreign (air) pressure (Pascals)

      ! output
      double precision abcoef             ! absorption coefficient (m^-1)

      integer nS,nT, iT
      parameter(nS=2001)    ! number of wavenumbers
      parameter(nT=39)      ! number of temperatures

      double precision kB
      parameter(kB=1.3806488e-23)

      double precision amagatS, amagatF, abcoefS, abcoefF, Nmolec
      double precision wn_arr(nS)
      double precision temp_arr(nT)
      double precision abs_arrS(nS,nT)
      double precision abs_arrF(nS,nT)
      double precision data_tmp(nT)
      
      character*43 dummy_var1
      character*46 dummy_var2

      integer nres

      double precision Ttemp

      character(LEN=*), parameter :: fmat1 = "(A43,I6,F6.1)"
      character(LEN=*), parameter :: fmat2 = "(A46,I6,F6.1)"


      integer k,ind
      logical firstcall

      save wn_arr, temp_arr, abs_arrS, abs_arrF !read by master

      character*100 dt_file
      integer strlen,ios

      amagatS=(273.15/temp)*(presS/101325.0)
      amagatF=(273.15/temp)*(presF/101325.0)

      if(firstcall)then ! called by sugas_corrk only
         print*,'----------------------------------------------------'
         print*,'Initialising H2O continuum from MT_CKD data...'

!     1.1 Open the ASCII files

!$OMP MASTER

         ! self broadening
         dt_file=TRIM(datadir)//'/continuum_data/H2O-H2O_continuum_MT_CKD3.3.cia'
         open(34,file=dt_file,form='formatted',status='old',iostat=ios)
         if (ios.ne.0) then        ! file not found
           write(*,*) 'Error from interpolateH2O_cont SELF'
           write(*,*) 'Data file ',trim(dt_file),' not found.'
           write(*,*) 'Check that your path to datagcm:',trim(datadir)
           write(*,*) ' is correct. You can change it in callphys.def with:'
           write(*,*) ' datadir = /absolute/path/to/datagcm'
           write(*,*) ' Check that there is a H2O-H2O_continuum_MT_CKD3.3.cia'
           write(*,*)'Continuum file available here:'
           write(*,*)' https://www.lmd.jussieu.fr/~lmdz/planets/LMDZ.GENERIC/datagcm/continuum_data/'
           call abort
         else
           do iT=1,nT
             read(34,fmat1) dummy_var1,nres,Ttemp
             if(nS.ne.nres)then
               print*,'Resolution given in file: ',trim(dt_file)
               print*,'is ',nres,', which does not match nS.'
               print*,'Adjust nS value in interpolateH2O_MTCKD...F90'
               stop
             endif
             temp_arr(iT)=Ttemp
             !write(*,*) 'H2O_H2O'
             do k=1,nS
               read(34,*) wn_arr(k),abs_arrS(k,it)
               !write(*,*) nres,temp_arr(iT),wn_arr(k),abs_arrS(k,it)
             end do
           end do
         endif
         close(34)
           
         ! foreign broadening
         dt_file=TRIM(datadir)//'/continuum_data/H2O-AIR_continuum_MT_CKD3.3.cia'
         open(35,file=dt_file,form='formatted',status='old',iostat=ios)
         if (ios.ne.0) then        ! file not found
           write(*,*) 'Error from interpolateH2O_cont FOREIGN'
           write(*,*) 'Data file ',trim(dt_file),' not found.'
           write(*,*)'Check that your path to datagcm:',trim(datadir)
           write(*,*)' is correct. You can change it in callphys.def with:'
           write(*,*)' datadir = /absolute/path/to/datagcm'
           write(*,*)' Check that there is a H2O-AIR_continuum_MT_CKD3.3.cia'
           write(*,*)'Continuum file available here:'
           write(*,*)' https://www.lmd.jussieu.fr/~lmdz/planets/LMDZ.GENERIC/datagcm/continuum_data/'
           call abort
         else
           do iT=1,nT
             read(35,fmat2) dummy_var2,nres,Ttemp
             if(nS.ne.nres)then
               print*,'Resolution given in file: ',trim(dt_file)
               print*,'is ',nres,', which does not match nS.'
               print*,'Adjust nS value in interpolateH2O_MTCKD...F90'
               stop
             endif
             temp_arr(iT)=Ttemp
             !write(*,*) 'H2O_AIR'
             do k=1,nS
               read(35,*) wn_arr(k),abs_arrF(k,it)
               !write(*,*) nres,temp_arr(iT),wn_arr(k),abs_arrF(k,it)
             end do
           end do
         endif
         close(35)

         print*,'interpolateH2O_MTCKDcont: At wavenumber ',wn,' cm^-1'
         print*,'   temperature ',temp,' K'
         print*,'   H2O pressure ',presS,' Pa'
         print*,'   air pressure ',presF,' Pa'
!$OMP END MASTER
!$OMP BARRIER
         
      endif

      call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arrS,wn,temp,abcoefS,ind)
      !print*,'MTCKD - self absorption is ',abcoefS,' cm^2 molecule^-1'

      call bilinearbig(nS,nT,wn_arr,temp_arr,abs_arrF,wn,temp,abcoefF,ind)
      !print*,'MTCKD - foreign absorption is ',abcoefF,' cm^2 molecule^-1'

! abcoefS and abcoefF are in cm-1 amagat-2
! First we multiply by amagat^2
      abcoef = abcoefS*amagatS + abcoefF*amagatF
      abcoef = abcoef*amagatS
! Then we convert cm-1 in m-1
      abcoef = 100.*abcoef
      
      !print*,'MTCKD_v3.3 : So the total absorption is ',abcoef,' m^-1'
      !print*,'for PH2O/PN2/TEMP/wn=',presS,presF,temp,wn

      return
    end subroutine interpolateH2O_self_foreign