* program eplot * * author Norbert Ligterink * date: Nov. 2002 * use: use and change as you like * * function plotting bubblegum data * input: bubblegum 'in.dat': noninteractive input file * bubblegum output: 'tij.dat, kij.dat, bij.dat, pij.dat' * one integer number to select data: * 11111 all * 01110 all but Gamma and Perturbative * 01010 T-matrix and Breit-Wigner * 00100 K-matrix only * etc. * * output: 'plot.eps' * ***** ****************************************************************** PROGRAM eplot IMPLICIT NONE * INTEGER I, J, L, N, POINTS, XA, XAA, XX(2), YY(2) INTEGER D, NR, DATA, CH REAL*8 STARTRANGE, ENDRANGE, THRESH(2), DUMMY, MR(64), E(10000) REAL*8 X(2,2,2,10000), B(2,2,2,10000), T(2,2,2,10000) REAL*8 K(2,2,2,10000), WW(2,2,10000), MAX(2,2), MIN(2,2) * PRINT *,"Welcome to Norbert Ligterink's bubblegum eplot" PRINT *,"----------------------------------------------" PRINT *,"Gamma functions" PRINT *," T-matrix results" PRINT *," K-matrix results" PRINT *," Breit-Wigner results" PRINT *," Perturbative results" PRINT *,"select data: GTKBP (e.g. 01010 = T-matrix and B-W)" READ *,DATA * OPEN(UNIT=1, FILE='in.dat', STATUS='OLD') OPEN(UNIT=21, FILE='t11.dat', STATUS='OLD') OPEN(UNIT=22, FILE='t12.dat', STATUS='OLD') OPEN(UNIT=23, FILE='t21.dat', STATUS='OLD') OPEN(UNIT=24, FILE='t22.dat', STATUS='OLD') OPEN(UNIT=31, FILE='k11.dat', STATUS='OLD') OPEN(UNIT=32, FILE='k12.dat', STATUS='OLD') OPEN(UNIT=33, FILE='k21.dat', STATUS='OLD') OPEN(UNIT=34, FILE='k22.dat', STATUS='OLD') OPEN(UNIT=41, FILE='p11.dat', STATUS='OLD') OPEN(UNIT=42, FILE='p12.dat', STATUS='OLD') OPEN(UNIT=43, FILE='p21.dat', STATUS='OLD') OPEN(UNIT=44, FILE='p22.dat', STATUS='OLD') OPEN(UNIT=71, FILE='b11.dat', STATUS='OLD') OPEN(UNIT=72, FILE='b12.dat', STATUS='OLD') OPEN(UNIT=73, FILE='b21.dat', STATUS='OLD') OPEN(UNIT=74, FILE='b22.dat', STATUS='OLD') OPEN(UNIT=51, FILE='gamma1.dat', STATUS='OLD') OPEN(UNIT=52, FILE='gamma2.dat', STATUS='OLD') OPEN(UNIT=9, FILE='plot.eps', STATUS='UNKNOWN') * READ(1,*)STARTRANGE READ(1,*)ENDRANGE READ(1,*)POINTS * IF(POINTS .GT. 10000)THEN PRINT *,'Number of data points exceeds array size' PRINT *,'exciting' STOP ENDIF * READ(1,*)NR DO I=1, NR READ(1,*)MR(I) ENDDO DO I=1, 4*NR READ(1,*)DUMMY ENDDO READ(1,*)THRESH(1) READ(1,*)DUMMY READ(1,*)THRESH(2) READ(1,*)DUMMY * DO I=1, POINTS * * full T matrix * READ(21,222)E(I),T(1,1,1,I),T(2,1,1,I) READ(22,222)E(I),T(1,1,2,I),T(2,1,2,I) READ(23,222)E(I),T(1,2,1,I),T(2,2,1,I) READ(24,222)E(I),T(1,2,2,I),T(2,2,2,I) * * the K-matrix (no real parts, i.e., no analyticity) * READ(31,222)E(I),K(1,1,1,I),K(2,1,1,I) READ(32,222)E(I),K(1,1,2,I),K(2,1,2,I) READ(33,222)E(I),K(1,2,1,I),K(2,2,1,I) READ(34,222)E(I),K(1,2,2,I),K(2,2,2,I) * * perturbative result (tree diagram) * READ(41,222)E(I),X(1,1,1,I),X(2,1,1,I) READ(42,222)E(I),X(1,1,2,I),X(2,1,2,I) READ(43,222)E(I),X(1,2,1,I),X(2,2,1,I) READ(44,222)E(I),X(1,2,2,I),X(2,2,2,I) * * breit-wigner result (isobar diagrams; tree with widths) * READ(71,222)E(I),B(1,1,1,I),B(2,1,1,I) READ(72,222)E(I),B(1,1,2,I),B(2,1,2,I) READ(73,222)E(I),B(1,2,1,I),B(2,2,1,I) READ(74,222)E(I),B(1,2,2,I),B(2,2,2,I) * * gamma data * READ(51,222),E(I),WW(1,1,I),WW(2,1,I) READ(52,222),E(I),WW(1,2,I),WW(2,2,I) * ENDDO * DO J=1, 2 DO N=1, 2 MAX(N,J) = -100.0D0 MIN(N,J) = 100.D0 DO I=1, POINTS DO L=1, 2 IF(MOD(DATA,10000)/1000 .EQ. 1)THEN IF(T(L,N,J,I) .GT. MAX(N,J))THEN MAX(N,J) = T(L,N,J,I) ENDIF IF(T(L,N,J,I) .LT. MIN(N,J))THEN MIN(N,J) = T(L,N,J,I) ENDIF ENDIF IF(MOD(DATA,1000)/100 .EQ. 1)THEN IF(K(L,N,J,I) .GT. MAX(N,J))THEN MAX(N,J) = K(L,N,J,I) ENDIF IF(K(L,N,J,I) .LT. MIN(N,J))THEN MIN(N,J) = K(L,N,J,I) ENDIF ENDIF IF(MOD(DATA,100)/10 .EQ. 1)THEN IF(B(L,N,J,I) .GT. MAX(N,J))THEN MAX(N,J) = B(L,N,J,I) ENDIF IF(B(L,N,J,I) .LT. MIN(N,J))THEN MIN(N,J) = B(L,N,J,I) ENDIF ENDIF ENDDO ENDDO ENDDO ENDDO * WRITE(9,99)'%!PS-Adobe-2.0 EPSF-2.0' WRITE(9,99)'%%Title: plot.eps' WRITE(9,99)'%%Creator: fig2dev 3.2 3c and Norbert Ligterink' WRITE(9,99)'%%CreationDate: Mon Nov 11 11:11:11 1918' WRITE(9,99)'%%For: eplot and bubblegum' WRITE(9,99)'%%BoundingBox: 0 0 484 516' WRITE(9,99)'%%Magnification: 1.0000' WRITE(9,99)'%%EndComments' WRITE(9,99)'/$F2psDict 200 dict def $F2psDict begin $F2psDict ' WRITE(9,99)'/mtrx matrix put /col-1 {0 setgray} bind def /col0 ' WRITE(9,99)'{0.000 0.000 0.000 srgb} bind def /col1 {0.000 ' WRITE(9,99)'0.000 1.000 srgb} bind def /col2 {0.000 1.000 ' WRITE(9,99)'0.000 srgb} bind def /col3 {0.000 1.000 1.000 ' WRITE(9,99)'srgb} bind def /col4 {1.000 0.000 0.000 srgb} bind ' WRITE(9,99)'def /col5 {1.000 0.000 1.000 srgb} bind def /col6 ' WRITE(9,99)'{1.000 1.000 0.000 srgb} bind def /col7 {1.000 ' WRITE(9,99)'1.000 1.000 srgb} bind def /col8 {0.000 0.000 ' WRITE(9,99)'0.560 srgb} bind def /col9 {0.000 0.000 0.690 ' WRITE(9,99)'srgb} bind def /col10 {0.000 0.000 0.820 srgb} ' WRITE(9,99)'bind def /col11 {0.530 0.810 1.000 srgb} bind def ' WRITE(9,99)'/col12 {0.000 0.560 0.000 srgb} bind def /col13 ' WRITE(9,99)'{0.000 0.690 0.000 srgb} bind def /col14 {0.000 ' WRITE(9,99)'0.820 0.000 srgb} bind def /col15 {0.000 0.560 ' WRITE(9,99)'0.560 srgb} bind def /col16 {0.000 0.690 0.690 ' WRITE(9,99)'srgb} bind def /col17 {0.000 0.820 0.820 srgb} ' WRITE(9,99)'bind def /col18 {0.560 0.000 0.000 srgb} bind def ' WRITE(9,99)'/col19 {0.690 0.000 0.000 srgb} bind def /col20 ' WRITE(9,99)'{0.820 0.000 0.000 srgb} bind def /col21 {0.560 ' WRITE(9,99)'0.000 0.560 srgb} bind def /col22 {0.690 0.000 ' WRITE(9,99)'0.690 srgb} bind def /col23 {0.820 0.000 0.820 ' WRITE(9,99)'srgb} bind def /col24 {0.500 0.190 0.000 srgb} ' WRITE(9,99)'bind def /col25 {0.630 0.250 0.000 srgb} bind def ' WRITE(9,99)'/col26 {0.750 0.380 0.000 srgb} bind def /col27 ' WRITE(9,99)'{1.000 0.500 0.500 srgb} bind def /col28 {1.000 ' WRITE(9,99)'0.630 0.630 srgb} bind def /col29 {1.000 0.750 ' WRITE(9,99)'0.750 srgb} bind def /col30 {1.000 0.880 0.880 ' WRITE(9,99)'srgb} bind def /col31 {1.000 0.840 0.000 srgb} ' WRITE(9,99)'bind def ' WRITE(9,99)'' WRITE(9,99)'end save newpath 0 516 moveto 0 0 lineto 484 0 ' WRITE(9,99)'lineto 484 516 lineto closepath clip newpath -10.0 ' WRITE(9,99)'513.0 translate 1 -1 scale ' WRITE(9,99)'' WRITE(9,99)'/cp {closepath} bind def /ef {eofill} bind def ' WRITE(9,99)'/gr {grestore} bind def /gs {gsave} bind def /sa ' WRITE(9,99)'{save} bind def /rs {restore} bind def /l {lineto} ' WRITE(9,99)'bind def /m {moveto} bind def /rm {rmoveto} bind ' WRITE(9,99)'def /n {newpath} bind def /s {stroke} bind def /sh ' WRITE(9,99)'{show} bind def /slc {setlinecap} bind def /slj ' WRITE(9,99)'{setlinejoin} bind def /slw {setlinewidth} bind ' WRITE(9,99)'def /srgb {setrgbcolor} bind def /rot {rotate} ' WRITE(9,99)'bind def /sc {scale} bind def /sd {setdash} bind ' WRITE(9,99)'def /ff {findfont} bind def /sf {setfont} bind def ' WRITE(9,99)'/scf {scalefont} bind def /sw {stringwidth} bind ' WRITE(9,99)'def /tr {translate} bind def /tnt {dup dup ' WRITE(9,99)'currentrgbcolor 4 -2 roll dup 1 exch sub 3 -1 roll ' WRITE(9,99)'mul add 4 -2 roll dup 1 exch sub 3 -1 roll mul add ' WRITE(9,99)'4 -2 roll dup 1 exch sub 3 -1 roll mul add srgb} ' WRITE(9,99)'bind def /shd {dup dup currentrgbcolor 4 -2 roll ' WRITE(9,99)'mul 4 -2 roll mul 4 -2 roll mul srgb} bind def ' WRITE(9,99)'/reencdict 12 dict def /ReEncode { reencdict begin ' WRITE(9,99)'/newcodesandnames exch def /newfontname exch def ' WRITE(9,99)'/basefontname exch def /basefontdict basefontname ' WRITE(9,99)'findfont def /newfont basefontdict maxlength dict ' WRITE(9,99)'def basefontdict { exch dup /FID ne { dup ' WRITE(9,99)'/Encoding eq { exch dup length array copy newfont ' WRITE(9,99)'3 1 roll put } { exch newfont 3 1 roll put } ' WRITE(9,99)'ifelse } { pop pop } ifelse } forall newfont ' WRITE(9,99)'/FontName newfontname put newcodesandnames aload ' WRITE(9,99)'pop 128 1 255 { newfont /Encoding get exch ' WRITE(9,99)'/.notdef put } for newcodesandnames length 2 idiv ' WRITE(9,99)'{ newfont /Encoding get 3 1 roll put } repeat ' WRITE(9,99)'newfontname newfont definefont pop end } def ' WRITE(9,99)'/isovec [ 8#055 /minus 8#200 /grave 8#201 /acute ' WRITE(9,99)'8#202 /circumflex 8#203 /tilde 8#204 /macron 8#205 ' WRITE(9,99)'/breve 8#206 /dotaccent 8#207 /dieresis 8#210 ' WRITE(9,99)'/ring 8#211 /cedilla 8#212 /hungarumlaut 8#213 ' WRITE(9,99)'/ogonek 8#214 /caron 8#220 /dotlessi 8#230 /oe ' WRITE(9,99)'8#231 /OE 8#240 /space 8#241 /exclamdown 8#242 ' WRITE(9,99)'/cent 8#243 /sterling 8#244 /currency 8#245 /yen ' WRITE(9,99)'8#246 /brokenbar 8#247 /section 8#250 /dieresis ' WRITE(9,99)'8#251 /copyright 8#252 /ordfeminine 8#253 ' WRITE(9,99)'/guillemotleft 8#254 /logicalnot 8#255 /hyphen ' WRITE(9,99)'8#256 /registered 8#257 /macron 8#260 /degree ' WRITE(9,99)'8#261 /plusminus 8#262 /twosuperior 8#263 ' WRITE(9,99)'/threesuperior 8#264 /acute 8#265 /mu 8#266 ' WRITE(9,99)'/paragraph 8#267 /periodcentered 8#270 /cedilla ' WRITE(9,99)'8#271 /onesuperior 8#272 /ordmasculine 8#273 ' WRITE(9,99)'/guillemotright 8#274 /onequarter 8#275 /onehalf ' WRITE(9,99)'8#276 /threequarters 8#277 /questiondown 8#300 ' WRITE(9,99)'/Agrave 8#301 /Aacute 8#302 /Acircumflex 8#303 ' WRITE(9,99)'/Atilde 8#304 /Adieresis 8#305 /Aring 8#306 /AE ' WRITE(9,99)'8#307 /Ccedilla 8#310 /Egrave 8#311 /Eacute 8#312 ' WRITE(9,99)'/Ecircumflex 8#313 /Edieresis 8#314 /Igrave 8#315 ' WRITE(9,99)'/Iacute 8#316 /Icircumflex 8#317 /Idieresis 8#320 ' WRITE(9,99)'/Eth 8#321 /Ntilde 8#322 /Ograve 8#323 /Oacute ' WRITE(9,99)'8#324 /Ocircumflex 8#325 /Otilde 8#326 /Odieresis ' WRITE(9,99)'8#327 /multiply 8#330 /Oslash 8#331 /Ugrave 8#332 ' WRITE(9,99)'/Uacute 8#333 /Ucircumflex 8#334 /Udieresis 8#335 ' WRITE(9,99)'/Yacute 8#336 /Thorn 8#337 /germandbls 8#340 ' WRITE(9,99)'/agrave 8#341 /aacute 8#342 /acircumflex 8#343 ' WRITE(9,99)'/atilde 8#344 /adieresis 8#345 /aring 8#346 /ae ' WRITE(9,99)'8#347 /ccedilla 8#350 /egrave 8#351 /eacute 8#352 ' WRITE(9,99)'/ecircumflex 8#353 /edieresis 8#354 /igrave 8#355 ' WRITE(9,99)'/iacute 8#356 /icircumflex 8#357 /idieresis 8#360 ' WRITE(9,99)'/eth 8#361 /ntilde 8#362 /ograve 8#363 /oacute ' WRITE(9,99)'8#364 /ocircumflex 8#365 /otilde 8#366 /odieresis ' WRITE(9,99)'8#367 /divide 8#370 /oslash 8#371 /ugrave 8#372 ' WRITE(9,99)'/uacute 8#373 /ucircumflex 8#374 /udieresis 8#375 ' WRITE(9,99)'/yacute 8#376 /thorn 8#377 /ydieresis] def ' WRITE(9,99)'/Times-Roman /Times-Roman-iso isovec ReEncode ' WRITE(9,99)'/$F2psBegin {$F2psDict begin /$F2psEnteredState ' WRITE(9,99)'save def} def /$F2psEnd {$F2psEnteredState restore ' WRITE(9,99)'end} def ' WRITE(9,99)'' WRITE(9,99)'$F2psBegin ' WRITE(9,99)'%%Page: 1 1' WRITE(9,99)'10 setmiterlimit 0.06000 0.06000 sc ' WRITE(9,99)'%' WRITE(9,99)'% Fig objects follow' WRITE(9,99)'%' WRITE(9,99)'/Times-Roman-iso ff 300.00 scf sf 300 525 m gs 1 ' WRITE(9,99)'-1 sc (11) col11 sh gr /Times-Roman-iso ff 300.00 ' WRITE(9,99)'scf sf 4350 525 m gs 1 -1 sc (12) col11 sh gr ' WRITE(9,99)'/Times-Roman-iso ff 300.00 scf sf 300 4650 m gs 1 ' WRITE(9,99)'-1 sc (21) col11 sh gr /Times-Roman-iso ff 300.00 ' WRITE(9,99)'scf sf 4350 4650 m gs 1 -1 sc (22) col11 sh gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'15.000 slw n 200 200 m 8200 200 l 8200 8200 l 200 ' WRITE(9,99)'8200 l cp gs col0 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 4200 200 m 4200 8200 l gs col0 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 200 4200 m 8200 4200 l gs col0 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 1200 8325 m 1800 8325 l gs col0 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 1200 8475 m 1800 8475 l gs col1 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 3000 8325 m 3600 8325 l gs col4 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 3000 8475 m 3600 8475 l gs col5 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 5400 8325 m 6000 8325 l gs col12 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 5400 8475 m 6000 8475 l gs col14 s gr ' WRITE(9,99)'% Polyline' WRITE(9,99)'n 7500 8400 m 8100 8400 l gs col3 s gr ' WRITE(9,99)'/Times-Roman-iso ff 240.00 scf sf 3900 8475 m gs 1 ' WRITE(9,99)'-1 sc (Breit-Wigner) col0 sh gr /Times-Roman-iso ' WRITE(9,99)'ff 240.00 scf sf 6225 8475 m gs 1 -1 sc ' WRITE(9,99)'(Perturbative) col0 sh gr /Times-Roman-iso ff ' WRITE(9,99)'240.00 scf sf 225 8475 m gs 1 -1 sc (T-matrix) ' WRITE(9,99)'col0 sh gr /Times-Roman-iso ff 240.00 scf sf 1950 ' WRITE(9,99)'8475 m gs 1 -1 sc (K-matrix) col0 sh gr ' WRITE(9,99)'/Times-Roman-iso ff 300.00 scf sf 225 150 m gs 1 ' WRITE(9,99)'-1 sc (TWO-CHANNEL T-MATRIX ) col0 sh gr ' WRITE(9,99)'/Times-Roman-iso ff 300.00 scf sf 4275 150 m gs 1 ' WRITE(9,99)'-1 sc (range = ) col0 sh gr /Times-Roman-iso ff ' WRITE(9,99)'200.00 scf sf 5325 150 m gs 1 -1 sc' WRITE(9,*)'(',STARTRANGE,'-',ENDRANGE,') col0 ' WRITE(9,99)'sh gr' WRITE(9,*)'/Times-Roman-iso ff 120.00 scf sf' WRITE(9,*)'6990 150 m' WRITE(9,*)'gs 1 -1 sc (BUBBLEGUM EPLOT) col0 sh gr' WRITE(9,*)'/Times-Roman-iso ff 120.00 scf sf' WRITE(9,*)'6990 45 m' WRITE(9,*)'gs 1 -1 sc (Norbert Ligterink) col0 sh gr' WRITE(9,99)'%' WRITE(9,99)'% data' WRITE(9,99)'%' * WRITE(9,99)'% zero lines' * DO I=1, 2 XX(1) = 200 + 4000*(I-1) XX(2) = 4200 + 4000*(I-1) DO J=1, 2 YY(1) = 4200 + 4000*(J-1) + c INT(4000.0*MIN(J,I)/(MAX(J,I)-MIN(J,I))) WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(1),' l gs col0 s gr ' ENDDO ENDDO * * * WRITE(9,99)'% scattering data' * DO I=1, POINTS-1 DO L=1, 2 DO J=1, 2 XX(1) = 4000*(L-1) + c INT(200.0D0 + 4000.0D0*(E(I)-STARTRANGE)/ c (ENDRANGE-STARTRANGE)) XX(2) = 4000*(L-1) + c INT(200.0D0 + 4000.0D0*(E(I+1)-STARTRANGE)/ c (ENDRANGE-STARTRANGE)) * IF(MOD(DATA,10000)/1000 .EQ. 1)THEN * * real T * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(T(1,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(T(1,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col0 s gr ' * * * imag T * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(T(2,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(T(2,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col1 s gr ' * ENDIF * * IF(MOD(DATA,1000)/100 .EQ. 1)THEN * real K * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(K(1,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(K(1,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col4 s gr ' * * * imag K * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(K(2,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(K(2,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col5 s gr ' * ENDIF * IF(MOD(DATA,100)/10 .EQ. 1)THEN * * real B * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(B(1,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(B(1,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) IF(YY(1) .GT. 4200 + 4000*(J-1))THEN YY(1) = 4200 + 4000*(J-1) ENDIF IF(YY(1) .LT. 200 + 4000*(J-1))THEN YY(1) = 200 + 4000*(J-1) ENDIF IF(YY(2) .GT. 4200 + 4000*(J-1))THEN YY(2) = 4200 + 4000*(J-1) ENDIF IF(YY(2) .LT. 200 + 4000*(J-1))THEN YY(2) = 200 + 4000*(J-1) ENDIF IF((YY(1) .EQ. 4200 + 4000*(J-1) .AND. c YY(2) .EQ. 4200 + 4000*(J-1)) .OR. c (YY(1) .EQ. 200 + 4000*(J-1) .AND. c YY(2) .EQ. 200 + 4000*(J-1)))THEN ELSE WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col14 s gr ' ENDIF * * * imag B * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(B(2,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(B(2,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) IF(YY(1) .GT. 4200 + 4000*(J-1))THEN YY(1) = 4200 + 4000*(J-1) ENDIF IF(YY(1) .LT. 200 + 4000*(J-1))THEN YY(1) = 200 + 4000*(J-1) ENDIF IF(YY(2) .GT. 4200 + 4000*(J-1))THEN YY(2) = 4200 + 4000*(J-1) ENDIF IF(YY(2) .LT. 200 + 4000*(J-1))THEN YY(2) = 200 + 4000*(J-1) ENDIF IF((YY(1) .EQ. 4200 + 4000*(J-1) .AND. c YY(2) .EQ. 4200 + 4000*(J-1)) .OR. c (YY(1) .EQ. 200 + 4000*(J-1) .AND. c YY(2) .EQ. 200 + 4000*(J-1)))THEN ELSE WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col12 s gr ' ENDIF * ENDIF * IF(MOD(DATA,10) .EQ. 1)THEN * * real pert * YY(1) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(X(1,J,L,I)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) YY(2) = 4000*(J-1) + c INT(4200.0D0 - 4000.0D0*(X(1,J,L,I+1)-MIN(J,L))/ c (MAX(J,L)-MIN(J,L))) IF(YY(1) .GT. 4200 + 4000*(J-1))THEN YY(1) = 4200 + 4000*(J-1) ENDIF IF(YY(1) .LT. 200 + 4000*(J-1))THEN YY(1) = 200 + 4000*(J-1) ENDIF IF(YY(2) .GT. 4200 + 4000*(J-1))THEN YY(2) = 4200 + 4000*(J-1) ENDIF IF(YY(2) .LT. 200 + 4000*(J-1))THEN YY(2) = 200 + 4000*(J-1) ENDIF IF((YY(1) .EQ. 4200 + 4000*(J-1) .AND. c YY(2) .EQ. 4200 + 4000*(J-1)) .OR. c (YY(1) .EQ. 200 + 4000*(J-1) .AND. c YY(2) .EQ. 200 + 4000*(J-1)))THEN ELSE WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col3 s gr ' ENDIF * ENDIF * IF(MOD(DATA,100000)/10000 .EQ. 1)THEN * * gamma (phase space) * DO CH=1, 2 YY(1) = 4200 + 4000*(J-1) - c INT(1000.0D0*WW(1,CH,I)/THRESH(CH)) YY(2) = 4200 + 4000*(J-1) - c INT(1000.0D0*WW(1,CH,I+1)/THRESH(CH)) IF(YY(1) .GT. 4200 + 4000*(J-1))THEN YY(1) = 4200 + 4000*(J-1) ENDIF IF(YY(1) .LT. 200 + 4000*(J-1))THEN YY(1) = 200 + 4000*(J-1) ENDIF IF(YY(2) .GT. 4200 + 4000*(J-1))THEN YY(2) = 4200 + 4000*(J-1) ENDIF IF(YY(2) .LT. 200 + 4000*(J-1))THEN YY(2) = 200 + 4000*(J-1) ENDIF IF((YY(1) .EQ. 4200 + 4000*(J-1) .AND. c YY(2) .EQ. 4200 + 4000*(J-1)) .OR. c (YY(1) .EQ. 200 + 4000*(J-1) .AND. c YY(2) .EQ. 200 + 4000*(J-1)))THEN ELSE WRITE(9,*)'n ',XX(1),' ',YY(1),' m ',XX(2), c ' ',YY(2),' l gs col11 s gr ' ENDIF ENDDO * ENDIF * * ENDDO ENDDO ENDDO * WRITE(9,99)'% resonances' * DO I=1, NR * IF(MR(I) .LT. ENDRANGE .AND. MR(I) .GT. STARTRANGE)THEN XA = INT(200.0D0 + 4000.0D0*(MR(I)-STARTRANGE)/ c (ENDRANGE-STARTRANGE)) WRITE(9,*)'n ',XA,' 4200 m ',XA,' 3700 l gs col2 s gr ' WRITE(9,*)'n ',XA,' 8200 m ',XA,' 7700 l gs col2 s gr ' XA = INT(4200.0D0 + 4000.0D0*(MR(I)-STARTRANGE)/ c (ENDRANGE-STARTRANGE)) WRITE(9,*)'n ',XA,' 4200 m ',XA,' 3700 l gs col2 s gr ' WRITE(9,*)'n ',XA,' 8200 m ',XA,' 7700 l gs col2 s gr ' ENDIF * ENDDO * * * min-max * WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'7200 450 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MAX(1,2),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'7200 4500 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MAX(2,2),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'3225 450 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MAX(1,1),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'3225 4500 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MAX(2,1),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'3225 4125 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MIN(1,1),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'7200 4125 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MIN(1,2),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'7200 8100 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MIN(2,2),')' WRITE(9,99)' col0 sh gr' WRITE(9,99)'/Times-Roman-iso ff 180.00 scf sf' WRITE(9,99)'3225 8100 m' WRITE(9,99)'gs 1 -1 sc ' WRITE(9,*)'(',MIN(2,1),')' WRITE(9,99)' col0 sh gr' * * WRITE(9,99)'$F2psEnd rs ' * CLOSE(1) CLOSE(21) CLOSE(22) CLOSE(23) CLOSE(24) CLOSE(31) CLOSE(32) CLOSE(33) CLOSE(34) CLOSE(41) CLOSE(42) CLOSE(43) CLOSE(44) CLOSE(71) CLOSE(72) CLOSE(73) CLOSE(74) CLOSE(51) CLOSE(52) CLOSE(9) * * PRINT *,'graph output > plot.eps' * 99 FORMAT(A) 222 FORMAT(3G14.5) * END * ***** ******************************************************************