
! 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 - 24 May 2008

!%%%%%%%%%%%%%%%
PROGRAM stdprep
!%%%%%%%%%%%%%%%

   USE PXDR_FLAGS
   USE PXDR_CONSTANTES
   USE PXDR_CHEM_DATA
   USE PXDR_PROFIL
   USE PREP_VAR
   USE PREP_LECTUR
   USE PREP_ABONDA
   USE PREP_COLDEN
   USE PREP_EMISSI
   USE PREP_CHOFRO
   USE PREP_AUTRE
   USE PREP_SPHERE

   IMPLICIT NONE

   INTEGER :: iargc

   INTEGER :: ii, j
   INTEGER :: ifin, ifalse
   INTEGER :: ipoint
   INTEGER :: islash
   INTEGER :: ii1

   CHARACTER (LEN=75) :: texte
   CHARACTER (LEN=50) :: fichi
   CHARACTER (LEN=50) :: fichout

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

   PRINT *, "***********************************"
   PRINT *, "*                                 *"
   PRINT *, "*   PDR MODEL RESULTS ANALYSIS    *"
   PRINT *, "*                                 *"
   PRINT *, "***********************************"

   PRINT *
   PRINT *, 'Do you want to keep track of this run?'
   PRINT *, '1: yes,   0: no'
   READ *, irec
   IF (irec == 1) THEN
      PRINT *, '   Commands are recorded infile "prepin"'
      OPEN (8, file='prepin', status='new')
      WRITE (8,*) irec-1
   ENDIF

   !========================================================
   ! Choose the input file (.bin file)
   !========================================================

   IF (iargc() .eq. 1) THEN
      CALL getarg(1,fichier)
      islash = INDEX(fichier,'/',back=.true.)
      ipoint = INDEX(fichier,'.',back=.true.)
      modele = fichier(islash+1:ipoint-1)
      out_dir = TRIM(out_dir)//TRIM(modele)//"/"
   ELSE
      PRINT *
      PRINT *, 'Enter name of "bin" file'
      READ (*,'(a50)') fichi
      fichi = TRIM(ADJUSTL(fichi))
      IF (irec == 1) THEN
         WRITE (8,'(a50)') fichi
      ENDIF
      ipoint = INDEX(fichi,'.',back=.true.)
      IF (ipoint > 1) THEN
         modele = fichi(1:ipoint-1)
         PRINT *, modele
      ENDIF
      out_dir = TRIM(out_dir)//TRIM(modele)//"/"
      fichier = TRIM(out_dir)//TRIM(fichi)
   ENDIF

   !========================================================
   ! READ INPUT DATAFILE
   !========================================================

   CALL PLECTUR
   PRINT *, " Set CMB temperature to local value"
   tcmb = tcmb0

   !========================================================
   ! EXTRACTION OF DATA AND ANALYSIS
   !========================================================

   ifin = 1
   DO WHILE (ifin == 1)

      !--- Choose the output file name ---------------------
      PRINT *
      PRINT *, 'Enter output file name'
      READ (*,'(a50)') fichout
      fichout = TRIM(ADJUSTL(fichout))
      IF (irec == 1) THEN
         WRITE (8,'(a50)') fichout
      ENDIF

      fichier = TRIM(out_dir)//fichout
      PRINT *,'Output written in: ', TRIM(ADJUSTL(fichier))
      OPEN (25, file = fichier, status = 'new')

      PRINT *, '   Enter a comment line'
      READ (*,'(a75)') texte
      IF (irec == 1) THEN
         WRITE (8,'(a75)') texte
      ENDIF
