Module MPR11_CONSTRUCTATOM
   !
   ! S1  : Structure des niveaux d'énergie retenue pour l'atome considéré
   ! N_1 : Nombre de niveaux d'énergie de l'atome
   ! S2  : Structure des transitions indexées retenues pour l'atome considéré 
   ! N_2 : Nombre de transitions de l'atome
   ! S3  : Structure des tables de photoionisation
   !
   USE CONFIG, ONLY: abund, Mass, ETL, Facteur_ETL, Facteur_FIN, CE_QUANTI, CE_SEATON, TESP_FMIN, CE_UPS,  &
                            CH_QUANTI, CH_DRAWIN, S_H, CH_BF, CH_CE, NQ, QMAX, Q0, IW, Gvdw, Gs, NPTS, L_MIN
   USE MTD_STRUCT, ONLY: S_0, S_1, S_2, S_3, N_1, N_2, N_3
   USE MPR07_COLLISIONS, ONLY: COLLISIONS_E, COLLISIONS_H
   USE MPR09_FUNCTIONS, ONLY: LAMBDA_AIR, DEGRE_IONISATION, NQS
   !
   Implicit None
   !
   Integer :: I, J
   Integer :: ios 
   !  
CONTAINS
   !
   !--------------------------------------------------------------------
   ! CONSTRUCTION DE L'ATOME
   !--------------------------------------------------------------------
   !
   Subroutine CONSTRUCTATOM(f3, comment, CDATE)
      !
      USE MOD_F_SEATON, ONLY: ON_DEPASSE
      !
      Character(len = *), Intent(in)    :: f3
      Character(len = *), Intent(out)   :: comment
      Character(len = *), Intent(in)    :: CDATE  
      !
      Integer           :: NCOLL, IIon 
      Integer           :: NCOL_E = 0, NCOL_H = 0
      Character(len=60) :: fout
      Character(len=6)  :: nom
      Character(len=65) :: record
      !    
      !Création du nom de fichier de sortie
      !
      nom = S_0%Symbol//S_0%Ion
      fout = './output/atom.' // nom
      If (ETL) fout = './output/atom.' // TRIM(nom) // "_ETL" 
      comment = 'Model atom output file: ' // fout
      !
      ! Nombre de collisions
      !
      NCOLL = (N_1-1)*((N_1-1)-1)/2
      ! 
      ! Mise en forme de l'ionisation
      IIon = DEGRE_IONISATION(S_0%Ion)
      !
      print '(/,A,/)','------------------------------------------------------------'
      print*,"Construction de l'atome de ", nom
      print '(/,A,/)','------------------------------------------------------------'
      !
      !Ecriture du fichier de sortie
      open(unit=50,file=fout,status='replace',action='write',iostat=ios)
      if (ios/=0) stop "IN SUBROUTINE CONSTRUCTATOM: PB-00."
      !
      Call WRITE_ATOM_HEADER(CDATE, NCOLL, NCOL_E, NCOL_H)
      !
      Call WRITE_ATOM_LEVELS( )
      Write(*, '(A,I0)'), "Nombre de niveaux d'énergie de la base NIST sélectionnés        : ", N_1
      !
      Call WRITE_ATOM_RADIATION_BB(f3, NQ, QMAX, Q0, IW, Gvdw, Gs)
      if (index(f3,'KURUCZ')/=0) print'(A,I0)',"Nombre de transitions de la base KURUCZ sélectionnées           : ", N_2
      if (index(f3,'VALD')/=0)   print'(A,I0)',"Nombre de transitions de la base VALD sélectionnées             : ", N_2
      !
      Call WRITE_ATOM_RADIATION_BF( NPTS, L_MIN )
      Write(*, '(A,I0)'), "Nombre de tables de photoionisation de la TopBase sélectionnées : ", N_3
      !
      ! ECRITURE DES COLLISIONS
      !
      Write(50, '(A)') "* COLLISIONAL BOUND-BOUND AND BOUND-FREE TRANSITIONS"
      Write(50, '(A)') "GENCOL" 
      !
      ! TRANSITIONS B-B et B-F AVEC LES ELECTRONS
      !
      Write(50, '(A)') "* COLLISIONS WITH ELECTRONS"
      Call COLLISIONS_E(S_0, S_1, S_2, S_3, NCOL_E)
      !
      ! TRANSITIONS B-B  et B-F AVEC L'H NEUTRE
      !
      Write(50, '(A)') "* COLLISIONS WITH NEUTRAL HYDROGEN"
      Call COLLISIONS_H(S_0, S_1, S_2, S_3, NCOL_H) 
      !
      Write(*, '(A,I0)') "Nombre de transitions collisionnelles bb possibles              : ", NCOLL
      Write(*, '(A,I0)') "Nombre de transitions collisionnelles électroniques (bb+bf)     : ", NCOL_E
      Write(*, '(A,I0)') "Nombre de transitions collisionnelles avec H        (bb+bf)     : ", NCOL_H
      Write(*, *) "ON_DEPASSE = ", ON_DEPASSE
      Write(50, '(A)') "END"      
      !
      close(50)
      !
      Open(50,file=fout,access='direct',form='formatted',recl=65,pad='yes',status='old',action='readwrite',iostat=ios)
      if (ios/=0) stop "IN SUBROUTINE CONSTRUCTATOM: PB-01."
      !
      Read(50,'(A)',rec=3) record
      Write(record(32 : 37), '(I6.6)', iostat = ios) NCOL_E
      IF (ios/=0) stop "IN SUBROUTINE CONSTRUCTATOM: PB-02." 
      Write(50,'(A)',rec=3) record
      !
      Read(50,'(A)',rec=4) record
      Write(record(32 : 37), '(I6.6)', iostat = ios) NCOL_H
      IF (ios/=0) stop "IN SUBROUTINE CONSTRUCTATOM: PB-02."
      Write(50,'(A)',rec=4) record  
      !
      Close(50)         
      !
      Write(*, '(A,A30)'), "Fichier de sortie                                               : ", fout 
      !
   End Subroutine CONSTRUCTATOM
   !
   !--------------------------------------------------------------------
   !
   Subroutine WRITE_ATOM_RADIATION_BF( NPTS, L_MIN )
      Integer,            Intent(in)    :: NPTS
      Real,               Intent(in)    :: L_MIN
      !
      Character(len = 60) ::fmtout30, fmtout31, fmtout32
      !
      fmtout30 = '(2(I5), ES10.3, 2(I5))'
      fmtout31 = '(4(F10.3, ES10.3))'
      fmtout32 = '(2(I5), ES10.3, I5, F10.1)'
      !
      Write(50, '(A)') "* RADIATIVE BOUND-FREE TRANSITIONS" 
      Write(50, '(A)') "* ION    I    A0       NPTS " 
      Do I =1, N_1-1         
         If (S_3(I)%N /= 1) then
            Write(50, fmtout30, iostat = ios) N_1, I, S_3(I)%seff_tab(1), S_3(I)%N, -1
            IF (ios /= 0) STOP "WRITE_ATOM_RADIATION_BF: PB-00."
            Write(50, fmtout31, iostat = ios) (S_3(I)%en_tab(J), S_3(I)%seff_tab(J), J=1, S_3(I)%N)
            IF (ios /= 0) STOP "WRITE_ATOM_RADIATION_BF: PB-01."
         Else
            Write(50, fmtout32, iostat = ios) N_1, I, S_3(I)%seff_tab(1), NPTS, L_MIN
            IF (ios /= 0) STOP "WRITE_ATOM_RADIATION_BF: PB-02."
         End If 
      End Do
      !
   End Subroutine WRITE_ATOM_RADIATION_BF
   !
   !--------------------------------------------------------------------
   !
   Subroutine WRITE_ATOM_RADIATION_BB(f3, NQ, QMAX, Q0, IW, Gvdw, Gs )
      !
      Character(len = *), intent(in) :: f3
      Integer, intent(in) :: NQ, IW
      Real, intent(in) :: Q0, QMAX, Gs
      Real, intent(inout) :: Gvdw
      !
      !Variable pour le calcul des sections efficaces de Van der Waals OBA
      !
      Double precision :: Elimit_upp, Elimit_low  ! cm-1
      Double precision :: Eupp, Elow              ! cm-1
      Integer          :: Lupp, Llow, Z_N         ! nombre quantique secondaire, degré d'ionisation
      Real             :: Gvdw_temp
      Integer          :: ABO = 0, IIon
      Double precision :: lambda_A
      Real             :: fij
      Character(len = 6) :: ELT, csource_f = 'xxxxxx'  
      Character(len = 62), parameter :: fmtout  = '(I4,I4,ES12.4,I5,2(F6.1),I3,ES10.3,F9.3,F4.1,F16.4, I7, 1X, A)'
      Integer :: NQ_I
      Real    :: QMAX_I
      !
      Gvdw_temp = Gvdw ! Sauvegarde de la valeur fournit par l'utilisateur, suceptible d'être modifié par ABO
      !
      ELT  = Trim(S_0%Symbol) // " " // Trim(S_0%Ion)
      IIon = DEGRE_IONISATION(S_0%Ion)
      !
      Write(50, '(A)') "* RADIATIVE BOUND-BOUND TRANSITIONS" 
      Write(50, '(A)') "*  J   I      F       NQ   QMAX   Q0  IW       GA     GVW    GS      LAMBDA (A)     KR SOURCE F"  
      !
      If (INDEX(f3, 'KURUCZ') /= 0) Then
         csource_f = 'KURUCZ'
      Else If (INDEX(f3, 'VALD') /= 0) Then
         csource_f = 'VALD'
      Else
         csource_f = ''
         Write(*, *) "Attention, source de F prévus actuellement : VALD et KURUCZ."
         Read(*, *)
      End If 
      !
      Do I = 1, N_2
         !Calcul de la longueur d'onde de la transition 
         lambda_A = 1.D10 / ( (S_1(S_2(I)%Nj)%en_cm - S_1(S_2(I)%Ni)%en_cm ) * 100.D0)
         lambda_A = LAMBDA_AIR(lambda_A)
         !Calcul des sections efficaces de Van der Waals par OBA (n'a été testé que pour Mg)
         !N'est possible que si l'élément est neutre
         If (IIon == 1) then
            Elimit_upp = S_1(N_1)%en_cm
            Elimit_low = S_1(N_1)%en_cm
            Eupp = S_1(S_2(I)%Nj)%en_cm
            Elow = S_1(S_2(I)%Ni)%en_cm
            Z_N = 1
            Lupp = NQS(S_1(S_2(I)%Nj)%config)
            Llow = NQS(S_1(S_2(I)%Ni)%config)                     
            Call IS_BARKLEM_VDW(Elimit_upp, Elimit_low, Eupp, Elow, Lupp, Llow, Z_N, Gvdw)
            IF ( ABS(Gvdw-Gvdw_temp) >= 1.E-3 ) ABO = ABO + 1 
         Else If (IIon == 2) Then
            If ( ELT == 'Ca II') Then
               If ( ABS(lambda_A - 3968.4683) < 0.001 .OR. &
                    ABS(lambda_A-  3933.6632) < 0.001       ) Gvdw = 234.223
               If ( ABS(lambda_A - 8662.1353) < 0.001 .OR. &
                    ABS(lambda_A - 8498.0180) < 0.001 .OR. &
                    ABS(lambda_A - 8542.0857) < 0.001       ) Gvdw = 291.275
            Else 
               !
               ! Ajout d'autres cas particuliers possibles
               !
            End If
         End if
         !
         !Ecriture des transitions indexées
         !
         fij = 10**(S_2(I)%loggf) / S_1(S_2(I)%Ni)%g
         !
         QMAX_I = F_QMAX(lambda_A, fij)
         !Write(*,*)"lambda_A,fij,QMAX",lambda_A,fij,QMAX_I
         !Read(*,*)
         NQ_I = NQ
         !
         ! Call IS_MODIFIED_NQ_QMAX( ELT, S_2(I)%lambda_nm*10, NQ_I, QMAX_I, NQ, QMAX )
         !
         Write (50, fmtout) S_2(I)%Nj, S_2(I)%Ni, 10**(S_2(I)%loggf) / S_1(S_2(I)%Ni)%g, &
              & NQ_I, QMAX_I, Q0, IW, 10**(S_2(I)%Gr) , Gvdw, Gs, &
              & lambda_A, I, csource_f
         !
         Gvdw = Gvdw_temp
      End Do
      !
      Write(*, '(A, I0)') "Nombre de sections efficaces ABO calculé                        : ", ABO 
      !
   End Subroutine WRITE_ATOM_RADIATION_BB
   !
   !--------------------------------------------------------------------
   !
   Subroutine IS_BARKLEM_VDW(Elimit_upp, Elimit_low, Eupp, Elow, Lupp, Llow, Z_N, Gvdw)
      !
      USE BARKLEM
      !
      Double Precision, intent(in) :: Elimit_upp, Elimit_low  ! cm-1
      Double Precision, intent(in) :: Eupp, Elow              ! cm-1
      Integer,          intent(in) :: Lupp, Llow, Z_N         ! nombre quantique secondaire, degré d'ionisation
      Real,             intent(InOut):: Gvdw
      !
      Real             :: NSTARupp, NSTARlow      ! nombre quantique principal effectif      
      Real             :: CROSS                   ! Section efficace de collision inélastique avec H
      !                                           ! en unité atomique à la vitesse de 10000m/s
      Real             :: ALPHA                   ! Paramètre de vitesse (sans dimension) 
      Integer          :: IFAIL_INT 
      !
      !N'est possible que pour les transitions sp, pd et df
      If (Lupp < 4 .AND. Llow < 4) then 
         !Calcul des nombres quantiques principaux effectifs
         NSTARupp = Z_N/SQRT((Elimit_upp-Eupp)/109678.758)
         NSTARlow = Z_N/SQRT((Elimit_low-Elow)/109678.758)
         !
         IFAIL_INT = 0 
         Call RETCROSS(NSTARlow, NSTARupp, Llow, Lupp, CROSS, ALPHA, IFAIL_INT)
         !
         If (IFAIL_INT == 0) then 
            Gvdw = nint(CROSS) + ALPHA ! Calcul réussi
         End If
         !
      End if 
      !
   End Subroutine IS_BARKLEM_VDW
   !
   !--------------------------------------------------------------------
   !
   Subroutine WRITE_ATOM_LEVELS( )
      !
      Integer              :: I, IIon
      Character(len = 100) :: mot
      Character(len = 5)   :: scterm
      Character(len = 6)   :: ELT
      Real                 :: g_Ion
      Character(len = 60)  :: fmtout     
      !
      fmtout  = '(F12.3,F6.1,1x,A30,I3, I7)' ! Format d'écriture de sortie des niveaux
      !
      ELT  = Trim(S_0%Symbol) // " " // Trim(S_0%Ion) ! Ex : "Ca II"
      !
      IIon = DEGRE_IONISATION(S_0%Ion)
      !
      Write(50, '(A)') "*   E (1/CM)   G    CONFIGURATION                ION      NK"
      !
      Do I = 1, N_1-1
         ! Ecriture des niveaux d'énergie
         Write(scterm, '(I3.3)') S_1(I)%term
         mot = "'"// ELT // " " // trim(S_1(I)%config) // "  " // trim(scterm)// "'"
         !
         Call IS_NAME_CONFIG_IN_ABSDAT( ELT, mot, S_1(I)%g )
         !
         Write(50, fmtout) S_1(I)%en_cm, S_1(I)%g, mot, IIon, I
      End Do
      !
      !Ecriture de l'ionisation
      mot = "'" // ELT // 'Limit' // "'"
      !
      Select Case (ELT)
         Case('Mg I')
          g_Ion = 2.
         Case('Ca I')
          g_Ion = 2.
         Case('Mg II')
          g_Ion = 1.
         Case('Ca II')
          g_Ion = 1.
         Case Default
          Write(*, *) "WRITE_ATOM_LEVELS : POIDS STATISTIQUE DU NIVEAU D'IONISATION NON CONNU."
      End Select
      !  
      Write (50, fmtout) S_1(I)%en_cm, g_Ion, mot, (IIon+1) 
      !
   End Subroutine WRITE_ATOM_LEVELS
   !
   !--------------------------------------------------------------------
   !
   Subroutine WRITE_ATOM_HEADER(CDATE, NCOLL, NCOL_E, NCOL_H)
      Character(len = *), Intent(in) :: CDATE 
      Integer,            Intent(in) :: NCOLL, NCOL_E, NCOL_H
      !
      Character(len = 10)  :: ELT
      Character(len = 100) :: MSG1, MSG2, MSG3, MSG4, MSG5, MSG6
      ! 
      ELT  = S_0%Symbol // S_0%Ion
      MSG1 = "*   xyz LEVELS,                xyz PHOTOIONIZATIONS FROM TOPBASE "
      MSG2 = "* vwxyz RADIATIVE TRANSITIONS, uvwxyz E- COLLISIONAL TRANSITIONS "
      MSG3 = "* ETL : COLLISIONS * FACTOR, FACTOR = "
      MSG4 = "* FACTOR_FINE = "
      MSG5 = "*                              uvwxyz H  COLLISIONAL TRANSITIONS " 
      !
      Write(MSG1( 5 :  7), '(I3.3)', iostat = ios) N_1
      IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-00."
      Write(MSG1(32 : 34), '(I3.3)', iostat = ios) N_3
      IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-01."
      Write(MSG2( 3 :  7), '(I5.5)', iostat = ios) N_2
      IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-02."
      Write(MSG2(32 : 37), '(I6.6)', iostat = ios) NCOL_E
      IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-03."
      !
      If (CH_QUANTI .OR. CH_DRAWIN) Then
         Write(MSG5(32:37), '(I6.6)', iostat = ios) NCOL_H
         IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-04."
         IF(CH_DRAWIN) Write(MSG5(3:23), '(A)', iostat = ios) 'CLASSICAL DRAWIN 1969'
         IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-05." 
         IF(CH_QUANTI) Write(MSG5(3:22), '(A)', iostat = ios) 'QUANTIC COMPUTATIONS'
         IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-06."
         IF(CH_QUANTI .AND. CH_DRAWIN)  Write(MSG5(3:23), '(A)', iostat = ios) 'QUANTIC + DRAWIN 1969'     
         IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-07."     
      Else
         Write(MSG5(32:37), '(I5.5)', iostat = ios) 0
         IF (ios /= 0) STOP "WRITE_ATOM_HEADER: PB-07."         
      End If
      !
      If (CH_CE .AND. .NOT. CH_BF) Then
         MSG6 = "* WITH CHARGE EXCHANGE FOR ATOM-H COLLISIONS"
      Else If (CH_BF .AND. .NOT. CH_CE) Then
         MSG6 = "* WITH BOUND-FREE FOR ATOM-H COLLISIONS"
      Else If (CH_CE .AND. CH_BF) Then
         MSG6 = "* WITH CE AND BF FOR ATOM-H COLLISIONS"
      Else
         MSG6 = "* WITHOUT CE NOR BF FOR ATOM-H COLLISIONS"
      End If
      !
      If (.NOT. CH_QUANTI .AND. .NOT. CH_DRAWIN) MSG6="* "
      !
      Write(50, '(3A)') ELT,"                                         ", Trim(CDATE) 
      !
      If (ETL) Then
         Write(50,'(A, /, A, /, A, /, A, /, A, ES10.1)') Trim(MSG1), Trim(MSG2), Trim(MSG5), Trim(MSG6), Trim(MSG4), Facteur_FIN
         Write(50, '(A, ES10.1)') Trim(MSG3), Facteur_ETL
      Else
         Write(50,'(A, /, A, /, A, /, A, /, A, ES10.1)') Trim(MSG1), Trim(MSG2), Trim(MSG5), Trim(MSG6), Trim(MSG4), Facteur_FIN
      End If
      !
      Write(50,'(A)')"*  ABUND    Mass"
      Write(50,'(2F8.2)') abund, Mass
      Write(50,'(A)') "*   NK  NLINE  NCONT  NRFIX"
      Write(50,'(4I6)') N_1, N_2, N_1-1, 0
      !
   End Subroutine WRITE_ATOM_HEADER
   !
   !--------------------------------------------------------------------
   !
   Subroutine IS_NAME_CONFIG_IN_ABSDAT(nom, mot, g)
      Character (len = *), intent(in)    :: nom
      Character (len = *), intent(inout) :: mot
      Real,                intent(in)    :: g
      !
      Select Case (nom)
         !
         Case ('Mg I')
            !
            If (Trim(mot) == "'Mg I   2p6.3s2  100'") Then
               mot = "'MG I 2P6 3S3S 1SE'"
            Else If (trim(mot) == "'Mg I   3s.3p  311'") Then
               mot = "'MG I 2P6 3S3P 3PO'"
            Else If (trim(mot) == "'Mg I   3s.3p  111'") Then
               mot = "'MG I 2P6 3S3P 1PO'"
            Else If (trim(mot) == "'Mg I   3s.4s  300'") Then
               mot = "'MG I 2P6 3S4S 3SE'"
            Else If (trim(mot) == "'Mg I   3s.4s  100'") Then
               mot = "'MG I 2P6 3S4S 1SE'"
            Else If (trim(mot) == "'Mg I   3s.3d  120'") Then
               mot = "'MG I 2P6 3S3D 1DE'"
            Else If (trim(mot) == "'Mg I   3s.3d  320'") Then
               mot = "'MG I 2P6 3S3D 3DE'"
            Else If (trim(mot) == "'Mg I   3s.4p  311'") Then
               mot = "'MG I 2P6 3S4P 3PO'"
            Else If (trim(mot) == "'Mg I   3s.4p  111'") Then
               mot = "'MG I 2P6 3S4P 1PO'"
            Else If (trim(mot) == "'Mg I   3s.4d  320'") Then
               mot = "'MG I 2P6 3S4D 3DE'"
            Else If (trim(mot) == "'Mg I   3s.6h  351'") Then
               mot = "'MG I MERGED-1    '"
            Else If (trim(mot) == "'Mg I   3s.7i  360'") Then
               mot = "'MG I MERGED-2    '"
            End If    
            !
         Case ('Mg II')
            !
            If (mot == "'Mg II  2p6.3s  200'") Then
               mot = "'MG II 2P6 3S 2SE 1/2'"
            Else If (trim(mot) == "'Mg II  2p6.3p  211'" .AND. INT(g) == 2) Then
               mot = "'MG II 2P6 3P 2PO 1/2'"
            Else If (trim(mot) == "'Mg II  2p6.3p  211'" .AND. INT(g) == 4) Then
               mot = "'MG II 2P6 3P 2PO 3/2'"
            Else If (trim(mot) == "'Mg II  2p6.4s  200'") Then
               mot = "'MG II 2P6 4S 2SE 1/2'"
            Else If (trim(mot) == "'Mg II  2p6.3d  220'" .AND. INT(g) == 6) Then
               mot = "'MG II 2P6 3D DSE 5/2'"
            Else If (trim(mot) == "'Mg II  2p6.3d  220'" .AND. INT(g) == 4) Then
               mot = "'MG II 2P6 3D DSE 3/2'"  
            End If             
            !       
         Case ('Ca I')
            !
            If (Trim(mot) == "'Ca I   3p6.4s2  100'") Then
               mot = "'CA I 3P6 4S2 1SE     '" 
            Else If ( Trim(mot) == "'Ca I   3p6.4s.4p  311'" .AND. INT(g) == 3) Then
               mot = "'CA I 3P6 4S 4P 3PO1  '"
            Else If ( Trim(mot) == "'Ca I   3p6.4s.4p  311'" .AND. INT(g) == 1) Then
               mot = "'CA I 3P6 4S 4P 3PO2  '"  
            Else If ( Trim(mot) == "'Ca I   3p6.4s.4p  311'" .AND. INT(g) == 5) Then
               mot = "'CA I 3P6 4S 4P 3PO2  '" 
            Else If ( Trim(mot) == "'Ca I   3p6.3d.4s  320'") Then
               mot = "'CA I 3P6 4S 3D 3DE'   " 
            Else If ( Trim(mot) == "'Ca I   3p6.3d.4s  120'") Then
               mot = "'CA I 3P6 4S 3D 1DE'   " 
            Else If ( Trim(mot) == "'Ca I   3p6.4s.4p  111'") Then
               mot = "'CA I 3P6 4S 4P 1PO'   " 
            Else If ( Trim(mot) == "'Ca I   3p6.4s.5s  300'") Then
               mot = "'CA I 3P6 4S 5S 3SE'   " 
            Else If ( Trim(mot) == "'Ca I   3p6.4s.5p  111'") Then
               mot = "'CA I 3P6 4S 5P 1PO'   " 
            End If
            !     
         Case ('Ca II')
            !
            If (Trim(mot) == "'Ca II  3p6.4s  200'") Then
               mot = "'CA II 3P6 4S 2SE    '"
            Else If ( Trim(mot) == "'Ca II  3p6.3d  220'" .AND. INT(g) == 4 ) Then
               mot = "'CA II 3P6 3D 2DE 3/2'"
            Else If ( Trim(mot) == "'Ca II  3p6.3d  220'" .AND. INT(g) == 6 ) Then
               mot = "'CA II 3P6 3D 2DE 5/2'"
            Else If ( Trim(mot) == "'Ca II  3p6.4p  211'" .AND. INT(g) == 2 ) Then
               mot = "'CA II 3P6 4P 2PO 1/2'"
            Else If ( Trim(mot) == "'Ca II  3p6.4p  211'" .AND. INT(g) == 4 ) Then        
               mot = "'CA II 3P6 4P 2PO 3/2'"
            End If
            !    
         Case Default
            Write(*, *) "IS_NAME_CONFIG_IN_ABSDAT : A FAIRE POUR ", nom, "."
            !
      End Select
      ! 
   End subroutine IS_NAME_CONFIG_IN_ABSDAT
   !
   !--------------------------------------------------------------------
   !
   Real Function F_QMAX(lbd,fij)
      Double precision, intent(in) :: lbd
      Real,             intent(in) :: fij
      Integer :: X, Y
      !
      ! Emirical relation
      !
      !fij \ lbd     | <2000 | 2000<lbd<5000 | 5000<lbd<10000 | >10000
      !        <1e-4 |    10 |        7      |        5       |      3    
      !1e-4<fij<1e-2 |    40 |       30      |       20       |     10  
      !1e-2<fij<1    |    80 |       70      |       60       |     50
      !1   <         |   400 |      350      |      300       |    200
      !
      X = NINT(10*LOG10(fij))
      Y = NINT(lbd)
      !
      Select case (X)
         Case(:-41)
            Select Case (Y)
               Case (:2000) 
                  F_QMAX = 10.
               Case (2001:5000) 
                  F_QMAX = 7.
               Case (5001:10000) 
                  F_QMAX = 5.
               Case (10001:) 
                  F_QMAX = 3.
               Case Default 
                  STOP "F_QMAX: PB-00."
            End Select
         Case(-40:-21)
            Select Case (Y)
               Case (:2000) 
                  F_QMAX = 40.
               Case (2001:5000) 
                  F_QMAX = 30.
               Case (5001:10000) 
                  F_QMAX = 20.
               Case (10001:) 
                  F_QMAX = 10.
               Case Default 
                  STOP "F_QMAX: PB-01."
            End Select          
         Case(-20:-1)
            Select Case (Y)
               Case (:2000) 
                  F_QMAX = 80.
               Case (2001:5000) 
                  F_QMAX = 70.
               Case (5001:10000) 
                  F_QMAX = 60.
               Case (10001:) 
                  F_QMAX = 50.
               Case Default 
                  STOP "F_QMAX: PB-02."
            End Select
         Case(0:)
            Select Case (Y)
               Case (:2000) 
                  F_QMAX = 400.
               Case (2001:5000) 
                  F_QMAX = 350.
               Case (5001:10000) 
                  F_QMAX = 300.
               Case (10001:) 
                  F_QMAX = 200.
               Case Default 
                  STOP "F_QMAX: PB-03."
            End Select
         Case Default 
            STOP "F_QMAX: PB-05."
       End Select 
      !
   End Function F_QMAX
   !
   !--------------------------------------------------------------------
   !
   Subroutine IS_MODIFIED_NQ_QMAX(nom, lambda, NQ_temp, QMAX_temp, NQ, QMAX)
      !
      USE DATAGRAPH
      !
      Character(len = *), intent(in) :: nom
      Real,    intent(in)  :: lambda ! Angstroem
      Integer, intent(out) :: NQ_temp
      Real,    intent(out) :: QMAX_temp
      Integer, intent(in)  :: NQ
      Real,    intent(in)  :: QMAX
      !
      Integer        :: II
      Real,parameter :: prec = 0.02
      !
      NQ_temp = NQ
      QMAX_temp = QMAX
      !
      Select Case (nom)
        Case('Ca II', 'Ca I', 'Mg I') 
          Do II = 1, App1_N 
             If (Abs(lambda - App1_lambda(II)) <= prec)  Then
                NQ_temp = 300
                QMAX_temp = App1_QMAX(II) 
             End If
          End Do
          
        Case Default
          Write(*, *) "IS_MODIFIED_NQ_QMAX : A FAIRE POUR ", nom, "."
          NQ_temp = NQ
          QMAX_temp = QMAX
      End Select
      !
   End Subroutine IS_MODIFIED_NQ_QMAX
   !
   !--------------------------------------------------------------------
   !
End Module MPR11_CONSTRUCTATOM