c ====================================================================== subroutine SCATTER2(j,avalx,avaly,M,rbx,rby) include 'common.f' Real rbx,rby,dum Integer M,intax,intay,SCnt Real HXY,SCFC CALL IACWK(4) CALL IDAWK(1) call iswn(100*j,xmin(M),xmax(M),ymin(M),ymax(M)) SCFC = SCEF If(RNDFLAG)Then Call HXYIJ(H2ID(M),avalx,avaly,intax,intay) avalx = real(rbx*(intax-1)) + rndm(dum)*rbx + xmin(M) avaly = real(rby*(intay-1)) + rndm(dum)*rby + ymin(M) EndIf If(ScatNum(j).EQ.ScatDS)Then call ISELNT(100*j) If(COLFLAG) Then SCnt = HXY(H2ID(M),avalx,avaly) 222 If(SCnt.ge.0 .and. SCnt.le.5*SCFC) Call ISPMCI(8) If(SCnt.gt.5*SCFC .and. SCnt.le.10*SCFC) Call ISPMCI(9) If(SCnt.gt.10*SCFC .and. SCnt.le.15*SCFC) Call ISPMCI(10) If(SCnt.gt.15*SCFC .and. SCnt.le.20*SCFC) Call ISPMCI(11) If(SCnt.gt.20*SCFC .and. SCnt.le.25*SCFC) Call ISPMCI(12) If(SCnt.gt.25*SCFC .and. SCnt.le.30*SCFC) Call ISPMCI(13) If(SCnt.gt.30*SCFC .and. SCnt.le.35*SCFC) Call ISPMCI(14) If(SCnt.gt.35*SCFC .and. SCnt.le.40*SCFC) Call ISPMCI(15) If(SCnt.gt.40*SCFC .and. SCnt.le.45*SCFC) Call ISPMCI(16) If(SCnt.gt.45*SCFC .and. SCnt.le.50*SCFC) Call ISPMCI(17) If(SCnt.gt.50*SCFC .and. SCnt.le.55*SCFC) Call ISPMCI(18) If(SCnt.gt.55*SCFC .and. SCnt.le.60*SCFC) Call ISPMCI(19) If(SCnt.gt.60*SCFC .and. SCnt.le.65*SCFC) Call ISPMCI(20) If(SCnt.gt.65*SCFC .and. SCnt.le.70*SCFC) Call ISPMCI(21) If(SCnt.gt.70*SCFC .and. SCnt.le.75*SCFC) Call ISPMCI(22) If(SCnt.gt.75*SCFC .and. SCnt.le.80*SCFC) Call ISPMCI(23) If(SCnt.gt.80*SCFC .and. SCnt.le.85*SCFC) Call ISPMCI(24) If(SCnt.gt.85*SCFC .and. SCnt.le.90*SCFC) Call ISPMCI(25) If(SCnt.gt.90*SCFC .and. SCnt.le.95*SCFC) Call ISPMCI(26) If(SCnt.gt.95*SCFC .and. SCnt.le.100*SCFC) Call ISPMCI(27) If(SCnt.gt.100*SCFC) Then SCnt = SCnt - 100*SCFC + 1 SCFC = SCFC * 10. Goto 222 EndIf EndIf call IPM(1,avalx,avaly) Call ISPMCI(28) ScatNum(j) = 0 EndIf ScatNum(j) = ScatNum(j) + 1 Call IACWK(1) Call IDAWK(4) return end c ====================================================================== Subroutine MKSCATTER Include 'common.f' Character idtitle*80,idtemp*10 real rxmin,rxmax,rymin,rymax Call IACWK(4) Call IDAWK(1) WX = 1./N2X WY = 1./N2Y RWX = 0.8*WX RWY = 0.8*WY Call ISWN(1,0.,1.,0.,1.) Call ISVP(1,0.,1.,0.,1.) k = 0 If(HST2FLAG)Then Do nny = 1, n2y Do nnx = 1, n2x k = k + 1 If(k.le.anumh2id)Then Do j = 1, i2-1 c Do j = 1, j2 If(ah2id(k).eq.h2id(j))Then SWX = (WX-RWX)/2.+(NNX-1)*WX + 0.02 SWY = 1.-((WY-RWY)/2.+RWY)-(NNY-1)*WY + 0.02 rxmin = swx rxmax = swx + rwx rymin = swy rymax = swy + rwy c write(*,*)rxmin,rxmax,rymin,rymax Call ISELNT(1) Call ISTXAL(2,0) Call IGSET('PASS',1.) Call IGTEXT(rxmin+rwx/2.,rymax,title_2d(j), & rwy/20.,0,'C') Write(idtemp,*)h2id(j) idtitle = 'Histogram ID ='//idtemp Call ISTXAL(2,1) Call IGTEXT(rxmin+5.*rwx/6.,rymin-rwy*0.12, & idtitle,rwy/40.,0,'C') Call ISWN(100*k,xmin(j),xmax(j),ymin(j),ymax(j)) Call ISVP(100*k,rxmin,rxmax,rymin,rymax) Call ISELNT(100*k) Call IGAXIS(xmin(j),xmax(j),ymin(j),ymin(j), & Xmin(j),Xmax(j),510,' ') Call IGAXIS(xmin(j),xmin(j),ymin(j),ymax(j), & Ymin(j),Ymax(j),510,' ') EndIf EndDo EndIf EndDo EndDo EndIf Call IACWK(1) Call IDAWK(4) Return End c ================================================================= Subroutine PLOTHIST(HID,PLCHOPT,PLL) Include 'common.f' Character PLCHOPT*10 Integer PLL,PKIND Call ReadDispIDfromPAWC If(HID.EQ.0) Then c Write(*,*)'DSeqID : ',DSeqID,' DispID : ',DispID(DSeqID) If(DispID(DSeqID).EQ.0) Return HID = DispID(DSeqID) EndIf Call HIDALL(AIDALL,AMAXHST) Call HKIND(HID,PKIND,' ') If(HEXIST(HID) .and. PKIND.NE.4)Then Call GetDispID(HID) HID = CURRHID Call HPLOT(HID,PLCHOPT(1:PLL),' ',0) Write(*,*)'Current Histogram ID : ',HID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine NEXTHIST(PLCHOPT,PLL) Include 'common.f' Character PLCHOPT*10 Integer PLL,NKIND 1 Continue Call ReadDispIDfromPAWC Call HIDALL(AIDALL,AMAXHST) Call NextDispID NEXTHID = CURRHID Call HKIND(NEXTHID,NKIND,' ') If(HEXIST(NEXTHID) .and. NKIND.NE.4) Then Call HPLOT(NEXTHID,PLCHOPT(1:PLL),' ',0) Write(*,*)'Current Histogram ID : ',NEXTHID Call WRTHID(CURRHID) ElseIf(NKIND.EQ.4 .and. DseqID.LT.CommonMaxHist) Then Goto 1 Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No more Histograms.' Write(*,*)' ' ReachLimit = .False. EndIf Return End c ================================================================= Subroutine PREVHIST(PLCHOPT,PLL) Include 'common.f' Character PLCHOPT*10 Integer PLL,PKIND 1 Continue Call ReadDispIDfromPAWC Call HIDALL(AIDALL,AMAXHST) Call PrevDispID PREVHID = CURRHID Call HKIND(PREVHID,PKIND,' ') If(HEXIST(PREVHID) .and. PKIND.NE.4) Then Call HPLOT(PREVHID,PLCHOPT(1:PLL),' ',0) Write(*,*)'Current Histogram ID : ',PREVHID Call WRTHID(CURRHID) ElseIf(PKIND.EQ.4 .and. DseqID.GT.1) Then Goto 1 Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No more Histograms.' Write(*,*)' ' ReachLimit = .False. EndIf Return End c ================================================================= Subroutine BLOW(BLXMIN,BLXMAX,BLYMIN,BLYMAX) Include 'common.f' Integer NextHID,FKIND,TLEN Character BLTITLE*80 Integer BLNX,BXMIN,BXMAX,BLNY,BYMIN,BYMAX,NWT,LOC Real BLXMIN,BLXMAX,BLYMIN,BLYMAX HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') Call HGIVE(HID,BLTITLE,BLNX,DUMX1,DUMX2, & BLNY,DUMY1,DUMY2,NWT,LOC) c -- 1D Histogram -- If(FKIND.EQ.1) Then If(BLXMIN.EQ.-1.) Then BLXMIN = DUMX1 Call KUPROR(' Min >',BLXMIN) EndIf If(BLXMAX.EQ.-1.) Then BLXMAX = DUMX2 Call KUPROR(' Max >',BLXMAX) EndIF BYMIN = HMIN(HID) BYMAX = HMAX(HID)*1.25 If(BLYMIN.EQ.-1.) Then BLYMIN = BYMIN EndIf If(BLYMAX.EQ.-1.) Then BLYMAX = BYMAX EndIF Call HXI(HID,BLXMIN,BXMIN) Call HXI(HID,BLXMAX,BXMAX) BYMIN = INT(BLYMIN) BYMAX = INT(BLYMAX) c -- 2D Histogram -- ElseIf(FKIND.EQ.2) Then If(BLXMIN.EQ.-1.)BLXMIN = DUMX1 If(BLXMAX.EQ.-1.)BLXMAX = DUMX2 If(BLXMIN.EQ.-1. .AND. & (BLYMIN.EQ.-1. .OR. BLYMAX.EQ.-1.)) Then BLXMIN = DUMX1 Call KUPROR(' Min >',BLXMIN) EndIf If(BLXMAX.EQ.-1. .AND. & (BLYMIN.EQ.-1. .OR. BLYMAX.EQ.-1.)) Then BLXMAX = DUMX2 Call KUPROR(' Max >',BLXMAX) EndIF If(BLYMIN.EQ.-1.) Then BLYMIN = DUMY1 Call KUPROR(' Min >',BLYMIN) EndIf If(BLYMAX.EQ.-1.) Then BLYMAX = DUMY2 Call KUPROR(' Max >',BLYMAX) EndIF Call HXYIJ(HID,BLXMIN,BLYMIN,BXMIN,BYMIN) Call HXYIJ(HID,BLXMAX,BLYMAX,BXMAX,BYMAX) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Call TGETLEN(BLTITLE,TLEN) BLTITLE = 'Blow.'//'('//BLTITLE(1:TLEN)//')' If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) If(FKIND.EQ.1) Then Call HCOPYR(HID,NextHID,BLTITLE, & BXMIN,BXMAX-1,0,0,' ') Call HMINIM(NextHID,BYMIN) Call HMAXIM(NextHID,BYMAX) ElseIf(FKIND.EQ.2) Then Call HCOPYR(HID,NextHID,BLTITLE, & BXMIN,BXMAX-1,BYMIN,BYMAX-1,' ') EndIf Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine XBLOW Include 'common.f' Integer NextHID,FKIND,TLEN Character BLTITLE*80 Integer BLNX,BXMIN,BXMAX,BLNY,BYMIN,BYMAX,NWT,LOC Real TMPX1,TMPX2,TMPY1,TMPY2 Real BLXMIN,BLXMAX,BLYMIN,BLYMAX Real HX Integer ISTAT,NT Character*4 OPTLGX OPTLGX = 'LOGX' Call GETHPLOPT(OPTLGX) HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') Call HGIVE(HID,BLTITLE,BLNX,DUMX1,DUMX2, & BLNY,DUMY1,DUMY2,NWT,LOC) If(FKIND.EQ.1) Then Call IRQLC(1,20,ISTAT,NT,TMPX1,TMPY1) Call IRQLC(1,20,ISTAT,NT,TMPX2,TMPY2) If(TMPX1.GT.TMPX2) Then BLXMIN = TMPX2 BLXMAX = TMPX1 Else BLXMIN = TMPX1 BLXMAX = TMPX2 EndIf If(OPTLGX.EQ.'LOGX') Then BLXMIN = 10.**(BLXMIN) BLXMAX = 10.**(BLXMAX) EndIF Call HXI(HID,BLXMIN,BXMIN) Call HXI(HID,BLXMAX,BXMAX) ElseIf(FKIND.EQ.2) Then Call IRQLC(1,20,ISTAT,NT,TMPX1,TMPY1) Call IRQLC(1,20,ISTAT,NT,TMPX2,TMPY2) If(TMPX1.GT.TMPX2) Then BLXMIN = TMPX2 BLXMAX = TMPX1 Else BLXMIN = TMPX1 BLXMAX = TMPX2 EndIf If(TMPY1.GT.TMPY2) Then BLYMIN = TMPY2 BLYMAX = TMPY1 Else BLYMIN = TMPY1 BLYMAX = TMPY2 EndIf If(OPTLGX.EQ.'LOGX') Then BLXMIN = 10.**(BLXMIN) BLXMAX = 10.**(BLXMAX) EndIF BYMIN = INT(DUMY1) BYMAX = INT(DUMY2) Call HXYIJ(HID,BLXMIN,DUMY1,BXMIN,BYMIN) Call HXYIJ(HID,BLXMAX,DUMY2,BXMAX,BYMAX) Else Write(*,*)' ' Write(*,*)' ANAPAW-E : No Histogram.' Write(*,*)' ' Return EndIf Call TGETLEN(BLTITLE,TLEN) BLTITLE = 'XBlow.'//'('//BLTITLE(1:TLEN)//')' If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) If(FKIND.EQ.1) Then Call HCOPYR(HID,NextHID,BLTITLE, & BXMIN,BXMAX-1,0,0,' ') ElseIf(FKIND.EQ.2) Then Call HCOPYR(HID,NextHID,BLTITLE, & BXMIN,BXMAX-1,BYMIN,BYMAX-1,' ') EndIf Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine XYBLOW Include 'common.f' Integer NextHID,FKIND,TLEN Character BLTITLE*80 Integer BLNX,BXMIN,BXMAX,BLNY,BYMIN,BYMAX,NWT,LOC Real TMPX1,TMPX2,TMPY1,TMPY2 Real BLXMIN,BLXMAX,BLYMIN,BLYMAX Real HX,IPLX(2),IPLY(2) Integer ISTAT,NT Character*4 OPTLGX,OPTLGY OPTLGX = 'LOGX' OPTLGY = 'LOGY' Call GETHPLOPT(OPTLGX) Call GETHPLOPT(OPTLGY) HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') Call HGIVE(HID,BLTITLE,BLNX,DUMX1,DUMX2, & BLNY,DUMY1,DUMY2,NWT,LOC) If(FKIND.EQ.1) Then Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 2D-Histogram.' Write(*,*)' ' ElseIf(FKIND.EQ.2) Then Call IRQLC(1,20,ISTAT,NT,TMPX1,TMPY1) IPLX(1) = TMPX1 IPLX(2) = TMPX1 IPLY(1) = DUMY1 IPLY(2) = DUMY2 Call IPL(2,IPLX,IPLY) IPLX(1) = DUMX1 IPLX(2) = DUMX2 IPLY(1) = TMPY1 IPLY(2) = TMPY1 Call IPL(2,IPLX,IPLY) Call IRQLC(1,20,ISTAT,NT,TMPX2,TMPY2) If(TMPX1.GT.TMPX2) Then BLXMIN = TMPX2 BLXMAX = TMPX1 Else BLXMIN = TMPX1 BLXMAX = TMPX2 EndIf If(TMPY1.GT.TMPY2) Then BLYMIN = TMPY2 BLYMAX = TMPY1 Else BLYMIN = TMPY1 BLYMAX = TMPY2 EndIf If(OPTLGX.EQ.'LOGX') Then BLXMIN = 10.**(BLXMIN) BLXMAX = 10.**(BLXMAX) EndIF If(OPTLGY.EQ.'LOGY') Then BLYMIN = 10.**(BLYMIN) BLYMAX = 10.**(BLYMAX) EndIf Call HXYIJ(HID,BLXMIN,BLYMIN,BXMIN,BYMIN) Call HXYIJ(HID,BLXMAX,BLYMAX,BXMAX,BYMAX) Else Write(*,*)' ' Write(*,*)' ANAPAW-E : No Histogram.' Write(*,*)' ' Return EndIf Call TGETLEN(BLTITLE,TLEN) BLTITLE = 'XYBlow.'//'('//BLTITLE(1:TLEN)//')' If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) Call HCOPYR(HID,NextHID,BLTITLE, & BXMIN,BXMAX-1,BYMIN,BYMAX-1,' ') Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine PROJC(PKIND) Include 'common.f' Integer NextHID,FKIND,PKIND,TLEN Character PRTITLE*80,KUCOMLINE*80,IDTEMP*5 Integer PRNX,PXMINI,PXMAXI,PRNY,PYMINI,PYMAXI,NWT,LOC Real PRXMIN,PRXMAX HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') If(FKIND.EQ.2) Then Call HGIVE(HID,PRTITLE,PRNX,DUMX1,DUMX2, & PRNY,DUMY1,DUMY2,NWT,LOC) Call TGETLEN(PRTITLE,TLEN) If(PKIND.EQ.1) Then PRTITLE = '''Prox.'//'('//PRTITLE(1:TLEN)//')''' ElseIf(PKIND.EQ.2) Then PRTITLE = '''Proy.'//'('//PRTITLE(1:TLEN)//')''' EndIf If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) If(PKIND.EQ.1) Then Call HCOPY(HID,9999,PRTITLE) Call KUEXEC('PROX 9999') Call KUEXEC('HIST/PROJECT 9999') Write(IDTEMP,'(I5)')NextHID KUCOMLINE = 'HIST/COPY 9999.PROX'//IDTEMP//' '//PRTITLE Call KUEXEC(KUCOMLINE) ElseIf(PKIND.EQ.2) Then Call HCOPY(HID,9999,PRTITLE) Call KUEXEC('PROY 9999') Call KUEXEC('HIST/PROJECT 9999') Write(IDTEMP,'(I5)')NextHID KUCOMLINE = 'HIST/COPY 9999.PROY'//IDTEMP//' '//PRTITLE Call KUEXEC(KUCOMLINE) EndIf Call HDELET(9999) Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Else Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 2D-Histogram.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine BAND(PKIND,BANDMIN,BANDMAX) Include 'common.f' Integer NextHID,FKIND,PKIND,TLEN Character PRTITLE*80,KUCOMLINE*80,IDTEMP*5 Character MINTEMP*20,MAXTEMP*20,KUTEMP*80 Integer PRNX,PXMINI,PXMAXI,PRNY,PYMINI,PYMAXI,NWT,LOC Real PRXMIN,PRXMAX,BANDMIN,BANDMAX HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') If(FKIND.EQ.2) Then Call HGIVE(HID,PRTITLE,PRNX,DUMX1,DUMX2, & PRNY,DUMY1,DUMY2,NWT,LOC) Call TGETLEN(PRTITLE,TLEN) If(PKIND.EQ.1) Then PRTITLE = '''Banx.'//'('//PRTITLE(1:TLEN)//')''' ElseIf(PKIND.EQ.2) Then PRTITLE = '''Bany.'//'('//PRTITLE(1:TLEN)//')''' EndIf If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) If(PKIND.EQ.1) Then If(BANDMIN.EQ.-1.) Then BANDMIN = DUMY1 Call KUPROR(' Min >',BANDMIN) EndIf If(BANDMAX.EQ.-1.) Then BANDMAX = DUMY2 Call KUPROR(' Max >',BANDMAX) EndIf Call HCOPY(HID,9999,PRTITLE) Write(MINTEMP,*)BANDMIN Write(MAXTEMP,*)BANDMAX KUTEMP = 'BANX 9999 '//MINTEMP//' '//MAXTEMP Call KUEXEC(KUTEMP) Call KUEXEC('HIST/PROJECT 9999') Write(IDTEMP,'(I5)')NextHID KUCOMLINE = 'HIST/COPY 9999.BANX'//IDTEMP//' '//PRTITLE Call KUEXEC(KUCOMLINE) ElseIf(PKIND.EQ.2) Then If(BANDMIN.EQ.-1.) Then BANDMIN = DUMX1 Call KUPROR(' Min >',BANDMIN) EndIf If(BANDMAX.EQ.-1.) Then BANDMAX = DUMX2 Call KUPROR(' Max >',BANDMAX) EndIf Call HCOPY(HID,9999,PRTITLE) Write(MINTEMP,*)BANDMIN Write(MAXTEMP,*)BANDMAX KUTEMP = 'BANY 9999 '//MINTEMP//' '//MAXTEMP Call KUEXEC(KUTEMP) Call KUEXEC('HIST/PROJECT 9999') Write(IDTEMP,'(I5)')NextHID KUCOMLINE = 'HIST/COPY 9999.BANY'//IDTEMP//' '//PRTITLE Call KUEXEC(KUCOMLINE) EndIf Call HDELET(9999) Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Else Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 2D-Histogram.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine MAMI(MRYMIN,MRYMAX) Include 'common.f' Integer NextHID,FKIND,TLEN Character MTITLE*80 Integer MNX,MXMIN,MXMAX,MNY,MYMIN,MYMAX,NWT,LOC Real TMPX1,TMPX2,TMPY1,TMPY2 Real MRXMIN,MRXMAX,MRYMIN,MRYMAX Real HX Integer ISTAT,NT HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') Call HGIVE(HID,MTITLE,MNX,DUMX1,DUMX2, & MNY,DUMY1,DUMY2,NWT,LOC) If(FKIND.EQ.2) Then c MYMIN = INT(DUMY1) c MYMAX = INT(DUMY2) If(MRYMIN.EQ.-1) Then c Call HIJXY(HID,MXMIN,MYMIN,MRXMIN,MRYMIN) c MRYMIN = MYMIN MRYMIN = DUMY1 Call KUPROR(' Min >',MRYMIN) EndIf If(MRYMAX.EQ.-1) Then C Call HIJXY(HID,MXMAX,MYMAX,MRXMAX,MRYMAX) C MRYMAX = MYMAX MRYMAX = DUMY2 Call KUPROR(' Max >',MRYMAX) EndIf Call HXYIJ(HID,DUMX1,MRYMIN,MXMIN,MYMIN) Call HXYIJ(HID,DUMX2,MRYMAX,MXMAX,MYMAX) ElseIf(FKIND.EQ.1) Then MYMIN = HMIN(HID) MYMAX = HMAX(HID) If(MRYMIN.EQ.-1) Then MRYMIN = MYMIN Call KUPROR(' Min >',MRYMIN) EndIf If(MRYMAX.EQ.-1) Then MRYMAX = MYMAX Call KUPROR(' Max >',MRYMAX) EndIf MYMIN = INT(MRYMIN) MYMAX = INT(MRYMAX) Call HXI(HID,DUMX1,MXMIN) Call HXI(HID,DUMX2,MXMAX) Else Write(*,*)' ' Write(*,*)' ANAPAW-E : No Histogram.' Write(*,*)' ' Return EndIf Call TGETLEN(MTITLE,TLEN) MTITLE = 'Mami.'//'('//MTITLE(1:TLEN)//')' If(HEXIST(HID))Then Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) If(FKIND.EQ.2) Then Call HCOPYR(HID,NextHID,MTITLE, & MXMIN,MXMAX-1,MYMIN,MYMAX-1,' ') ElseIf(FKIND.EQ.1) Then Call HCOPY(HID,NextHID,MTITLE) Call HMINIM(NextHID,MYMIN) Call HMAXIM(NextHID,MYMAX) EndIf Call HPLOT(NextHID,' ',' ',0) Write(*,*)'Current Histogram ID : ',NextHID Call WRTHID(CURRHID) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine XVALUES Include 'common.f' real xvX1,xvY1 REAL HX INTEGER ISTAT,NT,FKIND Character*4 OPTLGX Character*80 CTITLE Integer CBX,CBY,NWT,LOC Real IPLX(2),IPLY(2) HID = DispID(DSeqID) CURRHID = HID Call HKIND(CURRHID,FKIND,' ') If(FKIND.EQ.2) Then Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 1D-Histograms.' Write(*,*)' ' Return EndIf OPTLGX = 'LOGX' Call GETHPLOPT(OPTLGX) Call IRQLC(1,20,ISTAT,NT,xvX1,xvY1) Call HGIVE(CURRHID,CTITLE,CBX,DUMX1,DUMX2, & CBY,DUMY1,DUMY2,NWT,LOC) IPLX(1) = xvX1 IPLX(2) = xvX1 IPLY(1) = 0. IPLY(2) = HMAX(CURRHID)*10. Call IPL(2,IPLX,IPLY) If(OPTLGX.EQ.'LOGX')xvX1 = 10.**(xvX1) Write(*,*)' ' Write(*,'(A5,I5,A12,F8.2,A13,I10)') & ' ID: ',CURRHID,' | X Value: ',xvX1, & ' | Contents: ',INT(HX(CURRHID,xvX1)) Write(*,*)' ' Return End c ================================================================= Subroutine XYVALUES(OPTION) Include 'common.f' real xvX1,xvY1 REAL HXY INTEGER ISTAT,NT,XYWKID,FKIND Character*4 OPTION,OPTLGX,OPTLGY Character*80 CTITLE Integer CBX,CBY,NWT,LOC,XYVALHID Real IPLX(2),IPLY(2) HID = DispID(DSeqID) CURRHID = HID Call HKIND(CURRHID,FKIND,' ') If(FKIND.EQ.1) Then Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 2D-Histograms.' Write(*,*)' ' Return EndIf OPTLGX = 'LOGX' OPTLGY = 'LOGY' Call GETHPLOPT(OPTLGX) Call GETHPLOPT(OPTLGY) If(OPTION .EQ. 'S' .or. OPTION .EQ. 's')Then If(HST2FLAG .AND. SCATFL)Then xywkid = 4 Call ISELNT(100*ANUMH2ID) Call IRQLC(xywkid,20,ISTAT,NT,xvX1,xvY1) Call ISELNT(NT) XYVALHID = AH2ID(INT(NT/100)) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Scatter Window Opened.' Write(*,*)' ' Return EndIf ElseIf(OPTION .EQ. ' ')Then xywkid = 1 XYVALHID = CURRHID Call IRQLC(xywkid,20,ISTAT,NT,xvX1,xvY1) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No such option.' Write(*,*)' ' Return EndIF Call HGIVE(XYVALHID,CTITLE,CBX,DUMX1,DUMX2, & CBY,DUMY1,DUMY2,NWT,LOC) If(OPTION .EQ. ' ') Then IPLX(1) = xvX1 IPLX(2) = xvX1 IPLY(1) = DUMY1 IPLY(2) = DUMY2 Call IPL(2,IPLX,IPLY) IPLX(1) = DUMX1 IPLX(2) = DUMX2 IPLY(1) = xvY1 IPLY(2) = xvY1 Call IPL(2,IPLX,IPLY) EndIf If(OPTLGX .EQ. 'LOGX')xvX1 = 10.**(xvX1) If(OPTLGY .EQ. 'LOGY')xvY1 = 10.**(xvY1) Write(*,*)' ' Write(*,'(A5,I5,A12,F8.2,A12,F8.2,A13,I10)') & ' ID: ',XYVALHID,' | X Value: ',xvX1,' | Y Value: ',xvY1, & ' | Contents: ',INT(HXY(XYVALHID,xvX1,xvY1)) Write(*,*)' ' Return End c ================================================================= Subroutine ReadDispIDfromPAWC c c For Fetch or other booking command. c Include 'common.f' Call HIDALL(AIDALL,AMAXHST) If(CommonMAXHist.LT.AMAXHST) Then Do J = 1, AMAXHST Do I = 1, CommonMAXHist If(AIDALL(J).EQ.DispID(I)) Goto 10 EndDo If(AIDALL(J).EQ.1000000) Then Call HDELET(AIDALL(J)) Goto 10 EndIf CommonMAXHist = CommonMAXHist + 1 DSeqID = CommonMAXHist DispID(DSeqID) = AIDALL(J) If(AIDALL(J).GT.100 .and. AIDALL(J).LT.500000) & idcount = idcount + 1 10 Continue EndDo EndIf Return End c ================================================================= Subroutine ReadDispID(HID) Include 'common.f' Integer TEMPID TEMPID = DSeqID Call HIDALL(AIDALL,AMAXHST) DSeqID = AMAXHST DispID(DSeqID) = HID CURRHID = DispID(DSeqID) DSeqID = DSeqID + 1 Call HIDALL(AIDALL,AMAXHST) CommonMAXHist = AMAXHST DSeqID = TEMPID Return End c ================================================================= Subroutine InitDispID Include 'common.f' Call HIDALL(AIDALL,AMAXHST) Do I = 1, AMAXHST DispID(I) = AIDALL(I) EndDo DSeqID = 1 CURRHID = DispID(DSeqID) Return End c ================================================================= Subroutine GetDispID(HID) Include 'common.f' Call HIDALL(AIDALL,AMAXHST) Do I = 1, AMAXHST If(DispID(I).eq.HID) Then DSeqID = I CURRHID = DispID(DSeqID) Return EndIf EndDo Return End c ================================================================= Subroutine NextDispID Include 'common.f' DSeqID = DSeqID + 1 ReachLimit = .FALSE. If(DispID(DSeqID).EQ.0) Then DSeqID = CommonMAXHist Write(*,*)' ' Write(*,*)' ANAPAW-W : No more Histograms.' Write(*,*)' ' ReachLimit = .TRUE. EndIf CURRHID = DispID(DSeqID) Return End c ================================================================= Subroutine PrevDispID Include 'common.f' DSeqID = DSeqID - 1 ReachLimit = .FALSE. If(DispID(DSeqID).EQ.0) Then DSeqID = 1 Write(*,*)' ' Write(*,*)' ANAPAW-W : No more Histograms.' Write(*,*)' ' ReachLimit = .TRUE. EndIf CURRHID = DispID(DSeqID) Return End c ================================================================= Subroutine AddDispID(NextHID) Include 'common.f' Call HIDALL(AIDALL,AMAXHST) Do I = AMAXHST, DSeqID + 1, -1 DispID(I+1) = DispID(I) EndDo DispID(DSeqID+1) = NextHID CURRHID = DispID(DSeqID+1) DSeqID = DSeqID + 1 CommonMAXHist = AMAXHST + 1 Return End c ================================================================= Subroutine SubDispID(HNUM) Include 'common.f' Integer TEMPID,HNUM TEMPID = DSeqID Call HIDALL(AIDALL,AMAXHST) Do I = DSeqID, AMAXHST DispID(I) = DispID(I + HNUM) EndDo DSeqID = TEMPID CURRHID = DispID(DSeqID) Call HIDALL(AIDALL,AMAXHST) CommonMAXHist = AMAXHST Return End c ================================================================= Subroutine ListDispID(LOPT) Include 'common.f' Character CTEMP*80,CFKIND(8)*3,LOPT*80,LKEY*80 Data CFKIND/'(1)','(2)',' ','(N)',' ',' ',' ','(P)'/ Integer GBINX,GBINY,NWT,LOC,FKIND,TLEN,ILINE ILINE = 1 LKEY = 'M' Call ReadDispIDfromPAWC If(LOPT.EQ.' ' .OR. LOPT.EQ.'P') Then Write(*,*)' ' Write(*,*)'===> Histogram List ' Write(*,*)' ' Write(*,*)' # HID Kind Title' Write(*,*)' ' Do I = 1, CommonMAXHist CTEMP = ' ' Call HGIVE(DispID(I),CTEMP,GBINX,DUMX1,DUMX2, & GBINY,DUMY1,DUMY2,NWT,LOC) Call HKIND(DispID(I),FKIND,' ') Call TGETLEN(CTEMP,TLEN) If(TLEN.GT.80)TLEN=80 If(TLEN.EQ.0) Then TLEN=1 If(I.EQ.DSeqID) Then Write(*,200)' -> ',I,DispID(I), & CFKIND(FKIND) Else Write(*,200)' ',I,DispID(I), & CFKIND(FKIND) EndIf Else If(I.EQ.DSeqID) Then Write(*,100)' -> ',I,DispID(I), & CFKIND(FKIND),CTEMP(1:TLEN) Else Write(*,100)' ',I,DispID(I), & CFKIND(FKIND),CTEMP(1:TLEN) EndIf EndIf ILINE = ILINE + 1 If(LOPT.EQ.'P' .and. ILINE.EQ.20) Then ILINE = 1 Write(*,*)' ' 102 Call KUPROC('More(M)/Quit(Q)>',LKEY,L) Write(*,*)' ' If(LKEY(1:1).EQ.'m' .or. LKEY(1:1).EQ.'M') Then Write(*,*)' ' Write(*,*)'===> Histogram List ' Write(*,*)' ' Write(*,*)' # HID Kind Title' Write(*,*)' ' Goto 101 ElseIf(LKEY(1:1).EQ.'q' .or. LKEY(1:1).EQ.'Q') Then Return Else Goto 102 EndIf EndIf 101 Continue EndDo 100 Format(5X,A5,I5,2X,I5,2X,A4,5X,A) 200 Format(5X,A5,I5,2X,I5,2X,A4) Write(*,*)' ' Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No such option.' Write(*,*)' ' EndIf Return End c ================================================================= Subroutine SliceHist(SLKIND,NSLICE) Include 'common.f' Integer NextHID,FKIND,SLKIND,TLEN,NSLICE,II Character PRTITLE*80,KUCOMLINE*80 Character COMTEMP*11,HIDTEMP*5,IDTEMP*5,SLNUM*5 Integer PRNX,PXMINI,PXMAXI,PRNY,PYMINI,PYMAXI,NWT,LOC Real PRXMIN,PRXMAX HID = DispID(DSeqID) Call HKIND(HID,FKIND,' ') If(FKIND.EQ.2) Then If(NSLICE.EQ.0) Then 111 Call KUPROI(' Num. of Slices>',NSLICE) If(NSLICE.EQ.0) Goto 111 EndIf Call HGIVE(HID,PRTITLE,PRNX,DUMX1,DUMX2, & PRNY,DUMY1,DUMY2,NWT,LOC) Call TGETLEN(PRTITLE,TLEN) If(SLKIND.EQ.1) Then PRTITLE = '''Slix.'//'('//PRTITLE(1:TLEN) ElseIf(SLKIND.EQ.2) Then PRTITLE = '''Sliy.'//'('//PRTITLE(1:TLEN) EndIf If(HEXIST(HID))Then If(SLKIND.EQ.1) Then Write(COMTEMP,'(I5,1X,I5)')HID,NSLICE KUCOMLINE = 'SLIX '//COMTEMP Call KUEXEC(KUCOMLINE) Write(HIDTEMP,'(I5)')HID KUCOMLINE = 'HIST/PROJECT '//HIDTEMP Call KUEXEC(KUCOMLINE) Do II = 1, NSLICE Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) Write(IDTEMP,'(I5)')II call clshift(IDTEMP,SLNUM) Write(IDTEMP,'(I5)')NextHID Call TGETLEN(PRTITLE,TLEN) KUCOMLINE = 'HIST/COPY'//HIDTEMP//'.SLIX.'//SLNUM// & ' '//IDTEMP//' '//PRTITLE(1:TLEN)// & ').'//SLNUM//' '' ' Call KUEXEC(KUCOMLINE) EndDo ElseIf(SLKIND.EQ.2) Then Write(COMTEMP,'(I5,1X,I5)')HID,NSLICE KUCOMLINE = 'SLIY '//COMTEMP Call KUEXEC(KUCOMLINE) Write(HIDTEMP,'(I5)')HID KUCOMLINE = 'HIST/PROJECT '//HIDTEMP Call KUEXEC(KUCOMLINE) Do II = 1, NSLICE Call HIDALL(AIDALL,AMAXHST) idcount = AIDALL(AMAXHST) idcount = idcount + 1 NextHID = idcount Call AddDispID(NextHID) Write(IDTEMP,'(I5)')II call clshift(IDTEMP,SLNUM) Write(IDTEMP,'(I5)')NextHID Call TGETLEN(PRTITLE,TLEN) KUCOMLINE = 'HIST/COPY'//HIDTEMP//'.SLIY.'//SLNUM// & ' '//IDTEMP//' '//PRTITLE(1:TLEN)// & ').'//SLNUM//' '' ' Call KUEXEC(KUCOMLINE) EndDo EndIf KUCOMLINE = 'HT '//HIDTEMP Call KUEXEC(KUCOMLINE) Else Write(*,*)' ' Write(*,*)' ANAPAW-W : No Histograms.' Write(*,*)' ' EndIf Else Write(*,*)' ' Write(*,*)' ANAPAW-W : Not 2D-Histogram.' Write(*,*)' ' EndIf Return End subroutine clshift(chin,chout) character*5 chnull/' '/,chin,chout integer i,iini/1/,ifin/5/ do i = 1,5 if(chin(i:i).ne.' ')then iini = i goto 999 endif enddo 999 continue chout = chin(iini:ifin)//chnull(1:iini-1) return end c ================================================================= Subroutine DISPLAYCID() Include 'common.f' HID = DispID(DSeqID) open(98, file='./CurrentHID.txt', status='replace') write(98,*) HID close(98) write(*,*) 'Current HID :' , HID return end c =================================================================