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