Module MPR02_COLLECT ! USE MTD_STRUCT USE MPR09_FUNCTIONS, ONLY : TERME, CONFIG USE MOD_CSTES, ONLY : Ryd => cste_Ryd, c => cste_c, h => cste_h, & q => cste_q, me => cste_m_e, pi => cste_pi ! Implicit None PRIVATE PUBLIC :: COLLECTF1, COLLECTF2, COLLECTF3, COLLECTF4 ! Integer :: ios ! Variable de contrôle dans les opérations d'E/S Integer :: er ! Variable de contrôle dans les affectations dynamiques de mémoire Character(len = 300) :: line, templine ! Enregistrement d'une ligne d'un fichier Character(len = 12) :: cskip ! Saut d'enregistrements ! CONTAINS ! !-------------------------------------------------------------------- ! COLLECTE DES NIVEAUX DE NIST !-------------------------------------------------------------------- Subroutine COLLECTF1(f1, N, Nin, sep, S1) ! f1 : Fichier de la base de donnée NIST ! N : Nombre de niveaux brut de NIST ! Nin : Position du début du tableau dans le fichier f1 ! sep : Vecteur de séparateur des champs ! S1 : Structure des niveaux de NIST ! ! Structure de la base de données NIST pour les niveaux ! Configuration | Term | J | Level (cm-1) ! ! sep(1) sep(2) sep(3) sep(4) ! | | | | !3s.3p | 3P* | 0 | 21850.405 | ! Integer, intent(in) :: N, Nin Integer, dimension(:), intent(in) :: sep !4 Character(len = *), intent(in) :: f1 !100 Type(LEVELS), dimension(N), intent(out) :: S1 ! Integer :: I, JJ, K, L, pos, pos_virg, term, NumJ, DenJ, pos1, pos2 real :: g, J double precision :: en_cm, en_Ryd, en_eV character(len=100) :: config, config_mem, temp, temp_mem, Jtemp character(len=12) :: clen1, clen2, clen3, clen4 character(len=1) :: rep Logical :: first_ionization = .TRUE. ! I = 1 ; JJ = 0 ; K = 0 ; L = 0 ! cskip = '(xyz(/),A)'; Open(unit = 10, file = f1, status = 'old', action = 'read', position = 'rewind', iostat = ios) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-00." Write(cskip(2:4), '(I3.3)', iostat = ios) Nin IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-01." Read(10, cskip, iostat = ios) line IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-02." ! !Formatage des champs ! clen1 = '(Axy)' clen2 = clen1 clen3 = clen1 clen4 = '(F10.3)' ! Write(clen1(3:4), '(I2.2)', iostat = ios) sep(1)-1 IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-03." write(clen2(3:4),'(I2.2)',iostat=ios) sep(2)-sep(1) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-04." write(clen3(3:4),'(I2.2)',iostat=ios) sep(3)-sep(2) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-05." ! B1: Do While (I <= N) ! Read(10, '(A)', iostat = ios) line Write(*,*) trim(line) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-06." ! !Teste si le champ Level ne contient pas de chiffres ! TL1: If (Scan(line(sep(3)+1:), '012345678') == 0) Then JJ = JJ + 1 CYCLE B1 End If TL1 ! !Teste si la ligne est vide ! TL2: If (Scan(line(sep(3)+1:sep(4)-1), '1234567890-') == 0) Then K = K + 1 CYCLE B1 End If TL2 ! !Teste si la ligne est une séparatrice ! TL3: If (Index(line, '----|----') /= 0) Then L = L + 1 CYCLE B1 End If TL3 ! !AFFECTATION DES CHAMPS ! !Affectation de la configuration électronique ! Read(line(:sep(1)), clen1, iostat = ios) config IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-07." config = Adjustl(Trim(config)) ! !Teste si la ligne possède sa configuration ! IF (Len_trim(config) == 0) config = config_mem config_mem = config ! !Affectation du terme spectroscopique ! Read(line(sep(1)+1:sep(2)-1), clen2, iostat = ios) temp IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-08." temp = Trim(Adjustl(temp)) ! !Teste si la ligne possède son terme ! IF (Len_trim(temp) == 0) temp = temp_mem temp_mem = temp term = TERME(temp) ! !Affectation du niveau d'énergie en cm-1 ! ! sep(3) sep(4) ! | | ! | 0 | ! | 61471 | ! | 21850.405 | ! | 55891.80 | ! | 61060.5 | ! !Extraction du nombre si le champ Level contient du texte ! If (Scan(line(sep(3) + 1 : ), '<>[]?') /= 0) Then pos1 = Scan(line(sep(3) + 1 : ), '0123456789') pos2 = Scan(line(sep(3) + 1 : ), '0123456789', back=.true.) templine = line(sep(3)+ 1 + pos1 : pos2) Write(*,*) line Write(*,*) pos1,pos2,templine Read(*,*) Read(templine, clen4, iostat=ios) en_cm IF (ios /= 0) Read(templine,*, iostat=ios) en_cm IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: en_cm read problem." Write(*,*) en_cm Else ! !Détection de . dans le champ en_cm ! If (scan(line(sep(3)+1:sep(4)-1), '.') /= 0) Then ! trim(adjustl(line(...))) templine = Adjustl(line(sep(3)+1:sep(4)-1)) Read(templine, clen4, iostat = ios) en_cm IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-09." Else templine = Adjustl(line(sep(3)+1:sep(4)-1)) Read(templine, '(F7.0)', iostat = ios) en_cm IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-10." End If ! End if ! !Détection de l'ionisation ! !If (first_ionization) Then ! If (term == 999) Then ! Eion_cm = en_cm ! Write(*,'(/,A,F13.3,A)', advance = 'no') "Ionization energy : ", Eion_cm, "OK (y/n) ? " ! Read(*,*) rep ! IF (rep=='o'.OR.rep=='O'.OR.rep=='y'.OR.rep=='Y'.OR.rep=='0') first_ionization = .FALSE. ! End If !End If ! !Affectation de g ! IF (term == 999) g = 999 ! Ionisation IF (line(sep(2)+1:sep(3)-1)=='') g = 888 ! Vide If (line(sep(2)+1:sep(3)-1) /= '' .and. term /= 999) then Read(line(sep(2)+1:sep(3)-1), clen3, iostat = ios) Jtemp IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-11." Jtemp = Trim(Adjustl(Jtemp)) ! ! Cas où il y a plusieurs valeurs de J demi entiers séparé par une virgules (ex: | 7/2,9/2 | ! If (scan(Jtemp, ',') /=0) Then pos_virg = Scan(Jtemp, ',') If (scan(Jtemp, '/') /= 0) Then pos = Scan(Jtemp, '/') Read(Jtemp(:pos-1), '(I2.2)', iostat = ios) NumJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-121." Read(Jtemp(pos+1:pos_virg-1), '(I2.2)', iostat = ios) DenJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-131." J = Real(NumJ) / Real(DenJ) ! pos = Scan(Jtemp(pos_virg+1:), '/') Read(Jtemp(pos_virg+1:pos-1), '(I2.2)', iostat = ios) NumJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-122." Read(Jtemp(pos_virg+pos+1:), '(I2.2)', iostat = ios) DenJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-132." J = J + Real(NumJ) / Real(DenJ) GO TO 100 Else STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-15 (TO IMPLEMENT)" End If End If ! !Cas où J est demi entier ! If (scan(Jtemp, '/') /= 0) Then pos = Scan(Jtemp, '/') Read(Jtemp(:pos-1), '(I2.2)', iostat = ios) NumJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-12." Read(Jtemp(pos+1:), '(I2.2)', iostat = ios) DenJ IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-13." J = Real(NumJ) / Real(DenJ) End If ! !Cas où J est entier ! If (Scan(Jtemp, '0123456789') /= 0 .and. Scan(Jtemp, '/') == 0) then Read(Jtemp, '(F2.0)') J IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF1: PB-14." End If ! !Calcul de g (g =2*J + 1) ! g = 2*J + 1 ! End If ! !Affectation de en_Ryd et en_eV ! 100 en_Ryd = en_cm * 100 / Ryd en_eV = en_cm * 100 * (h*c) / q ! !Affectation de la structure ! S1(I) = LEVELS(config, term, en_cm, en_Ryd, en_eV, g, 0,'NIST') I = I + 1 ! End Do B1 ! Close(10) ! End Subroutine COLLECTF1 ! !-------------------------------------------------------------------- ! COLLECTE DES NIVEAUX DE LA TOPBASE !-------------------------------------------------------------------- ! Subroutine COLLECTF2(f2, N, Nin, S2) ! f2 : Nom du fichier de données de la TOPBASE ! N : Nombre de niveaux brut de la TOPBASE ! Nin : Position du début du tableau dans le fichier f2 ! S2 : Structure des niveaux de la TOPBASE ! ! Structure de la base de données TOPBASE pour les niveaux ! i (NZ) (NE) iSLP (iLV) iCONF E(RYD) gi ! Integer, intent(in) :: N, Nin Character(len = *), intent(in) :: f2 Type(LEVELS), dimension(N), intent(out) :: S2 ! Integer :: I, term Real :: g Double precision :: en_cm, en_Ryd, en_eV Character(len = 100) :: conf, config_temp Logical :: ground = .TRUE. ! I = 0 ! cskip = '(xyz(/),A)' ! Open(unit = 20, file = f2, status = 'old', action = 'read', position = 'rewind', iostat = ios) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF2: PB-00." Write(cskip(2:4), '(I3.3)', iostat = ios) Nin-1 IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF2: PB-01." Read(20, cskip, iostat = ios) line IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF2: PB-02." ! B2: Do While (I < N) I = I + 1 ! !Comme les champs sont toujours de longueur fixe, il est bcp + simple de fixer le format ! Read(20, '(A)') line IF (Scan(line, '0123456789') == 0) CYCLE B2 Read(line(24:39), '(A16)') config_temp Read(line(16:18), '(I3.3)') term Read(line(40:52), '(ES13.5)') en_Ryd Read(line(52:56), '(F5.1)') g If (ground) Then en_cm = S_0%Eion_cm + en_Ryd * Ryd / 100. en_eV = en_cm * 100. * (h*c) / q Else en_cm = en_Ryd * Ryd / 100. en_eV = en_cm * 100. * (h*c) / q End If ! !Mise en forme de la configuration électronique ! conf = CONFIG(config_temp) ! !Affectation des champs ! S2(I) = LEVELS(conf,term,en_cm,en_Ryd,en_eV,g,I,"TOPB") ! End Do B2 ! Close(20) ! End Subroutine COLLECTF2 ! !-------------------------------------------------------------------- ! COLLECTE DES TRANSITIONS DE KURUCZ / VALD !-------------------------------------------------------------------- ! Subroutine COLLECTF3(f3, N, Nin, S0, S3) ! f3 : Nom du fichier de données de KURUCZ / VALD ! N : Nombre de transitions brut de KURUCZ / VALD ! Nin : Position du début du tableau dans le fichier f3 ! S0 : S_atom, structure de type ATOM contenant les infos générales de l'atome ! S3 : Structure des transitions de KURUCZ / VALD ! ! Structure de la base de données de KURUCZ/VALD pour les transitions ! Wl(nm) Wavenumbers(cm-1) log_gf Aij(s-1) Elt E_lower.(cm-1) J Config. ! E_upper.(cm-1) J Config. Gamma_Damping (R S W) ! Integer, intent(in) :: N, Nin Character(len = *), intent(in) :: f3 Type(ATOM), intent(in) :: S0 Type(LINES),dimension(N), intent(out):: S3 ! Integer :: I, J, K, pos1, pos2, term1, term2 Real :: loggf, Aij, Gr, J1, J2 Double Precision :: en_cm, en1_cm, en2_cm, en1_eV, en2_eV, lambda_nm, lambda_A, Cste Character(len = 12) :: cterm1, cterm2, temp Character(len = 130) :: config1, config2, line1, line2 Logical :: l1 Integer, dimension(13) :: sep1 Integer, dimension(9) :: sep2 Logical, parameter :: BLABLA = .FALSE. Integer, parameter :: lambda_test = 4303 Double precision :: eps0 ! I = 0 ; J = 0 ! !Constante pour le calcul de la relation entre loggf et Aij ! eps0 = 1D7/(4*pi*c**2) Cste = (2.d0*pi*q**2) / (me*c*eps0) ! cskip = '(xy/,A)' Write(cskip(2:3), '(I2.2)', iostat = ios) Nin-1 IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-00." ! Open(unit = 30, file = f3, status= 'old', action = 'read', position = 'rewind', iostat = ios) IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-01." Read(30, cskip, iostat = ios) line IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-03." IF (BLABLA) Write(*, *) "line = ", line IF (BLABLA) Read(*, *) ! ! DONNEES ATOMIQUES KURUCZ ! !
----------------------------------------------------------------------------------------------------------------------------------
      !    Wl / nm   Wavenumbers log_gf   A-Value  Element E_lower_lev.   J   Config.    E_upper_lev.   J   Config.     Gamma (Damping)  
      !vac<200nm<air  / cm^(-1)            / 1/s   (Name)    / cm^(-1)  lower lower        / cm^(-1)  upper !upper        R     S     W   
      !----------------------------------------------------------------------------------------------------------------------------------
      !   162.1507    61685.068 -17.959 1.732e-11 Mg I           0.000   0.0 3s2  1S       61671.020  80.0 CONTINUUM    !0.00  0.00  0.00 
      !   162.1970    61667.460  -5.767 1.445e+03 Mg I           0.000   0.0 3s2  1S       61653.414   1.0 80p  1P      3.73  1.49 -5.15 
      !
      If (Index(f3, 'KURUCZ') /= 0) Then
      If (Index(line,'----------') == 0) STOP 'Début de fichier anormal.'
      !
