DataMuseum.dk

top - download

    Length: 4324 (0x10e4)
    Types: TextFile
    Names: »subsh.f«

└─⟦a0efdde77⟧ Bits:30001252 EUUGD11 Tape, 1987 Spring Conference Helsinki
    └─ ⟦this⟧ »EUUGD11/euug-87hel/sec1/utep/subsh.f« 

TextFile

*****************************************************************************
*
* subroutine howmpg does the following:
*  (how many pages)
*     + inquire about how many saved pages
*       exist,save value in common variable
*       (numspg)
*
*****************************************************************************
	subroutine howmpg
	common/pnum/numspg
	common/uf/iunit(5,2),files(5,2)
	character*6 files,filnam
	logical f1
	integer ipcont
c
	ipcont=0
	do 20 i=1,5
	   filnam=files(i,1)
	   inquire(file=filnam,exist=f1)
	   if(f1)then
	             ipcont=ipcont+1
	   else
	             numspg=ipcont
	             return
	   endif
20	continue
	numspg=ipcont
	return
	end
****************************************************************************
*
* subroutine whichp(nump) does the following:
* ( which page)
*     + interactivly ask user to specify a page
*       number between one and current number
*       of saved images (numspg)
*     + valid number?
*      - yes-->
*        * return value in (nump)
*      - no-->
*        * error--incorrect value--try again
*
****************************************************************************
	subroutine whichp(nump)
	integer nump
	common/pnum/numspg
c
	do 30 i=1,4
	write(0,10)numspg
10	format(5x,'Specify image number to be >= 1 and <=',I1,/,5x,
     *            'like this ex: 2')
	read(5,20)nump
20	format(I1)
	if(nump.lt.1.or.nump.gt.numspg)then
	        call error(2)
	else
	        i=5
	endif
30	continue
	return
	end
*******************************************************************************
*
* subroutine whichf(nump,file1,file2) does the following:
* (which files)
*     + image number (nump)
*     + inquire about files names that hold image
*       number (nump)
*     + return names in (file1) and (file2)
*
*******************************************************************************
	subroutine whichf(nump,file1,file2)
	integer nump
	common/uf/iunit(5,2),files(5,2)
	character*6 files,file1,file2
c
	file1=files(nump,1)
	file2=files(nump,2)
	return
	end
******************************************************************************
*
* subroutine whichu(nump,unit1,unit2) does the following:
*  (which units)
*     + image number (nump)
*     + inquire about units names that hold image
*       number (nump)
*     + return names in (unit1) and (unit2)
*
******************************************************************************
	subroutine whichu(nump,unit1,unit2)
	integer nump,unit1,unit2
	common/uf/iunit(5,2),files(5,2)
	character*6 files
c
	unit1=iunit(nump,1)
	unit2=iunit(nump,2)
	return
	end
******************************************************************************
*
* subroutine csif(unit1,unit2) does the following:
* (close and save image files)
*   + close units (unit1) and (unit2) but save
*     its contents after excution
*
******************************************************************************
	subroutine csif(unit1,unit2)
	integer unit1,unit2
c
	close(unit=unit1,status="keep")
	close(unit=unit2,status="keep")
	return
	end
******************************************************************************
*
* subroutine oif(unit1,unit2,file1,file2)
* (open image files)
*   + open image files for access
*
******************************************************************************
	subroutine oif(unit1,unit2,file1,file2)
	integer unit1,unit2
	character*6 file1,file2
c
	open(unit=unit1,file=file1,status="old",access="sequential",
     *       form="unformatted")
	rewind(unit1)
	open(unit=unit2,file=file2,status="old",access="sequential",
     *       form="formatted")
	rewind(unit2)
	return
	end
*****************************************************************************
*
* subroutine uftabl does the following:
* (units and files table)
*   + This table contains units numbers
*     and files names
*
*****************************************************************************
	subroutine uftabl
	common/uf/iunit(5,2),files(5,2)
	character*6 files
c
	ivalue=9
	do 20 i=1,5
	  iunit(i,1)=ivalue
	  iunit(i,2)=ivalue+1
	  ivalue=ivalue+2
20	continue
c
	files(1,1)='f1.dat'
	files(1,2)='fa.dat'
	files(2,1)='f2.dat'
	files(2,2)='fb.dat'
	files(3,1)='f3.dat'
	files(3,2)='fc.dat'
	files(4,1)='f4.dat'
	files(4,2)='fd.dat'
	files(5,1)='f5.dat'
	files(5,2)='fe.dat'
	return
	end