Module MPR04_SELECT ! USE MTD_STRUCT USE CONFIG USE MPR05_GRAPH USE MPR09_FUNCTIONS USE DATAGRAPH USE MOD_CSTES, ONLY: Ryd => cste_Ryd, c => cste_c, h => cste_h, q => cste_q ! Implicit None PRIVATE PUBLIC :: CRITLEVELS, CRITLEVELS2, CRITLINES, CRITPHOTOIONS ! !Integer :: er, ios ! Variable de contrôle dans les affectations dynamiques de mémoire ! CONTAINS ! !-------------------------------------------------------------------- ! SELECTION DES NIVEAUX D'ENERGIE PAR COMPARAISON TOPBASE <=> NIST !-------------------------------------------------------------------- ! Subroutine CRITLEVELS2(S1, S2, S3, fmt1, S_out, N) Type(LEVELS), dimension(:), intent(in) :: S1 Type(LEVELS), dimension(:), intent(in) :: S2 Type(PHOTOIONS), dimension(:), intent(in) :: S3 Character(len = *), intent(in) :: fmt1 Type(LEVELS), dimension(:), intent(out) :: S_out Integer, intent(out) :: N ! Integer :: I, J, K, L, M Integer :: NN1, NN2, NP, Nnist, Ntopb, Nsupl Integer :: nqp_i, nqs_i Logical :: Critere, lconfig, lenergy, lterm, lg, ident_nist_topb Type(LEVELS), dimension(10000) :: S_nist, S_topb, S_supl Type(LEVELS) :: S_temp ! NN1 = Size(S1) NN2 = Size(S2) NP = Size(S3) ! ! Sélection des niveaux NIST ! J = 1 ! B1: Do I=1, NN1 ! If (Lim_E_eV) Then Critere = Real(Abs(S1(I)%en_eV)) <= E_eV_max Else IF (l_max >= n_max) STOP "IN MODULE MPR04_SELECT, SUBROUTINE CRITLEVELS2: L_MAX >= N_MAX !!!" nqp_i = NQP(S1(I)%config) nqs_i = NQS(S1(I)%config) Critere = nqp_i <= n_max .AND. nqs_i <= l_max End If ! If (Critere .AND. S1(I)%en_cm <= S_0%Eion_cm) Then S_nist(J) = S1(I) J = J + 1 End If ! End Do B1 ! Nnist = J - 1 Write(*, *) "Selection of NIST energy levels: ", Nnist, "/", NN1 ! ! Sélection des niveaux TOPBASE ! J = 1 ! B2: Do I=1, NN2 ! If (Lim_E_eV) Then Critere = Real(Abs(S2(J)%en_eV)) <= E_eV_max Else IF (l_max >= n_max) STOP "IN MODULE MPR04_SELECT, SUBROUTINE CRITLEVELS2: L_MAX >= N_MAX !!!" nqp_i = NQP(S2(I)%config) nqs_i = NQS(S2(I)%config) Critere = nqp_i <= n_max .AND. nqs_i <= l_max End If ! If (Critere .AND. S2(I)%en_cm <= S_0%Eion_cm) Then S_topb(J) = S2(I) J = J + 1 End If ! End Do B2 ! Ntopb = J-1 Write(*, *) "Selection of TOPBASE energy levels: ", Ntopb, "/", NN2 ! ! Ajout de niveaux suplémentaires ! If (user_lev) Then ! J = 1 ! B3: Do I = 1, Klevels ! If (Lim_E_eV) Then Critere = Real(Abs(S_level_sup(I)%en_eV)) <= E_eV_max Else nqp_i = NQP(S_level_sup(I)%config) nqs_i = NQS(S_level_sup(I)%config) Critere = nqp_i <= n_max .AND. nqs_i <= l_max End If ! If (Critere) Then S_supl(J) = S_level_sup(I) ! défini dans mdatagraph J = J + 1 End If ! End Do B3 ! Nsupl = J-1 Write(*, *) "Selection of supplementary levels: ", Nsupl, "/", Klevels ! End If ! K = 1 ! ! Affectation des tables de photoionisation de la TOPBASE aux niveaux NIST ! B4: Do I=1, Nnist B5: Do J=1,Ntopb lconfig = Index( S_nist(I)%config, Trim(S_topb(J)%config)) /= 0 lterm = S_nist(I)%term == S_topb(J)%term If (lconfig .AND. lterm) Then S_nist(I)%NTP = S_topb(J)%NTP K = K + 1 End If End Do B5 ! End Do B4 ! Write(*, *) "Number of selected NIST energy levels with TOPBASE photoionization: ", K-1 ! ! Sélection des niveaux NIST sauf si présent dans MDATAGRAPH (et user_lev = true) ! K = 1 L = 1 M = 1 ! B6: Do I=1, Nnist ! If (user_lev) Then B7: Do J=1, Nsupl lconfig = Trim(S_nist(I)%config) == Trim(S_supl(J)%config) lenergy = S_nist(I)%en_cm == S_supl(J)%en_cm IF (lconfig .AND. lenergy) CYCLE B6 End Do B7 End If ! S_out(K) = S_nist(I) K = K + 1 M = M + 1 ! End Do B6 ! ! Sélection des niveaux supl de MDATAGRAPH si pas déjà sélectionné ! If (user_lev) Then ! B8: Do I = 1, Nsupl S_out(K) = S_supl(I) K = K + 1 L = L + 1 End Do B8 ! End If ! Write(*, *) "Number of selected energy levels: ", K-1 Write(*, *) "Number of NIST energy levels: ", M-1 Write(*, *) "Number of supplementary energy levels: ", L-1 ! ! Nombre de niveaux (incluant l'ionisation) sélectionnés ! N = K-1 ! ! Classement des niveaux par en_cm croissants ! B9: Do I = 1, N-1 Do J = I, 1, -1 If (S_out(J+1)%en_cm < S_out(J)%en_cm) Then S_temp = S_out(J) S_out(J) = S_out(J+1) S_out(J+1) = S_temp End If End Do End Do B9 ! End Subroutine CRITLEVELS2 ! !-------------------------------------------------------------------- ! Subroutine CRITLEVELS(S_atom, S1, S2, S3, Lim_E_eV, E_eV_max, n_max, l_max, fmt1, l2, S_out, N) ! S_atom : structure de l'atome ! S1 : structure des niveaux NIST ! S2 : structure des niveaux TOPBASE ! S3 : structure des tables de photoionisation ! Lim_E_eV : logique vrai si E_eV_max utilisé comme critère de sélection faux si n_max et l_max utilisé ! E_eV_max : comme son nom l'indique ! n_max : NQP max ! l_max : NQS max ! fmt1 : format des données de la structure ! l2 : variable logique d'affichage des étapes de sélection ! S_out : structure des niveaux sélectionnés ! N : nombre de niveaux sélectionnés ! Type(ATOM), intent(in) :: S_atom Type(LEVELS), dimension(:), intent(in) :: S1 Type(LEVELS), dimension(:), intent(in) :: S2 Type(PHOTOIONS), dimension(:), intent(in) :: S3 Logical, intent(in) :: Lim_E_eV Real, intent(in) :: E_eV_max Integer, intent(in) :: n_max, l_max Character(len = *), intent(in) :: fmt1 Logical, intent(inout) :: l2 Type(LEVELS), dimension(:), intent(out) :: S_out Integer, intent(out) :: N ! Integer :: I, II, J, JJ, JJJ, K, KK, gtemp, ident_config Integer :: NN1, NN2, NP Integer :: nqp_i, nqs_i !nombre quantique principal et secondaire de la configuration électronique en cours Integer, dimension(50) :: pos_JJ Logical :: Critere Type(LEVELS) :: S_temp ! NN1 = Size(S1) NN2 = Size(S2) NP = Size(S3) ! Write(*, '(/,A,/)') '-------------------------------------------------------------------' Write(*, *) "Sélection des niveaux d'énergie par comparaison TOPBASE <=> NIST" Write(*, '(/,A,/)') '-------------------------------------------------------------------' ! !DETECTION DE L'IONISATION ! B0: Do I = 1, NN1 If (S1(I)%term == 999) Then S_out(1) = S1(I) If (l2) then Write(*, *) "Détection de l'ionisation : " Write(*, fmt1) I, S_out(1) End If EXIT B0 End If End Do B0 ! II = 0 !Compteur de tables de photoionisation différentes K = 2 !Le niveau d'ionisation est positionné en 1 ! B1: Do I = 1,NN2 !Niveaux TOPBASE ! B2: Do J = 1, NN1 !Niveaux NIST ! ! Critère de sélection des niveaux ! If (Lim_E_eV) Then Critere = Real(Abs(S1(J)%en_eV)) <= E_eV_max Else IF (l_max >= n_max) STOP "IN MODULE MPR04_SELECT, SUBROUTINE CRITLEVELS: L_MAX >= N_MAX !!!" nqp_i = NQP(S2(I)%config) nqs_i = NQS(S2(I)%config) Critere = nqp_i <= n_max .AND. nqs_i <= l_max End If ! If (Critere) then ! !Identificat° de la structure élec I de la TOPBASE avec la structure J de NIST ! ident_config = Index( S1(J)%config, Trim(S2(I)%config)) ! ! Cas où il y a inversion entre NIST et TOPBASE (ex CaI : 3p6.4s.3d et 3p6.3d.4s) ! IF(ident_config == 0) ident_config = Index( S1(J)%config, Trim(CHANGE_CONFIG(S2(I)%config, S_atom%Z))) ! If (ident_config /= 0) Then ! !Identification du terme (SLP)I de la TOPBASE avec le terme (SLP)J de NIST ! If (S2(I)%term == S1(J)%term) Then ! !Vérification que (niveau I de la TOPBASE) < Eion (S1:NIST, S2:TOPBASE) ! If (Abs(S2(I)%en_cm) <= Abs(S2(1)%en_cm)) Then ! !Identification des poids statistiques des niveaux dela TOPBASE et de NIST ! If (S2(I)%g == S1(J)%g) Then ! !PAS DE STRUCTURE FINE : Niveau identifié ! S_out(K) = S1(J) ! !Affectation du numéro de la table de photoionisation à associer ! S_out(K)%NTP = S2(I)%NTP ! IF (l2) Call DISPLAY_AGAIN(S1(J)) ! K = K + 1 ! Compteur de niveau d'énergie sélectionné II = II + 1 ! Compteur de table de photoionisation différente EXIT B2 ! Else ! !IDENTIFICATION DE LA STRUCTURE FINE des niveaux de NIST ! If (S2(I)%g > S1(J)%g) then pos_JJ = 0 ! Initialisation des posit° des niveaux de structure fine KK = 1 ! Initialisation du compteurs de niveaux fins gtemp = S1(J)%g ! !Cherche la structure fine sur les JJ = 50 niveaux suivants de NIST ! B3: Do JJ = 1, NN1 - J !50 ! !Cherche une configuration identique ! ident_config = index(S1(J+JJ)%config,trim(S2(I)%config)) ! If (ident_config == 0) Then ident_config = Index( S1(J+JJ)%config, Trim(CHANGE_CONFIG(S2(I)%config, S_atom%Z))) End If ! If (ident_config /= 0) Then ! !Cherche un terme identique ! If (S1(J+JJ)%term == S2(I)%term) Then ! !Identification du nombre de niveaux fins ! gtemp = gtemp + S1(J+JJ)%g pos_JJ(KK) = JJ !Nombre de niveaux de la structure fine KK = KK + 1 ! !Niveaux fins identifiés ! If (gtemp == S2(I)%g) Then ! IF (l2) Write(*, *) 'Niveau TOPBASE : ', I, ' , g = ', S2(I)%g ! B41: Do JJJ = 1, KK S_out(K) = S1(J+pos_JJ(JJJ)) ! ! Affectation du numéro de la table de photoionisation à associer ! S_out(K)%NTP = S2(I)%NTP ! IF (l2) Call DISPLAY_AGAIN(S1(J+pos_JJ(JJJ))) K = K + 1 ! Compteur de niveau d'énergie sélectionné End Do B41 II = II + 1 !Compteur de table de photoionisat° différente EXIT B2 End If ! End If ! End If ! End Do B3 ! ! Cas où g(TOBBASE) > Somme[g(NIST)] ! If (S2(I)%g > gtemp) Then If (l2) print*,'Niveau TOPBASE : ',I,' , g = ',S2(I)%g ! B42: Do JJJ = 1, KK S_out(K) = S1(J+pos_JJ(JJJ)) ! ! Affectation du n° de la table de photoionisation à associer ! S_out(K)%NTP = S2(I)%NTP ! IF (l2) Call DISPLAY_AGAIN(S1(J+pos_JJ(JJJ))) K = K + 1 ! Compteur de niveau d'énergie sélectionné End Do B42 II = II + 1 ! Compteur de table de photoionisation différente EXIT B2 End If ! End If ! End If ! End If ! End If ! End If ! End If ! End Do B2 ! End Do B1 ! !Ajout de niveaux supplémentaires (vient du module MDATAGRAPH) ! If (Klevels > 1) Then IF (Symbol /= S_atom%Symbol .OR. & & Z_IONI /= DEGRE_IONISATION(S_atom%Ion)) STOP "Modifiez le module MDATAGRAPH !!!" JJ = 0 ! Do J = 1, Klevels If (Lim_E_eV) Then Critere = Real(Abs(S_level_sup(J)%en_eV)) <= E_eV_max Else nqp_i = NQP(S_level_sup(J)%config) nqs_i = NQS(S_level_sup(J)%config) Critere = nqp_i <= n_max .AND. nqs_i <= l_max End If ! If (Critere) Then S_out(K+JJ) = S_level_sup(J) ! NIST sans TOPBASE JJ = JJ + 1 End If End Do ! Write(*, *) 'Ajout de ', JJ, 'niveaux supplémentaires.' K = K + JJ End If ! N = K-1 ! Nombre de niveaux sélectionnés (peut être sup à l'ionisation) ! If (l2 .AND. JJ /= 0) Then Write(*, *) "Niveaux avec les ajouts non classés : " Do I = 1, N Write(*, fmt1) I, S_out(I) End Do End If ! ! Classement des niveaux par leur énergie en cm-1 croissante ! Do I = 1, N-1 Do J = I, 1, -1 If (S_out(J+1)%en_cm < S_out(J)%en_cm) Then S_temp = S_out(J) S_out(J) = S_out(J+1) S_out(J+1) = S_temp End If End Do End Do ! N = Maxloc(S_out(1 : N)%term, dim = 1) Write(*, *) 'Valeur de N détérminé :', N ! If (l2) Then Write(*, *) "Niveaux classés :" Do I = 1, N Write(*, fmt1) I, S_out(I) End Do End If ! CONTAINS ! !----------------------------------------------------------------- ! Subroutine DISPLAY_AGAIN(niveau) ! Type(LEVELS), intent(in) :: niveau Character :: choix ! !Affiche la sélection des niveaux ! Write(*, *) 'Niveau TOPBASE : ',I Write(*, fmt1) K, niveau ! Do Write(*, *) 'Encore (o/n) ? ' Read(*,*) choix ! Select Case (choix) Case ('o', 'O', 'y', 'Y') EXIT Case ('n', 'N') l2 = .FALSE. EXIT Case Default CYCLE End Select ! End Do ! End Subroutine ! End Subroutine CRITLEVELS ! !-------------------------------------------------------------------- ! SELECTION DES TRANSITIONS DE LA BASE KURUCZ / VALD !-------------------------------------------------------------------- ! Subroutine CRITLINES(S1, S2, fmt1, fmt2, N1, N2, S_lines, S_index, S2_out) ! ! S1 : structure des transitions KURUCZ / VALD ! S2 : structure des niveaux sélectionnés ! dE_cm : Erreur permise sur l'énergie des niveaux pour la sélection fixé par l'utilisateur ! minlogf: Valeur minimale du loggf fixé par l'utilisateur !maxloggf: Valeur maximale du loggf fixé par l'utilisateur !fmt1,fmt2: format des données de la structure ! l3,l4 : variable logique d'affichage des étapes de sélection ! l7 : impressions des questions ! S_lines: structure des transitions sélectionnés ! S_index: structure des transitions sélectionnées et indexées aux niveaux sélectionnés ! S2_out : structure des niveaux participants aux transitions < ou = S2 ! N1 : Nombre de transitions sélectionnées ! N2 : Nombre de niveaux sélectionnés ! Type(LINES), dimension(:), intent(in) :: S1 Type(LEVELS), dimension(:), intent(in) :: S2 Character(len = *), intent(in) :: fmt1, fmt2 Integer, intent(inout) :: N1, N2 Type(LINES), dimension(:), intent(out) :: S_lines Type(INDEXLINES), dimension(:), intent(out) :: S_index Type(LEVELS), dimension(:), intent(out) :: S2_out ! Double Precision, parameter :: dEsup_cm = 0.010_8 ! Pour ne pas avoir des niveaux dégénérés de même énergie Integer :: I, II, J, K, L Integer :: NN2,NT Integer,dimension(:), allocatable :: level_select Character :: c1 Logical, parameter :: BLABLA = .FALSE. Logical, parameter :: GAIA = .FALSE. ! !type(LEVELS),dimension(:),allocatable :: S2_out_temp Type(INDEXLINES) :: S_temp ! II = 1 L = 1 ! NN2 = Size(S2) NT = Size(S1) ! Write(*, *) 'NN2 = ', NN2 Write(*, *) 'N2 = ', N2 !allocate(S2_out_temp(NN2),stat=er) !if (er/=0) stop "Erreur d'allocation de la structure de type LEVELS" Allocate(level_select(N2), stat = er) IF (er /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITLINES: PB-00" ! level_select = 1 ! mise à 0 pour chaque niveau utilisé ! Write(*, '(/, A, /)') '-------------------------------------------------------------------' Write(*, *) 'Sélection des transitions de KURUCZ / VALD' Write(*, '(/, A, /)') '-------------------------------------------------------------------' Write(*, *) 'Critères de sélection : ' Write(*, *) '-----------------------' Write(*, *) 'dE_cm = ', dE_cm Write(*, *) 'minloggf = ', minloggf Write(*, *) 'maxloggf = ', maxloggf ! !Sélection des transitions ! TI: Do I = 1, NT ! TJ: Do J = 1, N2-1 ! !Détection de la configuration électronique du niveau bas d'énergie, de son poids statistique, de son terme spectro ! If (Index(S2(J)%config, S1(I)%config1) /= 0 .AND. & Abs(S1(I)%en1_cm - S2(J)%en_cm) < dE_cm .AND. & 2 * S1(I)%J1 + 1. == S2(J)%g .AND. & Abs(S1(I)%term1 - S2(J)%term) < 2 .OR. & SPECIAL(GAIA, J, S1(I)%config1, S1(I)%term1) ) Then ! If(BLABLA) Write(*, *) S1(I)%en2_cm, S2(J)%en_cm, 2 * S1(I)%J2 + 1., S2(J)%g, S1(I)%term2, S2(J)%term IF(BLABLA) Write(*, *) IF(BLABLA) Write(*, *) "Transition I = ", I IF(BLABLA) Write(*, *) "Niveau bas J = ", J, " : ", S2(J) ! TK: Do K = 1, N2-1 ! !Détection de la configuration électronique du niveau haut d'énergie, !de son poids statistique, de son terme spectro ! ! IF (BLABLA) Write(*, *), S1(I)%en2_cm, S2(K)%en_cm, 2 * S1(I)%J2 + 1., S2(K)%g, S1(I)%term2, S2(K)%term ! If (Index(S2(K)%config,S1(I)%config2) /= 0 .AND. & Abs(S1(I)%en2_cm-S2(K)%en_cm) < dE_cm .AND. & 2 * S1(I)%J2 + 1. == S2(K)%g .AND. & Abs(S1(I)%term2 - S2(K)%term) < 2 .OR. & SPECIAL(GAIA, K, S1(I)%config2, S1(I)%term2) ) Then IF(BLABLA) Write(*, *) "Niveau haut K = ", K, " : ", S2(K) IF (BLABLA) Read(*, *) ! !Valeur de loggf compris dans l'encadrement donné ! If (minloggf <= S1(I)%loggf .AND. S1(I)%loggf <= maxloggf) Then S_lines(L) = S1(I) S_index(L) = INDEXLINES(K, J, S1(I)%loggf, S1(I)%Aij, S1(I)%Gr, S1(I)%lambda_nm) level_select(J) = 0 level_select(K) = 0 IF(BLABLA) Write(*, *) ! If (l3) Then Write(*, *) 'Ni : ', J, ' , Nj : ', K, ' des niveaux sélectionnés' !Write(*, *) 'Terme bas : ',S1(I)%term1,'Kurucz / ',S2(J)%term,' NIST' Write(*, *) "Transition sélectionnée L : ", L Write(*, fmt2) L, S_lines(L) ! If (L == 100*II) Then Write(*, *) 'Encore (o/n) ? ' Read(*, *) c1 IF (c1 == 'n') l3 = .FALSE. II = II + 1 End If ! End If ! L = L+1 CYCLE TI ! End If ! End If ! End Do TK ! End If ! End Do TJ ! End Do TI ! !Sélection des transitions supplémentaires ! If(Klines /= 0) Then ! TPI: Do I = 1, Klines ! TPJ: Do J = 1, N2-1 ! If(Index(S2(J)%config, S_line_sup(I)%config1) /= 0 .AND. & Abs(S_line_sup(I)%en1_cm - S2(J)%en_cm) < dE_cm .AND. & 2 * S_line_sup(I)%J1 + 1. == S2(J)%g .AND. & Abs(S_line_sup(I)%term1 - S2(J)%term) < 2 ) Then ! TPK: Do K = 1, N2-1 ! If(Index(S2(K)%config,S_line_sup(I)%config2) /= 0 .AND. & Abs(S_line_sup(I)%en2_cm-S2(K)%en_cm) < dE_cm .AND. & 2 * S_line_sup(I)%J2 + 1. == S2(K)%g .AND. & Abs(S_line_sup(I)%term2 - S2(K)%term) < 2 ) Then ! If(minloggf <= S_line_sup(I)%loggf .AND. S_line_sup(I)%loggf <= maxloggf) Then S_lines(L) = S_line_sup(I) S_index(L) = INDEXLINES(K, J, S_line_sup(I)%loggf, S_line_sup(I)%Aij, S_line_sup(I)%Gr, S_line_sup(I)%lambda_nm) level_select(J) = 0 level_select(K) = 0 L = L+1 CYCLE TPI End If ! End If ! End Do TPK ! End If ! End Do TPJ ! End Do TPI ! End If ! N1 = L-1 !Nombre de transitions sélectionnées ! Write(*, '(/, A, I0)') "Nombre de niveaux d'énergie non utilisés dans les transitions :", Sum(level_select) - 1 ! !Affiche les indices et les niveaux non utilisés ! If (l4) Then Write(*, *) 'Niveaux non concernés (par absence de transitions depuis ou vers ces niveaux) : ' ! do I = 1, NN2 If (level_select(I) == 1) Then Write(*, fmt1) I, S2(I) End If End Do ! End If ! J = 1 ! !Sélection ou non des niveaux utilisés ! If (l7) Then Write(*, '(A)') "Voulez-vous sélectionner uniquement les niveaux utilisés dans les transitions (o/n) ?" Read(*, *) c1 Else c1 = 'n' End If ! Select Case(c1) ! Case('o', 'O', 'y', 'Y', '0') ! Do I = 1, NN2 ! If (level_select(I) == 0) Then S2_out(J) = S2(I) J = J + 1 End If ! S2_out(J) = S2(NN2) End Do ! Write(*, '(A, I4, A, I4, /)') 'Nombre de niveaux utilisés dans les transitions : ',J,' /', NN2 NN2 = J ! Nouveau nombre de niveaux N2 = NN2 ! Case('n', 'N') S2_out(1:N2) = S2(1:N2) Write(*, '(A,I4,A,I4, /)') 'Nombre de niveaux utilisés dans les transitions : ', N2-(Sum(level_select)-1), ' /', N2 Read(*,*) !N2 = NN2 ! End Select ! !Modification des énergies des niveaux dégénérés !(MULTI ne tolère pas des niveaux de même énergie) ! Write(*, '(A)') "Modification des énergies des niveaux dégénérés" ! Do I = 2, N2 ! If ( Abs(S2_out(I)%en_cm - S2_out(I-1)%en_cm) <= dEsup_cm .OR. & & S2_out(I)%en_cm < S2_out(I-1)%en_cm ) Then S2_out(I)%en_cm = S2_out(I-1)%en_cm + dEsup_cm S2_out(I)%en_eV = (100.d0*h*c/q) * S2_out(I)%en_cm !print*, 'I = ', I, 'N2 = ', N2 Write(*, '(F10.3, 1X, F10.3)') S2_out(I-1)%en_cm, S2_out(I)%en_cm End If ! End Do ! If (l4) Then ! Do I = 1, N2 Write(*, fmt1) I, S2_out(I) End Do ! End If ! !Classement des transitions par les niveaux bas croissants (2 --> 1, 3 --> 1, 5 --> 1, etc.) ! Do J = 1, N1 ! Do I = 1, N1 - 1 ! If (S_index(I)%Ni > S_index(I+1)%Ni) Then S_temp = S_index(I) S_index(I) = S_index(I+1) S_index(I+1) = S_temp End If ! If (S_index(I)%Ni == S_index(I+1)%Ni) Then ! If (S_index(I)%Nj > S_index(I+1)%Nj) Then S_temp = S_index(I) S_index(I) = S_index(I+1) S_index(I+1) = S_temp End If ! End If ! End Do ! End Do ! Deallocate(level_select) !,S2_out_temp) ! CONTAINS ! !----------------------------------------------------------------- ! Logical Function SPECIAL(GAIA, M, config_nivo, term_nivo) Logical, intent(in) :: GAIA Integer, intent(in) :: M ! Index du niveau Character(len = *), intent(in) :: config_nivo Integer, intent(in) :: term_nivo ! ! Si M = J => identification du terme bas ! Si M = K => identification du terme haut ! If (GAIA) Then SPECIAL = & ! Rajout spécifique pour prendre en compte les multiplets du terme bas/haut 3s.4p Index(S2(M)%config, config_nivo) /= 0 .AND. Trim(S2(M)%config) == '3s.4p' .AND. Abs(term_nivo - S2(M)%term) < 2 .OR. & ! Rajout spécifique pour prendre en compte les multiplets du terme bas/haut 3s.7d Index(S2(M)%config, config_nivo) /= 0 .AND. Trim(S2(M)%config) == '3s.7d' .AND. Abs(term_nivo - S2(M)%term) < 2 .OR. & ! Rajout spécifique pour prendre en compte les multiplets du terme bas/haut 3s.3d Index(S2(M)%config, config_nivo) /= 0 .AND. Trim(S2(M)%config) == '3s.3d' .AND. Abs(term_nivo - S2(M)%term) < 2 .OR. & ! Rajout spécifique pour prendre en compte les multiplets du terme bas 3s.7f Index(S2(M)%config, config_nivo) /= 0 .AND. Trim(S2(M)%config) == '3s.7f' Else SPECIAL = .FALSE. End If ! End Function SPECIAL ! End Subroutine CRITLINES ! !-------------------------------------------------------------------- ! SELECTION DES TABLES DE PHOTOIONISATION DE LA TOPBASE !-------------------------------------------------------------------- ! Subroutine CRITPHOTOIONS(S1, S2, N1, N2, fmt3, l6, l7, lambda_min_A, Nmin, Mwin, Lech, S3, Nphot,ext1_fig) ! S1 : Structure des niveaux d'énergie retenues pour l'atome considéré ! S2 : Structure des tables de photoionisation de la TOPBASE ! N1 : Nombre de niveaux d'énergie retenues ! N2 : Vecteur des nombres de points par table de photoionisation ! fmt3 : format d'affichage des données ! l6 : variable logique d'affichage des étapes de sélection ! l7 : variable logique d'affichage des questions ! lambda_min_A : borne inférieure des sections efficaces de photoionisation ! Nmin : Nombre de sections efficaces minimal par table ! Mwin : Taille de la fenêtre glissante (strictement impair) ! Lech : Sous échantillonnage (1pt/Lech) ! S3 : Structure des tables de photoionisation sélectionnées ! Nphot : Nombre de tables de photoionisation différentes utilisées ! ext1_fig : extension pour la figure (eps, png, ...) ! Type(LEVELS), dimension(:), intent(in) :: S1 Type(PHOTOIONS), dimension(:), intent(in) :: S2 Integer, intent(in) :: N1 Integer, dimension(:), intent(in) :: N2 Character(len = *), intent(in) :: fmt3 Logical, intent(in) :: l6, l7 Real, intent(in) :: lambda_min_A Integer, intent(inout) :: Nmin, Mwin, Lech Type(PHOTOIONS), dimension(:), intent(out) :: S3 Integer, intent(out) :: Nphot Character(len=*), intent(in) :: ext1_fig ! Integer :: I, J, K, N, NTP, Ntemp, Mtemp, Ltemp, Nsech, Z Real :: E_ion_n_Ryd_TOPB, E_ion_n_Ryd_NIST Real :: dE_cor_Ryd, dE_cor_A Real :: en_Ryd, en_cm Real, dimension(2000) :: en_temp, seff_temp, en_ech, seff_ech Real, dimension(2000, 2) :: mat Real, dimension(:), allocatable :: en_tab, seff_tab Real :: g_bf_MP, g_bf_KL Double Precision :: nu ! fréquence d'ionisation au seuil Integer :: l Character(len = 100) :: txt Character :: cc, choice Character(len = 100), parameter :: fout = './output/Select_phot.dat' Character(len = 100), parameter :: fout2 = './output/Z_Secteff.dat' Logical, parameter :: BLABLA = .FALSE. ! Write(*, '(/,A,/)') '-------------------------------------------------------------------' Write(*, *) 'Sélection des tables de photoionisation de la TOPBASE' Write(*, '(/,A,/)') '-------------------------------------------------------------------' Write(*, *) 'Critères de sélection : ' Write(*, *) '-----------------------' Write(*, *) 'lambda_min_A = ', lambda_min_A Write(*, *) 'Nmin = ', Nmin Write(*, *) 'Mwin = ', Mwin Write(*, *) 'Lech = ', Lech ! ! Pour chaque niveau, on cherche la table de photoionisation correspondante dans la TOPBASE ! If (l6) Write(*, *) 'Nlevels = ', N1 If (l6) Read(*, *) ! NTP = 0 Nphot = 0 ! If (l7) Then print'(/,A)','Sélection graphique (o/n) ?' read(*,*) cc Else cc = 'n' End If ! if (l6) then Write(*, *) 'N°/ En (cm-1)/ En (Ryd)/ Terme (SLP)/ Nbre de points' Write(*, fmt3) (I, S2(I)%en_cm, S2(I)%en_Ryd, S2(I)%term, S2(I)%N, I = 1, Size(S2)) Read(*, *) End If ! Open(10, file = fout, status = 'replace', action = 'write', position = 'rewind', iostat = ios) IF (ios /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITPHOTOIONS: PB-00." ! Open(11, file = fout2, status = 'replace', action = 'write', position = 'rewind', iostat = ios) IF (ios /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITPHOTOIONS: PB-01." ! Write(11, *) 'I Lambda (A) Sigma_bf (Mbarns)' ! Write(10, *) 'Ionisation' write(10, '(I3, 1X, A25, I4, F11.3, 2(1X, ES14.7), 1X, F5.1, 1X, I4, A)') I, S1(N1) ! P1: Do I = 1, N1-1 ! !Numéro de la table de photoionisation de la TOPBASE ! NTP = S1(I)%NTP ! Write(*, '(/, A)') '-------------------------------------------------------------------' If (l6) Then Write(*, *) 'Niveau sélectionné : ', I Write(*, *) 'N°/ Configuration électronique/ Term (SLP)/ En (cm-1)/ En (Ryd)/ En (eV)/ g/ N°TP' Write(*, '(I3, 1X, A25, I4, F11.3, 2(1X, ES14.7), 1X, F5.1, 1X, I4,A)') I, S1(I) End If ! Write(10, *) 'Niveau sélectionné : ',I Write(10, '(I3, 1X, A25, I4, F11.3, 2(1X, ES14.7), 1X, F5.1, 1X, I4,A)') I, S1(I) ! !Cas où le niveau n'a pas d'équivalent TOPBASE et donc pas de table de photoionisation ! If (NTP == 0) Then Write(*, *) "Niveau supplémentaire ajouté à la main n'ayant pas de table de photoionisation dans la TOPBASE." Write(10, *) "Niveau supplémentaire ajouté à la main n'ayant pas de table de photoionisation dans la TOPBASE." ! en_cm = S1(N1)%en_cm - S1(I)%en_cm ! Write(*, '(A,F10.3)') 'S1(N1)%en_cm :', S1(N1)%en_cm Write(*, '(A,F10.3)') 'S1( I)%en_cm :', S1(I)%en_cm ! Allocate(en_tab(1), seff_tab(1), stat = er) IF (er /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITPHOTOIONS: PB-02." ! ! UTILISATION DE FORMULE DE MIHALAS ET MENZEL-PICKERIS (1935) QUANTUM DEFECT METHOD ! UTILISATION DE FORMULE DE MIHALAS ET KARZAS ET LATTER (1960) ! en_tab = HUGE(0.) seff_tab = HUGE(0.) ! Call PAS_DE_TABLE_DE_PHOTOIONISATION( ) ! !Affectation dans la structure ! S3(I)%en_cm = en_cm S3(I)%en_Ryd = S1(I)%en_Ryd S3(I)%term = S1(I)%term S3(I)%N = 1 S3(I)%en_tab(1 : 1) = en_tab S3(I)%seff_tab(1 : 1) = seff_tab ! Deallocate(en_tab, seff_tab) CYCLE P1 End If ! !Cas où il existe une table de photoionisation ! Ntemp = S2(NTP)%N ! Nombre initial de sections efficaces dans la table n° NTP ! IF (l6) Write(*, *) 'Nbre initial de sections efficaces dans la table : ', Ntemp ! ! Compteur du nombre de tables de photoioisation différentes utilisé ! Nphot = Nphot + 1 ! !Traitement des niveaux fins : même table de photoionisation !Cas où 2 niveaux se succédant sont fins ! If ( I > 1 ) Then If ( NTP == S1(I-1)%NTP .AND. NTP /= 0) Then S3(I) = S3(I-1) Write(*, *) 'Graphe ', I, ' Idem niveau ', I-1 Write(10, *) 'Table de photoionisation identique au niveau ',I-1 Write(10, *) '---------------------------------------------------------------------------------------' Write(11, '(I5,F11.3,F12.5,1X,A)') I, S3(I)%en_tab(1), S3(I)%seff_tab(1)/1E-18, 'IDEM' !Il faut donc soustraire 1 car la même table que I-1 est utilisée Nphot = Nphot-1 CYCLE P1 End If End If ! !Affectation des sections efficaces initiales dans des vecteurs temporaires !Suppression des sections efficaces nulles ! K = 0 ! do J = 1, Ntemp ! If (S2(NTP)%seff_tab(J) /= 0.) Then K = K + 1 ! Nombre de sections efficaces non nulles en_temp(K) = S2(NTP)%en_tab(J) seff_temp(K) = S2(NTP)%seff_tab(J) End If ! End Do ! IF (l6) Write(*, *), 'Nbre de sections efficaces nulles : ',Ntemp - K, '/ ', Ntemp Write(10, *) 'Nbre de sections efficaces nulles : ', Ntemp - K, '/ ', Ntemp Ntemp = K ! !Correction NIST de l'énergie de photoionisation ! E_ion_n_Ryd_NIST = S1(N1)%en_Ryd - S1(I)%en_Ryd ! Référence à la valeur du continu E_ion_n_Ryd_TOPB = Abs( S2(NTP)%en_Ryd ) dE_cor_Ryd = E_ion_n_Ryd_TOPB - E_ion_n_Ryd_NIST dE_cor_A = (1.D-10/Ryd) * (1./E_ion_n_Ryd_TOPB - 1./E_ion_n_Ryd_NIST) ! Write(*, *) 'E_ion_n_Ryd_NIST = ', E_ion_n_Ryd_NIST Write(* ,*) 'E_ion_n_Ryd_TOPB = ', E_ion_n_Ryd_TOPB Write(10, '(A, F10.2, A, ES10.3, A, F10.3, A)') 'Correction NIST : ',dE_cor_Ryd*Ryd/100.D0,' cm-1, ',& dE_cor_Ryd,' Ryd, ',dE_cor_A,' A.' en_Ryd = E_ion_n_Ryd_TOPB - dE_cor_Ryd ! = E_ion_n_Ryd_NIST en_cm = en_Ryd * Ryd/100.D0 ! ! SELECTION SUIVANT LE PREMIER CRITERE ! Troncature des sections de photoionisation à lambda_min_A ! K = 0 ! Compte le nombre de sections efficaces à éliminier suivant ce critère ! P2: Do J = 1, Ntemp ! !Correction NIST de la table des énergies de photoionisation !fourni par la TopBase ! IF(BLABLA) Write(*,*) 'en_temp(J) en Ryd', en_temp(J) en_temp(J) = en_temp(J) - dE_cor_Ryd ! !Conversion en longueur d'onde ! en_temp(J) = 1.D10/(en_temp(J) * Ryd ) ! Energie exprimée en Angstroem ! !Suppressions de points si énergies inférieures lambda_min_A ! IF(BLABLA) Write(*, *) en_temp(J), lambda_min_A ! If (en_temp(J) <= lambda_min_A) Then seff_temp(J) = 0. K = K + 1 End If ! End Do P2 ! N = Ntemp - K !Nouveau nombre de sections efficaces IF(BLABLA) Write(*, *) 'Nombre de sections efficaces retenues suivant le premier critère :', N, ' /', Ntemp ! Write(*, *) 'Graphe ',I,' Nb de points > ',lambda_min_A,' A : ',N,' / ',Ntemp Write(10, *) 'Graphe ',I,' Nb de points > ',lambda_min_A,' A : ',N,' / ',Ntemp ! if (N /= 0) Then ! ! SELECTION SUIVANT LE DEUXIEME CRITERE ! Lissage et sous-échantillonnage des sections efficaces de photoionisation ! Allocate(en_tab(N), seff_tab(N), stat = er) IF (er /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITPHOTOIONS: PB-02." ! !Initialisation ! en_tab = HUGE(0.) seff_tab = HUGE(0.) ! Write(*, *) 'Nombre de section efficaces N : ', N ! If (Nmin < N) Then Ntemp = Nmin ! Nombre de sections efficaces gardés après le seuil Else Ntemp = N ! Cas ou Nmin > Nb de seff non nulles End If ! Mtemp = Mwin ! Taille de la fenêtre Ltemp = Lech ! Enchantillonnage tous les Lech points ! Select Case(cc) ! !Sélection des données par visualisation graphique ! Case('o', 'O', 'y', 'Y') ! txt = 'Level : xyz, Number of selected points : wxyz / wxyz' write(txt(10:12),'(I3.3)') I write(txt(47:51),'(I4.4)') N write(txt(56:59),'(I4.4)') N+K ! print fmt51,(en_temp(J), seff_temp(J), J=1, N) !Sélection de la longueur d'onde à partir de laquelle on lissera les données P3: do !print*,size(en_temp),size(seff_temp),N,size(en_temp(1:Ntemp)),size(seff_temp(1:Ntemp)),Ntemp call SECT_EFF(I, en_temp,seff_temp, N,en_temp(1:Ntemp),seff_temp(1:Ntemp),Ntemp,txt,'XWIN') print*,'Nmin = ',Ntemp print*,'Nombre de sections efficaces juste au-dessus du seuil gardé suffisant (o/n) ?' read(*,*) choice if (choice == 'o') then !Lissage des données if (Nmin lambda_min_A) ! Ntemp : nombre d'échantillons conservé sans lissage au dessus du seuil ! Mtemp : taille de la fenêtre glissante mat = WINDOW(seff_temp,en_temp,N,Ntemp,Mtemp) print*,'Nombre de points à lisser : ',N-Ntemp txt = 'Level : xyz, Number of smoothing pts : wxyz / wxyz' write(txt(10:12),'(I3.3)') I write(txt(41:44),'(I4.4)') N-Ntemp write(txt(50:53),'(I4.4)') N ! ZOOM sur la partie du graphe lissé call SECT_EFF(I, en_temp(Ntemp:),seff_temp(Ntemp:),N-Ntemp, & &mat(Ntemp:,1), mat(Ntemp:,2), N-Ntemp,txt,'XWIN') print*,'Taille de la fenêtre glissante : ',Mtemp print*,'Données suffisament lissées (o/n) ? ' read(*,*) choice if (choice == 'o') then ! Sous-échantillonnage des données lissées P5: do en_ech(1:int(N/Ltemp):1) = mat(Ntemp+1:N:Ltemp,1) seff_ech(1:int(N/Ltemp):1) = mat(Ntemp+1:N:Ltemp,2) Nsech = int((N-Ntemp)/Ltemp) print*,'Données sous échantillonnées :',Nsech,' / ',N-Ntemp txt = 'Level : xyz, Number of undersampled : wxyz / wxyz' write(txt(10:12),'(I3.3)') I write(txt(41:44),'(I4.4)') Nsech write(txt(50:53),'(I4.4)') N-Ntemp ! Affichage des données lissées sous-échantillonnées call SECT_EFF(I, en_temp(Ntemp:),seff_temp(Ntemp:),N-Ntemp, & &en_ech, seff_ech, Nsech,txt,'XWIN') print*,"Sélection d' 1 pt / ",Ltemp," pts" print*,'Sous échantillonage suffisant (o/n) ? ' read(*,*) choice if (choice=='o') then !Affectation en_tab(1:Ntemp) = mat(1:Ntemp,1) en_tab(Ntemp+1:) = en_ech(1:int(N/Ltemp):1) seff_tab(1:Ntemp) = mat(1:Ntemp,2) seff_tab(Ntemp+1:)= seff_ech(1:int(N/Ltemp):1) !Affichage des données sélectionnées et traitées txt = 'Level : xyz, Number of final points : wxyz sur wxyz' write(txt(10:12),'(I3.3)') I write(txt(41:44),'(I4.4)') Ntemp+Nsech write(txt(50:53),'(I4.4)') S2(NTP)%N call SECT_EFF(I, en_temp,seff_temp,N,en_tab,seff_tab,Nsech+Ntemp,txt,'XWIN') P6: do ! filename = './OUTPUT/FIGURE/Seff_level_xyz.ps' ! write(filename(28:30),'(I3.3)') I ! print*,filename print*,'Nombre final de points sélectionnés pour le niveau ',& &I,' :' ,Nsech+Ntemp print*,'Sélection satisfaisante (o/n) ?' read(*,*) choice if (choice =='o') exit P3 if (choice =='n') cycle P3 end do P6 else print*,'Nouvelle valeur de Lech = ' read(*,'(I3)') Ltemp cycle P5 end if end do P5 else do print*,'Nouvelle valeur de Mwin = ' read(*,'(I3)') Mtemp if (mod(Mtemp,2)==1) cycle P4 print*,'Rentrer une valeur IMPAIRE de Mwin, merci.' end do end if end do P4 else en_tab = en_temp seff_tab = seff_temp Ntemp = N Nsech = 0 print*,'Nombre final de points sélectionnés pour le niveau ',& &I,' :' ,Nsech+Ntemp print*,'Sélection satisfaisante (o/n) ?' read(*,*) choice if (choice =='o') exit P3 if (choice =='n') cycle P3 end if else print*,'Nouvelle valeur de Nmin = ' read(*,'(I3)') Ntemp cycle P3 end if exit end do P3 write(10,*) "Nmin = ", Ntemp,", Mwin = ", Mtemp," Lech = ", Ltemp ! !Sélection automatique (sans visualisation graphique) ! Case default ! ! Si le nb de points min à garder est sup au nombre de seff de la table ! If (N > Nmin) Then !Lissage possible que si Nmin < nb de seff de la table ! ! Lissage des données ! mat = WINDOW(seff_temp, en_temp, N, Ntemp, Mtemp) Write(*, *) 'Nombre de section efficaces N : ', N ! ! Sous-échantillonnage ! Nsech = (N-Ntemp-1)/Ltemp + 1 en_ech(1 : Nsech ) = mat(Ntemp+1 : N : Ltemp, 1) seff_ech(1 : Nsech ) = mat(Ntemp+1 : N : Ltemp, 2) ! Write(*, *) 'Nombre de sections efficaces sous echantillonnées Nsech :', Nsech ! ! Affectation ! en_tab(1 : Ntemp) = mat(1 : Ntemp, 1) en_tab(Ntemp+1 : Ntemp+Nsech) = en_ech(1 : Nsech : 1) ! seff_tab(1 : Ntemp) = mat(1 : Ntemp, 2) seff_tab(Ntemp+1 : Ntemp+Nsech) = seff_ech(1 : Nsech : 1) Else en_tab(1 : N) = en_temp(1 : N) seff_tab(1 : N) = seff_temp(1 : N) Nsech = 0 Write(*, *) End If ! Write(*, *) 'Nombre final de points sélectionnés pour le niveau ',I,' :' ,Nsech + Ntemp ! ! Interpolation de la section efficace au seuil ! en_tab(1) = 1.E8/en_cm !A ! ! INTERPOLATION DANS LA TABLE CORRIGE DE L'ECART A NIST ! Mais possibilité de différence entre la première longueur d'onde dans la table en_temp(J) et ! et l'énergie d'ionisation (en Angstroem) du niveau NIST en_tab(1) ! Boucle pour s'assurer que l'interpolation en lambda se fait entre les 2 sect eff les plus proches ! P7: Do J = 2, 10 ! ATTENTION If (en_tab(1) > en_temp(J)) Then ! !il faut supprimer les premières valeurs ! en_tab(1 : N -(J-2)) = en_tab(J-1 : N) seff_tab(1 : N -(J-2)) = seff_tab(J-1 : N) en_tab(1) = 1.E8 / en_cm seff_tab(1) = INTERP(en_temp(J-1), en_temp(J), seff_temp(J-1), seff_temp(J), en_tab(1)) Ntemp = Ntemp -(J-2) ! If (l6) Then Write(*, *) '(lambda1(A), seff1(cm2)) = (', en_temp(J-1), seff_temp(J-1), ')' Write(*, *) '(lambda2(A), seff2(cm2)) = (', en_temp(J), seff_temp(J), ')' Write(*, *) 'lambda_seuil (A) = ', en_tab(1) Write(*, *) 'seff_interpolé_seuil (cm2) = ', seff_tab(1) End If ! Write(10, '(A,F10.3,A,ES10.3,A)') '(lambda1(A), seff1(cm2)) = (', en_temp(J-1), ', ', seff_temp(J-1), ')' Write(10, '(A,F10.3,A,ES10.3,A)') '(lambda2(A), seff2(cm2)) = (', en_temp(J), ', ', seff_temp(J), ')' Write(10, '(A,F10.3)') 'lambda_seuil (A) = ', en_tab(1) Write(10, '(A,ES10.3)') 'seff_interpolé_seuil (cm2) = ', seff_tab(1) Write(10, *) 'Nombre final de points sélectionnés pour le niveau ',I,' :' , Nsech + Ntemp Write(11, '(I5, F11.3, F12.5, 1X, A)') I, en_tab(1), seff_tab(1)/1E-18, 'TOPBASE' EXIT P7 End If ! End Do P7 ! End Select ! ! Ecriture du graphe au format PDF/PNG/PS ! txt = 'Level : xyz, Number of final points : wxyz / wxyz' Write(txt(10:12),'(I3.3)') I Write(txt(41:44),'(I4.4)') Ntemp + Nsech Write(txt(50:53),'(I4.4)') S2(NTP)%N ! ! PAS NORMAL PLANTE quand je décommente la ligne suivante. Call SECT_EFF(I, en_temp, seff_temp, N, en_tab, seff_tab, Nsech + Ntemp, txt, ext1_fig) ! Else ! Fin du cas ou existe une table de photoionisation ! Allocate(en_tab(1),seff_tab(1),stat=er) IF (er /= 0) STOP "In MPR04_SELECT, SUBROUTINE CRITPHOTOIONS: PB-10." ! ! UTILISATION DE FORMULE DE MIHALAS ET MENZEL-PICKERIS (1935) QUANTUM DEFECT METHOD ! en_tab = HUGE(0.) seff_tab = HUGE(0.) ! Nsech = 0 Ntemp = 1 ! Call PAS_DE_TABLE_DE_PHOTOIONISATION( ) ! End If ! !Affectation dans la structure ! !S3(I) = PHOTOIONS(en_cm, en_Ryd, S2(NTP)%term, Nsech+Ntemp, en_tab, seff_tab) S3(I)%en_cm = en_cm S3(I)%en_Ryd = en_Ryd S3(I)%term = S2(NTP)%term S3(I)%N = Nsech + Ntemp S3(I)%en_tab(1 : Nsech + Ntemp) = en_tab(1 : Nsech + Ntemp) S3(I)%seff_tab(1 : Nsech + Ntemp) = seff_tab(1 : Nsech + Ntemp) ! If (l6) Then Write(*, *) ,'N°/ En (cm-1)/ En (Ryd)/ Terme (SLP)/ Nbre de points' Write(*, fmt3) I, S3(I)%en_cm, S3(I)%en_Ryd, S3(I)%term, S3(I)%N Write(*, *) 'dE_cor_Ryd = ', dE_cor_Ryd Read(*, *) End If ! Write(10, *) '---------------------------------------------------------------------------------------' Deallocate(en_tab, seff_tab) ! End Do P1 ! Close(10) Close(11) ! CONTAINS ! !----------------------------------------------------------------- ! Subroutine PAS_DE_TABLE_DE_PHOTOIONISATION( ) ! Z = Z_IONI ! degré d'ionisation en_tab(1) = 1.E8 / en_cm ! energie en Angstroem n = NQP(S1(I)%config) l = NQS(S1(I)%config) nu = 100 * en_cm * c ! g_bf_MP = GAUNT_MP(Z, nu, n) g_bf_KL = GAUNT_KL(Z, nu, n, l) seff_tab(1) = CROSSECT_BF_THRES(g_bf_KL, Z, nu, n) ! Write(*, '(A, ES10.3)') "nu = ", nu Write(*, *) 'g_bf_MP = ', g_bf_MP Write(*, *) 'g_bf_KL = ', g_bf_KL Write(*, *) 'n = ', n Write(*, *) 'seff_tab(1) = ',seff_tab(1) Write(10,'(A)') "Calcul de la section au seuil par la formule de Mihalas (1970)" Write(10,'(A,I2)') 'n = ',n Write(10,'(A,I2)') 'l = ',l Write(10,'(A,F8.6)') 'g_bf_MP = ', g_bf_MP Write(10,'(A,F8.6)') 'g_bf_KL = ', g_bf_KL Write(10,'(A,F10.3)') 'lambda_seuil (A) = ',en_tab(1) Write(10,'(A,ES10.3)') 'seff_calculé_seuil (cm2) = ',seff_tab(1) Write(10,*)'---------------------------------------------------------------------------------------' Write(11,'(I5,F11.3,F12.5,1X,A)') I,en_tab(1),seff_tab(1)/1E-18,'MIHALAS' ! End Subroutine PAS_DE_TABLE_DE_PHOTOIONISATION ! End Subroutine CRITPHOTOIONS ! End Module MPR04_SELECT