!     WRITE (25,'(7x,a75)') texte

      !--- Choose X variable (first axis) -----------------
      ifalse = 1
      DO WHILE (ifalse == 1)
         PRINT *, '   Which variable is x?'
         PRINT *, '   1: tau      2: Av'
         PRINT *, '   3: NH       4: N(H2)'
         READ *, ii
         PRINT *, '  x variable is number:', ii
         IF (irec == 1) THEN
            WRITE (8,*) ii
         ENDIF

         IF (ii == 1) THEN
            x(0:npo) = tau(0:npo)
            textx = 'tau           '
            ifalse = 0
         ELSE IF (ii == 2) THEN
            x(0:npo) = visualext(0:npo)
            textx = 'Av            '
            ifalse = 0
         ELSE IF (ii == 3) THEN
            x(0:npo) = codesp(i_h,0:npo) + 2.0_dp * codesp(i_h2,0:npo)
            textx = 'NH            '
            ifalse = 0
         ELSE IF (ii == 4) THEN
            x(0:npo) = codesp(i_h2,0:npo)
            textx = 'N(H2)         '
            ifalse = 0
         ELSE
            PRINT *, '     ****  WARNING: value not allowed ******'
            PRINT *, '  ii =', ii
         ENDIF
      ENDDO

      !--- Choose the other quantities -------------------------------------
      iimax = 0

      ifalse = 1
      DO WHILE (ifalse == 1)
         PRINT *, '   Select next variable kind'
         PRINT *, '     0: end'
         PRINT *, '     1: Abundance  2: Column density   3: Emissivity'
         PRINT *, '     4: Heating - Cooling'
         PRINT *, '     5: Else (T, density, ions, ...)'
         PRINT *, '     6: Pseudo-Spherical cloud (Experimental)'
         READ *, ii1
         IF (irec == 1) THEN
            WRITE (8,*) ii1
         ENDIF

         IF (ii1 == 0) THEN
            ifalse = 0
            CYCLE
         ELSE IF (ii1 == 1) THEN
            CALL ABONDA
         ELSE IF (ii1 == 2) THEN
            CALL COLDEN
         ELSE IF (ii1 == 3) THEN
            CALL EMISSI
         ELSE IF (ii1 == 4) THEN
            CALL CHOFRO
         ELSE IF (ii1 == 5) THEN
            CALL AUTRE
         ELSE IF (ii1 == 6) THEN
            CALL SPHERE
         ELSE
            PRINT *, '     ****  ATTENTION: value not allowed ******'
            PRINT *, '  ii1 =', ii1
            CYCLE
         ENDIF

         IF (iimax < ncolf) THEN
            PRINT *
            PRINT *, 'Do you want to continue?'
            PRINT *, '1: yes,   0: no'
            READ *, ifalse
            IF (irec == 1) THEN
               WRITE (8,*) ifalse
            ENDIF
         ELSE
            PRINT *, ' '
            PRINT *, '*************************************************'
            PRINT *, '                   WARNING  '
            PRINT *, '  Number of allowed columns too small '
            PRINT *, '  - Number of columns to print : ', iimax
            PRINT *, '  - Number of columns allowed  : ', ncolf
            PRINT *, '  Modify ncolf in PREP_VAR.f90 and do : '
            PRINT *, '  > make clean '
            PRINT *, '  > make'
            PRINT *, ' '
            PRINT *, '                     STOP '
            PRINT *, '*************************************************'
            STOP
         ENDIF
      ENDDO

      !-----------------------------------------------------------------------
      ! WRITE OUTPUTS
      !-----------------------------------------------------------------------
      PRINT *, '   There are ', iimax,' y columns in file ', fichout

      WRITE (25,'(A1,1X,I8,400I17)') '#', 1, (ii+1, ii=1,iimax)
      WRITE (25,'(2x,400a17)') textx, (texty(ii), ii=1,iimax)
      DO j = 0, npo
         WRITE (25,'(1p,e19.10,400e17.8E3)') x(j), (y(ii,j), ii=1,iimax)
      ENDDO

      CLOSE (25)

      !-----------------------------------------------------------------------
      ! PREPARATION FOR WRITTING ANOTHER FILE
      !-----------------------------------------------------------------------
      PRINT *
      PRINT *, 'Do you want a new file?'
      PRINT *, '1: yes,   0: no'
      READ *, ifin
      IF (irec == 1) THEN
        WRITE (8,*) ifin
      ENDIF
   ENDDO

END PROGRAM stdprep
