Module MPR07_COLLISIONS ! USE MTD_STRUCT USE CONFIG, ONLY: ETL, Facteur_ETL, Facteur_FIN, CE_QUANTI, CE_SEATON, TESP_FMIN, CE_UPS, & CH_QUANTI, CH_DRAWIN, S_H, CH_BF, CH_CE, CH_BB_FBD USE MPR09_FUNCTIONS USE SEATON USE VAN_REGEMORTER USE DRAWIN ! Implicit none ! PRIVATE PUBLIC :: COLLISIONS_E, COLLISIONS_H ! Integer :: I, J, K Integer :: er Integer :: N1 ! Dimension de S1 (LEVELS) et S3 (PHOTOIONS) Integer :: N2 ! Dimension de S2 (INDEXLINES) ! Character(len = 7) :: Elt Integer :: Ni, Nj, Z Integer :: NQPi, NQSi, NQPj, NQSj, TERMi, TERMj Real :: gi, gj Double Precision :: En_i_cm, En_j_cm, DeltaE_cm, En_Ion_cm Double Precision :: lambda_vac, lambda ! Angstroem Character(len = 50) :: Config_i, Config_j ! Integer :: K_special ! Compteur de transitions dans tables théoriques Integer :: NTEMP Real, dimension(:), Allocatable :: TEMP Real, dimension(:), Allocatable :: UPSILON Character(len = 40) :: mot_clef ! Real :: Facteur = 1. Logical :: transition_niveaux_fins ! CONTAINS ! !*********************************************************************** ! Subroutine COLLISIONS_E (S0, S1, S2, S3, NCOL_E) ! Type(ATOM) , intent(in) :: S0 Type(LEVELS) , dimension(:), intent(in) :: S1 !N1 Type(INDEXLINES), dimension(:), intent(in) :: S2 !N2 Type(PHOTOIONS) , dimension(:), intent(in) :: S3 !N1 Integer, intent(out) :: NCOL_E ! Logical :: BLABLA = .FALSE. ! mode bavard Logical, parameter :: choix_calcul_empirique_interdite = .FALSE. ! Jeu de valeurs empiriques(non testé), Seaton si faux Logical :: choix_calcul_theorique = .FALSE. ! Auteurs de la littérature précisés Logical :: choix_calcul_empirique_permise = .FALSE. ! Van Regemorter si vrai, Seaton si faux Logical :: transition_niveaux_fins ! ! Initialisation ! choix_calcul_theorique = CE_QUANTI choix_calcul_empirique_permise = .NOT. CE_SEATON ! ! Dimension des structures ! N1 = SIZE(S1) N2 = SIZE(S2) ! If (ETL) Facteur = Facteur_ETL ! Si on est à l'ETL toutes les collisions sont multipliés par Facteur_ETL ! ! de LowerLevel (loop LL, index I) to UpperLevel (loop UL, index J) ! LL: Do I = 1, N1-1 ! UL: Do J = I+1, N1-1 ! TRANSITIONS BOUND BOUND If ( ALLOCATED(UPSILON) ) Deallocate(UPSILON) If ( ALLOCATED(TEMP) ) Deallocate(TEMP) NTEMP = 1 ! K = IS_ALLOWED_TRANSITION(S2, I , J ) ! K > 0 IF ALLOWED, K = 0 IF STRICTLY FORBIDDEN ! IF(K > 0) K = IS_SEMI_ALLOWED_TRANSITION( I, J, K, TESP_FMIN ) ! K = -1 IF SEMI ALLOWED with F < TESP_FMIN ELSE K > 0 ! transition_niveaux_fins = ( S1(I)%Config == S1(J)%Config ) ! Call ATOMIC_FEATURES_OF_TRANSITION(S0,S1,S2,S3, I, J, K ) ! A: If ( choix_calcul_theorique .AND. .NOT. transition_niveaux_fins) Then K_special = 0 ! If (Elt == 'CaI') Then K_special = WHICH_LINE_IN_SAMSON_BERRINGTON(I, J) If (K_special > 0) Then Call COMPUTE_SAMSON_BERRINGTON(K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If End If ! If (Elt == 'CaII') Then K_special = WHICH_LINE_IN_BURGESS_TULLY(I, J) If (K_special > 0) Then Call COMPUTE_BURGESS_TULLY(K, K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If End If ! If (Elt == 'MgI') Then K_special = WHICH_LINE_IN_ZATSARINNY(I, J) If (K_special >0) Then Call COMPUTE_ZATSARINNY(K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If End If ! If (Elt == 'MgII') Then K_special = WHICH_LINE_IN_SIGUT_PRADHAN(I, J) If (K_special > 0) Then Call COMPUTE_SIGUT_PRADHAN(K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If End If ! ! On peut rajouter ici des calculs théoriques pour d'autres élements ! End If A ! B: If (choix_calcul_empirique_permise .AND. K > 0 .AND. .NOT. transition_niveaux_fins) Then Call COMPUTE_VAN_REGEMORTER(K, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If B ! D: If (choix_calcul_empirique_interdite .AND. K == 0) Then !Call COMPUTE_SET_EMPIRICAL_FORBIDDEN Write(*, *) "Jeu complet de valeurs empiriques pour transitions interdites à faire." Read (*, *) End If D ! E: If (K == -1) Then Call COMPUTE_SEMI_ALLOWED(K, NTEMP, TEMP, UPSILON, mot_clef) GOTO 100 End If E ! ! On a ce cas si : choix_calcul_empirique_permise == .FALSE. ! OU choix_calcul_empirique_permise == .FALSE. ET transition_niveaux_fins == .TRUE. ! OU choix_calcul_empirique_permise == .TRUE. ET transition_niveaux_fins == .TRUE. ! Call COMPUTE_SEATON_CE(K, transition_niveaux_fins, NTEMP, TEMP, UPSILON, mot_clef) ! 100 Call WRITE_COLLISIONS_BB_IN_ATOM(mot_clef, NTEMP, TEMP, UPSILON, Facteur) NCOL_E = NCOL_E + 1 ! End Do UL ! TRANSITION BOUND FREE Call WRITE_COLLISIONS_E_BF_IN_ATOM(I) NCOL_E = NCOL_E + 1 ! End Do LL ! CONTAINS ! !------------------------------------------------------------------- ! Subroutine COMPUTE_SEATON_CE (K, fin, NTEMP, TEMP, UPSILON, mot_clef) Integer, intent(in) :: K ! positif si permise, nul si interdite Logical, intent(in) :: fin Integer, intent(out) :: NTEMP Real, dimension(:), allocatable, intent(out) :: TEMP, UPSILON Character(len = *), intent(out) :: mot_clef ! Integer :: L ! NTEMP = 8 Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_SEATON_CE : PB-00 " ! TEMP = (/1000., 2000., 4000., 6000., 8000., 10000., 15000., 20000./) ! Select Case (K) Case(1:) ! TRANSITION PERMISE Do L = 1, NTEMP Call SEATON_BB(K, TEMP(L), S0, S1, S2, UPSILON(L)) End Do mot_clef = 'TEP SEATON 1962' Case(0) ! TRANSITION INTERDITE UPSILON = 1. ! Par défaut mot_clef = 'TEI OMEGA = UPSILON = CSTE = 1.' If (fin) UPSILON = Facteur_FIN ! Choix arbitraire (on considère les niveaux fins d'un même terme à l'ETL entre eux) If (fin) mot_clef = 'TEF OMEGA = UPSILON = CSTE' Case Default STOP "COMPUTE_SEATON_CE : PB-01" End Select ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_SEATON_CE ! !------------------------------------------------------------------- ! Subroutine COMPUTE_VAN_REGEMORTER(K, NTEMP, TEMP, UPSILON, mot_clef) ! Integer, intent(in) :: K ! positif si permise, nul si interdite Integer, intent(out) :: NTEMP Real, dimension(:), allocatable, intent(out) :: TEMP, UPSILON Character(len = *), intent(out) :: mot_clef ! Integer :: L ! If (K == 0) STOP " COMPUTE_VAN_REGEMORTER : PB-00." ! NTEMP = 8 Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_VAN_REGEMORTER : PB-01." ! TEMP = (/1000., 2000., 4000., 6000., 8000., 10000., 15000., 20000./) ! Do L = 1, NTEMP Call VAN_REGEMORTER_BB(K, TEMP(L), S0, S1, S2, UPSILON(L)) End Do ! mot_clef = 'TEP VAN REGEMORTER 1962' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_VAN_REGEMORTER ! !------------------------------------------------------------------- ! Subroutine COMPUTE_SEMI_ALLOWED(K, NTEMP, TEMP, UPSILON, mot_clef) ! Integer, intent(in) :: K ! = -1 pour semi permise Integer, intent(out) :: NTEMP Real, dimension(:), allocatable, intent(out) :: TEMP, UPSILON Character(len = *), intent(out) :: mot_clef ! Integer :: L ! NTEMP = 2 Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_SEMI_ALLOWED : PB-01." ! TEMP = (/1000., 20000./) ! Do L = 1, NTEMP UPSILON(L) = CE_UPS End Do ! mot_clef = 'TESP OMEGA = UPSILON = CSTE' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_SEMI_ALLOWED ! !------------------------------------------------------------------- ! Subroutine WRITE_COLLISIONS_E_BF_IN_ATOM (I) ! Integer, intent (in) :: I ! Real :: SIGMA_THRESHOLD Character(len = 200) :: fmt1 = '(2I5, ES10.2)' ! SIGMA_THRESHOLD = S3(I)%seff_tab(1) ! lambda_vac = 1.D10/((S1(N1)%En_cm- S1(I)%En_cm) * 100.D0) ! lambda = LAMBDA_AIR(lambda_vac) ! Write(50, '(A,F15.4)') 'CI SEATON 1962 <', lambda Write(50, fmt1) I, N1, SIGMA_THRESHOLD * Facteur ! End Subroutine WRITE_COLLISIONS_E_BF_IN_ATOM ! !------------------------------------------------------------------- ! Integer Function IS_SEMI_ALLOWED_TRANSITION( I , J, K, TESP_FMIN ) Result ( Ktemp ) ! Integer, Intent(In) :: I, J, K Real, Intent(In) :: TESP_FMIN ! Ktemp = K ! If ( S1(I)%term < 300 .AND. S1(J)%term > 299 .OR. & S1(I)%term > 299 .AND. S1(J)%term < 300 ) Then !WE ONLY CONSIDERED AS SEMI ALLOWED TRANSITIONS WHERE F > TESP_FMIN IF ( 10**(S2(K)%loggf)/S1(I)%g < TESP_FMIN) Ktemp = -1 End If ! End Function IS_SEMI_ALLOWED_TRANSITION ! !------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_ZATSARINNY(I, J) Result (K_Zatsarinny) ! USE DATAGRAPH_MGI ! Integer, intent(in) :: I, J ! K_Zatsarinny = 0 ! par défaut, si la transition n'est pas dans la table ! !Write(*,*) NQPi, NQSi, TERMi, NQPj, NQSj, TERMj Do K_Zatsarinny = ZatsN, 1, -1 If (ALL( ZatsConf(K_Zatsarinny, : ) == (/NQPi,NQSi,TERMi,Int(gi), NQPj,NQSj,TERMj,Int(gj)/))) Return End Do ! End Function WHICH_LINE_IN_ZATSARINNY ! !------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_BURGESS_TULLY (I, J) Result (K_Burgess) ! USE DATAGRAPH_CaII ! Integer, Intent(In) :: I, J ! K_Burgess = 0 ! par défaut, si la transition n'est pas dans la table ! Do K_Burgess = BurgN, 1, -1 If (ALL( BurgConf(K_Burgess, : ) == (/ NQPi, NQSi, NQPj, NQSj/))) Return End Do ! End Function WHICH_LINE_IN_BURGESS_TULLY ! !------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_SIGUT_PRADHAN (I, J) Result (K_Sigut) ! USE DATAGRAPH_MgII ! Integer, Intent(In) :: I, J Integer :: NQPi, NQSi, NQPj, NQSj ! K_Sigut = 0 ! par défaut, si la transition n'est pas dans la table ! NQPi = NQP(S1(I)%Config) NQSi = NQS(S1(I)%Config) NQPj = NQP(S1(J)%Config) NQSj = NQS(S1(J)%Config) ! !If (wod) Write(*, *) NQPi, NQSi, NQPj, NQSj ! Do K_Sigut = SiguN, 1, -1 If (ALL( SiguConf(K_Sigut, : ) == (/ NQPi, NQSi, NQPj, NQSj/))) Return End Do ! End Function WHICH_LINE_IN_SIGUT_PRADHAN ! !------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_SAMSON_BERRINGTON (I, J) Result (K_Samson) ! USE DATAGRAPH_CaI ! Integer, Intent(In) :: I, J Integer :: NQPi, NQSi, NQPj, NQSj, TERMi, TERMj ! K_Samson = 0 ! par défaut, si la transition n'est pas dans la table ! NQPi = NQP(S1(I)%Config) NQSi = NQS(S1(I)%Config) TERMi = S1(I)%term NQPj = NQP(S1(J)%Config) NQSj = NQS(S1(J)%Config) TERMj = S1(J)%term ! !If (wod) Write(*, *) NQPi, NQSi, TERMi, NQPj, NQSj, TERMj ! Do K_Samson = SamsN, 1, -1 If (ALL( SamsConf(K_Samson, : ) == (/ NQPi, NQSi, TERMi, NQPj, NQSj, TERMj /))) Return End Do ! End Function WHICH_LINE_IN_SAMSON_BERRINGTON ! !------------------------------------------------------------------- ! Subroutine COMPUTE_ZATSARINNY(K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_MgI ! Integer, intent(in) :: K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 8 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_MGH_BARKLEM : PB-00 " ! TEMP = (/1000., 2000., 4000., 6000., 8000., 10000., 15000., 20000./) ! UPSILON = Zats_Upsilon(K_special, :) ! mot_clef = 'TEPI ZATSARINNY 2009' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_ZATSARINNY ! !------------------------------------------------------------------- ! Subroutine COMPUTE_SIGUT_PRADHAN(K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_MgII ! Integer, intent(in) :: K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 6 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_SIGUT_PRADHAN : PB-00 " ! TEMP = (/1000., 3000., 5000., 10000., 20000., 30000./) ! UPSILON = Sigu_Upsilon(K_special, :) ! mot_clef = 'TEPI (A TESTER) SIGUT-PRADHAN 1995' ! End Subroutine COMPUTE_SIGUT_PRADHAN ! !------------------------------------------------------------------- ! Subroutine COMPUTE_SAMSON_BERRINGTON(K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_CaI ! Integer, intent(in) :: K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 9 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_SAMSON_BERRINGTON : PB-00 " ! TEMP = (/1000., 2000., 3000., 4000., 5000., 6000., 7000., 8000., 10000./) ! UPSILON = Sams_Upsilon(K_special, :) ! mot_clef = 'TEPI SAMSON-BERRINGTON 2001' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_SAMSON_BERRINGTON ! !------------------------------------------------------------------- ! Subroutine COMPUTE_BURGESS_TULLY(K, K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_CaII USE BURGESS_TULLY, ONLY : UPSIL ! Integer, intent(in) :: K, K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! Integer :: KTEMP, KBurg Real :: Eij_Ryd Real :: C Real :: P1, P2, P3, P4, P5 ! Real :: frac_Upsilon ! pour les composantes des transitions ! NTEMP = 8 Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_BURGESS_TULLY : PB-00 " ! TEMP = (/1000., 2000., 4000., 6000., 8000., 10000., 15000., 20000./) ! ! Type de transition suivant Burgess et Tully ! ! pour moi, K est le numero de la transition permise trouvee dans S2 donc KBurg = 1 ! sinon, la transition n'est pas trouvee dans S2 car interdite et donc KBurg = 2 ! Select Case ( K ) Case (1:) KBurg = 1 ! permise Case (0) If (K_special == 8 .OR. K_special == 12 .OR. K_special == 16 .OR. & K_special == 22 .OR. K_special == 28 .OR. K_special == 32) Then Kburg = 1 ! interdite entre termes permis Else KBurg = 2 ! interdite End If Case Default ; STOP "K ne peut-être négatif dans cette routine COMPUTE_BURGESS_TULLY." End Select ! Eij_Ryd = S1(J)%en_Ryd -S1(I)%en_Ryd ! C = BurgC (K_special) P1 = BurgP1(K_special) P2 = BurgP2(K_special) P3 = BurgP3(K_special) P4 = BurgP4(K_special) P5 = BurgP5(K_special) ! frac_Upsilon = WHICH_FRACTION_IN_BURGESS_TULLY(K, K_special) ! Do KTEMP = 1 ,NTEMP ! Fonction UPSIL venant du module BURGESS_TULLY UPSILON(KTEMP) = frac_Upsilon * UPSIL(KBurg, Eij_Ryd, C, P1, P2, P3, P4, P5, TEMP(KTEMP)) End Do ! mot_clef = 'TEPI BURGESS ET AL. 1995' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_BURGESS_TULLY ! !------------------------------------------------------------------- ! Real Function WHICH_FRACTION_IN_BURGESS_TULLY(K, K_special) ! USE DATAGRAPH_CaII ! Integer, intent(in) :: K, K_special ! Integer :: K_Burgess = 0 Logical :: TEST = .FALSE. ! Do K_Burgess = 32, 1, -1 If (ALL( BurgFracIndex(K_Burgess, : ) == (/ K_special, INT(gi), INT(gj) /) ) ) EXIT End Do ! If (K_Burgess == 0) Then ! TRANSITION INTERDITE : FRACTION BASE SUR LES POIDS STATISTIQUES BAS Gi WHICH_FRACTION_IN_BURGESS_TULLY = 1. Else ! TRANSITION PERMISE : FRACTION BASE SUR LES GF DE VALD ! OU TRANSITION INTERDITE ENTRE 2 TERMES PERMIS WHICH_FRACTION_IN_BURGESS_TULLY = BurgFrac( K_Burgess ) / 100. End If ! If (TEST) Then Write(*, *) "K_special = ", K_special, "K_Burgess = ", K_Burgess Write(*, *) WHICH_FRACTION_IN_BURGESS_TULLY Read(*, *) End If ! End Function WHICH_FRACTION_IN_BURGESS_TULLY ! End Subroutine COLLISIONS_E ! !*********************************************************************** ! Subroutine WRITE_COLLISIONS_BB_IN_ATOM(mot_clef, NTEMP, TEMP, UPSILON, Facteur) Character(len = *), intent(in) :: mot_clef Integer, intent(in) :: NTEMP Real, dimension(:), allocatable, intent(in) :: TEMP, UPSILON Real, intent(in) :: Facteur ! Character(len = 200) :: fmt1 = '(5X, I5, xyF10.0)' Character(len = 200) :: fmt2 = '(2I5, xyES10.2)' Character(len = 10) :: info ! info = '' ! Write(fmt1(10:11), '(I2.2)', iostat = er) NTEMP If (er /= 0) STOP "WRITE_COLLISIONS_BB_IN_ATOM : PB-00" Write(fmt2(7:8), '(I2.2)', iostat = er) NTEMP If (er /= 0) STOP "WRITE_COLLISIONS_BB_IN_ATOM : PB-01" ! If (.NOT. ALLOCATED(UPSILON)) STOP "WRITE_COLLISIONS_BB_IN_ATOM : PB-03" ! If (NTEMP > 1) Then Write(50, *) 'TEMP' Write(50, fmt1) NTEMP, TEMP End If ! IF(K == 0) info = ' FORBIDDEN' Write(50, '(A, F15.4, A)') mot_clef, lambda, info Write(50, fmt2) I, J, UPSILON * Facteur ! !IF (BLABLA) Call BAVARD( ) ! End Subroutine WRITE_COLLISIONS_BB_IN_ATOM ! !*********************************************************************** ! Subroutine ATOMIC_FEATURES_OF_TRANSITION(S0,S1,S2,S3, I, J, K ) Type(ATOM) , intent(in) :: S0 Type(LEVELS) , dimension(:), intent(in) :: S1 !N1 Type(INDEXLINES), dimension(:), intent(in) :: S2 !N2 Type(PHOTOIONS) , dimension(:), intent(in) :: S3 !N1 Integer, intent(in) :: I, J, K ! Elt = TRIM(S0%Symbol // S0%Ion) Z = DEGRE_IONISATION( S0%Ion ) Ni = I Nj = J !Write(*, *) "Ni, Nj, K", Ni, Nj, K ! ! TEST DE REDONDANCE POUR LES NIVEAUX IMPLIQUES DANS LA TRANSITION PERMISE ! If (K > 0) Then IF ( Ni /= S2(K)%Ni ) STOP "ATOMIC_FEATURES_OF_TRANSITION : PB-01" IF ( Nj /= S2(K)%Nj ) STOP "ATOMIC_FEATURES_OF_TRANSITION : PB-02" End If ! Config_i = S1(Ni)%config Config_j = S1(Nj)%config ! NQPi = NQP(Config_i) NQSi = NQS(Config_i) TERMi = S1(I)%term NQPj = NQP(Config_j) NQSj = NQS(Config_j) TERMj = S1(J)%term ! gi = S1(Ni)%g gj = S1(Nj)%g ! En_i_cm = S1(Ni)%En_cm En_j_cm = S1(Nj)%En_cm En_Ion_cm = S1(N1)%En_cm DeltaE_cm = En_j_cm - En_i_cm ! lambda_vac = 1.D10/( DeltaE_cm * 100.D0) ! lambda = LAMBDA_AIR(lambda_vac) ! End Subroutine ATOMIC_FEATURES_OF_TRANSITION ! !*********************************************************************** ! Subroutine BAVARD( ) Character(len=9) :: fmt1='(xF10.1) ', fmt2='(xES10.2)' Write(fmt1(2:2),'(I1)') NTEMP; Write(fmt2(2:2),'(I1)') NTEMP Write(*, *) Elt, Trim(Config_i), ' => ', Trim(Config_j) Write(*, '(A,I5,A,L)') "K = ", K, " transition_niveaux_fins = ", transition_niveaux_fins Write(*, '(3(A, I5))') "Z = ", Z, ", Ni = ", Ni, ", Nj = ", Nj Write(*, '(2(A, F14.3))') "En_i_cm = ", En_i_cm, ", En_j_cm = ", En_j_cm Write(*, '(2(A, F14.4))') "lambda_vac = ", lambda_vac, ", lambda = ", lambda Write(*,*) "I, J = ",I,J Write(*, '(A,I6)') mot_clef, NTEMP Write(*, fmt=fmt1) TEMP Write(*, fmt=fmt2) UPSILON * Facteur Read(*, *) End Subroutine BAVARD ! !*********************************************************************** ! Integer Function IS_ALLOWED_TRANSITION(S2, I , J ) Result ( K ) Type(INDEXLINES), dimension(:), intent(in) :: S2 !N2 Integer, Intent(In) :: I, J ! K = 0 ! par defaut, transition interdite ! Do K = 1 , N2 If ( ( S2(K)%Ni == I ) .AND. ( S2(K)%Nj == J ) ) Return End Do ! ! debug ! If ( K /= N2 + 1 ) Write(*, *) "IS_ALLOWED_TRANSITIONS : PB-00 " K = 0 ! !Do K = N2 , 1 , -1 ! If ( ( S2(K)%Ni == I ) .AND. ( S2(K)%Nj == J ) ) Return !End Do ! End Function IS_ALLOWED_TRANSITION ! !*********************************************************************** ! Subroutine COLLISIONS_H(S0, S1, S2, S3, NCOL_H) ! Type(ATOM) , intent(in) :: S0 Type(LEVELS) , dimension(:), intent(in) :: S1 !N1 Type(INDEXLINES), dimension(:), intent(in) :: S2 !N2 Type(PHOTOIONS) , dimension(:), intent(in) :: S3 !N1 Integer, intent(out):: NCOL_H Logical :: BLABLA = .FALSE. ! mode bavard ! ! Dimension des structures ! N1 = SIZE(S1) N2 = SIZE(S2) Write(*,*)"N1,N2=",N1,N2 ! If (ETL) Facteur = Facteur_ETL ! Si on est à l'ETL toutes les collisions sont multipliés par Facteur_ETL If (CH_DRAWIN .AND. .NOT.ETL) Facteur = S_H ! IF(.NOT. CH_QUANTI .AND. .NOT. CH_DRAWIN) RETURN ! LL: Do I = 1, N1-1 UL: Do J = I+1, N1-1 K = IS_ALLOWED_TRANSITION(S2,I,J) Call ATOMIC_FEATURES_OF_TRANSITION(S0,S1,S2,S3,I,J,K) ! TRANSITION BOUND-BOUND transition_niveaux_fins = ( Config_i == Config_j ) If (CH_QUANTI) Then K_special = 0 ! If (Elt == 'MgI') Then K_special = WHICH_LINE_IN_MGH_BARKLEM(I, J) If (K_special > 0) Then Call COMPUTE_MGH_BB_BARKLEM(K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 200 Else CYCLE End If ! ! On peut rajouter ici des calculs théoriques pour d'autres élements ! End If End If ! If(CH_DRAWIN) then Select Case (K) Case(1:) Call COMPUTE_DRAWIN_CH(K, NTEMP, TEMP, UPSILON, mot_clef) Case(0) If (CH_BB_FBD) Then Call COMPUTE_DRAWIN_CH_FBD(NTEMP, TEMP, UPSILON, mot_clef) Else CYCLE End If Case default STOP " COLLISIONS_H : PB-01." End Select End If ! 200 Call WRITE_COLLISIONS_BB_IN_ATOM(mot_clef, NTEMP, TEMP, UPSILON,Facteur) NCOL_H = NCOL_H + 1 ! End Do UL ! ! TRANSITION BOUND-FREE ! IF(I==N1-1) Call ATOMIC_FEATURES_OF_TRANSITION(S0,S1,S2,S3,I,J,K) ! If (CH_QUANTI .AND. CH_CE) Then ! If (Elt == 'MgI') Then K_special = WHICH_LINE_IN_MGH_BF_BARKLEM(I) If(I==11) write(*,*)"K_special",K_special If (K_special>0) Then Call COMPUTE_MGH_BF_BARKLEM(K_special, NTEMP, TEMP, UPSILON, mot_clef) GOTO 250 End If Else STOP"COLLISIONS_H: PAS DE CALCULS QUANTIQUES IMPLEMENTES POUR CET ELEMENT." End If ! End If ! If (CH_DRAWIN .AND. CH_BF) Then Call COMPUTE_DRAWIN_CH(K, NTEMP, TEMP, UPSILON, mot_clef,I) GOTO 250 Else CYCLE End If ! 250 Call WRITE_COLLISIONS_BF_IN_ATOM(mot_clef, NTEMP, TEMP, UPSILON,Facteur) NCOL_H = NCOL_H + 1 End Do LL ! CONTAINS ! !----------------------------------------------------------------------- ! Subroutine WRITE_COLLISIONS_BF_IN_ATOM(mot_clef, NTEMP, TEMP, UPSILON, Facteur) Character(len = *), intent(in) :: mot_clef Integer, intent(in) :: NTEMP Real, dimension(:), allocatable, intent(in) :: TEMP, UPSILON Real, intent(in) :: Facteur ! Character(len = 200) :: fmt1 = '(5X, I5, xyF10.0)' Character(len = 200) :: fmt2 = '(2I5, xyES10.2)' ! Write(fmt1(10:11), '(I2.2)', iostat = er) NTEMP If (er /= 0) STOP "WRITE_COLLISIONS_BF_IN_ATOM : PB-00" Write(fmt2(7:8), '(I2.2)', iostat = er) NTEMP If (er /= 0) STOP "WRITE_COLLISIONS_BF_IN_ATOM : PB-01" ! If (.NOT. ALLOCATED(UPSILON)) STOP "WRITE_COLLISIONS_BF_IN_ATOM : PB-03" ! If (NTEMP > 1) Then Write(50, *) 'TEMP' Write(50, fmt1) NTEMP, TEMP End If ! lambda_vac = 1.D10/((S1(N1)%En_cm- S1(I)%En_cm) * 100.D0) ! lambda = LAMBDA_AIR(lambda_vac) ! Write(50, '(2A, F15.4, A)') mot_clef,' <',lambda Write(50, fmt2) I, N1, UPSILON * Facteur ! !IF (BLABLA) Call BAVARD( ) ! End Subroutine WRITE_COLLISIONS_BF_IN_ATOM ! !-------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_MGH_BF_BARKLEM(I) Result (K_Barklem) ! USE DATAGRAPH_MGI ! Integer, intent(in) :: I ! K_Barklem = 0 ! par défaut, si la transition n'est pas dans la table ! !Write(*,*) NQPi, NQSi, TERMi Do K_Barklem = BarkNi, 1, -1 If (ALL( BarkiConf(K_Barklem, : ) == (/ NQPi, NQSi, TERMi, Int(gi)/))) Return End Do ! End Function WHICH_LINE_IN_MGH_BF_BARKLEM ! !-------------------------------------------------------------------- ! Integer Function WHICH_LINE_IN_MGH_BARKLEM(I, J) Result (K_Barklem) ! USE DATAGRAPH_MGI ! Integer, intent(in) :: I, J ! K_Barklem = 0 ! par défaut, si la transition n'est pas dans la table ! !Write(*,*) NQPi, NQSi, TERMi, NQPj, NQSj, TERMj Do K_Barklem = BarkN, 1, -1 If (ALL( BarkConf(K_Barklem, : ) == (/NQPi,NQSi,TERMi,Int(gi), NQPj,NQSj,TERMj,Int(gj)/))) Return End Do ! End Function WHICH_LINE_IN_MGH_BARKLEM ! !-------------------------------------------------------------------- ! Subroutine COMPUTE_MGH_BB_BARKLEM(K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_MgI ! Integer, intent(in) :: K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 5 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_MGH_BARKLEM : PB-00 " ! TEMP = (/500., 2000., 4000., 6000., 8000./) ! UPSILON = Bark_Upsilon(K_special, :) ! mot_clef = 'THPI BARKLEM PRIVATE COM 2011' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_MGH_BB_BARKLEM ! !-------------------------------------------------------------------- ! Subroutine COMPUTE_MGH_BF_BARKLEM(K_special, NTEMP, TEMP, UPSILON, mot_clef) ! USE DATAGRAPH_MgI ! Integer, intent(in) :: K_special Integer, intent(out) :: NTEMP Real, dimension(:), Allocatable, intent(out) :: TEMP Real, dimension(:), Allocatable, intent(out) :: UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 5 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_MGH_BF_BARKLEM : PB-00 " ! TEMP = (/500., 2000., 4000., 6000., 8000./) ! UPSILON = Barki_Upsilon(K_special, :) ! mot_clef = 'CHCE BARKLEM PRIVATE COM 2011' ! IF (BLABLA) Call BAVARD( ) ! End Subroutine COMPUTE_MGH_BF_BARKLEM ! !-------------------------------------------------------------------- ! Subroutine COMPUTE_DRAWIN_CH_FBD(NTEMP, TEMP, UPSILON, mot_clef) Integer, intent(out) :: NTEMP Real, dimension(:), allocatable, intent(out) :: TEMP, UPSILON Character(len = *), intent(out) :: mot_clef ! NTEMP = 2 ! Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_DRAWIN_CH_FORBIDDEN : PB-00 " ! TEMP = (/1000., 10000./) ! UPSILON = 1. ! mot_clef = 'THP DRAWIN 1969b' End Subroutine COMPUTE_DRAWIN_CH_FBD ! !-------------------------------------------------------------------- ! Subroutine COMPUTE_DRAWIN_CH(K, NTEMP, TEMP, UPSILON, mot_clef,I) ! Integer, intent(in) :: K ! positif si permise, nul si interdite Integer, intent(out) :: NTEMP Real, dimension(:), allocatable, intent(out) :: TEMP, UPSILON Character(len = *), intent(out) :: mot_clef Integer, optional, intent(in) :: I ! For ionisation of level I ! Integer :: L ! NTEMP = 8 Allocate ( TEMP(NTEMP) , UPSILON(NTEMP) , Stat = er ) If ( er /= 0 ) STOP " COMPUTE_DRAWIN_CH : PB-01." ! TEMP = (/1000., 2000., 4000., 6000., 8000., 10000., 15000., 20000./) ! ! BOUND-FREE ! If (Present(I)) Then Do L = 1, NTEMP Call DRAWIN_BB_BF(K, TEMP(L), S0, S1, S2, UPSILON(L),I) End Do mot_clef = 'CHI DRAWIN 1969b' IF(BLABLA) Call BAVARD() Return End If ! ! BOUND-BOUND ! Do L = 1, NTEMP Call DRAWIN_BB_BF(K, TEMP(L), S0, S1, S2, UPSILON(L)) End Do ! mot_clef = 'THP DRAWIN 1969b' ! IF(BLABLA) Call BAVARD() ! End Subroutine COMPUTE_DRAWIN_CH ! !-------------------------------------------------------------------- ! End Subroutine COLLISIONS_H ! !*********************************************************************** ! End Module MPR07_COLLISIONS