Module MPR05_GRAPH ! USE CONFIG USE DATAGRAPH USE DISLIN USE MOD_CSTES, ONLY: cste_Ryd, cste_h, cste_q, cste_c !USE MOD_CSTES, ONLY: Ryd => cste_Ryd, c => cste_c, h => cste_h, q => cste_q ! Implicit None ! Private Public :: SECT_EFF, GROTRIAN ! CONTAINS ! !-------------------------------------------------------------------- ! TRACE LES SECTIONS EFFICACES EN FCT DE LA LONGUEUR D'ONDE ! DES TABLES DE PHOTOIONISATION !-------------------------------------------------------------------- ! Subroutine SECT_EFF(Index_level, xx1, y1, N1, xx2, y2, N2, info, meta) ! ! Index_level : index du niveau d'énergie ! x1 : vecteur des abscisses de la fonction 1 ! y1 : vecteur des ordonnées associées ! N1 : taille des vecteurs x1 et y1 ! x2 : vecteur des abscisses de la fonction 2 ! y2 : vecteur des ordonnées associées ! N2 : taille des vecteurs x2 et y2 ! info : niveau et nombre de points sélectionnés ! meta : type 'XWIN', 'PS' ou 'PDF' ! Integer, intent(in) :: Index_level, N1, N2 Real, dimension(N1), intent(in) :: xx1, y1 Real, dimension(N2), intent(in) :: xx2, y2 Character(len = *), intent(in) :: info, meta ! Real, dimension(N1) :: x1 ! abscisse en E (eV) Real, dimension(N2) :: x2 ! abscisse en E (eV) ! Real :: x1min, x1max, x1pas Real :: y1min, y1max, y1pas Real :: logy1min, logy1max Character(len = 42) :: leg0, leg1, leg2 Character(len = 126) :: leg Real, dimension(N2) :: y3 Real, dimension(N2) :: dy_quant_Kram Real, dimension(N2) :: dy_quant_sel Real :: errmax Integer, parameter :: Nvec = 100 Real, dimension(Nvec) :: vec integer :: I, J Real :: fact_x = 1000. ! Pour les abscisses en Angstroem Real, parameter :: fact = 1E18 ! Conversion des cm² en Mbarns Logical, parameter :: abs_eV = .TRUE. ! eV si vraie Angstrom sinon Logical, parameter :: lplot_1 = .TRUE. ! Affiche les sections efficaces d'origine Logical, parameter :: lplot_2 = .TRUE. ! Affiche les sections efficaces sélectionnées Logical, parameter :: lplot_3 = .TRUE. ! Affiche la dépendance à la Kramers ! !Légende ! leg0 = Trim(S_0%Symbol) // Trim(S_0%Ion) // ' : ' // S_1(Index_level)%config ! If (lang) Then If (abs_eV) Then leg1 = 'Threshold energy : vwxyz.w eV' Else leg1 = 'Threshold energy : vwxyz.w &A' End If leg2 = 'Threshold cross section : wxy.z Mb' Else If (abs_eV) Then leg1 = 'Energie de seuil : vwxyz.w eV' Else leg1 = 'Energie de seuil : vwxyz.w &A' End If leg2 = 'Section efficace au seuil : wxy.z Mb' End If ! If (abs_eV) Then fact_x = 1. ! ! Conversion en eV ! IF (Any(xx1 == 0.0) .OR. Any(xx2 == 0.0)) STOP "IN MODULE MPR05_GRAPH, SUBROUTINE SECT_EFF: PB-00." x1 = cste_h*cste_c/cste_q * 1.E10/xx1 x2 = cste_h*cste_c/cste_q * 1.E10/xx2 Else ! ! abscisse en Angstroem ! x1 = xx1 x2 = xx2 End If ! !Read(*,*) ! write(leg1(20:26),'(F7.1)') x2(1) write(leg2(29:33),'(F5.1)') y2(1)*fact ! If (abs_eV) Then x1min = 0. ! Floor(Minval(x1)) x1max = 16. ! Floor(Maxval(x1)) Else x1min = Nint(Minval(x1)/fact_x) * fact_x x1max = Ceiling(Maxval(x1)/fact_x) * fact_x End If ! If (y1min == 0.) Then y1min = 1E-25 Else y1min = Minval(y1) End If ! y1max = Maxval(y1) ! ! Conversion ! y1min = y1min*fact y1max = y1max*fact logy1min = Log10(Abs(y1min)) -1. logy1max = Log10(Abs(y1max)) +1. ! x1pas = Nint((x1max-x1min) / 7.) y1pas = (y1max-y1min) / 5. y1pas = y1pas * fact ! ! NIVEAU 0 ! Call metafl(meta) Call setpag('DA4L') Call scrmod('REVERSE') Call setfil('output/figures/photoionisation/Phot.'// Trim(meta)) !Call errdev('file') Call disini ! ! NIVEAU 1 ! !Call pagera Call hwfont ! Police Call eushft('danish', '&') ! Caractères spéciaux !Call paghdr('T. Merle','',2,0) ! ! Titre et noms des axes ! !Call titlin('Courbe de photoionisation pour le Mg I', 2) !Call titlin(info, 4) Call mixalf Call hname(60) ! 40 Call height(60) ! If (lang) Then Call name("Cross - Section (Mb)", 'Y') Else Call name("Sections efficaces (Mb)", 'Y') End If ! ! Positions des figures ! Call axslen(2500, 1400) ! axslen(2500, 1480) Call axspos( 320, 1500) Call axsscl('log', 'Y') Call labels('log', 'Y') Call height(70) !36 Call labdig(-1, 'Y') Call setgrf('TICKS', 'NAME', 'TICKS', 'TICKS') !Call graf(x1min, x1max, x1min, x1pas, logy1min, logy1max, Int(logy1min)*1.+1., 1.) Call graf(x1min, x1max, x1min, x1pas, -5., 5., -4., 1.) ! ! NIVEAU 2 ! !Sections efficaces d'origine ! If (lplot_1) Then !Call dash Call curve(x1, y1*fact, N1) Call height(35) ; Call title End If ! !Sections efficaces sélectionnées ! If (lplot_2) Then Call color('red') !; call incmrk(1) ; call hsymbl(7) Call thkcrv(2) Call solid Call curve(x2, y2*fact, N2) End If ! ! Formule de Kramer ! If (lplot_3) Then Call color('blue') Call thkcrv(2) If (abs_eV) Then vec = (/ (i/Nvec, i = 1, Nvec) /) ! vec = x2(1) + vec*abs(x2(1)-x1(N1)) ! Call curve(vec, y2(1)*fact*(vec(1)/vec)**3, Nvec) y3 = y2(1)*(x2(1)/x2)**3 Call curve(x2, y3*fact, N2) Else vec = (/ (-i/Nvec, i = 1, Nvec) /) vec = x2(1) + vec*abs(x2(1)-x1(N1)) Call curve(vec, y2(1)*fact*(vec(1)/vec)**(-3), Nvec) End If End If ! ! Trace le seuil par un symbole ! If (lplot_1) Then Call color ('FORE') Call hsymbl(100) Call mysymb((/0., 0., 0./), (/0., 0., -1./), 3, 10, 1) Call rlsymb(10, x1(1), y1(1)*fact) End If ! If (lplot_2) Then Call color ('red') Call hsymbl(100) Call mysymb((/0., 0., 0./), (/0., 0., -1./), 3, 10, 1) Call rlsymb(10, x2(1), y2(1)*fact) End If ! Call color('FORE') Call height(60) Call solid Call legini(leg, 3, 42) Call leglin(leg, leg0, 1) Call leglin(leg, leg1, 2) Call leglin(leg, leg2, 3) Call legtit('') Call legopt(0.0, 0.5, 1.0) Call frame(0) Call legend(leg, 7) ! Call endgrf ! ! Ecarts ! dy_quant_sel = 0. ; dy_quant_Kram = 0. ! Do I = 1, N2 Do J = I, N1 If (x2(I) == x1(J)) Then If (lplot_2) dy_quant_sel(I) = abs((y1(J) - y2(I)))/y1(J) * 100 If (lplot_3) dy_quant_Kram(I) = abs((y1(J) - y3(I)))/y1(J) * 100 End If End Do End Do ! errmax = Ceiling(Maxval(abs(dy_quant_sel))*fact) ! Call height(60) !40 ! If (lang) Then Call hname(60) !30 Call name("Error (%)", 'Y') Call hname(60) !40 If (abs_eV) Then Call name("Energy (eV)",'X') Else Call name("Wavelength (&A)",'X') End If Else Call hname(70) !30 Call name("Erreur (%)", 'Y') Call hname(70) !40 If (abs_eV) Then Call name("Energie (eV)",'X') Else Call name("Longueur d'onde (&A)",'X') End If End If ! Call axslen(2500, 420) !axslen(2500,1800) Call axspos( 320, 1920) Call axsscl('lin','Y'); call labels('log','Y') Call labdig(-1,'X') Call setgrf('NAME', 'NAME', 'TICKS', 'TICKS') !Call graf(x1min, x1max, x1min, x1pas, -errmax-1., errmax+1., -errmax, errmax) Call graf(x1min, x1max, x1min, x1pas, 0., 100., 0., 50.) ! ! NIVEAU 2 ! Call color('red') Call hsymbl(20) ! If(lplot_2) Then Call color ('red') Do I = 1, N2 call rlsymb(3, x2(I), dy_quant_sel(I)) call solid End Do !call curve(x2, dy_quant_sel,N2) End If If (lplot_3) Then Call color ('blue') Do I = 1, N2 call rlsymb(3, x2(I), dy_quant_Kram(I)) End Do call solid !call curve(x1, dy_quant_Kram,N1) ENd If ! !call curve(x2,dy*fact,N2) ! Call dot Call color('FORE') Call curve((/x1min, x1max/), (/0., 0./), 2) Call solid ! Call endgrf ! Call disfin ! !Read(*, *) ! End Subroutine SECT_EFF ! !-------------------------------------------------------------------- ! TRACE LE DIAGRAMME DE GROTRIAN !-------------------------------------------------------------------- ! Subroutine GROTRIAN(exterm, levels, Nj, Ni, Gro_elt, figure, meta, param) ! ! exterm : vecteur de réels contenant les termes spectroscopiques au format SLP ! levels : vecteur de réels des niveaux d'énergie en eV ! Nlevels : nombre de niveaux dans l'atome ! Nj : vecteur d'entiers représentant les niveaux hauts des transistions indexées ! Ni : vecteur d'entiers représentant les niveaux bas des transitions indéxées ! Nlines : nombre de transitions dans l'atome ! Gro_elt : nom et ionisation de l'atome (Ex: 'Ca II', 'Mg I') ! figure : nom de la figure ! meta : type de sortie ('PDF', 'XWIN', 'PS', 'PNG'...) ! param : spécificités du dessin ! Integer, dimension(:), intent(in) :: Nj, Ni Real, dimension(:), Allocatable, intent(in) :: exterm, levels Character(len = *), intent(in) :: figure, meta, param Character(len = *), intent(in) :: Gro_elt Character(len = 10) :: atom Integer :: Nlevels, Nlines, Ncontinuum Integer :: I, J Character(len = 100) :: titre3, info1, info2 Real, dimension(2) :: x, y Real, dimension(:), allocatable :: term Logical, parameter :: linfo = .FALSE. ! n'affiche pas les infos hormis le nom de l'atome ! Nlevels = size(levels) Nlines = size(Nj) atom = Trim(Gro_elt) ! Allocate(term(Nlevels-1), stat = er) If (er/=0) STOP "IN MODULE MPR05_GRAPH, SUBROUTINE GROTRIAN: PB-00." ! term = (/ (HUGE(0.), I = 1, Nlevels-1) /) ! ! Mise en forme des termes spectro ! Do I = 1, Nlevels-1 Do J = 1, lenterm If ( Abs(exterm(I)-SLP(J)) <= 1.0E-6 ) term(I) = iterm(J) End Do !Write(*,*) 'exterm(I), term(',I,')=', exterm(I), term(I) End Do ! If(lang) Then titre3 = " (xyz Levels + Ionization)" Else titre3 = " (xyz Niveaux + Ionisation)" End If ! Write(titre3(3:5), '(I3.3)', iostat =ios) Nlevels-1 IF (ios /= 0) STOP "IN MODULE MPR05_GRAPH, SUBROUTINE GROTRIAN: PB-01." titre3 = atom // titre3 Ncontinuum = Size(abscontinuum) ! ! NIVEAU 0 Call metafl(meta) ! Type de sortie (XWIN, PDF, PS, PNG, ...) Call setpag(cpage) ! Mise en page Call scrmod('REVERSE') ! Couleur de fond Call setfil(Trim(figure)) ! Nom du fichier de sortie !Call setfil('OUTPUT/FIGURES/GROTRIAN/Gro.'// Trim(meta)) ! Nom du fichier de sortie !Call errdev('file') ! Call disini ! Initialisation ! ! NIVEAU 1 Call complx ! Choix de la police de caractère Call eushft('danish', '&') ! Caractères spéciaux Call eushft('acute','!') Call mixalf ! Cherche les caractères de contrôle !Call paghdr('T. Merle','',3,0) ! Date et auteur du graphique !---------------------------------! ! Call titlin("Grotrian Diagram",3) ! Titre ligne 3 ! Call titlin("Diagramme de Grotrian",3) ! Titre ligne 3 ! Call titlin(titre3,4) ! Titre ligne 4 !---------------------------------! Call axspos(posx, posy) ! Position des axes Call axslen(lenx, leny) ! taille des axes !---------------------------------! Call labels('NONE','X') ! Définition de l'axe des abscisses Call ticks(1,'X') ! Nbre d'intervalle entre 2 marqueurs des X !---------------------------------! Call height(40) !35 ! If (lang) Then Call name('Energy (eV)','Y') ! Définition des axes des ordonnées Else Call name('Energie (eV)', 'Y') ! End If ! Call intax ! Call ticks(2, 'Y') ! Nbre d'intervalle entre 2 marqueurs des Y !---------------------------------! ! Call yaxis(0.,61700.,0.,10000.,leny-80,"Energy (cm[-1$)",0,posx+lenx,posy-44) ! Axe supplémentaire !---------------------------------! !Write(*, *) levels(Nlevels) ! !Write(*,*)term(1)-0.7, iterm(lenterm)+0.5, 1., 1., -0.2, levels(Nlevels)+0.2, 0., 1. Call graf(term(1)-0.7, iterm(lenterm)+0.5, 1., 1., -0.2, levels(Nlevels)+0.1, 0., 1.) ! NIVEAU 2 Call addlab(continuum,levels(Nlevels)+0.1,0,'Y') ! Energie du continuum sur l'axe Y !----------------------------------------------! Call height(40) ! 36 ! ! Do I = 1, lenterm ! Call addlab(cterm(I), iterm(I), 0, 'X') ! Tracé des termes spectro sur l'axe X End Do ! !----------------------------------------------! Call hsymbl(80) ! Call color('FORE') ! Call mysymb((/-1.,0.,1./), (/0.,0.,0./), 3, 10, 1) ! Définition du symbole d'un niveau ! !----------------------------------------------! !Call color('FORE') ! Call height(30) ! Call title ! Tracé du titre !-----------------------------------------------------------------------------! Call dot ! Call curve(abscontinuum, (/(levels(Nlevels), I = 1, Ncontinuum)/), Ncontinuum)! Tracé du continuum !-----------------------------------------------------------------------------! Call color('FORE') Call height(80) Call solid Call legini(atom, 1, 5) Call leglin(atom, Gro_elt, 1) Call legtit('') Call legopt(0.0, 0.5, 1.0) Call frame(0) Call legend(atom, 6) ! !-----------------------------------------------------------------------! ! If (param == 'NIVEAUX') then ! ! Call TRACE_NIVEAUX( ) ! Call TRACE_NOMS_NIVEAUX( ) ! ! ! If (linfo) Then If (Gro_elt == 'Mg I') Then ! Supplément MgI Call dash; Call setrgb(0.7,0.7,0.7) Call curve( (/ 5.5, 5.5/), (/-0.5, 8.0/), 2) ! Tracé du système 1 Call curve( (/11.5, 11.5/), (/-0.5, 8.0/), 2) ! Tracé du système 3 Call solid; Call color('FORE') If (N_1 == 150) Then Call height(35) If (lang) Then Call rlmess('SINGLET SYSTEM', 1., 2.) Call rlmess('38 levels', 1., 1.5) Call rlmess('TRIPLET SYSTEM', 6., 2.) Call rlmess('38 levels', 6., 1.5) Call rlmess('30 with fine structure', 6., 1.2) Call rlmess('SINGLET + TRIPLET', 11.8, 2.) Call rlmess('SYSTEMS', 11.8, 1.8) Call rlmess('15 levels', 11.8, 1.5) Call rlmess('without fine structure', 11.8, 1.2) Else Call rlmess('SYSTEME SINGULET', 1., 2.) Call rlmess('38 niveaux', 1., 1.5) Call rlmess('SYSTEME TRIPLET', 6., 2.) Call rlmess('38 niveaux', 6., 1.5) Call rlmess('avec structure fine', 6., 1.2) Call rlmess('SYSTEMES', 11.8, 2.) Call rlmess('SINGULET+TRIPLET', 11.8, 1.8) Call rlmess('15 niveaux', 11.8, 1.5) Call rlmess('sans structure fine', 11.8, 1.2) End If End If End If ! If (Gro_elt == 'Ca I') Then ! supplément CaI Call dash; Call setrgb(0.7,0.7,0.7) Call curve( (/ 7.5, 7.5/), (/-0.5, 7.0/), 2) ! Tracé du système 1 Call curve( (/16.5, 16.5/), (/-0.5, 7.0/), 2) ! Tracé du système 3 Call solid; Call color('FORE') If (N_1 == 174) Then !152 Call height(35)!25 If (lang) Then Call rlmess('SINGLET SYSTEM',2.,1.5) Call rlmess('46 levels', 2., 1.2) Call rlmess('TRIPLET SYSTEM',9.,1.5) Call rlmess('46 levels', 9., 1.2) Call rlmess('with fine structure', 9., 0.9) Call rlmess('SINGLET + TRIPLET', 11.5, 2.) Call rlmess('SYSTEMS', 11.5, 1.8) Call rlmess('11 levels', 11.5, 1.5) Call rlmess('without fine structure', 11.5, 1.2) Else Call rlmess('SYSTEME SINGULET',2.,1.5) Call rlmess('46 niveaux', 2., 1.2) Call rlmess('SYSTEME TRIPLET',9.,1.5) Call rlmess('46 niveaux', 9., 1.2) Call rlmess('avec structure fine', 9., 0.9) Call height(30) Call rlmess('SYSTEMES', 16.6, 1.7) Call rlmess('SINGULET+TRIPLET', 16.6, 1.5) Call rlmess('11 niveaux', 16.6, 1.2) Call rlmess('sans structure fine', 16.6, 0.9) Call height(35) End If End If End If ! If (Gro_elt == 'Ca II' .and. N_1 == 74) Then Call height(35) If (lang) Then Call rlmess('DOUBLET SYSTEM', 4.5, 4.) Call rlmess('40 levels', 4.5, 3.5) Call rlmess('with fine structure', 4.5, 3.5) Else Call rlmess('SYSTEME DOUBLET', 4.5, 4.) Call rlmess('40 niveaux', 4.5, 3.5) Call rlmess('avec structure fine', 4.5, 3.) End If End If ! If (Gro_elt == 'Mg II' .and. N_1 == 77) Then Call height(35) If (lang) Then Call rlmess('DOUBLET SYSTEM', 4.5, 4.) Call rlmess('40 levels', 4.5, 3.5) Call rlmess('with fine structure', 4.5, 3.5) Else Call rlmess('SYSTEME DOUBLET', 4.5, 4.) Call rlmess('42 niveaux', 4.5, 3.5) Call rlmess('avec structure fine', 4.5, 3.) End If End If ! End If End If ! !-----------------------------------------------------------------------! ! If (param == 'TRANS_RAD') Then ! Call color('red') ! Do I = 1, Nlines x = (/term(Ni(I)),term(Nj(I))/) y = (/levels(Ni(I)),levels(Nj(I))/) ! ! Tracé des transitions ! If (term(Ni(I)) < 7 .and. term(Nj(I)) >= 7 .or. term(Nj(I)) < 7 .and. term(Ni(I)) >= 7) Then ! 7 pour CaI et CaII, 6 pour MgI ! ! Raies d'intercombinaison ! Call dash Call curve(x,y,2) Else ! ! Transitions radiatives ! Call solid Call curve(x,y,2) End If ! End Do ! If (phot) Then Call solid Do I = 1, Nlevels-1 x = (/ term(I), term(I) /) y = (/ levels(I), levels(Nlevels) /) Call curve(x, y, 2) End Do End If ! Call color('fore') ! Call TRACE_NIVEAUX( ) ! Call TRACE_NOMS_NIVEAUX( ) ! Call lintyp(0) Call hsymbl(1) ! If (lang) Then info1 = 'wxyz b-b lines' info2 = 'wxyz b-f lines' Else info1 = 'wxyz transitions li!ees-li!ees' info2 = 'wxyz transitions li!ees-libres' End If ! Write(info1(1:4), '(I4.4)') Nlines Write(info2(1:4), '(I4.4)') Nlevels-1 Call height(40) If (linfo) Then Call rlmess(info1, levelpos(levelsize, 1)-5, levelpos(1, 1)+2) ! Nombre de transitions IF (phot) Call rlmess(info2, levelpos(levelsize, 1)-5, levelpos(1, 1)+1) End If ! End If ! !-----------------------------------------------------------------------! ! If (param == 'TRANS_COL') Then ! Call color('blue') ! Do I = 1, Nlevels-1 Do J = 1, Nlevels-1 x = (/ term(I), term(J) /) y = (/ levels(I), levels(J) /) Call curve(x, y, 2) End Do If (phot) Then x = (/ term(I), term(I) /) y = (/ levels(I), levels(Nlevels) /) Call curve(x, y, 2) End If End Do ! Call TRACE_NIVEAUX( ) Call TRACE_NOMS_NIVEAUX( ) ! If (lang) Then info1 = 'vwxyz b-b lines' info2 = 'vwxyz b-f lines' Else info1 = 'vwxyz transitions li!ees-li!ees' info2 = 'vwxyz transitions li!ees-libres' End If ! Write(info1(1:5), '(I5.5)') (Nlevels-1)*(Nlevels-2) Write(info2(1:5), '(I5.5)') (Nlevels-1) Call height(40) If (linfo) Then Call rlmess(info1, levelpos(levelsize, 1)-5, levelpos(1, 1)+2) ! Nombre de transitions IF(phot) Call rlmess(info2, levelpos(levelsize, 1)-5, levelpos(1, 1)+1) End If ! End If ! !-----------------------------------------------------------------------! ! If (param == 'SPECIAL') then !vect = (/1,2,3,4,23,47,48,50,85,87,121,122,123/) ! Call TRACE_NIVEAUX() ! If (Gro_elt == 'Ca II') Then ! Call solid Call color('fore') ! Do I = 1, Nlines x = (/term(Ni(I)),term(Nj(I))/) ! y = (/levels(Ni(I)),levels(Nj(I))/) ! Call curve(x,y,2) ! Tracé des transitions End Do ! Call solid Call color('red') ! Do I = 1, 9 ! Tracé des transitions x = (/ term( GNi(I) ), term( GNj(I) ) /) ! y = (/levels( GNi(I) ), levels( GNj(I) ) /) ! Call curve(x, y, 2) End Do ! ! Call height(31) Call color('fore') ! Do I = 1, levelsize ! Call rlmess(levelname(I),levelpos(I,1),levelpos(I,2)) ! Tracé des noms des niveaux End Do ! Call rlmess('DOUBLY SYSTEM', 4., 3.) Call rlmess('40 levels', 4., 2.7) Call rlmess('with fine structure', 4., 2.4) ! Call color('red') Call height(27) ! Call rlmess('H&K lines', 1.5, 1.1) Call rlmess('3933&A', 1.4, 0.8 ) Call rlmess('3968&A', 1.3, 0.6) ! Call rlmess('IR triplet',1.8, 2.4) Call rlmess('8498&A', 2.05, 2.2) Call rlmess('8542&A', 2.20, 2.0) Call rlmess('8662&A', 2.35, 1.8) ! Call rlmess('8248&A', 3.00, 8.7) Call rlmess('9854&A', 0.6, 8.0) Call rlmess('8912&A', 4.0, 7.5) Call rlmess('11949&A',0.6, 7.0) End If ! If (Gro_elt == 'Ca I') Then Call height(31) !20 !Call color('red') ! Do I = 1, levelsize ! Call rlmess(levelname(I), levelpos(I,1), levelpos(I,2)) ! Tracé des noms des niveaux End Do ! Call color('fore') !Call curve((/6.5,6.5/),(/0.,3.5/),2) ! Tracé des systèmes Call height(35) Call rlmess('SINGLET SYSTEM',2.,1.5) Call rlmess('40 levels', 2., 1.2) Call rlmess('TRIPLET SYSTEM',9.,1.5) Call rlmess('41 levels', 9., 1.2) Call rlmess('with fine structure', 9., 0.9) Call lintyp(0) ; call hsymbl(1) ! Do I = 1, 20 ! Tracé des transitions IF (I > 15) call dash x = (/term(GNi(I)), term(GNj(I))/) ! y = (/levels(GNi(I)), levels(GNj(I))/) ! Call curve(x,y,2) End Do ! Call solid Call color('fore') Call height(27) Call rlmess('6572&A',3.,0.4) Call rlmess('4226&A',0.45,1.) ! Call rlmess('Red triplet',6.5,3.0) Call rlmess('6102&A',7.2,2.8) Call rlmess('6122&A',7.4,2.6) Call rlmess('6162&A',7.6,2.4) ! Call rlmess('4425&A',9.9,4.2) Call rlmess('6455&A',4.5,4.4) ! Double excitation ! !Call rlmess('6499&A',12.4,4.0) ! Double excitation !Call rlmess('6493&A',12.1,3.8) ! Double excitation !Call rlmess('6471&A',11.9,3.6) ! Double excitation !Call rlmess('6439&A',11.65,3.4) ! Double excitation ! !Call rlmess('5590&A',11.,4.4) ! Double excitation !Call rlmess('5588&A',10.9,4.2) ! Double excitation ! Call rlmess('4578&A',12.8,5.) ! Call rlmess('6169.04&A',8.1,4.3) Call rlmess('6169.56&A',8.2,4.1) Call rlmess('6166&A',8.550,3.9) Call rlmess('6161&A',8.7,3.7) ! Call rlmess('7326&A',2.42,3.5) Call rlmess('5867&A',0.45,4.4) Call rlmess('5512&A',0.45,4.6) ! Call rlmess('8525&A',10.25,5.4)! Double excitation Call rlmess('8583&A',10.60,5.2)! Double excitation Call rlmess('8633&A',11.00,5.0)! Double excitation !Call rlmess('7148&A',3.5, 3.5) ! Double excitation Call rlmess('8608&A',3.5, 5.5) ! Double excitation Call rlmess('8602&A',6.0, 5.2) ! Double excitation End If ! Call height(27) Call color('FORE') !Call rlmess('4562, 4571, 4575 A',5.,1.) !Call rlmess('4380, 4388, 4392 A',3.,4.7) !Call rlmess('2777, 2778, 2780, 2781, 2782 A',8.,4.2) !Call rlmess('2852 A',1.7,2.) !Call rlmess('31930 A',7.05,7.5) ! If (Trim(Gro_elt) == 'Mg I') Then Call height(31) !20 !Call color('red') ! Do I = 1, levelsize IF (I == 6) levelpos(I, 1) = 3.48 IF (I == 20) levelpos(I, 1) = 9.4 ! Call rlmess(levelname(I), levelpos(I, 1)-0.1, levelpos(I, 2)) ! Tracé des noms des niveaux End Do ! Call color('fore') !Call curve((/6.5,6.5/),(/0.,3.5/),2) ! Tracé des systèmes Call height(35) Call rlmess('SINGLET SYSTEM', 1.4, 2.) Call rlmess('38 levels', 1.4, 1.5) Call rlmess('TRIPLET SYSTEM', 6.4, 2.) Call rlmess('38 levels', 6.4, 1.5) Call rlmess('30 with fine structure', 6.4, 1.2) Call rlmess('SINGLET + TRIPLET', 11.6, 2.) Call rlmess('SYSTEMS', 11.6, 1.8) Call rlmess('15 levels', 11.6, 1.5) Call rlmess('without fine structure', 11.6, 1.2) Call lintyp(0) ; call hsymbl(1) ! Do I = 1, App1_N ! Tracé des transitions !Call color('red') IF (I > 15) call dash x = (/term(GNi(I)), term(GNj(I))/) ! y = (/levels(GNi(I)), levels(GNj(I))/) ! Call curve(x,y,2) End Do ! Call solid Call height(27) Call rlmess('4571&A',3.2,0.8) Call rlmess('b triplet',7.,4.2) Call rlmess('5167&A',7.4,3.8) Call rlmess('5172&A',7.55,3.6) Call rlmess('5183&A',7.7,3.4) !Call rlmess('3829 &A',8.5,4.) Call rlmess('11828&A',0.4,5.1) Call rlmess('8806&A',2.95,5.4) Call rlmess('5711&A',0.4,6.3) Call rlmess('5528&A',2.95,6.3) Call rlmess('4730&A',0.34,6.7) Call rlmess('4702&A',2.95,6.73) Call rlmess('4167&A',2.95,7.14) Call rlmess('8923&A',0.4,5.85) Call rlmess('8473&A',7.,6.9) Call rlmess('8710&A',8.55,6.65) Call rlmess('8712&A',8.4,6.45) Call rlmess('8717&A',8.3,6.25) Call rlmess('8736&A',9.5,6.6) Call rlmess('8736&A',5.,6.8) Call rlmess('10312&A',1.75,7.) Call rlmess('7657&A',7.,5.4) Call rlmess('8997&A',5.5,7.10) End If End If Call disfin ! Deallocate(term) ! !----------------------------------------------------------------- ! CONTAINS ! !----------------------------------------------------------------- ! Subroutine TRACE_NIVEAUX( ) ! Call color('FORE') ! Do I = 1, Nlevels-1 ! Call rlsymb(10, term(I), levels(I)) ! Tracé des niveaux ! If (Gro_elt == 'Mg I' .and. N_1 == 150) Then If (I==48 .or. I==49 .or. I==51) then Call color('GREEN') Call rlsymb(10, term(I), levels(I)) Call color('FORE') End If End If ! If (Gro_elt == 'Ca I' .and. N_1 == 174) Then If (I==12 .or. I==13 .or. I==14 .or. I==15 .or. & I==24 .or. I==25 .or. I==26 .or. I==27 .or. I==28 .or. I==29 .or. I==30 .or. I==31 .or. I==32 .or. & I==34 .or. I==36 .or. I==38 .or. I==50 .or. I==51 .or. I==52 .or. & I==114 .or. I==115 .or. I==116 .or. I==117 .or. I ==136 .or. & I==171 .or. I==171 .or. I==173 ) Then Call color('GREEN') Call rlsymb(10, term(I), levels(I)) Call color('FORE') End If End If ! End Do ! End Subroutine TRACE_NIVEAUX ! !----------------------------------------------------------------- ! Subroutine TRACE_NOMS_NIVEAUX( ) ! Call height(30) Call setrgb(0.5,0.5,0.5) ! Do I = 1, levelsize IF (I == 1) Call rlmess(levelname(1), levelpos(1, 1), levelpos(1, 2)) If (Lim_E_eV) Then If(levelpos(I,2) <= E_eV_max) Then Call rlmess(levelname(I), levelpos(I, 1), levelpos(I, 2)) End if Else Call rlmess(levelname(I), levelpos(I, 1), levelpos(I, 2)) End If End Do ! Call setrgb(0.,0.,0.) ! End Subroutine TRACE_NOMS_NIVEAUX ! !----------------------------------------------------------------- ! End Subroutine GROTRIAN ! End Module MPR05_GRAPH