c***********************************************************                    
c* fortran program to read and write wcpoint.asc (file 17) *                    
c***********************************************************                    
      integer nlin                                                              
      integer id, slyr, trid                                                    
      real    sllong, sllat, slr, slg, slc, sls                                 
      real    trlong, trlat, travg, trmax, trlvl                                
      character slname*40, trname*50                                            
c***********************************************************                    
c* initialize a counter and open files for input/output    *                    
c***********************************************************                    
      nlin=0                                                                    
      open(unit=5,file='wcpoint.asc',readonly,status='old')                     
      open(unit=6,file='wcpoint.out',status='new')                              
c***********************************************************                    
c* read/write the point id and the 15 station variables    *                    
c***********************************************************                    
   10 read(5,100,end=999) id, sllong, sllat, slr, slg,                          
     1    slc, sls, slyr                                                        
      read(5,110) slname, trlong, trlat, travg,                                 
     1    trmax, trlvl                                                          
      read(5,120) trid, trname                                                  
                                                                                
      if (nlin.gt.32) nlin=0                                                    
      if (nlin.eq.0) write (6,130)                                              
      if (nlin.eq.0) write (6,140)                                              
      if (nlin.eq.0) write (6,150)                                              
      nlin=nlin+1                                                               
                                                                                
      write(6,105) id, sllong, sllat, slr, slg,                                 
     1     slc, sls, slyr                                                       
      write(6,115) slname, trlong, trlat, travg,                                
     1     trmax, trlvl                                                         
      write(6,125) trid, trname                                                 
                                                                                
   20 continue                                                                  
      go to 10                                                                  
  100 format (i5,6f8.2,i4)                                                      
  105 format (i5,6f8.2,i4)                                                      
  110 format (a40,5f8.2)                                                        
  115 format (a40,5f8.2)                                                        
  120 format (i4,a50)                                                           
  125 format (i4,a50)                                                           
  130 format (4x,'id',2x,'sllong',3x,'sllat',5x,'slr',                          
     1    5x,'slg',5x,'slc',5x,'sls',1x,'slyr')                                 
  140 format ('slname',36x,'trlong',3x,'trlat',3x,'travg',                      
     1    3x,'trmax',3x,'trlvl')                                                
  150 format ('trid',1x,'trname')                                               
c***********************************************************                    
c*****           close files and exit                 ******                    
c***********************************************************                    
  999 close(unit=5)                                                             
      close(unit=6)                                                             
      stop                                                                      
      end