B31 : Do While (I < N)
         Read(30, '(A)', iostat = ios) line
         IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-04."
         !
         !Teste si la ligne contient le terme CONTINUUM
         !
         If (Index(line, 'CONTINUUM') /= 0) Then
            J = J + 1
            cycle B31
         End If
         !
         !Teste la présence de lignes blanches
         !
         If (Trim(line) == '') CYCLE B31
         !
         !Teste si la ligne contient le symbole de l'élément
         !
         If (l1 .AND. Index(line,S0%Symbol) /= 0) Then
            l1 = .FALSE.
         End If
         !
         If (.NOT. l1) Then
            l1 = .TRUE.
            !
            !Comme les champs sont toujours de longueur fixe, il est bcp + simple de fixer le format 
            !
            Read(line(  1: 12), '(F12.4)', iostat = ios) lambda_nm
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-05."
            Read(line( 13: 24), '(F12.4)', iostat = ios) en_cm
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-06."
            Read(line( 26: 32), '(F7.3)' , iostat = ios) loggf
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-07."
            Read(line( 34: 42), '(ES9.3)', iostat = ios) Aij
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-08."
            Read(line( 53: 63), '(F11.3)', iostat = ios) en1_cm
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-09."
            Read(line( 66: 69), '(F4.1)' , iostat = ios) J1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-10."
            Read(line( 71: 82), '(A12)'  , iostat = ios) config1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-11."
            Read(line( 83: 93), '(F11.3)', iostat = ios) en2_cm
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-12."
            Read(line( 97: 99), '(F4.1)' , iostat = ios) J2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-13."
            Read(line(101:112), '(A12)'  , iostat = ios) config2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-14."
            Read(line(113:117), '(F5.2)' , iostat = ios) Gr
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-15."
            !            
            !Determination du terme spectroscopique & Mise en forme de la configuration électronique au format NIST
            !
            config1 = Trim(Adjustl(config1))
            config2 = Trim(Adjustl(config2))
            pos1 = Scan(config1,' ')
            pos2 = Verify(config1,' ', back = .TRUE.)
            temp = config1(pos1+1:pos2) ! Mot contenant le terme spectro
            term1   = TERME(temp)
            config1 = CONFIG(config1(1:pos1))
            pos1 = Scan(config2,' ')
            pos2 = Verify(config2,' ', back = .TRUE.)
            temp = config2(pos1+1:pos2) ! Mot contenant le terme spectro
            term2   = TERME(temp)
            config2 = CONFIG(config2(1:pos1))
            !
            !Affectation dans la structure
            !
            I = I + 1
            S3(I) = LINES(config1, term1, en1_cm, J1, config2, term2, en2_cm, J2, en_cm, lambda_nm, loggf, Aij, Gr)
            !
         End If
         !
      End Do B31
      End If
      !
      ! DONNEES ATOMIQUES VALD 
      !
      !                                                            Lande factors     Damping parameters
      !Elm Ion  WL(A)     log(gf) Exc. lo   J lo Exc. up   J up  lower upper  mean   Rad.   Stark  Waals
      !'Mg 1', 1621.5070,-17.959,  0.0000,  0.0,  7.6460, 80.0,99.000,99.000,99.000, 0.000, 0.000, 0.000,
      !         ' 3s2  1S  CONT                   1   1   1   1   1   1   1   1   1'
      !'Mg 1', 1621.9700, -5.767,  0.0000,  0.0,  7.6440,  1.0,99.000,99.000,99.000, 3.730, 1.490,-5.150,
      !         ' 3s2  1S   80p  1P    K          1   1   1   1   1   1   1   1   1'
      !'Mg 1', 1622.0210, -5.700,  0.0000,  0.0,  7.6440,  1.0,99.000,99.000,99.000, 3.800, 1.370,-5.190,
      !         ' 3s2  1S   76p  1P    K          1   1   1   1   1   1   1   1   1'
      !                                                            Lande factors     Damping parameters   
      !Elm Ion  WL(A)    log(gf) E_low(eV) J lo E_up(eV)  J up  lower upper  mean   Rad.   Stark  Waals
      !
      !'Ca 1',   1372.2880, -2.566,  0.0000,  0.0,  9.0350,  1.0, 0.000, 1.000, 1.000, 8.484,-4.619,-7.453,
      !'4s2 1S    4p9d 1P                1   1   1   1   1   1   1   1   1'
      !
      !0   0    1    1    2    2    3    3    4    4    5    5    6    6    7    7    8    8    9    9    0
      !1...5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0....5....0
      !
      If (Index(f3, 'VALD') /= 0) Then
         IF (Index(line, 'Elm') == 0) STOP 'IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: Début de fichier anormal.'
         If(BLABLA) Write(*, *) "N = ", N
         If(BLABLA) Read(*, *)
