Module MPR01_SPARSE
!
USE MTD_STRUCT
!
Implicit None
!
PRIVATE
PUBLIC :: SPARSING, SPARSINGF1, SPARSINGF2, SPARSINGF3, SPARSINGF4
!
Integer :: ios ! Variable de contrôle dans les opérations d'E/S
Character(len = 300) :: line ! Enregistrement d'une ligne d'un fichier
!
CONTAINS
!
!--------------------------------------------------------------------
! ANALYSE LEXICALE D'UN FICHIER
!--------------------------------------------------------------------
!
Integer Function SPARSING(f)
! Fonction qui retourne la taille du fichier f de structure (sans les lignes de commentaires)
! ni les tableaux de photoionisations
!
Integer :: pos1, pos2
Character(len = *) :: f
Logical, parameter :: BLABLA = .FALSE.
!
SPARSING = 0
!
Open(100, file = f, status = 'old', action = 'read', position = 'rewind', iostat = ios)
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, FUNCTION SPARSING: PB-00."
!
B1: Do While (ios == 0)
Read(100, '(A)', iostat = ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, FUNCTION SPARSING: PB-01."
!
! Cas des tables de photoionisation, on lit le nombre de niveaux en ligne 3 du fichier
!
!0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7
!1 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5
!
! pos1 pos2
! | |
!Photoionisations fournies par TOPBASE : 136
!
If (Index(line, 'Photoionisation') /= 0) Then
pos2 = scan(line, '1234567890', back=.TRUE.) !pos2 = 44
pos1 = scan(line, '1234567890') !pos1 = 42
Read(line(pos1:pos2), '(I3.3)', iostat = ios) SPARSING
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, FUNCTION SPARSING: PB-02."
IF(BLABLA) Write(*, *) 'line(pos1:pos2), SPARSING : ', line(pos1:pos2), SPARSING
SPARSING = SPARSING + 5
EXIT B1
End If
SPARSING = SPARSING + 1
End Do B1
!
! 4 lignes de commentaires au début des fichiers écrit par out1struct
!
SPARSING = SPARSING - 5
!
Close(100)
!
End Function SPARSING
!
!--------------------------------------------------------------------
! ANALYSE LEXICALE DU FICHIER DES NIVEAUX DE NIST
!--------------------------------------------------------------------
!
Subroutine SPARSINGF1(f1, NN1, N1in, N1out, sep)
!
! f1 : Nom du fichier à analyser (ex : MgI_levels_NIST.dat)
! NN1 : Nombre de niveaux brut de NIST
! N1in : Position du début du tableau dans le fichier f1
! N1out : Position de la fin du tableau dans le fichier f1
! sep : Vecteur de séparateur des champs
!
Character(len = *), intent(in) :: f1
Integer, intent(out) :: NN1,N1in,N1out
Integer, dimension(:), intent(out) :: sep
!
!Compteurs de lignes : fichier, étranges, théoriques, vides, séparatrices
!
Integer :: I, J, K, L, M
Integer :: pos1, pos2, pos3, pos33, pos4
Integer :: NN0
Character(len=2) :: CSymbol
Character(len=4) :: CIon
Logical :: l1, l2, l3
Logical, parameter :: BLABLA = .FALSE.
!
!Initialisations
!
I = 0; J = 0; K = 0; L = 0; M = 0
pos1 = 0; pos2 = 0; pos3 = 0; pos33 = 0; pos4 = 0
l1 = .TRUE.; l2 = .TRUE.; l3 = .TRUE.
!
Write(*, *) 'Lecture du fichier ', f1
Open(10, file = f1, status = 'old', action = 'read', position = 'rewind', iostat = ios)
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF1: PB-00."
!
B1: Do While (ios == 0)
I = I + 1
Read(10, '(A)', iostat = ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF1: PB-01."
!
!DETECTION DE L'ELEMENT, DE L'IONISATION ET DU NOMBRE DE NIVEAUX DONNES PAR NIST
!
!0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7
!1 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5
!
!pos2 pos3 pos33 pos4
! | | | |
! Mg I 323 Levels Found
! Mg II 149 Levels Found
! pos3 pos4
! | |
!Li I 182 Levels Found
!Mg I 323 Levels Found
!
If (l1 .AND. Index(line, 'Levels Found') /= 0) Then
pos4 = Index(line, 'Levels Found') ! pos4=16
pos3 = Scan(line(:pos4), 'IVX', back = .TRUE.) ! pos3=8
! pos2 = scan(line(:pos3),'ABCDEFGHIJKLMNOPQRSTUVWXYZ') ! pos2=5
pos2 = 5
pos33 = pos3 + Scan(line(pos3 + 1:pos4 - 1), '1234567890')
!
Read(line(pos33:pos4-1), '(I6)', iostat = ios) NN0
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF1: PB-02."
!
CSymbol = Trim(Adjustl(line(pos2 : pos3 - 1)))
CIon = Trim(Adjustl(line(pos2 + 2 : pos3)))
!
!Test du symbole chimique
!
IF (Csymbol /= S_0%Symbol) STOP "Le symbole de l'élément n'est pas correct !!! Vérifier dans 'config_*.in'."
!
!Test de l'ionisation
!
IF (CIon /= S_0%Ion) STOP "L'ionisation de l'élément n'est pas correct !!! Vérifier dans 'config_*.inc'."
l1 = .false.
CYCLE B1
End If
!
!DETECTION DU DEBUT DU TABLEAU, DES SEPARATEURS ET DES CHAMPS
!
If (l2 .AND. Index(line, '----------------------------------------') /= 0) Then
N1in = I
CYCLE B1
End If
!
!Détection des mots clefs de l'en-tête du tableau
!
!0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7
!1 5 0 5 0 5 0 5 0 5 0 5 0 5 0 5
!-----------------------------------------------------------------------------
!Configuration | Term | J | Level | J=0
!------------------------------------|--------------|-----|------------------ J=1
!-------------------------------------------------------------
!Configuration | Term | J | Level |
!------------------------|--------|------|-------------------|
!
pos1 = Index(line, 'Configuration') ! pos1 = 1
pos2 = Index(line, 'Term') ! pos2 = 39
pos3 = Index(line, 'J') ! pos3 = 56
pos4 = Index(line, 'Level') ! pos4 = 68
!
!Détections des positions des séparateurs de champs
!
If (l2 .AND. pos1 > 0 .AND. pos2 > 0 .AND. pos3 > 0 .AND. pos4 > 0) then
sep(1) = Index(line, '|') ! sep1 = 37
sep(2) = Index(line(sep(1) + 1 : ),'|') + sep(1) ! sep2 = 52
sep(3) = Index(line(sep(2) + 1 : ),'|') + sep(2) ! sep3 = 58
sep(4) = Index(line(sep(3) + 1 : ),'|') + sep(3) ! sep4 = 77
l2 = .FALSE.
CYCLE B1
End If
!
!DETECTION DES LIGNES BLANCHES, LIGNES SEPARATRICES ET LIGNES BIZARRES
!
If (.NOT. l2 .AND. l3) Then
!
!Teste si le champ Level contient du texte
!
TL1: If (Scan(line(sep(3) + 1 : sep(4) - 1), '<>[]?') /= 0) Then
IF(BLABLA) Write(*, *) "Level avec du texte...", line
J = J + 1
!
!Teste si le champ Level contenant du texte contient un nombre
!
TL11: If (Scan(line(sep(3) + 1 : ), '0123456789') /= 0) Then
IF(BLABLA) Write(*, *) "Level sans doute théorique...", line
M = M + 1
cycle B1
End If TL11
!
cycle B1
endif TL1
!
!Teste si la ligne est vide
!
TL2: If (Scan(line(sep(3) + 1 : sep(4) - 1), '1234567890-') == 0) Then
IF(BLABLA) Write(*, *) 'Ligne blanche'
K = K + 1
CYCLE B1
End If TL2
!
!Teste si la ligne est une séparatrice
!
TL3: If (index(line,'----|----')/=0) then
IF(BLABLA) Write(*, *) line
L = L + 1
CYCLE B1
End If TL3
!
End If
!
!DETECTION DE LA FIN DU TABLEAU
!
If (l3 .AND. Index(line, '----------------------------------------') /= 0) Then
N1out = I
l3 = .FALSE.
CYCLE B1
End If
CYCLE B1
End Do B1
Close(10)
!
NN1 = (N1out-1)- (N1in+1) - (J + K + L) + M
!
Write(*, *) '-----------------------------------------------'
Write(*, *) 'Nombre de niveaux fournis par NIST pour ', Csymbol, Trim(CIon), ' : ', NN0
Write(*, *) 'Nombre de lignes dans le fichier : ', I-1
Write(*, *) 'Position du début du tableau : ', N1in
Write(*, *) 'Position de la fin du tableau : ', N1out
Write(*, *) 'Nombre de champ Level avec du texte : ', J
Write(*, *) 'Nombre de champ Level "théorique" : ', M
Write(*, *) 'Nombre de lignes blanches : ', K
Write(*, *) 'Nombre de lignes séparatrices : ', L
Write(*, *) 'Nombre de niveaux sélectionnés : ', NN1
Write(*, *) '-----------------------------------------------'
!
End Subroutine SPARSINGF1
!
!--------------------------------------------------------------------
! ANALYSE LEXICALE DU FICHIER DES NIVEAUX DE LA TOPBASE
!--------------------------------------------------------------------
!
Subroutine SPARSINGF2(f2, NN2, N2in, N2out)
!
! f2 : Nom du fichier à analyser
! NN2 : Nombre de niveaux brut de la TOPBASE
! N2in : Position du début du tableau dans le fichier f2
! N2out : Position de la fin du tableau dans le fichier f2
!
Character(len = *), intent(in) :: f2
Integer, intent(out) :: NN2, N2in, N2out
!
Integer :: I, temp
Logical :: l1
!
I = 0
l1 = .TRUE.
!
Write(*, *) 'Lecture du fichier ', f2
Open(20, file = f2, status ='old', action = 'read', position = 'rewind', iostat = ios)
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF2: PB-00."
!
NN2 = 0
!
! =======================================================
! i NZ NE iSLP iLV iCONF E(RYD) gi
! =======================================================
! 1 12 12 100 1 3s2 -5.64727E-01 1.0
! 2 12 12 100 2 3s 4s -1.65892E-01 1.0
! 3 12 12 100 3 3s 5s -8.19693E-02 1.0
!
B2: Do While(ios == 0)
I = I + 1 !Compteur de lignes du fichier
Read(20, '(A)', iostat = ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF2: PB-01."
!
!Détection du début du tableau
!
If (l1 .AND. Index(line, '======') /= 0) Then
Read(20, '(1/,A)', iostat = ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF2: PB-02."
IF(Index(line,'======') == 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF2: PB-03."
I = I + 2
N2in = I
l1 = .FALSE.
CYCLE B2
End If
!
!Détection des niveaux
!
If (.NOT.l1 .AND. (Index(line, '======') == 0)) Then
Read(line(1:7), '(I7)', iostat = ios) temp
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF2: PB-04."
!
If (temp == NN2 + 1) Then
NN2 = NN2 + 1
CYCLE B2
Else
STOP 'Le n°du niveau ne correspond pas au nombre de niveaux en mémoire.'
End If
!
End If
!
!Détection de la fin du tableau
!
IF (.NOT.l1 .AND. Index(line, '======') /= 0) EXIT B2
CYCLE B2
End Do B2
!
Close(20)
!
N2out = I
!
Write(*, *) '-----------------------------------------------'
Write(*, *) 'Nombres de niveaux fournis par la TOPBASE : ', NN2
Write(*, *) 'Nombre de lignes dans le fichier : ', I
Write(*, *) 'Position du début du tableau : ', N2in
Write(*, *) 'Position de la fin du tableau : ', N2out
Write(*, *) 'Nombre de niveaux sélectionnés : ', NN2
Write(*, *) '-----------------------------------------------'
!
End Subroutine SPARSINGF2
!
!--------------------------------------------------------------------
! ANALYSE LEXICALE DU FICHIER DES TRANSITIONS DE KURUCZ / VALD
!--------------------------------------------------------------------
!
Subroutine SPARSINGF3(f3,NT,N3in,N3out)
!
! f3 : Nom du fichier à analyser
! NT : Nombre de transitions brut de KURUCZ
! N3in : Position du début du tableau dans le fichier f3
! N3out : Position de la fin du tableau dans le fichier f3
!
Character(len = *), intent(in) :: f3
Integer, intent(out) :: NT,N3in,N3out
!
Integer :: I, J, K, L
Integer :: pos1, pos2
Integer :: NT0
Character(len = 100) :: line1,line2 !Cas des transitions VALD
Logical :: l1
Logical, parameter :: BLABLA = .FALSE.
!
I = 0; J = 0; K = 0
l1 = .TRUE.
!
Write(*, *), 'Lecture du fichier ', f3
Open(30, file = f3, status = 'old', action = 'read', position = 'rewind', iostat = ios)
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-00."
Read(30, '(A)', iostat = ios) line
!
! Base de données 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
!
!Transitions KURUCZ
!------------------
If (Index(f3, 'KURUCZ') /= 0) Then
IF (ios > 0 .OR. Index(line, '----------------') == 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-01."
Read(30, '(2(/))', iostat = ios)
IF (ios>0.or.index(line,'----------------')==0) STOP 'IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-02.'
!
I = 4; NT = 0; N3in = I
!
B31: Do While(ios == 0)
I = I + 1
Read(30,fmt='(A)',iostat=ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-03."
!
!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, S_0%Symbol) /= 0) Then
NT = NT + 1
CYCLE B31
End If
!
!Teste si la ligne est à la fin du tableau
!
If (Index(line, 'Number of lines in output') /= 0) Then
pos1 = scan(line, '0123456789')
pos2 = scan(line, '0123456789', back = .TRUE.)
Read(line(pos1:pos2), '(I6)', iostat = ios) NT0
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-04."
N3out = I - 1
l1 = .FALSE.
CYCLE B31
End If
!
!Teste si la ligne contient un autre symbole
!
If (l1) Then
K = K + 1
CYCLE B31
End If
!
End Do B31
!
Write(*, *) '-----------------------------------------------'
Write(*, *) 'Nombres de transitions fournies par KURUCZ : ', NT0
Write(*, *) 'Nombre de lignes dans le fichier : ', I-1
Write(*, *) 'Position du début du tableau : ', N3in
Write(*, *) 'Position de la fin du tableau : ', N3out
Write(*, *) 'Nombre de lignes étranges : ', J
Write(*, *) 'Nombre de lignes concernant un autre élément : ', K
Write(*, *) 'Nombre de transitions sélectionnées : ', NT
Write(*, *) '-----------------------------------------------'
!
End If
!
! Base de données 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, <= line1
! ' 3s2 1S CONT 1 1 1 1 1 1 1 1 1' <= line2
!'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, <= line1
! ' 3s2 1S 80p 1P K 1 1 1 1 1 1 1 1 1' <= line2
! 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, <= line1
!'4s2 1S 4p9d 1P 1 1 1 1 1 1 1 1 1' <= line2
!
!Transitions VALD
!----------------
If (Index(f3, 'VALD') /= 0) Then
IF (ios > 0 .OR. Index(line, 'Lande factors') == 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-05."
Read(30, '(A)', iostat = ios) line
IF (ios > 0 .OR. Index(line, 'Elm') == 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF3: PB-06."
!
I = 2; NT = 0; N3in = I
!
B32: Do While(ios == 0)
Read(30, '(A)', iostat = ios) line1
IF (ios /= 0) EXIT B32
!
I = I + 1
!
If (Index(line1, 'References') /= 0) Then
Write(*, *) 'NT = ', NT, 'References'
N3out = I-1
l1 = .FALSE.
CYCLE B32
End If
!
If (l1) Then
!
Read(30,fmt='(A)',iostat=ios) line2
IF (ios > 0) EXIT B32
I = I + 1
!
IF(BLABLA) Read(*, *)
!
If (Index(line2,'CONT') /= 0) Then
J = J + 1
CYCLE B32
End If
!
End If
!
If (l1 .AND. Index(line1, S_0%Symbol) /= 0) Then
NT = NT + 1
CYCLE B32
End If
!
End Do B32
!
NT0 = NT + J
!
Write(*, *) '-----------------------------------------------'
Write(*, *) 'Nombres de transitions fournies par VALD : ', NT0
Write(*, *) 'Nombre de lignes dans le fichier : ', I-1
Write(*, *) 'Position du début du tableau : ', N3in
Write(*, *) 'Position de la fin du tableau : ', N3out
Write(*, *) 'Nombre de photoionisation : ', J
Write(*, *) 'Nombre de transitions sélectionnées : ', NT
Write(*, *) '-----------------------------------------------'
!
End If
!
Close(30)
!
End Subroutine SPARSINGF3
!
!--------------------------------------------------------------------
! ANALYSE LEXICALE DU FICHIER DES TABLES DE PHOTOIONISATION DE LA TOPBASE
!--------------------------------------------------------------------
!
Subroutine SPARSINGF4(f4, NP, N4in, N4out)
!
! f4 : Nom du fichier à analyser
! NP : Nombre de tables de photoionisation brut de la TOPBASE
! N4in : Position du début du tableau dans le fichier f4
! N4out : Position de la fin du tableau dans le fichier f4
!
Character(len = *), intent(in) :: f4
Integer, intent(out) :: NP, N4in, N4out
!
Integer :: I, temp2
Character(len = 300) :: temp1
Logical :: l1
!
I = 0
l1 = .TRUE.
!
Write(*, *) 'Lecture du fichier ',f4
Open(40, file = f4, status = 'old', action = 'read', position = 'rewind', iostat = ios)
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF4: PB-00."
!
NP = 0
!
B4: Do While(ios == 0)
I = I + 1 !Compteur de lignes du fichier
Read(40, '(A)', iostat = ios) line
IF (ios > 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF4: PB-01."
!
!Détection du début du tableau
!
If (l1 .AND. Index(line, '======') /= 0) Then
Read(40, '(1/,A)', iostat = ios) line
IF (ios > 0 .AND. Index(line, '======') == 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF4: PB-02."
I = I + 2
N4in = I
l1 = .FALSE.
CYCLE B4
End If
!
!Détection des tables
!
If (.NOT.l1 .AND. Index(line, '======') == 0) Then
Read(line(1:4), '(A)', iostat = ios) temp1
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF4: PB-03."
!
If (Trim(temp1) == '') Then
Read(line(1:8), '(I8)', iostat = ios) temp2
IF (ios /= 0) STOP "IN MODULE MPR01_SPARSE, SUBROUTINE SPARSINGF4: PB-04."
!
If (temp2 == NP + 1) Then
!Compte la table
NP = NP + 1
CYCLE B4
End If
!
End If
!
End If
!
!Détection de la fin du tableau
!
IF (.NOT.l1 .AND. Index(line, '======') /= 0) EXIT B4
CYCLE B4
End Do B4
!
Close(40)
!
N4out = I
!
Write(*, *) '-----------------------------------------------'
Write(*, *) 'Nb de tables de photoionisation de la TOPBASE : ', NP
Write(*, *) 'Nombre de lignes dans le fichier : ', I
Write(*, *) 'Position du début du tableau : ', N4in
Write(*, *) 'Position de la fin du tableau : ', N4out
Write(*, *) 'Nombre de tables sélectionnées : ', NP
Write(*, *) '-----------------------------------------------'
!
End Subroutine SPARSINGF4
!
End Module MPR01_SPARSE