
! 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_COLDEN

  PRIVATE

  PUBLIC :: COLDEN

CONTAINS

!%%%%%%%%%%%%%%%%
SUBROUTINE COLDEN
!%%%%%%%%%%%%%%%%

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

   IMPLICIT NONE

!  definition des variables locales.
!  (les variables transmises sont dans INCLUDE).

   CHARACTER (LEN=lenSpeci) :: yspec

   INTEGER                  :: i, j, k, jj
   INTEGER                  :: ind_sp, inqn
   INTEGER                  :: ii2, ii3, ii4

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

   CALL CODENS

   DO
      PRINT *, '   Which column 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) = codesp(ii2,:)
         texty(iimax) = TRIM('CD..'//speci(ii2))
      ELSE
         PRINT *, "  WARNING:", yspec, " is not in species list"
      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)"
               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)%CoD(ii3,:)
                  texty(iimax) = 'CD.'//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)%CoD(i,:)
                     texty(iimax) = 'CD.'//TRIM(spec_lin(ind_sp)%nam) //'.l='//TRIM(ADJUSTL(ii2c(i)))
                  ENDDO
                  ii3 = 0
               ENDIF
            ENDDO
         ENDIF

         PRINT *, " Excitation diagram? (1: yes, 0: no)"
         READ  *,ii4
         IF (irec == 1) THEN
            WRITE (8,*) ii4
         ENDIF
         IF (ii4 == 1) THEN
            IF (yspec == 'h2') THEN
               CALL EXCIT
            ELSE
               fichier = TRIM(out_dir)//TRIM(modele)//'.ExDiag_'//TRIM(spec_lin(ind_sp)%SpID)
               !fichier = TRIM(out_dir)//TRIM(modele)//'.'//TRIM(spec_lin(ind_sp)%nam)//'_e'
               OPEN (unit=52, file=fichier, status="unknown")
               WRITE(52,'("#Excitation diagram - ",A12)') spec_lin(ind_sp)%spHname
               WRITE(52, '("#Index E [K]          N(X)/g [cm-2]")')
               DO i = 1, spec_lin(ind_sp)%use
                  WRITE (52,'(i4,1p,2e15.6)') i, spec_lin(ind_sp)%elk(i) &
                          , spec_lin(ind_sp)%CoD(i,npo) / spec_lin(ind_sp)%gst(i)
               ENDDO
               CLOSE (52)
               PRINT *," Excitation diagram written in : ",TRIM(ADJUSTL(fichier))
            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
               y(iimax,0:npo) = cdoph2(1,0:npo)
               texty(iimax) = "OP.i.tot"
               iimax = iimax + 1
               y(iimax,0:npo) = cdoph2(2,0:npo)
               texty(iimax) = "OP.i.emi"
               iimax = iimax + 1
               y(iimax,0:npo) = cdoph2(3,0:npo)
               texty(iimax) = "OP.i.vib"
            ENDIF
         ENDIF

      ENDIF

   ENDDO

END SUBROUTINE COLDEN

!%%%%%%%%%%%%%%%%
SUBROUTINE CODENS
!%%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PREP_VAR

!---------------------------------------------------------------------
!       calcul des colonnes densites dans le nuage
!---------------------------------------------------------------------

   IMPLICIT NONE

   INTEGER        :: iopt
   INTEGER        :: iv, ij
   INTEGER        :: nv
   INTEGER        :: j_sp, lev
   REAL (KIND=dp) :: para_1, para_2, para_3
   REAL (KIND=dp) :: orth_1, orth_2, orth_3

   cdoph2(:,0) = 0.0_dp

   DO iopt = 1, npo
      j_sp = in_sp(i_h2)
      h2v(:,iopt) = 0.0_dp
      DO lev = 1, l0h2
         nv = nvl_h2(lev)
         h2v(nv,iopt) = h2v(nv,iopt) + spec_lin(j_sp)%xre(lev,iopt)
      ENDDO

      para_1 = spec_lin(j_sp)%CoD(1,iopt)
      para_2 = 0.0d0
      para_3 = 0.0d0
      orth_1 = spec_lin(j_sp)%CoD(2,iopt)
      orth_2 = 0.0d0
      orth_3 = 0.0d0
      DO lev = 3, l0h2
         ij = njl_h2(lev)
         IF (ij > njh2) CYCLE
         iv = nvl_h2(lev)
         IF (MOD(ij,2) == 0) THEN
            para_1 = para_1 + spec_lin(j_sp)%CoD(lev,iopt)
            para_2 = para_2 + spec_lin(j_sp)%CoD(lev,iopt)
            IF (iv >= 1) THEN
               para_3 = para_3 + spec_lin(j_sp)%CoD(lev,iopt)
            ENDIF
         ELSE
            orth_1 = orth_1 + spec_lin(j_sp)%CoD(lev,iopt)
            orth_2 = orth_2 + spec_lin(j_sp)%CoD(lev,iopt)
            IF (iv >= 1) THEN
               orth_3 = orth_3 + spec_lin(j_sp)%CoD(lev,iopt)
            ENDIF
         ENDIF
      ENDDO
      cdoph2(1,iopt) = orth_1 / para_1
      cdoph2(2,iopt) = orth_2 / para_2
      cdoph2(3,iopt) = orth_3 / para_3
   ENDDO

END SUBROUTINE CODENS

END MODULE PREP_COLDEN
