X-Git-Url: https://oss.titaniummirror.com/gitweb/?a=blobdiff_plain;f=gcc%2Ftestsuite%2Fg77.f-torture%2Fnoncompile%2F19990826-4.f;fp=gcc%2Ftestsuite%2Fg77.f-torture%2Fnoncompile%2F19990826-4.f;h=0000000000000000000000000000000000000000;hb=6fed43773c9b0ce596dca5686f37ac3fc0fa11c0;hp=86d2a939064bd69e9f4789dca137284a2157b9f7;hpb=27b11d56b743098deb193d510b337ba22dc52e5c;p=msp430-gcc.git diff --git a/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f b/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f deleted file mode 100644 index 86d2a939..00000000 --- a/gcc/testsuite/g77.f-torture/noncompile/19990826-4.f +++ /dev/null @@ -1,648 +0,0 @@ -* Culled from 970528-1.f in Burley's g77 test suite. Copyright -* status not clear. Feel free to chop down if the bug is still -* reproducible (see end of test case for how bug shows up in gdb -* run of f771). No particular reason it should be a noncompile -* case, other than that I didn't want to spend time "fixing" it -* to compile cleanly (with -O0, which works) while making sure the -* ICE remained reproducible. -- burley 1999-08-26 - -* Date: Mon, 26 May 1997 13:00:19 +0200 (GMT+0200) -* From: "D. O'Donoghue" -* To: Craig Burley -* Cc: fortran@gnu.ai.mit.edu -* Subject: Re: g77 problems - - program dophot - parameter (napple = 4) - common /window/nwindo,ixwin(50),iywin(50),iboxwin(50),itype(50) - common/io/luout,ludebg - common/search/nstot,thresh - common /fitparms / acc(npmax),alim(npmax),mit,mpar,mfit1, - + mfit2,ind(npmax) - common /starlist/ starpar(npmax,nsmax), imtype(nsmax), - 1shadow(npmax,nsmax),shaderr(npmax,nsmax),idstr(nsmax) - common /aperlist/ apple(napple ,nsmax) - common /parpred / ava(npmax) - common /unitize / ufactor - common /undergnd/ nfast, nslow - common/bzero/ scale,zero - common /ctimes / chiimp, apertime, filltime, addtime - common / drfake / needit - common /mfit/ psfpar(npmax),starx(nfmax),stary(nfmax),xlim,ylim - common /vers/ version - logical needit,screen,isub,loop,comd,burn,wrtres,fixedxy - logical fixed,piped,debug,ex,clinfo - character header*5760,rhead*2880 - character yn*1,version*40,ccd*4,infile*20 - character*30 numf,odir,record*80 - integer*2 instr(8) - character*800 line - external pseud0d, pseud2d, pseud4d, pseudmd, shape -C -C Initialization - data burn, fixedxy,fixed, piped - + /.false.,.false.,.false.,.false./ - data needit,screen,comd,isub - + /.true.,.false.,.true.,.false. / - data acc / .01, -.03, -.03, .01, .03, .1, .03 / - data alim / -1.0e8, 2*-1.0e3, -1.0e8, 3*-1.0e3 / -C - version = 'DoPHOT Version 1.0 LINUX May 97 ' - debug=.false. - clinfo=.false. - line(1:800) = ' ' - odir = ' ' -C -C -C Read default tuneable parameters - call tuneup ( nccd, ccd, piped, debug ) - version(33:36) = ccd(1:4) -C - - ludebg=6 - if(piped)then - yn='n' - else - write(*,'(''****************************************'')') - write(*,1000) version - write(*,'(''****************************************''//)') -C - write(*,'(''Screen output (y/[n])? '',$)') - read(*,1000) yn - end if - if(yn.eq.'y'.or.yn.eq.'Y') then - screen=.true. - luout=6 - else - luout=2 - end if -C - if(piped)then - yn='y' - else - write(*,'(''Batch mode ([y]/n)? '',$)') - read(*,1000) yn - end if - if(yn.eq.'n'.or.yn.eq.'N') comd = .false. -C - if(.not.comd) then - write(*, - * '(''Do you want windowing ([y]/n)? '',$)') - read(*,1000)yn - iwindo=1 - if(yn.eq.'n'.or.yn.eq.'N')then - nwindo=0 - iwindo=0 - end if -C - write(*, - * '(''Star classification info (y/[n]) ?'',$)') - read(*,1000)yn - clinfo=.false. - if(yn.eq.'y'.or.yn.eq.'Y')clinfo=.true. -C - write(*, - * '(''Create a star-subtracted frame (y/[n])? '',$)') - read(*,1000) yn - if(yn.eq.'y'.or.yn.eq.'Y') isub = .true. -C - write(*,'(''Apply after-burner (y/[n])? '',$)') - read(*,1000) yn - if ( yn.eq.'y'.or.yn.eq.'Y' ) burn = .true. - wrtres = burn -C - write(*,'(''Read from fixed (X,Y) list (y/[n])? '',$)') - read(*,1000) yn - if ( yn.eq.'y'.or.yn.eq.'Y' ) then - fixedxy = .true. - fixed = .true. - burn = .true. - wrtres = .true. - endif - endif - iopen=0 -C -C This is the start of the loop over the input files -c - iframe=0 - open(10,file='timing',status='unknown',access='append') - -1 ifit = 0 - iapr = 0 - itmn = 0 - model = 1 - xc = 0.0 - yc = 0.0 - rc = 0.0 - ibr = 0 - ixy = 0 -C - iframe=iframe+1 - tgetpar=0.0 - tsearch=0.0 - tshape=0.0 - timprove=0.0 -C -C Batch mode ... - - if ( comd ) then - if(iopen.eq.0)then - iopen=1 - open(11,file='dophot.bat',status='old',err=995) - end if - read(11,1000,end=999)infile -c now read in the parameter instructions. these are: -c instr(1) : if 1, specifies uncrowded field, otherwise crowded -c instr(2) : if 1, specifies sequential frames of same field -c with a window around the stars of interest - -c all other objects are ignored -c instr(3) : if 0, takes cmin from dophot.inp (via tuneup) -c if>0, sets cmin=instr(3) -c instr(4) : if 0, does nothing -c if 1, then opens a file called classifications -c sets clinfo to .true. and writes out the star -c typing info to this file -c instr(5) : Delete the shd.nnnnnnn file -c instr(6) : Delete the out.nnnnnnn file -c instr(7) : Delete the input frame -c instr(8) : Create a star-subtracted frame - read(11,*)instr - read(11,*)ifit,iapr,tmn,model,xc,yc,rc,ibr,ixy - nocrwd = instr(1) - iwindo=instr(2) - if(iwindo.eq.0)nwindo=0 - itmn=tmn - if ( instr(3).gt.0 ) cmin=instr(3) - clinfo=.false. - if ( instr(4).gt.0 )then - clinfo=.true. - open(12,file='classifications',status='unknown') - ludebg=12 - end if - if ( instr(8).ne.0 ) then - isub = .true. - else - isub = .false. - endif -C - if(ibr.ne.0) burn = .true. - if(ixy.ne.0) then - fixedxy = .true. - fixed = .true. - burn = .true. - goto 20 - endif - if(iwindo.eq.0)then - write(6,10)iframe,infile(1:15) - 10 format(' ***** DoPHOT-ing frame ',i4,': ',a) - if(ludebg.eq.12)write(ludebg,11)iframe,infile(1:15) - 11 format(////' ',62('*')/ - * ' * DoPHOT-ing frame ',i4,': ',a, - * ' *'/' ',62('*')) - end if - if(iwindo.eq.1)then - write(6,12)iframe,infile(1:15) - 12 format(' ***** DoPHOT-ing frame ',i4,': ',a, - * ' - Windowed *****') - if(ludebg.eq.12)write(ludebg,13)iframe,infile(1:15) - 13 format(////' ',62('*')/ - * ' * DoPHOT-ing frame ',i4,': ',a, - * ' - Windowed *'/2x,62('*')) - end if -C -C Interactive... - else - write(*,'(''Image name: '',$)') - read(*,1000) infile - if(infile(1:1).eq.' ') goto 999 -1000 format(a) - write(*,'(''Crowded field mode ([y]/n) ? '',$)') - read(*,1000)yn - nocrwd=0 - if(yn.eq.'n'.or.yn.eq.'N')nocrwd=1 - if(.not.fixed) then - write(*,1001) -1001 format('Sky model ([1]=Plane, 2=Power, 3=Hubble)? ',$) - read(*,1000)record - if(record.ne.' ')then - read(record,*) model - else - model=1 - end if - else - burn=.true. - goto 20 - endif - endif -C -C if windowing, open the file and read the window - if(iwindo.eq.1)then - inquire(file='windows',exist=ex) - if(.not.ex)go to 997 - if(iframe.eq.1)open(9,file='windows',status='old') - nwindo=0 - 2 read(9,*,end=3)intype,inx,iny,inbox - nwindo=nwindo+1 - if(nwindo.gt.50)then - print *,'too many windows - max = 50' - stop - end if - ixwin(nwindo)=inx - iywin(nwindo)=iny - iboxwin(nwindo)=inbox - itype(nwindo)=intype - go to 2 - - 3 rewind 9 - if(screen)print 4,(itype(j),ixwin(j),iywin(j),iboxwin(j), - * j=1,nwindo) - 4 format(' Windows: Type X Y Size'/ - * (I13,i6,i5,i5)) - end if - - t1 = cputime(0.0) -C -C Read FITS frame. - call getfits(1,infile,header,nhead,nfast,nslow,numf,nc,line,ccd) -C -C Ignore frame if not the correct chip - if(nc.lt.0) goto 900 -C -C Estimate starting PSF parameters. - 15 call getparams(nfast,nslow,gxwid,gywid,skyval,tmin,tmax, - * iframe) - tgetpar = cputime(t1) + tgetpar - if(debug)write(ludebg,16)iframe,skyval,gxwid,gywid,tmin,tmax - 16 format(' Getparams on frame ',i4,' sky ',f6.1,' gxwid ',f5.1, - * ' gywid ',f5.1,' tmin ',f5.1,' tmax ',f5.1) -C -C Initialize - do j=1,nsmax - imtype(j) = 0 - do i=1,npmax - shadow(i,j)=0. - shaderr(i,j)=0. - enddo - enddo -C - skyguess=skyval - tfac = 1.0 -C Use 4.5 X SD as fitting width - fitr=fitfac*(gxwid*asprat*gywid)**0.25 + 0.5 - i=fitr - irect(1)=i - irect(2)=fitr/asprat -C Use 4/3 X FitFac X SD as aperture width - gmax = asprat*gywid - if(gxwid.gt.gmax) gmax=gxwid - aprw = 1.33*fitfac*sqrt(gmax) + 0.5 - i = aprw - arect(1) = i - i = aprw/asprat + 0.1 - arect(2) = i -C - if(irect(1).gt.50) irect(1)=50 - if(irect(2).gt.50) irect(2)=50 - if(arect(1).gt.45.) arect(1)=45. - if(arect(2).gt.45.) arect(2)=45. -C - if (screen) call htype(line,skyval,.false.,fitr,ngr,ncon) -C -C Prompt for further information - if ( .not.comd ) then - write(*,1002) - 1002 format(/'The above are the inital parameters DoPHOT'/ - * 'has found. You can change them now or accept'/ - * 'the values in [ ] by pressing enter'/) - - write(*,1004)tmin - 1004 format('Enter Tmin: threshold for star detection', - * ' [',f5.1,'] ',$) - read(*,1000)record - if(record.ne.' ')read(record,*)tmin - - write(*,1005)cmin - 1005 format('Enter Cmin: threshold for PSF stars', - * ' [',f5.1,'] ',$) - read(*,1000)record - if(record.ne.' ')read(record,*)cmin - - write(*,1006) - 1006 format('Do you want to fix the aperture mag size ?', - * ' (y/[n]) ') - read(*,1000)record - if(record.eq.'y'.or.record.eq.'Y')then - write(*,1007) - 1007 format('Enter the size in pixels: ',$) - read(*,*)iapr - if(iapr.gt.0) then - arect(1)=iapr - i = iapr/asprat + 0.1 - arect(2)=i - end if - endif -C - write(*,1008) - 1008 format('Satisfied with other input parameters ? ([y]/n)?',$) - read(*,1000) yn - if(yn.eq.'n'.or.yn.eq.'N')then - yn='n' - else - yn='y' - end if - if(.not.(yn.eq.'y'.or.yn.eq.'Y') ) call input - else - if ( ifit.ne.0 ) then - irect(1)=ifit - irect(2)=(ifit/asprat + 0.1) - endif - if ( iapr.ne.0 ) then - arect(1)=iapr - i = iapr/asprat + 0.1 - arect(2)=i - endif - if ( itmn.ne.0 ) tmin = itmn - if ( .not.(xc.eq.0.0.and.yc.eq.0.0) ) then - xcen = xc - ycen = yc - endif - endif -C -C-------------------------------- -C -C - call setup ( numf,nc,screen,line,skyval,fitr,ngr,ncon, - +nfast, nslow ) -C -C if the uncrowded field option has been chosen, jump -C straight to the minimum threshold -C - if(nocrwd.eq.1)tmax=tmin -C -C Adjust tfac so that thresh ends precisely on Tmin. - if(tmin/tmax .gt. 0.999) then - thresh = tmin - tfac = 1. - else - thresh = tmax - xnum = alog10(tmax/tmin)/alog10(2.**tfac) - if(xnum.gt.1.5) then - xnum = float(nint(xnum)) - else if(xnum.ge.1) then - xnum = 2.0 - else - xnum = 1.0 - endif - tfac = alog10(tmax/tmin)/alog10(2.)/xnum - endif -C -C------------------------------------------------------------------------ -C -C This is the BIG LOOP which searches the frame for stars -C with intensities > thresh. -C -C----------------------------------------------------------------------- -C - loop = .true. - nstot = 0 - do while ( loop ) - loop = thresh/tmin .ge. 1.01 - write(luout,1050) thresh -1050 format(/20('-')/'THRESHOLD: ', f10.3) - if(ludebg.eq.12)write(ludebg,1050) thresh -C -C Fit given model to sky values. -C - call varipar(nstot, nfast, nslow ) - t1 = cputime(0.0) -C -C Identifies potential objects in cleaned array IMG - nstar = isearch( pseud2d, nfast, nslow , clinfo) - tsearch = cputime(t1) + tsearch -C - if ( (nstar .ne. 0).or.(xnum.lt.1.5) ) then -C -C Performs 7-parameter PSF fit and determines nature of object. - t1 = cputime(0.0) - call shape(pseud2d,pseud4d,nfast,nslow,clinfo) - tshape = cputime(t1) + tshape -C -C Computes average sky values etc from star list - call paravg - t1 = cputime(0.0) -C -C Computes 4-parameter fits for all stellar objects using -C new average shape parameters. - call improve(pseud2d,nfast,nslow,clinfo) - timprove = cputime(t1) + timprove - end if -C -C Calculate aperture photometry on last pass. - if(.not.loop) call aper ( pseud2d, nstot, nfast, nslow ) -C - totaltime = (tgetpar+tsearch+tshape+timprove) - write(3,1060) totaltime - write(4,1060) totaltime - write(luout,1060) totaltime -1060 format('Total CPU time consumed:',F10.2,' seconds.') - write(10,1070)infile,tgetpar,tsearch,tshape,timprove, - * totaltime -1070 format(a20,' T(getp/f)',f5.1,' T(search)',f5.1, - * ' T(shape)',f5.1,' T(improve)',f5.1, - * ' Total',f6.1) - call title (line,skyval,.false.,fitr,ngr,ncon,strint,ztot,nums) - rewind(2) - rewind(3) - rewind(4) -C - call output ( line ) -C -C Now reduce the threshold and loop back -C - thresh = thresh/2.**tfac - end do -C -C--------- END OF BIG LOOP --------------------------------------- -C -C If after-burner required, residuals from analytic PSF are computed -C and stored in RES. -C -20 if ( burn ) then -C -C If using a fixed (X,Y) coordinate list, read it. - if (fixed) then -C Read the image frame - call getfits(1,infile,header,nhead,nfast,nslow,numf,nc,line) -C -C Initialize arrays, open files etc. - call setup ( numf,nc,screen,line,skyval,fitr,ngr,ncon, - +nfast, nslow ) -C -C Read the XY list - write(luout,'(''Reading XY list ...'')') - call xylist(numf, nc, ios ) - if(ios.ne.0) then - fixed = .false. - write(luout,'(''SXY file absent or incorrect...'')') - goto 15 - endif -C - call htype(line,skyval,.false.,fitr,ngr,ncon) -C -C Remove good stars - write(luout,'(''Cleaning frame of stars: '',i8)') nstot - call clean ( pseud2d, nstot, nfast, nslow, -1) -C -C Calculate aperture photometry -C call aper ( pseud2d, nstot, nfast, nslow ) - else - rewind(3) - rewind(4) - endif -C -C----------------------- -C Flag all stars close together in groups. Keep making the distance -C criterion FITR smaller until the maximum number in a group is less -C than NFMAX -C - fitr = amax1(arect(1),arect(2)) - fitr = fitr + 2.0 - nmax = 10000 - write(*,'(''Regrouping ...'')') -C - do while ( nmax.gt.nfmax ) - fitr = fitr - 1.0 - write(luout,'(''Min distance ='',f8.1)') fitr - call regroup( fitr, ngr, nmax ) - enddo -C - xlim = irect(1)/2 - ylim = irect(2)/2 -C -C Calculate normalized PSF residual from PSEUD2D - call getres (pseud0d,pseud2d,strint,rmn,rmx,nfast,nslow,irect, - +arect,ztot,nums) - if(nums.eq.0) then - write(luout,'(''No suitable PSF stars!'')') - goto 30 - endif -C - write(luout,'(/''AFTERBURNER tuned ON!'')') -C -C Fit multiple stars in a group with enhanced PSF using box size IRECT. - call mulfit( pseud2d,pseudmd,ngr,ncon,nfast,nslow,irect ) -C -C Re-calculate aperture photometry - call aperm ( pseudmd, nstot, nfast, nslow ) -C - call skyadj ( nstot ) -C - call title (line,skyval,.true.,fitr,ngr,ncon,strint,ztot,nums) - call output ( line ) - endif -C--------------------- -C -C----- This section skipped if PSF residual not written out ------ -C -30 if( isub ) then -C -C Write final Cleaned array. - infile = 'x'//numf(1:nc)//'.fits' - call putfits(2,infile,header,nhead,nfast,nslow) - close(2) -C -C If afterburner used, then residual array also written out. -C Find suitable scale for writing residual PSF to FITS "R" file. -C - if ( wrtres ) then - scale=20000.0/(rmx-rmn) - zero=-scale*rmn - do j=-nres,nres - jj=nres+j+1 - do i=-nres,nres - ii=nres+i+1 - big(ii,jj)=scale*res(i,j)+zero - enddo - enddo - nx=2*nres+1 -C - infile = 'r'//numf(1:nc)//'.fits' - zer=-zero/scale - scl=1.0/scale -C -C Create a FITS header for the normalized PSF residual image - call sethead(rhead,numf,nx,nx,zer,scl) - scale=1.0 - zero=0.0 -C Write the normalized PSF residual image - call putfits(2,infile,rhead,1,nx,nx) - close(2) - endif -C - end if -C -C -900 close(1) - close(3) - close(4) - if ( .not.screen ) close(luout) - if(comd) then - if(instr(5).eq.1)call system('rm shd.'//numf(1:nc)) - if(instr(6).eq.1)call system('rm out.'//numf(1:nc)) - n=1 - do while(infile(n:n).ne.' ') - n=n+1 - end do - if(instr(7).eq.1)call system('rm '//infile(1:n-1)) - end if - fixed = fixedxy - goto 1 -C -995 print 996 -996 format(/'*** Fatal error ***'/ - * 'You asked for batch processing but'/ - * 'I cant open the "dophot.bat" file.'/ - * 'Please make one (using batchdophot)'/ - * 'and restart DoPHOT'/) - go to 999 - -C -997 print 998 -998 format(/'*** Fatal error ***'/ - * 'You asked for "windowed" processing'/ - * 'but I cant open the "windows" file.'/ - * 'Please make one and restart DoPHOT'/) - -999 call exit(0) - end - -* (gdb) r -* Starting program: /home3/craig/gnu/f77-e/gcc/f771 -quiet < ../../play/19990826-4.f -O -* [...] -* Breakpoint 2, fancy_abort ( -* file=0x8285220 "../../g77-e/gcc/config/i386/i386.c", line=4399, -* function=0x82860df "output_fp_cc0_set") at ../../g77-e/gcc/rtl.c:1010 -* (gdb) up -* #1 0x8222fab in output_fp_cc0_set (insn=0x8382324) -* at ../../g77-e/gcc/config/i386/i386.c:4399 -* (gdb) p insn -* $1 = 0x3a -* (gdb) up -* #2 0x8222b81 in output_float_compare (insn=0x8382324, operands=0x82acc60) -* at ../../g77-e/gcc/config/i386/i386.c:4205 -* (gdb) p insn -* $2 = 0x8382324 -* (gdb) whatis insn -* type = rtx -* (gdb) pr -* (insn 2181 2180 2191 (parallel[ -* (set (cc0) -* (compare (reg:SF 8 %st(0)) -* (mem:SF (plus:SI (reg:SI 6 %ebp) -* (const_int -9948 [0xffffd924])) 0))) -* (clobber (reg:HI 0 %ax)) -* ] ) 29 {*cmpsf_cc_1} (insn_list 2173 (insn_list 2173 (nil))) -* (expr_list:REG_DEAD (reg:DF 8 %st(0)) -* (expr_list:REG_UNUSED (reg:HI 0 %ax) -* (nil)))) -* (gdb)