program csplit c c splits a cray cosmos file into its constituent parts. c c this looks for any line beginning with "*file name=" and then c creates the desired file. For simplicity, this string must c be exactly "*file name=", i.e., lower case with one space. c c Greg Hammett 19-Oct-1990 c modified for Sun by Bill Dorland c subroutine strip added to make namelist palatable to Sun c character cfilename*80 character filename*80 character line*132 write(*,*) 'name of cosmos file to split?' read(*,*) cfilename 5 format(a) open(unit=20,file=cfilename,status='old') c use the 'max' function to deal with blank lines! 10 read(20,11,end=500,err=490) ilength,line(1:max(ilength,1)) 11 format(q,a) 15 if(line(1:11) .ne. '*file name=') goto 10 c start writing a new file. c the file name is terminated by a blank or a comma: ifend=min(index(line(12:ilength),' '), 1 index(line(12:ilength),','))-1 if(ifend .lt. 1) ifend=ilength+1-12 filename=line(12:12+ifend-1) write(6,*) 'writing file ',filename(1:ifend) open(unit=21,file=filename,status='new', 1 carriagecontrol='list') 20 read(20,11,end=490,err=490) ilength,line(1:max(ilength,1)) if(line(1:1) .eq. '*') goto 150 if(ilength .gt. 0) then write(21,22) line(1:ilength) 22 format(a) else write(21,23) 23 format() endif goto 20 150 close(unit=21) goto 15 490 write(6,*) 'error reading ',cfilename 500 call strip stop end integer function nchar(string) ! returns the number of characters in the string (excluding trailing blanks) implicit none character*(*) string integer i,nchar do 10 i=len(string),1,-1 if(string(i:i) .ne. ' ')then nchar=i return endif 10 continue nchar=0 return end subroutine strip character instring(80)*1 open(unit=1,status='OLD',file='itg.in',err=501) open(unit=2,status='NEW',file='itg.input') 10 read(1,100,err=30) n,(instring(j), j=1,n) 100 format (Q,80 A1) do 20 i=1,n if (instring(i).eq.'!') then write(2,101) (instring(j),j=1,i-1) goto 10 endif 20 continue write(2,101) (instring(j), j=1,n) goto 10 101 format(80 A1) 30 continue i=system("mv itg.input itg.in") 501 return end