character map*4,maps(200)*4,ans*1,dum72*72 dimension mapn(200) logical exists data line,nmaps,nb,mapn/203*0/ print 100 100 format (' CNTMAPS, Plouff. 11-94. Lists names of maps and num', 1 'ber of occurrences in',/,' a file output from MAPINDEX (not ', 2 'pairs option).') inquire (file='CNTMAPS.PNT',exist=exists) if (exists) then print 101 101 format (' A print file CNTMAPS.PNT already exists.',/,' Do ', 1 'want to STOP to save it?') read 501, ans 501 format (a1) if (ans .eq. 'y' .or. ans .eq. 'Y' .or. ans .eq. ' ') stop end if inquire (file='MAPINDEX.PNT',exist=exists) if (.not. exists) then print 102 102 format (' **STOP. Input file MAPINDEX.PNT was not found.') stop end if open (15,file='MAPINDEX.PNT',form='formatted',status='old') open (16,file='CNTMAPS.PNT',form='formatted',status='unknown') c Read assumed map name only in columns 3-6. 1 read (15,150,end=9) map,dum72 150 format (2x,a4,a72) line=line+1 c Line with name of original data file if (map .eq. 'Inpu') write (16,150) map,dum72 if (map .eq. ' MAP' .or. map .eq. 'Inpu') then nb=nb+1 go to 1 end if if (nmaps .eq. 0) then c First map name encountered nmaps=1 maps(nmaps)=map mapn(nmaps)=1 go to 1 end if do 2 j=1,nmaps if (maps(j) .eq. map) then mapn(j)=mapn(j)+1 go to 1 end if 2 continue nmaps=nmaps+1 if (nmaps .gt. 200) then print 105, line 105 format (' **STOP. The number of unique map names exceeds ', 1 '200 at line',i5,/,' Check the kind of your input file or ', 2 'subdivide it.') go to 999 end if c A new map name on this line. maps(nmaps)=map mapn(nmaps)=1 go to 1 9 print 109, nmaps,nb,line 109 format (' There are',i4,' unique map names.',/ 1 ' The input file has',i4,' lines without ', 2 'map names from a total of',i4,' lines.',/,' TYPE:',/,' sort ', 3 'CNTMAPS.PNT -o CNTMAPS.SRT',/,' if you want to create a ', 4 'file CNTMAPS.SRT that is sorted by map name.') c Have initial gap so that the two lines are not sorted down write (16,160) 160 format (6x,'File CNTMAPS.* with map names and numbers of ', 1 'data points.') do 10 j=1,nmaps 10 write (16,161) maps(j),mapn(j) 161 format (1x,a4,i4) close (16) 999 close (15) stop end