B32:     Do While (I < N)
            I = I + 1
            Read(30, '(A)', iostat = ios) line1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-16."
            !
            sep1 = SEPARATORS_IN_LINE1(line1)
            !
            Read(line1(sep1( 1)+1 : sep1( 2)-1), '(F11.4)', iostat = ios) lambda_A
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-17."                 
            Read(line1(sep1( 2)+1 : sep1( 3)-1), '(F7.3)' , iostat = ios) loggf
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-18."
            Read(line1(sep1( 3)+1 : sep1( 4)+1), '(F8.4)' , iostat = ios) en1_eV
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-19."
            Read(line1(sep1( 4)+1 : sep1( 5)-1), '(F5.1)' , iostat = ios) J1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-20."
            Read(line1(sep1( 5)+1 : sep1( 6)-1), '(F8.4)' , iostat = ios) en2_eV
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-21."
            Read(line1(sep1( 6)+1 : sep1( 7)-1), '(F5.1)' , iostat = ios) J2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-22."
            Read(line1(sep1(10)+1 : sep1(11)-1), '(F6.3)' , iostat = ios) Gr
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-23."
            !
            Read(30, '(A)', iostat = ios) line2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-24."
            IF (Index(line1, 'References') /= 0) EXIT B32
            If (Index(line2, 'CONT') /= 0) Then
               I = I-1
               CYCLE B32
            End If
            !
            sep2 = SEPARATORS_IN_LINE2(line2)
            !
            Read(line2(sep2(2) : sep2(3)-1), '(A)', iostat =ios) config1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-25."
            Read(line2(sep2(4) : sep2(5)-1), '(A)', iostat = ios) cterm1
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-26."
            Read(line2(sep2(6) : sep2(7)-1), '(A)', iostat = ios) config2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-27."
            Read(line2(sep2(8) : sep2(9)-1), '(A)', iostat = ios) cterm2
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: PB-28."            
            !
            lambda_nm = lambda_A / 10.d0
            en1_cm = ( (q/(h*c)) * en1_eV ) / 100.d0
            en2_cm = ( (q/(h*c)) * en2_eV ) / 100.d0
            !
            !Determination du terme spectroscopique
            !
            config1 = CONFIG(Adjustl(config1))
            config2 = CONFIG(Adjustl(config2))
            IF(BLABLA) Write(*, *) "config1, config2 = ", Trim(config1), ", ", Trim(config2) 
            !
            term1 = TERME(cterm1)
            term2 = TERME(cterm2)
            IF(BLABLA) Write(*, *) "cterm1, cterm2, term1, term2 = ", Trim(cterm1), ", ", Trim(cterm2), term1, term2
            IF(BLABLA) Read(*, *)
            !
            If (BLABLA) Then
               If (Nint(lambda_A) - lambda_test == 0) Then
                  Write(*, *) 'config1 = ', config1
                  Write(*, *) 'config2 = ', config2
                  Read(*, *)
               End If
            End If
            !
            If (BLABLA) Then
               If (Nint(lambda_A) - lambda_test == 0) Then
                  Write(*, *) 'config1 = ', config1
                  Write(*, *) 'temp, pos1, pos2 = ', temp, pos1, pos2
                  Read(*, *)
               End If
            End If
            !
            If (BLABLA) Then
               If (Nint(lambda_A) - lambda_test == 0) Then
                  Write(*, *) 'config2 = ', config2
                  Write(*, *) 'temp, pos1, pos2 = ', temp, pos1, pos2
                  Read(*, *)
               End If
            End If
            !
            !Détermination de en_cm
            !
            en_cm = 1.d0 / (lambda_nm*1D-7)
            ! 
            !Détermination de Aij connaissant loggf et g       
            !
            Aij = (Cste/((2*J2+1)*(lambda_nm*1E-9)**2))*10**loggf
            !
            !Affectation dans la structure
            !
            J = J + 1
            S3(J) = LINES(config1, term1, en1_cm, J1, config2, term2, en2_cm, J2, en_cm, lambda_nm, loggf, Aij, Gr)
            !
         End Do B32                 
      End If
      !
      Close(30)
      !
   CONTAINS
   !--------------------------------------------------------------------
   Function SEPARATORS_IN_LINE1(line1) Result(sep)
      !
      Integer, dimension(13)         :: sep
      Character(len = *), Intent(in) :: line1
      !
      sep = 0
      !
      !EXEMPLES de line1 de VALD :
      !
      !'Mg 1', 1621.5070,-17.959,  0.0000,  0.0,  7.6460, 80.0,99.000,99.000,99.000, 0.000, 0.000, 0.000,
      !      |          |       |        |     |        |     |      |      |      |      |      |      |
      !    sep(1)     sep(2) sep(3)  sep(4) sep(5)  sep(6) sep(7) sep(8) sep(9) sep(10) sep(11) sep(12) sep(13) 
      !
      !'Ca 1',   1372.2880, -2.566,  0.0000,  0.0,  9.0350,  1.0, 0.000, 1.000, 1.000, 8.484,-4.619,-7.453,
      !      |            |       |        |     |        |     |      |      |      |      |      |      |
      !    sep(1)       sep(2) sep(3)  sep(4) sep(5)  sep(6) sep(7) sep(8) sep(9) sep(10) sep(11) sep(12) sep(13) 
      ! 
      sep(1) = Index(line1, ',')
      !
      Do K = 2, 13 
         sep(K) = index(line1(sep(K-1) + 1 : ), ',') + sep(K-1)
      End Do
      !  
      IF(BLABLA) Write(*, *) I, line1
      IF(BLABLA) Write(*, *) (sep(K), K = 1, 13)
      !
   End Function SEPARATORS_IN_LINE1
   !--------------------------------------------------------------------
   Function SEPARATORS_IN_LINE2(line2) Result (sep)
      !
      Integer, dimension(9)          :: sep
      Character(len = *), Intent(in) :: line2
      !
      sep = 0
      !
      !
      !EXEMPLES de line2 de VALD :
      !
      !         ' 3s2  1S   76p  1P    K          1   1   1   1   1   1   1   1   1'
      !         | |  | | |  |  | | |
      !        14   16   18   20   sep(22)
      !
      !'  4s2    1S      4p9d    1P                1   1   1   1   1   1   1   1   1'
      !|  |  |   | |     |   |   | |
      !14 15 16 17 18   19  20  21 sep(22)
      !
      sep(1) = Index(line2, "'") 
      sep(2) =  Scan(line2(sep(1) + 1 : ), "1234567890spdfghiklm") + sep(1)
      sep(3) = Index(line2(sep(2) + 1 : ),                    " ") + sep(2)
      sep(4) =  Scan(line2(sep(3) + 1 : ), "1234567890SPDFGHIKLM") + sep(3)
      sep(5) = Index(line2(sep(4) + 1 : ),                    " ") + sep(4)
      sep(6) =  Scan(line2(sep(5) + 1 : ), "1234567890spdfghiklm") + sep(5)
      sep(7) = Index(line2(sep(6) + 1 : ),                    " ") + sep(6)
      sep(8) =  Scan(line2(sep(7) + 1 : ), "1234567890SPDFGHIKLM") + sep(7)
      sep(9) = Index(line2(sep(8) + 1 : ),                    " ") + sep(8)
      !
      IF(BLABLA) Write(*, *) I, line2
      IF(BLABLA) Write(*, *) (sep(K), K = 1, 9)
      !
   End Function SEPARATORS_IN_LINE2
   !   
   End Subroutine COLLECTF3
   !
   !--------------------------------------------------------------------
   ! COLLECTE DES TABLES DE PHOTOIONISATION DE LA TOPBASE
   !--------------------------------------------------------------------
   !
   Subroutine COLLECTF4(f4, N, Nin, S4, Npt)
      ! f4     : Nom du fichier de données de la TOPBASE
      ! N      : Nombre de tables de photoionisation brut de la TOPBASE
      ! Nin    : Position du début du tableau dans le fichier f4 
      ! S4     : Structure des tables de photoionisation de la TOPBASE
      ! Npt    : Vecteur contenant le nombre de sections efficaces par table de photoionisation
      !
      ! Structure de la base de données de la TOPBASE pour les tables de photoionisations
      ! I  (NZ)  (NE)  ISLP  (ILV)   E(RYD)   NP
      ! E(RYD)  cross-section(Mbarn)
      !  ...        ...
      !
      Integer,                       intent(in)  :: N, Nin
      Character(len = *),            intent(in)  :: f4  
      Integer, dimension(:),         intent(out) :: Npt
      Type(PHOTOIONS), dimension(:), intent(out) :: S4
      !
      Integer                         :: I, J, term
      Double Precision                :: en_Ryd, en_cm
      Real, dimension(:), allocatable :: en_temp, seff_temp
      !
      cskip = '(xy/,A)'
      Write(cskip(2:3), '(I2.2)', iostat = ios) Nin-1
      IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-00."
      !
      Open(unit = 40, file = f4, status = 'old', action = 'read', position = 'rewind', iostat = ios)
      IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-01."
      Read(40, cskip, iostat = ios) line
      IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-02."
      IF (Index(line, '======') == 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF3: Début de fichier anormal."
      !
B40:  Do I = 1, N
         Read(40, '(A)', iostat = ios) line
         IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-03."
         !
         !Comme les champs sont toujours de longueur fixe, il est bcp + simple de fixer le format
         !
         Read(line(20:22),'(I3.3)'  , iostat = ios) term
         IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-04."
         Read(line(30:41),'(ES12.5)', iostat = ios) en_Ryd
         IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-05."
         Read(line(46:49),'(I5.5)'  , iostat =ios) Npt(I)
         IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-06."
         !
         Allocate(en_temp(Npt(I)), seff_temp(Npt(I)), stat = er)
         IF (er /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-07."
         !
B41:     Do J = 1, Npt(I)
            Read(40,  '(A)' , iostat = ios) line
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-08."
            Read(line( 3:14), '(ES13.6)', iostat = ios) en_temp(J)
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-09."
            Read(line(16:24), '(ES9.3)' , iostat = ios) seff_temp(J)
            IF (ios /= 0) STOP "IN MODULE MPR02_COLLECT, SUBROUTINE COLLECTF4: PB-10."
         End Do B41
         !
         !Conversion des en-tête
         en_cm  = en_Ryd*Ryd / 100
         !
         !Conversion de la table d'énergie de Ryd en Angstroem
         !
         !   en_temp   = 1.E8/((en_temp-en_Ryd_0)*Ryd) ! Angstroem
         !
         !Conversion de la table de sections efficaces de Mbarn en cm2
         !
         seff_temp = 1.E-18 * seff_temp              ! cm2
         !
         !Affectation de la structure
         !
         S4(I)%en_cm    = en_cm
         S4(I)%en_Ryd   = en_Ryd
         S4(I)%term     = term
         S4(I)%N        = Npt(I)
         !S4(I)%en_tab   = (/(  en_temp(J), J = 1, Npt(I))/)
         !S4(I)%seff_tab = (/(seff_temp(J), J = 1, Npt(I))/)
         S4(I)%en_tab(1 : Npt(I))   = (/(  en_temp(J), J = 1, Npt(I))/)
         S4(I)%seff_tab(1 : Npt(I)) = (/(seff_temp(J), J = 1, Npt(I))/)
         !
         Deallocate(en_temp, seff_temp)
         !
      End Do B40
      !
   End Subroutine COLLECTF4
   !
End Module MPR02_COLLECT