
! Copyright (C) 2002 - Observatoire de Paris/Meudon
!                      Universite Paris 7
!                      CNRS (France)
!                      Contact : Jacques.Lebourlot@obspm.fr
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License version 2
! as published by the Free Software Foundation.
!
! This program 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, write to the Free Software
! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

! JLB - 23 May 2008

MODULE PREP_ABONDA

  PRIVATE

  PUBLIC :: ABONDA

CONTAINS

!%%%%%%%%%%%%%%%%
SUBROUTINE ABONDA
!%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PXDR_AUXILIAR
   USE PREP_VAR

   IMPLICIT NONE

   CHARACTER (LEN=lenSpeci)  :: yspec
   CHARACTER (LEN=2)         :: debu
   CHARACTER (LEN=4)         :: numb
   INTEGER                   :: i, j, jj, k, mm
   INTEGER                   :: levl, ind_sp
   INTEGER                   :: ijl
   INTEGER                   :: ii2, ii3, ii4, ii5
   INTEGER                   :: inqn
   REAL (KIND=dp)            :: oh2, ph2
   REAL (KIND=dp), DIMENSION (:), ALLOCATABLE :: acum

!--------+---------+---------+---------+---------+---------+---------+-*-------+

   DO
      PRINT *, ' Which species density ? (end: -1)'
      READ (*,'(a8)') yspec
      IF (irec == 1) THEN
         WRITE (8,'(a8)') yspec
      ENDIF

      IF (yspec == '-1') THEN
         EXIT
      ENDIF

      ii2 = 0
      DO jj = 1, n_var
         IF (speci(jj) == yspec) THEN
            ii2 = jj
            EXIT
         ENDIF
      ENDDO
      IF (ii2 /= 0) THEN
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(ii2,0:npo)
         texty(iimax) = 'Ab..'//TRIM(speci(ii2))
      ELSE IF (yspec == "h:" .OR. yspec == "h::" .OR. yspec == "h2:") THEN
         iimax = iimax + 1
         y(iimax,0:npo) = 0.0_dp
         texty(iimax) = 'Ab..'//TRIM(yspec)                                   ! Keep an empty column to facilitate comparisons
      ELSE
         PRINT *, "  WARNING:", yspec, " is not in species list"
      ENDIF

      IF (yspec == "h:" .OR. yspec == "h2:") THEN
         IF (ii2 /= 0) THEN
            ALLOCATE (acum(0:npo))
            acum = 0.0_dp
            jj = nspec + (ii2 - nsp_n1 - 1) * npg
            DO mm = 1, npg
               acum(0:npo) = acum(0:npo) + wwmg(mm) * abnua(jj+mm,0:npo)
            ENDDO
            iimax = iimax + 1
            y(iimax,0:npo) = acum(0:npo) * densh(0:npo)                       ! This compute "H:" or "H2:" by summing over moments
            texty(iimax) = 'AbS.'//TRIM(yspec)                                ! It should be strictly equal to "Ab..h:" or "Ab..h2:"
            DEALLOCATE (acum)
            iimax = iimax + 1
            y(iimax,0:npo) = abnua(ii2,0:npo) * dsite*dsite / (s_gr_t * densh(0:npo)) ! Fraction of occupied surface sites
            texty(iimax) = 'Frac-'//TRIM(yspec)                               ! The sum over "H:" and "H2:" MUST be < 1
         ELSE
            iimax = iimax + 1
            y(iimax,0:npo) = 0.0_dp
            texty(iimax) = 'AbS.'//TRIM(yspec)                                ! Set to 0 to keep the same number of columns
            iimax = iimax + 1
            y(iimax,0:npo) = 0.0_dp
            texty(iimax) = 'Frac-'//TRIM(yspec)                               ! idem
         ENDIF
      ENDIF

      debu = TRIM(ADJUSTL(yspec))
      IF (debu(1:2) == "mo") THEN
         numb = "    "
         IF (yspec(1:4) == "moh2") THEN
            numb(3:4) = yspec(6:7)
         ELSE
            numb(3:4) = yspec(5:6)
         ENDIF
         CALL STR_INT(numb,mm)                                               ! Recover index of size bin
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(ii2,0:npo) * dsite*dsite / (4.0*xpi * adust(mm)**2) ! Fraction of grain covered
         texty(iimax) = 'Fr..'//TRIM(speci(ii2))
      ENDIF

      IF (ii2 == 0 .AND. yspec == "c*o") THEN                                ! If CO isotopes are not included, use standard ratios
         iimax = iimax + 1                                                   ! Useful for transfer effects in populations
         y(iimax,0:npo) = abnua(i_co,0:npo) / r_c13
         texty(iimax) = 'Ab..'//TRIM(yspec)
         ii2 = nspec + 1
      ELSE IF (ii2 == 0 .AND. yspec == "co*") THEN
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(i_co,0:npo) / r_o18
         texty(iimax) = 'Ab..'//TRIM(yspec)
         ii2 = nspec + 2
      ELSE IF (ii2 == 0 .AND. yspec == "c*o*") THEN
         iimax = iimax + 1
         y(iimax,0:npo) = abnua(i_co,0:npo) / (r_c13 * r_o18)
         texty(iimax) = 'Ab..'//TRIM(yspec)
         ii2 = nspec + 3
      ELSE IF (ii2 == 0 .OR. ii2 > nspec) THEN
         CYCLE
      ENDIF

      IF (in_sp(ii2) /= 0) THEN
         ind_sp = in_sp(ii2)
         PRINT *, " Relative populations? (1: yes, 0: no)"
         READ  *,ii4
         IF (irec == 1) THEN
            WRITE (8,*) ii4
         ENDIF

         IF (ii4 == 1) THEN
            jj = spec_lin(ind_sp)%nlv
            PRINT *, "  Num:    ", (spec_lin(ind_sp)%qnam(k), k=1,spec_lin(ind_sp)%nqn)
            DO i = 1, 1+jj/10
               DO j = 1+10*(i-1), MIN(jj,10*i)
                  WRITE (6,'(1x,i4," :")',ADVANCE="NO") j
                  inqn = 0
                  DO k = 1, spec_lin(ind_sp)%nqn
                     inqn = inqn + 1
                     WRITE (6,"(1x,a4)",ADVANCE="NO") spec_lin(ind_sp)%quant(j,inqn)
                  ENDDO
                  WRITE (6,*)
               ENDDO
               PRINT *, "  More? (yes: 1 - no: 0)"
               READ *, j
               IF (irec == 1) THEN
                  WRITE (8,*) j
               ENDIF
               IF (j /= 1) EXIT
            ENDDO
            ii3 = 999
            DO WHILE (ii3 /= 0)
               WRITE(*,*) '   Enter level index'
               WRITE(*,'("   -1 : all the ",I3," levels")') spec_lin(ind_sp)%use
               WRITE(*,*) '    0 : end'
               READ *, ii3
               IF (ii3 > spec_lin(ind_sp)%use) THEN
                  ii3 = 0
               ENDIF
               IF (irec == 1) THEN
                  WRITE (8,*) ii3
               ENDIF
               IF (ii3 > 0) THEN
                  iimax = iimax + 1
                  y(iimax,0:npo) = spec_lin(ind_sp)%xre(ii3,:)
                  texty(iimax) = TRIM(spec_lin(ind_sp)%nam) //'.l='//TRIM(ADJUSTL(ii2c(ii3)))
               ELSE IF (ii3 == -1) THEN
                  DO i = 1, spec_lin(ind_sp)%use
                     iimax = iimax + 1
                     y(iimax,0:npo) = spec_lin(ind_sp)%xre(i,:)
                     texty(iimax) = TRIM(spec_lin(ind_sp)%nam) //'.l='//TRIM(ADJUSTL(ii2c(i)))
                  ENDDO
                  ii3 = 0
               ENDIF
            ENDDO
         ENDIF
      ENDIF

      IF (yspec == 'h2') THEN
         PRINT *
         PRINT *, '   Do you want the O/P ratio? (1: yes, 0: no)'
         READ  *,ii4

         IF (irec == 1) THEN
            WRITE (8,*) ii4
         ENDIF

         IF (ii4 == 1) THEN
            iimax = iimax + 1
            DO j = 0, npo
               oh2 = 0.0d0
               ph2 = 0.0d0
               DO levl = 1, l0h2
                  ijl = njl_h2(levl)
                  IF (MOD(ijl,2) == 0) THEN
                     ph2 = ph2 + spec_lin(ind_sp)%xre(levl,j)
                  ELSE
                     oh2 = oh2 + spec_lin(ind_sp)%xre(levl,j)
                  ENDIF
               ENDDO
               y(iimax,j) = oh2/ph2
            ENDDO
            texty(iimax) = 'Rap.OsP.t '
         ENDIF
      ENDIF
    ENDDO

END SUBROUTINE ABONDA

END MODULE PREP_ABONDA
