c  ******************************************************************          
c  ***  fortran code to operate on the                            ***          
c  ***                                                            ***          
c  ***                 OPEN CLUSTER ISM DATABASE                  ***          
c  ***                                                            ***          
c  ***  current version of code written 2 March 1988              ***          
c  ***                                                            ***          
c  ***  for information, contact D. Leisawitz                     ***          
c  ***                           Laboratory for Astronomy and     ***
c  ***                             Solar Physics                  ***          
c  ***                           Code 685                         ***          
c  ***                           NASA/GSFC                        ***          
c  ***                           Greenbelt, MD, USA               ***          
c  ***                           20771                            ***          
c  ***                                                            ***          
c  ***                           phone: (301) 286-2150            ***          
c  ***                                                            ***          
c  ******************************************************************          
      integer iserno(150)                                                      
      open(unit=9,file='ocdb.rec',status='old',readonly)                       
      open(unit=10,file='ocdb.ref',status='old',readonly)                      
c                                                                              
c  read the database                                                           
      write(6,2000)                                                            
 2000 format(1h0,'Database being read ...')                                    
      call dbread(ncl)                                                         
      if (ncl.ge.150) write(6,1000)                                            
 1000 format(1h1,'WARNING: DATABASE MAY CONTAIN MORE CLUSTERS ',               
     *'THAN 150.  IF SO, INCREASE DIMENSIONS.')                                
      mskd = 0              ! database currently unmasked                      
c                                                                              
c  read the reference information                                              
      write(6,2001)                                                            
 2001 format(1h0,'Reference file being read and ',                             
     *           'alphabetized ...')                                           
      call rfread                                                              
c                                                                              
c  alphabetize the array of references                                         
      call abceez                                                              
c                                                                              
      call outdev(iunit,iprint)                                                
c                                                                              
c  initialize iserno, array of cluster indices on which to operate             
c  (value of 1 => include cluster i; value of 0 => exclude cluster i)          
      do 10 i=1,150                                                            
        iserno(i)=0                                                            
   10 continue                                                                 
c                                                                              
c  menu of options to operate on database:                                     
      call menu(iunit,iprint,mskd,ncl,iserno)                                  
      stop                                                                     
      end                                                                      
                                                                               
      SUBROUTINE MENU(IUNIT,IPRINT,MSKD,NCL,ISERNO)                            
c  ******************************************************************          
c  ***  this routine displays options available to the user to    ***          
c  ***  operate on the database and enables the selection of an   ***          
c  ***  option.                                                   ***          
c  ******************************************************************          
      integer iserno(150)                                                      
      character*1 option,mskok                                                 
    5 write(6,2000)                                                            
 2000 format(1h0,'PROCESSING OPTIONS:'/                                        
     *3x,'(a) change output device and/or format'/                             
     *3x,'(b) select clusters on which to operate'/                            
     *3x,'(c) type list of selected clusters'/                                 
     *3x,'(d) print catalog of cluster information'/                           
     *3x,'(e) mask out some references'/                                       
     *3x,'(f) average unmasked data and tabulate'/                             
     *3x,'(g) restore database (necessary to change ',                         
     *'masking configuration)'/                                                
     *3x,'(h) type complete list of database references'/                      
     *3x,'(i) stop processing'/)                                               
   10 write(6,2001)                                                            
 2001 format(1h ,'Please select an option by entering the ',                   
     *'corresponding letter:')                                                 
      read(5,1000)option                                                       
 1000 format(a1)                                                               
      if (option.eq.'a'.or.option.eq.'A') then                                 
        call outdev(iunit,iprint)                                              
      elseif (option.eq.'b'.or.option.eq.'B') then                             
        call select(ncl,iserno)                                                
      elseif (option.eq.'c'.or.option.eq.'C') then                             
        call listcl(iunit,ncl,iserno)                                          
      elseif (option.eq.'d'.or.option.eq.'D') then                             
        call seltst(iok,iserno)                                                
        if (iok.eq.0) go to 5                                                  
        if (mskd.ne.0) then                                                    
          write(6,2002)                                                        
 2002     format(1h ,'WARNING: Currently the database is'                      
     *    ' masked.  Is this okay?')                                           
          read(5,1000)mskok                                                    
          if (mskok.eq.'y'.or.mskok.eq.'Y') then                               
            write(6,2003)                                                      
 2003       format(1h ,'Masked references will appear as',                     
     *                 ' "XXXXX" in printout')                                 
          else                                                                 
            write(6,2004)                                                      
 2004       format(1h ,'You may want to restore the database'                  
     *      ' (option g) then try again')                                      
            go to 5                                                            
          endif                                                                
        endif                                                                  
        call prtcat(iunit,iprint,iserno,ncl)                                   
      elseif (option.eq.'e'.or.option.eq.'E') then                             
        call seltst(iok,iserno)                                                
        if (iok.eq.0) go to 5                                                  
        if (mskd.ne.0) then                                                    
          write(6,2005)                                                        
 2005     format(1h ,'Database is already masked.  First restore'              
     *               ' it (option g).')                                        
          go to 5                                                              
        endif                                                                  
        call masker(ncl,mskd)                                                  
      elseif (option.eq.'f'.or.option.eq.'F') then                             
        call seltst(iok,iserno)                                                
        if (iok.eq.0) go to 5                                                  
        if (mskd.ne.0) then                                                    
          write(6,2002)                                                        
          read(5,1000)mskok                                                    
          if (mskok.eq.'y'.or.mskok.eq.'Y') then                               
            write(6,2006)                                                      
 2006       format(1h ,'MASKED REFERENCES WILL BE IGNORED',                    
     *                 ' IN AVERAGES')                                         
          else                                                                 
            write(6,2004)                                                      
            go to 5                                                            
          endif                                                                
        endif                                                                  
        call averag(iunit,iserno,ncl)                                          
      elseif (option.eq.'g'.or.option.eq.'G') then                             
        rewind 9                                                               
        write(6,2007)                                                          
 2007   format(1h0,'database being restored ...')                              
        call dbread(ncl)                                                       
        mskd = 0       ! flag to indicate that database is unmasked            
      elseif (option.eq.'h'.or.option.eq.'H') then                             
        call biblee(iunit)                                                     
      elseif (option.eq.'i'.or.option.eq.'I') then                             
        go to 100                                                              
      else                                                                     
        go to 10                                                               
      endif                                                                    
      go to 5                                                                  
  100 return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE SELECT(NCL,ISERNO)                                            
c  ******************************************************************          
c  ***  this routine allows the user to select a set of clusters  ***          
c  ***  on which to operate.                                      ***          
c  ******************************************************************          
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      integer iserno(150),oclno(150),sharp(150),west(150),                     
     *prio(150),obs(150),nvalus(150,17)                                        
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      character*5 espt(150,8)                                                  
      character*10 name(150),name2(150),assoc(150)                             
      character*1 selopt,selyn                                                 
c                                                                              
c  initialize to no clusters selected:                                         
      do 5 i=1,150                                                             
        iserno(i) = 0                                                          
    5 continue                                                                 
      ncnt = 0                                                                 
    6 write(6,2000)                                                            
 2000 format(1h0,'Cluster sample options:'/                                    
     *3x,'(a) all clusters in database'/                                       
     *3x,'(b) select individual clusters from list'/                           
     *3x,'(c) include clusters specified by database number'/                  
     *3x,'(d) 34 clusters mapped for CO emission by LEI88')                    
      read(5,1000)selopt                                                       
 1000 format(a1)                                                               
      if (selopt.eq.'a'.or.selopt.eq.'A') then                                 
        ncnt = ncl                                                             
        do 10 i=1,ncl                                                          
          iserno(i) = 1                                                        
   10   continue                                                               
      elseif (selopt.eq.'b'.or.selopt.eq.'B') then                             
        write(6,2001)                                                          
 2001   format(1h ,'Respond with "y" to select a cluster ',                    
     *  '("q" to quit):')                                                      
        do 20 i=1,ncl                                                          
          write(6,2002)i,oclno(i),name(i)                                      
 2002     format(1h ,i3,1x,'include OCL ',i3,' (=',a10,                        
     *    ')?')                                                                
          read(5,1000)selyn                                                    
          if (selyn.eq.'y'.or.selyn.eq.'Y') then                               
            ncnt = ncnt + 1                                                    
            iserno(i) = 1                                                      
          endif                                                                
          if (selyn.eq.'q'.or.selyn.eq.'Q') go to 21                           
   20   continue                                                               
   21 continue                                                                 
      elseif (selopt.eq.'c'.or.selopt.eq.'C') then                             
        write(6,2003)                                                          
 2003   format(1h ,'Enter list of cluster database numbers'/                   
     *  3x,'(integers; one per line; 0 (zero) on last line)')                  
   30   read(5,*)icl                                                           
        if (icl.gt.0.and.icl.le.ncl) then                                      
          ncnt = ncnt + 1                                                      
          iserno(icl) = 1                                                      
          go to 30                                                             
        endif                                                                  
      elseif (selopt.eq.'d'.or.selopt.eq.'D') then                             
        do 40 i=1,ncl                                                          
          if (obs(i).eq.1) then                                                
            ncnt = ncnt + 1                                                    
            iserno(i) = 1                                                      
          endif                                                                
   40   continue                                                               
      else                                                                     
        write(6,2004)                                                          
 2004   format(1h ,'Please select one of the available options ...')           
        go to 6                                                                
      endif                                                                    
      write(6,2005)ncnt                                                        
 2005 format(1h ,i3,' CLUSTERS HAVE BEEN SELECTED'/)                           
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE SELTST(IOK,ISERNO)                                            
c  ******************************************************************          
c  ***  this routine checks to see that a list of clusters has    ***          
c  ***  been selected on which to operate.                        ***          
c  ******************************************************************          
      integer iserno(150)                                                      
      iok = 0                 ! initialize to no clusters selected             
      do 10 i=1,150                                                            
        if (iserno(i).eq.1) then                                               
          iok = 1             ! at least one cluster has been selected         
          go to 20                                                             
        endif                                                                  
   10 continue                                                                 
   20 continue                                                                 
      if (iok.eq.0) write(6,2000)                                              
 2000 format(1h0,'No clusters selected => CANNOT PERFORM ',                    
     *'REQUESTED OPERATION')                                                   
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE LISTCL(IUNIT,NCL,ISERNO)                                      
c  ******************************************************************          
c  ***  this routine enables user to write a list of clusters     ***          
c  ***  selected.  Selected clusters are ones on which operations ***          
c  ***  are performed.                                            ***          
c  ******************************************************************          
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      integer iserno(150),oclno(150),sharp(150),west(150),                     
     *prio(150),obs(150),nvalus(150,17)                                        
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      character*5 espt(150,8)                                                  
      character*10 name(150),name2(150),assoc(150)                             
      ncnt = 0                                                                 
      write(iunit,2003)                                                        
 2003 format(1h1,'LIST OF SELECTED CLUSTERS:'/)                                
      if (iunit.ne.6) write(6,2000)                                            
      write(iunit,2000)                                                        
 2000 format(1h0,'DB#',2x,'OCL#',3x,'L II',3x,'B II',11x,'NAME',               
     *11x,'MEM OF ASSOC',2x,'S',4x,'W'/)                                       
      do 10 i=1,ncl                                                            
        if (iserno(i).eq.1) then                                               
          if (iunit.ne.6)                                                      
     *    write(6,2001)i,oclno(i),glon(i),glat(i),name(i),                     
     *    name2(i),assoc(i),sharp(i),west(i)                                   
          write(iunit,2001)i,oclno(i),glon(i),glat(i),name(i),                 
     *    name2(i),assoc(i),sharp(i),west(i)                                   
 2001     format(1h ,i3,2x,i4,2x,f6.2,1x,f6.2,2x,a10,2x,a10,                   
     *    2x,a10,2x,i3,2x,i3)                                                  
          ncnt = ncnt + 1                                                      
        endif                                                                  
   10 continue                                                                 
      if (iunit.ne.6) write(6,2002)ncnt                                        
      write(iunit,2002)ncnt                                                    
 2002 format(1h0,'... a total of ',i3,' clusters in list.'/)                   
      if (iunit.ne.6) write(6,3000)iunit                                       
 3000 format(1h0,'this list was written to unit',i3,':')                       
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE OUTDEV(IUNIT,IPRINT)                                          
c  ******************************************************************          
c  ***  this routine enables user to specify output device/unit   ***          
c  ******************************************************************          
      character*80 fname                                                       
      character*1 outfil                                                       
      write(6,2000)                                                            
 2000 format(1h ,'Would you like to save output in a file?')                   
      read(5,3000)outfil                                                       
 3000 format(a1)                                                               
      if (outfil.eq.'y') then                                                  
        call filer(fname)                                                      
        open(unit=11,file=fname,status='new')                                  
        iunit = 11                                                             
      else                                                                     
        write(6,2001)                                                          
 2001   format(1h ,'Output directed to terminal')                              
        iunit = 6                                                              
      endif                                                                    
      call prtlev(iprint)                                                      
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE PRTLEV(IPRINT)                                                
c  *****************************************************************           
c  ***  this routine enables user to select volume of printout   ***           
c  *****************************************************************           
      character*1 prcl,blank,null                                              
      data blank/' '/,null/'^@'/                                               
      write(6,2000)                                                            
 2000 format(1h0,'Select level of printed output:'/                            
     *5x,'m => minimal printout/messages'/                                     
     *5x,'r => restricted output'/                                             
     *5x,'s => standard output format (default)')                              
      read(5,1000)prcl                                                         
 1000 format(a1)                                                               
c                                                                              
c  iprint = 2 => generate standard printout of database info for included      
c                clusters                                                      
c  iprint = 1 => generate short printout of database info for included clusters
c  iprint = 0 => minimal printout and warning messages                         
      if (prcl.eq.blank.or.prcl.eq.null) iprint = 2                            
      if (prcl.eq.'m'.or.prcl.eq.'M') iprint = 0                               
      if (prcl.eq.'r'.or.prcl.eq.'R') iprint = 1                               
      if (prcl.eq.'s'.or.prcl.eq.'S') iprint = 2                               
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE DBREAD(NCL)                                                   
c  *****************************************************************           
c  ***  this routine reads information about open clusters from  ***           
c  ***  the database and counts the number of clusters for which ***           
c  ***  information is stored (ncl)                              ***           
c  *****************************************************************           
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      common/refs/vstref,vhiirf,vcoref,muref,disref,angref,ldref,              
     *ageref,sptref,mstref,mhiref,mhiirf,mcoref,mdsref,avref,                  
     *cexref,turref                                                            
      integer oclno(150),sharp(150),west(150),                                 
     *prio(150),obs(150),nvalus(150,17)                                        
c
c   IMPORTANT NOTE: IF CHANGING DIMENSIONS OF DATA ELEMENTS, ALSO CHANGE
c   DIMENSIONS OF codlst, ETC. IN ROUTINE "RFLIST"
c
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      character*5 vstref(150,14),vhiirf(150,14),vcoref(150,14),                
     *muref(150,3),disref(150,18),angref(150,8),ldref(150,7),                  
     *ageref(150,14),espt(150,8),sptref(150,8),mstref(150,6),                  
     *mhiref(150,6),mhiirf(150,6),mcoref(150,6),mdsref(150,6),                 
     *avref(150,5),cexref(150,14),turref(150,7),blank                          
      character*10 name(150),name2(150),assoc(150)                             
      data blank/'     '/                                                      
      ncl=0                                                                    
c                                                                              
c     initialize reference code arrays:                                        
      do 1 i=1,150                                                             
        do 2 j=1,14                                                             
          vstref(i,j)=blank                                                     
          vhiirf(i,j)=blank                                                     
          vcoref(i,j)=blank                                                     
          ageref(i,j)=blank                                                     
          cexref(i,j)=blank                                                     
    2   continue                                                               
        do 3 j=1,3                                                             
          muref(i,j)=blank                                                     
    3   continue                                                               
        do 4 j=1,18                                                            
          disref(i,j)=blank                                                    
    4   continue                                                               
        do 5 j=1,8                                                             
          angref(i,j)=blank                                                    
          sptref(i,j)=blank                                                     
    5   continue                                                               
        do 6 j=1,7                                                              
          ldref(i,j)=blank                                                      
          turref(i,j)=blank                                                     
    6   continue                                                               
        do 7 j=1,6                                                              
          mstref(i,j)=blank                                                     
          mhiref(i,j)=blank                                                     
          mhiirf(i,j)=blank                                                     
          mcoref(i,j)=blank                                                     
          mdsref(i,j)=blank                                                     
    7   continue                                                               
        do 8 j=1,5                                                              
          avref(i,j)=blank                                                     
    8   continue                                                               
    1 continue                                                                 
      do 10 i=1,150                                                            
c  cluster identification info:                                                
        read(9,1001)oclno(i),name(i),sharp(i),west(i),                         
     *  assoc(i),name2(i)                                                      
 1001   format(i4,1x,a10,1x,i3,2x,i3,2a10)                                     
        if (oclno(i).eq.9999) go to 20          ! 9999 => end of cluster info  
        ncl=ncl+1                                                              
c  cluster position info:                                                      
        read(9,1002)glon(i),glat(i),ra1(i),ra2(i),dec1(i),dec2(i)              
 1002   format(2f6.2,3x,f3.0,1x,f4.1,2x,f4.0,1x,f3.0)                          
c  stellar radial velocity measurements and corresponding references:          
        read(9,1003)nvalus(i,1),(vst(i,j),vstref(i,j),j=1,7)                   
        if (nvalus(i,1).gt.7)                                                  
     *        read(9,1003)idum,(vst(i,j),vstref(i,j),j=8,14)                   
 1003   format(i2,2x,7(f5.0,1x,a5,2x))                                         
c  H II region radial velocity measurements and corresponding references:      
        read(9,1003)nvalus(i,2),(vhii(i,j),vhiirf(i,j),j=1,7)                  
        if (nvalus(i,2).gt.7)                                                  
     *        read(9,1003)idum,(vhii(i,j),vhiirf(i,j),j=8,14)                  
c  molecular cloud radial velocity measurements and corresponding references:  
        read(9,1003)nvalus(i,3),(vco(i,j),vcoref(i,j),j=1,7)                   
        if (nvalus(i,3).gt.7)                                                  
     *        read(9,1003)idum,(vco(i,j),vcoref(i,j),j=8,14)                   
c  proper motion measurements and corresponding references:                    
        read(9,1006)nvalus(i,4),(mux(i,j),muy(i,j),muref(i,j),                 
     *  j=1,3)                                                                 
 1006   format(i1,2x,3(f6.3,1x,f6.3,1x,a5,2x))                                 
c  cluster distance measurements and corresponding references:                 
        read(9,1007)nvalus(i,5),(dist(i,j),disref(i,j),j=1,9)                  
        if (nvalus(i,5).gt.9)                                                  
     *        read(9,1007)idum,(dist(i,j),disref(i,j),j=10,18)                 
 1007   format(i2,2x,9(f4.2,1x,a5,1x))                                         
c  angular diameter measurements and corresponding references:                 
        read(9,1008)nvalus(i,6),(ang(i,j),angref(i,j),j=1,8)                   
 1008   format(i1,2x,8(f5.0,1x,a5,2x))                                         
c  linear diameter measurements and corresponding references:                  
        read(9,1009)nvalus(i,7),(ldiam(i,j),ldref(i,j),j=1,7)                  
 1009   format(i1,2x,7(f5.0,1x,a5,2x))                                         
c  age estimates and corresponding references:                                 
        read(9,1003)nvalus(i,8),(age(i,j),ageref(i,j),j=1,7)                   
        if (nvalus(i,8).gt.7)                                                  
     *        read(9,1003)idum,(age(i,j),ageref(i,j),j=8,14)                   
c  earliest main sequence spectral type measurements and corresponding refs:   
        read(9,1011)nvalus(i,9),(espt(i,j),sptref(i,j),j=1,8)                  
 1011   format(i1,2x,8(a5,1x,a5,2x))                                           
c  cluster stellar mass estimates and corresponding references:                
        read(9,1012)nvalus(i,10),(mst(i,j),mstref(i,j),j=1,6)                  
 1012   format(i1,2x,6(e8.2,1x,a5,2x))                                         
c  associated H I mass estimates and corresponding references:                 
        read(9,1012)nvalus(i,11),(mhi(i,j),mhiref(i,j),j=1,6)                  
c  associated H II region mass estimates and corresponding references:         
        read(9,1012)nvalus(i,12),(mhii(i,j),mhiirf(i,j),j=1,6)                 
c  associated molecular cloud mass estimates and corresponding references:     
        read(9,1012)nvalus(i,13),(mco(i,j),mcoref(i,j),j=1,6)                  
c  associated dust mass estimates and corresponding references:                
        read(9,1012)nvalus(i,14),(mdust(i,j),mdsref(i,j),j=1,6)                
c  priority (1 - 10) assigned to cluster for CO survey observations (Leisawitz)
        read(9,1017)prio(i)                                                    
 1017   format(i2)                                                             
c  flag to indicate if cluster region was included in Leisawitz CO survey of   
c  young open clusters (obs = 1 => yes; 0 => no)                               
        read(9,1018)obs(i)                                                     
 1018   format(i1)                                                             
c  visual extinction measurements and corresponding references:                
        read(9,1009)nvalus(i,15),(avis(i,j),avref(i,j),j=1,5)                  
c  B-V color excess (reddening) measurements and corresponding references:     
        read(9,1003)nvalus(i,16),(colexc(i,j),cexref(i,j),j=1,7)               
        if (nvalus(i,16).gt.7)                                                 
     *        read(9,1003)idum,(colexc(i,j),cexref(i,j),j=8,14)                
c  main sequence turnoff color (B-V) measurements and corresponding references:
        read(9,1020)nvalus(i,17),(turnof(i,j),turref(i,j),j=1,7)               
 1020   format(i1,7(1x,f5.2,1x,a5))                                            
   10 continue                                                                 
   20 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE PRTCAT(IUNIT,IPRINT,ISERNO,NCL)                               
c  **************************************************************************  
c  ***  this routine prints information about selected clusters.  The     ***  
c  ***  array iserno determines which clusters are included.  If ibib = 1 ***  
c  ***  then a short index of reference codes and the references to which ***  
c  ***  they correspond is printed on the page following the data         ***  
c  ***  printout.                                                         ***  
c  **************************************************************************  
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      common/refs/vstref,vhiirf,vcoref,muref,disref,angref,ldref,              
     *ageref,sptref,mstref,mhiref,mhiirf,mcoref,mdsref,avref,                  
     *cexref,turref                                                            
      integer iserno(150),oclno(150),sharp(150),west(150),                     
     *prio(150),obs(150),nvalus(150,17)                                        
      integer index(18),year(18)                                               
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      real ddum(18),adum(18),vdum(18)                                          
      character*5 drdum(18),ardum(18),vrdum(18)                                
      character*5 vstref(150,14),vhiirf(150,14),vcoref(150,14),                
     *muref(150,3),disref(150,18),angref(150,8),ldref(150,7),                  
     *ageref(150,14),espt(150,8),sptref(150,8),mstref(150,6),                  
     *mhiref(150,6),mhiirf(150,6),mcoref(150,6),mdsref(150,6),                 
     *avref(150,5),cexref(150,14),turref(150,7),blank                          
      character*10 name(150),name2(150),assoc(150)                             
c  the array pgrows is a map of the page layout (120 rows x 132 columns)       
      character*1 pgrows(132,120)                                              
      character*1 irfs,iterm                                                   
      data blank/'        '/                                                   
      ibib = 0              ! default is no printing of short ref list         
      if (iprint.eq.2) then                                                    
        write(6,8000)                                                          
 8000   format(1h0,'Would you like a matched directory of ',                   
     *      'reference codes'/                                                 
     *      3x,'printed with data for each cluster?')                          
        read(5,9000)irfs                                                       
 9000   format(a1)                                                             
        if (irfs.eq.'y'.or.irfs.eq.'Y') ibib = 1                               
      endif                                                                    
      if (iunit.ne.6) then                                                     
        write(6,8001)iunit                                                     
 8001   format(1h0,'Catalog being written to unit',i3,' ...')                  
        if (iprint.eq.2) write(6,8003)                                         
 8003   format(1h ,2x,'(this may take a few minutes)')                         
      elseif (iprint.ne.0) then                                                
        write(6,8002)                                                          
 8002   format(1h ,'Output may appear messy on terminal.'/                     
     *  ' If you would prefer to save in file, enter "f"'/                     
     *  ' and select option (a) in menu.  (<CR> to continue).')                
        read(5,9000)iterm                                                      
        if (iterm.eq.'f'.or.iterm.eq.'F') go to 999                            
      endif                                                                    
 1001 format(1h )                                                              
 1002 format(1h0)                                                              
 1060 format(1h1)                                                              
 1100 format('    NO VALUES AVAILABLE')                                        
      if (iprint.lt.2) go to 600                                               
c                                                                              
c  loop for next cluster:                                                      
      do 10 i=1,ncl                                                            
        ipg=iserno(i)                                                          
        if (ipg.eq.0) go to 10  ! skip to next cluster if this one not included
        write(6,1900)name(i)                                                   
 1900   format(1h ,'formatting/writing page(s) for ',a10)                     
        nrow = 0                                                               
c                                                                              
c  initialize page to all blank:                                               
        do 1 irow=1,120                                                        
          encode(132,1111,pgrows(1,irow))                                      
 1111     format(132(' '))                                                     
    1   continue                                                               
c  cluster identification info:                                                
        nrow = nrow + 1                                                        
        encode(132,2000,pgrows(1,nrow))                                        
 2000   format('CLUSTER IDENTIFICATION:')                                      
        nrow = nrow + 1                                                        
        if (oclno(i).ne.0) then                                                
          nrow = nrow + 1                                                      
          encode(132,2010,pgrows(1,nrow))oclno(i)                              
 2010     format(1x,'ALTER et al.:',t20,'OCL',i4)                              
        endif                                                                  
        nrow = nrow + 1                                                        
        encode(132,2011,pgrows(1,nrow))name(i)                                 
        if (name2(i).ne.blank) then                                            
          nrow = nrow + 1                                                      
          encode(132,2911,pgrows(1,nrow))name2(i)                              
        endif                                                                  
 2011   format(1x,'COMMON NAME:',T20,A10)                                      
 2911   format(1X,'ALTERNATE NAME:',t20,a10)                                   
        if (sharp(i).ne.0) then                                                
          nrow = nrow + 1                                                      
          encode(132,2012,pgrows(1,nrow))sharp(i)                              
 2012     format(1x,'SHARPLESS:',t20,'S',i3)                                   
        endif                                                                  
        if (west(i).ne.0) then                                                 
          nrow = nrow + 1                                                      
          encode(132,2013,pgrows(1,nrow))west(i)                               
 2013     format(1x,'WESTERHOUT:',t20,'W',i3)                                  
        endif                                                                  
        if (assoc(i).ne.blank) then                                            
          nrow = nrow + 1                                                      
          encode(132,2014,pgrows(1,nrow))assoc(i)                              
 2014     format(1x,'MEMBER OF ASSOC.:',t20,a10)                               
        endif                                                                  
        nrow = nrow + 1                                                        
        encode(132,2015,pgrows(1,nrow))i                                       
 2015   format(1x,'DATA BASE NUM:',t20,i3)                                     
        nrow = nrow + 3                                                        
        ntopr = nrow                                                           
c  radial velocity info:                                                       
        encode(60,2050,pgrows(1,nrow))                                         
 2050   format('RADIAL VELOCITIES (w.r.t. LSR; km/s):')                        
        nrow = nrow + 1                                                        
        encode(132,2060,pgrows(1,nrow))                                        
 2060   format(2x,'STELLAR:')                                                  
        nrow = nrow + 1                                                        
        if (nvalus(i,1).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(132,2070,pgrows(1,nrow))                                      
 2070     format(4x,'VELOCITY',3X,'REF.')                                      
          jmx=nvalus(i,1)                                                      
c   arrange data in chronological order of citations:                          
          do 19 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(vstref(i,j),year(j))                                    
   19     continue                                                             
          call decr(jmx,year,index)                                            
          do 20 j=1,jmx                                                        
            do 21 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(132,2080,pgrows(1,nrow))vst(i,k),vstref(i,k)            
 2080           format(5x,f6.1,4x,a5)                                          
              endif                                                            
   21       continue                                                           
   20     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(132,1100,pgrows(1,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(132,2090,pgrows(1,nrow))                                        
 2090   format(2x,'H II REGION:')                                              
        nrow = nrow + 1                                                        
        if (nvalus(i,2).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(132,2070,pgrows(1,nrow))                                      
          jmx=nvalus(i,2)                                                      
c   arrange data in chronological order of citations:                          
          do 29 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(vhiirf(i,j),year(j))                                    
   29     continue                                                             
          call decr(jmx,year,index)                                            
          do 30 j=1,jmx                                                        
            do 31 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(132,2080,pgrows(1,nrow))vhii(i,k),vhiirf(i,k)           
              endif
   31       continue
   30     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(132,1100,pgrows(1,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(132,2100,pgrows(1,nrow))                                        
 2100   format(2x,'CO CLOUDS:')                                                
        nrow = nrow + 1                                                        
        if (nvalus(i,3).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(132,2070,pgrows(1,nrow))                                      
          jmx=nvalus(i,3)                                                      
c   arrange data in chronological order of citations:                          
          do 39 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(vcoref(i,j),year(j))                                    
   39     continue                                                             
          call decr(jmx,year,index)                                            
          do 40 j=1,jmx                                                        
            do 41 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(132,2080,pgrows(1,nrow))vco(i,k),vcoref(i,k)            
              endif                                                            
   41       continue                                                           
   40     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(132,1100,pgrows(1,nrow))                                      
        endif                                                                  
c  proper motion info:                                                         
        nrow = nrow + 3                                                        
        encode(132,2110,pgrows(1,nrow))                                        
 2110   format('PROPER MOTION (arcsec/100 yr):')                               
        nrow = nrow + 1                                                        
        if (nvalus(i,4).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(132,2120,pgrows(1,nrow))                                      
 2120     format(3x,'MU X',5x,'MU Y',5x,'REF.')                                
          jmx=nvalus(i,4)                                                      
c   arrange data in chronological order of citations:                          
          do 49 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(muref(i,j),year(j))                                    
   49     continue                                                             
          call decr(jmx,year,index)                                            
          do 50 j=1,jmx                                                        
            do 51 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(132,2130,pgrows(1,nrow))mux(i,k),muy(i,k),              
     *                          muref(i,k)                                     
 2130           format(2x,f6.3,3x,f6.3,3x,a5)                                  
              endif                                                            
   51       continue                                                           
   50     continue                                                             
        else                                                                   
c  cluster distance info:                                                      
          nrow = nrow + 1                                                      
          encode(132,1100,pgrows(1,nrow))                                      
        endif                                                                  
        nrow = nrow + 3                                                        
        encode(132,2140,pgrows(1,nrow))                                        
 2140   format('DISTANCE FROM SOLAR NEIGHBORHOOD (kpc):')                      
        nrow = nrow + 1                                                        
        if (nvalus(i,5).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(132,2150,pgrows(1,nrow))                                      
 2150     format(2x,'DIST',5x,'REF.')                                          
          jmx=nvalus(i,5)                                                      
c   arrange data in chronological order of citations:                          
          do 59 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(disref(i,j),year(j))                                    
   59     continue                                                             
          call decr(jmx,year,index)                                            
          do 60 j=1,jmx                                                        
            do 61 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(132,2160,pgrows(1,nrow))dist(i,k),disref(i,k)           
 2160           format(2x,f4.2,5x,a5)                                          
              endif                                                            
   61       continue                                                           
   60     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(132, 1100,pgrows(1,nrow))                                     
        endif                                                                  
        nbotr = nrow        ! store bottom row number                          
c  begin new column on page
        nrow = 1
c  cluster position info:                                                      
        encode(77,2020,pgrows(55,nrow))                                        
 2020   format('SPATIAL COORDINATES:')                                         
        nrow = nrow + 2                                                        
        encode(77,2030,pgrows(55,nrow))glon(i),ra1(i),ra2(i)                   
 2030   format(2x,'L II:',t10,f6.2,t25,'RA(1950.0):',t40,                      
     *  f3.0,1x,f4.1)                                                          
        nrow = nrow + 1                                                        
        encode(77,2040,pgrows(55,nrow))glat(i),dec1(i),dec2(i)                 
 2040   format(2x,'B II:',t10,f6.2,t25,'DEC(1950.0):',t40,                     
     *  f4.0,1x,f3.0)                                                          
        nrow = ntopr        ! skip to top data line                            
c  angular diameter info:                                                      
        encode(82,2170,pgrows(50,nrow))                                        
 2170   format('ANGULAR DIAMETER (arcmin):')                                   
        if (nvalus(i,6).ne.0) then                                             
          nrow = nrow + 2                                                      
          encode(80,2180,pgrows(52,nrow))                                      
 2180     format('ANG D',4x,'REF.')                                            
          jmx=nvalus(i,6)                                                      
c   arrange data in chronological order of citations:                          
          do 69 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(angref(i,j),year(j))                                    
   69     continue                                                             
          call decr(jmx,year,index)                                            
          do 70 j=1,jmx                                                        
            do 71 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(80,2190,pgrows(52,nrow))ang(i,k),angref(i,k)            
 2190           format(f5.1,4x,a5)                                             
              endif                                                            
   71       continue                                                           
   70     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(82,1100,pgrows(50,nrow))                                      
        endif                                                                  
c  linear diameter info:                                                       
        nrow = nrow + 3                                                        
        encode(82,2200,pgrows(50,nrow))                                        
 2200   format('LINEAR DIAMETER (pc):')                                        
        nrow = nrow + 1                                                        
        if (nvalus(i,7).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(80,2210,pgrows(52,nrow))                                      
 2210     format('LIN D',4x,'REF.')                                            
          jmx=nvalus(i,7)                                                      
c   arrange data in chronological order of citations:                          
          do 79 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(ldref(i,j),year(j))                                    
   79     continue                                                             
          call decr(jmx,year,index)                                            
          do 80 j=1,jmx                                                        
            do 81 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(80,2190,pgrows(52,nrow))ldiam(i,k),ldref(i,k)           
              endif                                                            
   81       continue                                                           
   80     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(82,1100,pgrows(50,nrow))                                      
        endif                                                                  
c  cluster age estimates:                                                      
        nrow = nrow + 3                                                        
        encode(82,2220,pgrows(50,nrow))                                        
 2220   format('AGE ESTIMATES:')                                               
        nrow = nrow + 1                                                        
        encode(80,2230,pgrows(52,nrow))                                        
 2230   format('AGE (Myr):')                                                   
        nrow = nrow + 1                                                        
        if (nvalus(i,8).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(78,2240,pgrows(54,nrow))                                      
 2240     format('AGE',5x,'REF.')                                              
          jmx=nvalus(i,8)                                                      
c   arrange data in chronological order of citations:                          
          do 89 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(ageref(i,j),year(j))                                    
   89     continue                                                             
          call decr(jmx,year,index)                                            
          do 90 j=1,jmx                                                        
            do 91 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(79,2250,pgrows(53,nrow))age(i,k),ageref(i,k)            
 2250           format(f5.0,4x,a5)                                             
              endif                                                            
   91       continue                                                           
   90     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(82,1100,pgrows(50,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(80,2260,pgrows(52,nrow))                                        
 2260   format('EARLIEST MS SPECTRAL TYPE:')                                   
        nrow = nrow + 1                                                        
        if (nvalus(i,9).ne.0) then                                             
          nrow = nrow + 1                                                      
          encode(77,2270,pgrows(55,nrow))                                      
 2270     format('eSpT',4X,'REF.')                                             
          jmx=nvalus(i,9)                                                      
c   arrange data in chronological order of citations:                          
          do 99 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(sptref(i,j),year(j))                                    
   99     continue                                                             
          call decr(jmx,year,index)                                            
          do 100 j=1,jmx                                                       
            do 101 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(77,2280,pgrows(55,nrow))espt(i,k),sptref(i,k)           
 2280           format(a5,3x,a5)                                               
              endif                                                            
  101       continue                                                           
  100     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(82,1100,pgrows(50,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(80,2265,pgrows(52,nrow))                                        
 2265   format('MS TURNOFF COLOR:')                                            
        nrow = nrow + 1                                                        
        if (nvalus(i,17).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(77,2275,pgrows(55,nrow))                                      
 2275     format('(B-V)',3x,'REF.')                                            
          jmx=nvalus(i,17)                                                     
c   arrange data in chronological order of citations:                          
          do 104 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(turref(i,j),year(j))                                    
  104     continue                                                             
          call decr(jmx,year,index)                                            
          do 105 j=1,jmx                                                       
            do 106 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(77,2285,pgrows(55,nrow))turnof(i,k),turref(i,k)         
 2285           format(f5.2,3x,a5)                                             
              endif                                                            
  106       continue                                                           
  105     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(82,1100,pgrows(50,nrow))                                      
        endif                                                                  
        if (nrow.gt.nbotr) nbotr = nrow                                        
c  begin new column on page
        nrow = ntopr                                                           
c  info about masses:                                                          
        encode(47,2290,pgrows(85,nrow))                                        
 2290   format('MASSES (SOLAR MASS UNITS):')                                   
        nrow = nrow + 1                                                        
        encode(45,2300,pgrows(87,nrow))                                        
 2300   format('STELLAR MASS:')                                                
        nrow = nrow + 1                                                        
        if (nvalus(i,10).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(41,2310,pgrows(91,nrow))                                      
 2310     format('MASS',5X,'REF.')                                             
          jmx=nvalus(i,10)                                                     
c   arrange data in chronological order of citations:                          
          do 109 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(mstref(i,j),year(j))                                    
  109     continue                                                             
          call decr(jmx,year,index)                                            
          do 110 j=1,jmx                                                       
            do 111 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(43,2320,pgrows(89,nrow))mst(i,k),mstref(i,k)            
 2320           format(1pe8.2,3x,a5)                                           
              endif                                                            
  111       continue                                                           
  110     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(45,2330,pgrows(87,nrow))                                        
 2330   format('MASS IN ASSOCIATED H I CLOUDS:')                               
        nrow = nrow + 1                                                        
        if (nvalus(i,11).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(41,2310,pgrows(91,nrow))                                      
          jmx=nvalus(i,11)                                                     
c   arrange data in chronological order of citations:                          
          do 119 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(mhiref(i,j),year(j))                                    
  119     continue                                                             
          call decr(jmx,year,index)                                            
          do 120 j=1,jmx                                                       
            do 121 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(43,2320,pgrows(89,nrow))mhi(i,k),mhiref(i,k)            
              endif                                                            
  121       continue                                                           
  120     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(45,2340,pgrows(87,nrow))                                        
 2340   format('IONIZED HYDROGEN MASS:')                                       
        nrow = nrow + 1                                                        
        if (nvalus(i,12).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(41,2310,pgrows(91,nrow))                                      
          jmx=nvalus(i,12)                                                     
c   arrange data in chronological order of citations:                          
          do 129 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(mhiirf(i,j),year(j))                                    
  129     continue                                                             
          call decr(jmx,year,index)                                            
          do 130 j=1,jmx                                                       
            do 131 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(43,2320,pgrows(89,nrow))mhii(i,k),mhiirf(i,k)           
              endif                                                            
  131       continue                                                           
  130     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(45,2350,pgrows(87,nrow))                                        
 2350   format('MASS IN ASSOCIATED MOLECULAR CLOUDS:')                         
        nrow = nrow + 1                                                        
        if (nvalus(i,13).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(41,2310,pgrows(91,nrow))                                      
          jmx=nvalus(i,13)                                                     
c   arrange data in chronological order of citations:                          
          do 139 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(mcoref(i,j),year(j))                                    
  139     continue                                                             
          call decr(jmx,year,index)                                            
          do 140 j=1,jmx                                                       
            do 141 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(43,2320,pgrows(89,nrow))mco(i,k),mcoref(i,k)            
              endif                                                            
  141       continue                                                           
  140     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        nrow = nrow + 2                                                        
        encode(45,2360,pgrows(87,nrow))                                        
 2360   format('ASSOCIATED MASS IN THE FORM OF DUST:')                         
        nrow = nrow + 1                                                        
        if (nvalus(i,14).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(41,2310,pgrows(91,nrow))                                      
          jmx=nvalus(i,14)                                                     
c   arrange data in chronological order of citations:                          
          do 149 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(mdsref(i,j),year(j))                                    
  149     continue                                                             
          call decr(jmx,year,index)                                            
          do 150 j=1,jmx                                                       
            do 151 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(43,2320,pgrows(89,nrow))mdust(i,k),mdsref(i,k)          
              endif                                                            
  151       continue                                                           
  150     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
c  visual extinction and reddening info:                                       
        nrow = nrow + 3                                                        
        encode(47,2370,pgrows(85,nrow))                                        
 2370   format('VISUAL EXTINCTION TOWARD CLUSTER (mag):')                      
        nrow = nrow + 1                                                        
        if (nvalus(i,15).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(44,2380,pgrows(88,nrow))                                      
 2380     format('AV',6x,'REF.')                                               
          jmx=nvalus(i,15)                                                     
c   arrange data in chronological order of citations:                          
          do 159 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(avref(i,j),year(j))                                    
  159     continue                                                             
          call decr(jmx,year,index)                                            
          do 160 j=1,jmx                                                       
            do 161 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(45,2390,pgrows(87,nrow))avis(i,k),avref(i,k)            
 2390           format(f5.2,4x,a5)                                             
              endif                                                            
  161       continue                                                           
  160     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        nrow = nrow + 3                                                        
        encode(47,2400,pgrows(85,nrow))                                        
 2400   format('B-V COLOR EXCESS (mag):')                                      
        nrow = nrow + 1                                                        
        if (nvalus(i,16).ne.0) then                                            
          nrow = nrow + 1                                                      
          encode(45,2410,pgrows(87,nrow))                                      
 2410     format('E(B-V)',3x,'REF.')                                           
          jmx=nvalus(i,16)                                                     
c   arrange data in chronological order of citations:                          
          do 169 j=1,jmx                                                        
            index(j)=jmx                                                       
            call refyr(cexref(i,j),year(j))                                    
  169     continue                                                             
          call decr(jmx,year,index)                                            
          do 170 j=1,jmx                                                       
            do 171 k=1,jmx                                                      
              if (index(k).eq.j) then                                          
                nrow = nrow + 1                                                
                encode(45,2390,pgrows(87,nrow))colexc(i,k),cexref(i,k)         
              endif                                                            
  171       continue
  170     continue                                                             
        else                                                                   
          nrow = nrow + 1                                                      
          encode(47,1100,pgrows(85,nrow))                                      
        endif                                                                  
        if (nrow.gt.nbotr) nbotr = nrow                                        
C        write(6,1002)                                                         
C        if (obs(i).ne.0) then                                                 
C          write(6,2430)                                                       
C 2430     format(1h0,'THIS REGION WAS MAPPED FOR CO EMISSION WITH',           
C       *  ' THE GODDARD-COLUMBIA TELESCOPE.')                                 
C        else                                                                  
C          write(6,2440)                                                       
C 2440     format(1h0,'THIS REGION WAS NOT INCLUDED IN THE GODDARD-',          
C       *  'COLUMBIA SURVEY.')                                                 
C        endif                                                                 
c                                                                              
c  print the page(s):                                                          
        do 500 irows = 1,120                                                   
          if (irows.gt.nbotr) go to 501                                        
          if (irows.eq.(ntopr-1)) write(iunit,1070)                             
 1070     format(1h ,124('_'))                                                 
          if (irows.eq.1.or.irows.eq.60) then                                   
            write(iunit,5001)(pgrows(jc,irows),jc=1,132)                       
 5001       format(1h1,132a1)                                                  
          else                                                                 
            write(iunit,5000)(pgrows(jc,irows),jc=1,132)                       
 5000       format(1h ,132a1)                                                  
          endif                                                                
  500   continue                                                               
  501   continue                                                               
c                                                                              
c  print cited references for cluster i if ibib = 1                            
        if (ibib.eq.1) then                                                    
          if (nbotr.lt.60) then                                                
            write(iunit,1060)                                                  
          else                                                                 
            write(iunit,1001)                                                  
            write(iunit,1002)                                                  
          endif                                                                
          call rflist(iunit,i)                                                 
        endif                                                                  
   10 continue                                                                 
      go to 999                                                                
  600 continue           ! continue here if abbreviated printout               
      write(iunit,6000)                                                        
 6000 format(1h1)                                                              
      if (iprint.gt.0) go to 700                                               
      write(iunit,6001)                                                        
 6001 format(1h ,'CLUSTER IDENTIFICATION:',7x,                                 
     *           'SPATIAL COORDINATES:'/)                                      
      do 610 i=1,ncl                                                           
        ipg = iserno(i)                                                        
        if (ipg.eq.0) go to 610  ! skip to next cluster                        
        write(iunit,6002)oclno(i),glon(i),ra1(i),ra2(i)                        
 6002   format(1h ,1x,'ALTER et al.:',t20,'OCL',i4,t32,                        
     *  'L II:',t40,f6.2,t55,'RA(1950.0):',t70,f3.0,1x,f4.1)                   
        write(iunit,6003)name(i),glat(i),dec1(i),dec2(i)                       
 6003   format(1h ,1x,'COMMON NAME:',t20,a10,t32,                              
     *  'B II:',t40,f6.2,t55,'DEC(1950.0):',t70,f4.0,1x,f3.0)                  
        write(iunit,6004)                                                      
 6004   format(1h )                                                            
  610 continue                                                                 
      go to 999                                                                
  700 continue     ! continue here if modest output                            
      do 710 i=1,ncl                                                           
        ipg = iserno(i)                                                        
        if (ipg.eq.0) go to 710  ! skip to next cluster                        
        write(iunit,6001)                                                      
        write(iunit,6002)oclno(i),glon(i),ra1(i),ra2(i)                        
        write(iunit,6003)name(i),glat(i),dec1(i),dec2(i)                       
        write(iunit,7001)                                                      
 7001   format(1h0,'STELLAR RV (km/s):',t50,                                   
     *  'DISTANCE FROM SOLAR NEIGHBORHOOD (kpc):',t105,                        
     *  'CLUSTER AGE (Myr):'/)                                                 
        write(iunit,7002)                                                      
 7002 format(1h ,4x,'VELOCITY',3x,'REF.',t50,                                  
     *  2x,'DIST',5x,'REF.',t105,                                              
     *  4x,'AGE',5x,'REF.')                                                    
        mxv = nvalus(i,1)                                                      
        do 701 j=1,mxv                                                         
          index(j)=mxv                                                         
          call refyr(vstref(i,j),year(j))                                      
  701   continue                                                               
        call decr(mxv,year,index)                                              
        ix = 0                                                                 
        do 711 j=1,mxv                                                         
          do 721 k=1,mxv                                                       
            if (index(k).eq.j) then                                            
              ix = ix + 1                                                      
              vdum(ix) = vst(i,k)                                              
              vrdum(ix) = vstref(i,k)                                          
            endif                                                              
  721     continue                                                             
  711   continue                                                               
        mxd = nvalus(i,5)                                                      
        do 702 j=1,mxd                                                         
          index(j)=mxd                                                         
          call refyr(disref(i,j),year(j))                                      
  702   continue                                                               
        call decr(mxd,year,index)                                              
        ix = 0                                                                 
        do 712 j=1,mxd                                                         
          do 722 k=1,mxd                                                       
            if (index(k).eq.j) then                                            
              ix = ix + 1                                                      
              ddum(ix) = dist(i,k)                                              
              drdum(ix) = disref(i,k)                                          
            endif                                                              
  722     continue                                                             
  712   continue                                                               
        mxa = nvalus(i,8)                                                      
        do 703 j=1,mxa                                                         
          index(j)=mxa                                                         
          call refyr(ageref(i,j),year(j))                                      
  703   continue                                                               
        call decr(mxa,year,index)                                              
        ix = 0                                                                 
        do 713 j=1,mxa                                                         
          do 723 k=1,mxa                                                       
            if (index(k).eq.j) then                                            
              ix = ix + 1                                                      
              adum(ix) = age(i,k)                                              
              ardum(ix) = ageref(i,k)                                          
            endif                                                              
  723     continue                                                             
  713   continue                                                               
        do 720 j=1,18                                                           
          if (j.le.mxv) then                                                   
            if (j.le.mxd) then                                                 
              if (j.le.mxa) then                                               
                write(iunit,7003)vdum(j),vrdum(j),                             
     *          ddum(j),drdum(j),adum(j),ardum(j)                              
 7003           format(1h ,5x,f6.1,4x,a5,t50,                                  
     *          2x,f4.2,5x,a5,t105,3x,f5.0,4x,a5)                              
              else                                                             
                write(iunit,7003)vdum(j),vrdum(j),                             
     *          ddum(j),drdum(j)                                               
              endif                                                            
            else                                                               
              if (j.le.mxa) then                                               
                write(iunit,7004)vdum(j),vrdum(j),                             
     *          adum(j),ardum(j)                                               
 7004           format(1h ,5x,f6.1,4x,a5,                                      
     *          t105,3x,f5.0,4x,a5)                                            
              else                                                             
                write(iunit,7003)vdum(j),vrdum(j)                              
              endif                                                            
            endif                                                              
          else                                                                 
            if (j.le.mxd) then                                                 
              if (j.le.mxa) then                                               
                write(iunit,7005)                                              
     *          ddum(j),drdum(j),adum(j),ardum(j)                         
 7005           format(1h ,t50,                                                
     *          2x,f4.2,5x,a5,t105,3x,f5.0,4x,a5)                              
              else                                                             
                write(iunit,7005)ddum(j),drdum(j)                              
              endif                                                            
            else                                                               
              if (j.le.mxa) then                                               
                write(iunit,7006)adum(j),ardum(j)                              
 7006           format(1h ,t105,3x,f5.0,4x,a5)                                 
                write(iunit,7003)vdum(j),vrdum(j)                              
              endif                                                            
            endif                                                              
          endif                                                                
  720   continue                                                               
      write(iunit,1002)                                                        
      write(iunit,1070)                                                        
      write(iunit,1001)                                                        
  710 continue                                                                 
  999 return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE RFREAD                                                        
c  ******************************************************************          
c  ***  this routine reads from the database file the references  ***          
c  ***  and their corresponding codes.                            ***          
c  ******************************************************************          
      common/bibli/refcod,rfrnce,nrefs                                         
      character*1 refcod(500,5),rfrnce(500,116),a(64),b(64),blank              
      data blank/' '/                                                          
c                                                                              
c  initialize reference character array                                        
      do 5 i=1,500                                                             
        do 6 j=1,116                                                           
          rfrnce(i,j)=blank                                                    
    6   continue                                                               
    5 continue                                                                 
      nr=1                                                                     
c                                                                              
c  read first reference line                                                   
   10 read(10,1000)(a(j),j=1,64)                                               
   11 if (a(1).eq.blank) go to 100                                             
c                                                                              
c  read second reference line                                                  
      read(10,1000)(b(j),j=1,64)                                               
 1000 format(64a1)                                                             
c                                                                              
c  is second line a continuation of first? (icont=0 means no)                  
      icont=1                                                                  
      do 15 j=1,5                                                              
c  refcod is the code that refers to the reference stored in rfrnce            
        refcod(nr,j)=a(j)                                                      
        if (a(j).eq.b(j)) go to 15                                             
        icont=0                                                                
   15 continue                                                                 
c                                                                              
c  store reference information in rfrnce array                                 
      do 20 j=1,58                                                             
        k=j+6                                                                  
        rfrnce(nr,j)=a(k)                                                      
   20 continue                                                                 
      if (icont.ne.0) go to 25                                                 
c                                                                              
c  if ref info is not on two lines, return to read next line                   
      do 30 j=1,64                                                             
        a(j)=b(j)                                                              
   30 continue                                                                 
      nr=nr+1                                                                  
      go to 11                                                                 
   25 continue                                                                 
c                                                                              
c  if ref info is on two lines, store second half of ref info in rfrnce array  
      do 35 j=59,116                                                           
        k=j-52                                                                 
        rfrnce(nr,j)=b(k)                                                      
   35 continue                                                                 
      nr=nr+1                                                                  
c                                                                              
c  return to read next reference                                               
      go to 10                                                                 
  100 continue                                                                 
c  nrefs is the number of references stored in the array rfrnce                
      nrefs=nr-1                                                               
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE BIBLEE(IUNIT)                                                 
c  ********************************************************************        
c  ***  this routine prints the complete reference list as stored   ***        
c  ***  in the array rfrnce.  If the routine ABCEEZ is called       ***        
c  ***  before this routine is called, the references will be in    ***        
c  ***  alphabetical order.                                         ***        
c  ********************************************************************        
      common/bibli/refcod,rfrnce,nrefs                                         
      character*1 refcod(500,5),rfrnce(500,116)                                
      character*5 notrf1,notrf2,notrf3                                         
      character*1 nt1(5),nt2(5),nt3(5)                                         
      equivalence (nt1(1),notrf1),(nt2(1),notrf2),(nt3(1),notrf3)              
      data notrf1/'?????'/,notrf2/'LDCAL'/,notrf3/'VCIRC'/                    
      if (iunit.ne.6) write(6,2000)iunit                                       
 2000 format(1h0,'Reference list being written on unit',i3)                    
      write(iunit,1000)                                                        
 1000 format(1h1,45x,'REFERENCES'/)                                            
      do 10 i=1,nrefs                                                          
c  test to see if this is a "real" reference:                                  
        do 21 k1=1,5                                                           
          if (refcod(i,k1).ne.nt1(k1)) go to 31                                
   21   continue                                                               
        go to 10               ! "i" is not a real reference                   
   31   continue                                                               
        do 22 k2=1,5                                                           
          if (refcod(i,k2).ne.nt2(k2)) go to 32                                
   22   continue                                                               
        go to 10               ! "i" is not a real reference                   
   32   continue                                                               
        do 23 k3=1,5                                                           
          if (refcod(i,k3).ne.nt3(k3)) go to 33                                
   23   continue                                                               
        go to 10               ! "i" is not a real reference                   
   33   continue                                                               
        write(iunit,1100)                                                      
 1100   format(1h )                                                            
        write(iunit,1200)(refcod(i,j),j=1,5),(rfrnce(i,k),k=1,116)             
 1200   format(1h ,3x,5a1,2x,116a1)                                            
   10 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE ABCEEZ                                                        
c  *******************************************************************         
c  ***  this routine alphabetizes references by sorting the array  ***         
c  ***  rfrnce and the corresponding array of reference codes,     ***         
c  ***  refcod.                                                    ***         
c  *******************************************************************         
      common/bibli/refcod,rfrnce,nrefs                                         
      character*1 refcod(500,5),rfrnce(500,116),comma,dot,                     
     * blank,rtemp(116),ctemp(5),press(16,500)                                 
      character*4 refnam(4,500),temp(4)                                        
      logical swt                                                              
      data comma/','/,dot/'.'/,blank/' '/                                      
      equivalence(press(1,1),refnam(1,1))                                      
c                                                                              
c  compress alphabetization names (1st author, 2nd author, etc.) by            
c  stripping out blanks, periods, and commas and storing the first 16          
c  alphanumeric characters                                                     
      do 10 i=1,nrefs                                                          
        nchr=0                                                                 
        do 20 j=1,116                                                          
          if (rfrnce(i,j).eq.blank) go to 20                                   
          if (rfrnce(i,j).eq.dot) go to 20                                     
          if (rfrnce(i,j).eq.comma) go to 20                                   
          nchr=nchr+1                                                          
          press(nchr,i)=rfrnce(i,j)                                            
c  change all lower case letters in sorting array to upper case letters        
          call upcase(press(nchr,i))                                           
          if (nchr.eq.16) go to 10                                             
   20   continue                                                               
   10 continue                                                                 
c                                                                              
c  sort the reference arrays according to the values in the corresponding      
c  sorting array, refnam                                                       
      nmax = nrefs-1                                                           
      n=nmax                                                                   
      do 30 i=1,nmax                                                           
        swt=.false.                                                            
        do 40 j=1,n                                                            
          jp1 = j+1                                                            
c  Note: the sorting is done by comparing up to four 4-byte words.  This       
c        is an artifact of the transformation of this code from an earlier     
c        version in which refnam was declared as an integer.                   
          if (refnam(1,j).lt.refnam(1,jp1)) go to 40                           
          if (refnam(1,j).eq.refnam(1,jp1).and.                                
     *        refnam(2,j).lt.refnam(2,jp1)) go to 40                           
          if (refnam(1,j).eq.refnam(1,jp1).and.                                
     *        refnam(2,j).eq.refnam(2,jp1).and.                                
     *        refnam(3,j).lt.refnam(3,jp1)) go to 40                           
          if (refnam(1,j).eq.refnam(1,jp1).and.                                
     *        refnam(2,j).eq.refnam(2,jp1).and.                                
     *        refnam(3,j).eq.refnam(3,jp1).and.                                
     *        refnam(4,j).le.refnam(4,jp1)) go to 40                           
c  continue here if swapping is required to sort (otherwise, go to 40)         
          do 44 k=1,4                                                          
            temp(k)=refnam(k,j)                                                
            refnam(k,j)=refnam(k,jp1)                                          
            refnam(k,jp1)=temp(k)                                              
   44     continue                                                             
          do 45 k=1,116                                                        
            rtemp(k)=rfrnce(j,k)                                               
            rfrnce(j,k)=rfrnce(jp1,k)                                          
            rfrnce(jp1,k)=rtemp(k)                                             
   45     continue                                                             
          do 46 k=1,5                                                          
            ctemp(k)=refcod(j,k)                                               
            refcod(j,k)=refcod(jp1,k)                                          
            refcod(jp1,k)=ctemp(k)                                             
   46     continue                                                             
          swt=.true.                                                           
   40   continue                                                               
        if (.not.swt) go to 50                                                 
        n=n-1                                                                  
   30 continue                                                                 
   50 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE RFLIST(IUNIT,ICL)                                             
c  ********************************************************************        
c  ***  this routine produces a cross-index of references and cor-  ***        
c  ***  responding reference codes for the references cited for     ***        
c  ***  cluster number icl.  The short reference list is printed    ***        
c  ***  on a single page.  If the routine ABCEEZ was called before  ***        
c  ***  this routine is called, the index will be printed with      ***        
c  ***  references alphabetized.                                    ***        
c  ********************************************************************        
      common/refs/vstref,vhiirf,vcoref,muref,disref,angref,                    
     *ldref,ageref,sptref,mstref,mhiref,mhiirf,mcoref,mdsref,                  
     *avref,cexref,turref                                                      
      common/bibli/refcod,rfrnce,nrefs                                         
      character*1 refcod(500,5),refc(5,500),rfrnce(500,116)                    
     *,b1                                                                      
      character*5 vstref(150,14),vhiirf(150,14),vcoref(150,14),                
     *muref(150,3),disref(150,18),angref(150,8),ldref(150,7),                  
     *ageref(150,14),sptref(150,8),mstref(150,6),mhiref(150,6),                
     *mhiirf(150,6),mcoref(150,6),mdsref(150,6),avref(150,5),                  
     *cexref(150,14),turref(150,7),blank,codlst(155),cdlst2(155),               
     *cdlst3(155),code(500),temp                                                
      data blank/'     '/,bl/' '/                                              
      equivalence(refc(1,1),code(1))                                           
c                                                                              
c  initialize citation arrays                                                  
      do 5 i=1,155                                                              
        codlst(i)=blank                                                        
        cdlst2(i)=blank                                                        
        cdlst3(i)=blank                                                        
    5 continue                                                                 
c                                                                              
c  store in array codlst a list of codes for the references cited for          
c  cluster icl                                                                 
      index=0                                                                  
      do 10 i=1,14                                                              
        index = index+1                                                        
        codlst(index)=vstref(icl,i)                                            
   10 continue                                                                 
      do 20 i=1,14                                                              
        index = index+1                                                        
        codlst(index)=vhiirf(icl,i)                                            
   20 continue                                                                 
      do 30 i=1,14                                                              
        index = index+1                                                        
        codlst(index)=vcoref(icl,i)                                            
   30 continue                                                                 
      do 40 i=1,3                                                              
        index = index+1                                                        
        codlst(index)=muref(icl,i)                                             
   40 continue                                                                 
      do 50 i=1,18                                                              
        index = index+1                                                        
        codlst(index)=disref(icl,i)                                            
   50 continue                                                                 
      do 60 i=1,8                                                              
        index = index+1                                                        
        codlst(index)=angref(icl,i)                                            
   60 continue                                                                 
      do 70 i=1,7                                                              
        index = index+1                                                        
        codlst(index)=ldref(icl,i)                                             
   70 continue                                                                 
      do 80 i=1,14                                                              
        index = index+1                                                        
        codlst(index)=ageref(icl,i)                                            
   80 continue                                                                 
      do 90 i=1,8                                                              
        index = index+1                                                        
        codlst(index)=sptref(icl,i)                                            
   90 continue                                                                 
      do 100 i=1,6                                                             
        index = index+1                                                        
        codlst(index)=mstref(icl,i)                                            
  100 continue                                                                 
      do 110 i=1,6                                                             
        index = index+1                                                        
        codlst(index)=mhiref(icl,i)                                            
  110 continue                                                                 
      do 120 i=1,6                                                             
        index = index+1                                                        
        codlst(index)=mhiirf(icl,i)                                            
  120 continue                                                                 
      do 130 i=1,6                                                             
        index = index+1                                                        
        codlst(index)=mcoref(icl,i)                                            
  130 continue                                                                 
      do 140 i=1,6                                                             
        index = index+1                                                        
        codlst(index)=mdsref(icl,i)                                            
  140 continue                                                                 
      do 150 i=1,5                                                             
        index = index+1                                                        
        codlst(index)=avref(icl,i)                                             
  150 continue                                                                 
      do 160 i=1,14                                                             
        index = index+1                                                        
        codlst(index)=cexref(icl,i)                                            
  160 continue                                                                 
      do 170 i=1,7                                                             
        index = index+1                                                        
        codlst(index)=turref(icl,i)                                            
  170 continue                                                                 
c                                                                              
c  remove blanks from array of citations                                       
      indx2=0                                                                  
      do 200 i=1,155                                                            
        if (codlst(i).eq.blank) go to 200                                      
        indx2=indx2+1                                                          
        cdlst2(indx2)=codlst(i)                                                
  200 continue                                                                 
c                                                                              
c  reverse storage order of array of reference codes and store (by             
c  equivalence) codes in char*5 array "code"                                   
      do 350 i=1,500                                                           
        do 351 j=1,5                                                           
          refc(j,i)=refcod(i,j)                                                
  351   continue                                                               
  350 continue                                                                 
c                                                                              
c  write list of references for cluster icl by comparing array of              
c  citations (cdlst2) with array of ref codes (code)                           
      write(iunit,1100)                                                        
 1100 format(1h ,45x,'REFERENCES'/)                                            
      indx3=0                                                                  
c  search reference list in stored order (presumably alphabetized) for         
c  references cited                                                            
      do 400 i=1,nrefs                                                         
        do 410 j=1,indx2                                                       
c  print reference info if the ith reference code appears in the list          
c  of references cited                                                         
          if (code(i).ne.cdlst2(j)) go to 410                                  
          write(iunit,1300)(refcod(i,k),k=1,5),(rfrnce(i,k),k=1,116)           
 1300     format(1h ,6x,5a1,3x,116a1)                                          
c  store array of codes for references printed                                 
          indx3=indx3+1                                                        
          cdlst3(indx3)=cdlst2(j)                                              
          go to 400                                                            
  410   continue                                                               
  400 continue                                                                 
c                                                                              
c  if the number of refs printed does not equal the number cited, print        
c  warning that reference information is unavailable                           
      if (indx3.eq.indx2) go to 500                                            
      do 450 i=1,indx2                                                         
        do 460 j=1,indx3                                                       
          if (cdlst3(j).eq.cdlst2(i)) go to 450                                
  460   continue                                                               
        if (iunit.ne.6) write(6,1500)cdlst2(i)                                 
        write(iunit,1500)cdlst2(i)                                             
 1500   format(1h ,12x,'REFERENCE INFO IS UNAVAILABLE FOR ',a5)                
  450 continue                                                                 
  500 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE UPCASE(a)                                                     
c  ******************************************************************          
c  ***  this routine changes lower case letters to upper case     ***          
c  ***  letters.  All letters must be of same case to alphabetize ***          
c  ***  by sorting character string arrays.                       ***          
c  ******************************************************************          
      character*1 a                                                            
      if (a.eq.'a') a = 'A'                                                    
      if (a.eq.'b') a = 'B'                                                    
      if (a.eq.'c') a = 'C'                                                    
      if (a.eq.'d') a = 'D'                                                    
      if (a.eq.'e') a = 'E'                                                    
      if (a.eq.'f') a = 'F'                                                    
      if (a.eq.'g') a = 'G'                                                    
      if (a.eq.'h') a = 'H'                                                    
      if (a.eq.'i') a = 'I'                                                    
      if (a.eq.'j') a = 'J'                                                    
      if (a.eq.'k') a = 'K'                                                    
      if (a.eq.'l') a = 'L'                                                    
      if (a.eq.'m') a = 'M'                                                    
      if (a.eq.'n') a = 'N'                                                    
      if (a.eq.'o') a = 'O'                                                    
      if (a.eq.'p') a = 'P'                                                    
      if (a.eq.'q') a = 'Q'                                                    
      if (a.eq.'r') a = 'R'                                                    
      if (a.eq.'s') a = 'S'                                                    
      if (a.eq.'t') a = 'T'                                                    
      if (a.eq.'u') a = 'U'                                                    
      if (a.eq.'v') a = 'V'                                                    
      if (a.eq.'w') a = 'W'                                                    
      if (a.eq.'x') a = 'X'                                                    
      if (a.eq.'y') a = 'Y'                                                    
      if (a.eq.'z') a = 'Z'                                                    
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE MASKER(NCL,MSKD)                                              
c  ***********************************************************************     
c  ***  this routine masks all but the specified data base values.     ***     
c  ***  In a calculation of, e.g., the distribution of a certain       ***     
c  ***  cluster characteristic, or a comparison of one author's value  ***     
c  ***  with that of another, only unmasked database entries are con-  ***     
c  ***  sidered.  A value is "masked" if its associated reference is   ***     
c  ***  set to 'XXXXX'.  The value of nrefs determines how masking     ***     
c  ***  be done (see comments below).                                  ***     
c  ***********************************************************************     
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      common/refs/vstref,vhiirf,vcoref,muref,disref,angref,ldref,              
     *ageref,sptref,mstref,mhiref,mhiirf,mcoref,mdsref,avref,                  
     *cexref,turref                                                            
      integer oclno(150),sharp(150),west(150),                                 
     *prio(150),obs(150),nvalus(150,17)                                        
      integer index(18),year(18)                                               
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      character*5 vstref(150,14),vhiirf(150,14),vcoref(150,14),                
     *muref(150,3),disref(150,18),angref(150,8),ldref(150,7),                  
     *ageref(150,14),espt(150,8),sptref(150,8),mstref(150,6),                  
     *mhiref(150,6),mhiirf(150,6),mcoref(150,6),mdsref(150,6),                 
     *avref(150,5),cexref(150,14),turref(150,7)                                
      character*10 name(150),name2(150),assoc(150)                             
      character*5 mask,ref1,ref2                                               
      character*1 a1(5),a2(5)                                                  
      character*1 msktyp                                                       
      equivalence (a1(1),ref1),(a2(1),ref2)                                    
      data mask/'XXXXX'/                                                       
c                                                                              
c  select type of masking (see below)                                          
    1 write(6,4000)                                                            
 4000 format(1h0,'Select type of masking:'/                                    
     *5x,'(c) for chronological masking, or'/                                  
     *5x,'(s) for selection of specific references'/                           
     *' NOTE: enter "r" if you want to know the masking rules')                
      read(5,5000)msktyp                                                       
 5000 format(a1)                                                               
      if (msktyp.eq.'c'.or.msktyp.eq.'C') then                                 
        write(6,4001)                                                          
 4001   format(1h ,'retain how many "most current" references?')               
        read(5,*)nrefs                                                         
        nrefs = -nrefs      ! to signal type of masking                        
      elseif (msktyp.eq.'s'.or.msktyp.eq.'S') then                             
        write(6,4002)                                                          
 4002   format(1h ,'retain how many (1 or 2) specific references?')            
        read(5,*)nrefs                                                         
      else                                                                     
        call mskrul                                                            
        go to 1                                                                
      endif                                                                    
      if (msktyp.eq.'s'.or.msktyp.eq.'S') then                                 
c                                                                              
c  enter codes of references to leave unmasked:                                
        write(6,3000)                                                          
 3000   format(1h0,'enter code for the (first) reference to ',                 
     *             'leave unmasked:')                                          
        read(5,1000)ref1                                                       
 1000   format(a5)                                                             
        do 31 ichr=1,5                                                         
          call upcase(a1(ichr))    ! alpha characters in codes are upper case  
   31   continue                                                               
        if (nrefs.gt.1) then                                                   
          write(6,3001)                                                        
 3001     format(1h ,'enter code for second reference to leave ',              
     *               'unmasked:')                                              
          read(5,1000)ref2                                                     
          do 32 ichr=1,5                                                       
            call upcase(a2(ichr))    ! alpha characters in codes are upper case
   32     continue                                                             
        endif                                                                  
      endif                                                                    
c                                                                              
c  loop for new cluster                                                        
      do 10 i=1,ncl                                                            
        if (nrefs.gt.0) go to 30                                               
        mskd = 1       ! flag to indicate that database is masked              
c                                                                              
c  -------------------------------------------------------------               
c          FIRST TYPE OF MASKING (CHRONOLOGICAL)                               
c  _____________________________________________________________               
c  Rules:  Mask all but the most current database entries for each             
c  cluster characteristic.  Abs(nrefs) dictates the number of                  
c  references to escape masking.  More than abs(nrefs) entries                 
c  can remain unmasked if the database contains multiple entries               
c  for the same (most current) year.  In other words, abs(nrefs)               
c  is actually the number of most current years to be left                     
c  unmasked.                                                                   
   20   continue                                                               
        nunmsk=iabs(nrefs)     ! number of database entries to be left unmasked
c                                                                              
c  steps to mask database entries of cluster characteristic determined by ichr:
        ichr=1                 ! characteristic 1 => stellar RV                
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
c  in what years were the cited references published?                          
          do 251 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(vstref(i,j),year(j))                                    
  251     continue                                                             
          call decr(jmx,year,index) !determine chronological ranks of citations
c  perform masking operation                                                   
          do 261 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 261                                         
            vstref(i,j)=mask                                                   
  261     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=2                 ! characteristic 2 => H II region RV            
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 252 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(vhiirf(i,j),year(j))                                    
  252     continue                                                             
          call decr(jmx,year,index)                                            
          do 262 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 262                                         
            vhiirf(i,j)=mask                                                   
  262     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=3                 ! characteristic 3 => molec cloud RV            
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 253 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(vcoref(i,j),year(j))                                    
  253     continue                                                             
          call decr(jmx,year,index)                                            
          do 263 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 263                                         
            vcoref(i,j)=mask                                                   
  263     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=4                 ! characteristic 4 => proper motion             
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 254 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(muref(i,j),year(j))                                     
  254     continue                                                             
          call decr(jmx,year,index)                                            
          do 264 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 264                                         
            muref(i,j)=mask                                                    
  264     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=5                 ! characteristic 5 => cluster distance          
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 255 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(disref(i,j),year(j))                                    
  255     continue                                                             
          call decr(jmx,year,index)                                            
          do 265 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 265                                         
            disref(i,j)=mask                                                   
  265     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=6                 ! characteristic 6 => angular diameter          
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 256 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(angref(i,j),year(j))                                    
  256     continue                                                             
          call decr(jmx,year,index)                                            
          do 266 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 266                                         
            angref(i,j)=mask                                                   
  266     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=7                 ! characteristic 7 => linear diameter           
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 257 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(ldref(i,j),year(j))                                     
  257     continue                                                             
          call decr(jmx,year,index)                                            
          do 267 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 267                                         
            ldref(i,j)=mask                                                    
  267     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=8                 ! characteristic 8 => cluster age               
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 258 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(ageref(i,j),year(j))                                    
  258     continue                                                             
          call decr(jmx,year,index)                                            
          do 268 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 268                                         
            ageref(i,j)=mask                                                   
  268     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=9                 ! characteristic 9 => earliest MS spectral type 
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 259 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(sptref(i,j),year(j))                                    
  259     continue                                                             
          call decr(jmx,year,index)                                            
          do 269 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 269                                         
            sptref(i,j)=mask                                                   
  269     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=10                 ! characteristic 10 => stellar mass            
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 230 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(mstref(i,j),year(j))                                    
  230     continue                                                             
          call decr(jmx,year,index)                                            
          do 240 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 240                                         
            mstref(i,j)=mask                                                   
  240     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=11                 ! characteristic 11 => H I mass                
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 231 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(mhiref(i,j),year(j))                                    
  231     continue                                                             
          call decr(jmx,year,index)                                            
          do 241 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 241                                         
            mhiref(i,j)=mask                                                   
  241     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=12                 ! characteristic 12 => H II region mass        
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 232 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(mhiirf(i,j),year(j))                                    
  232     continue                                                             
          call decr(jmx,year,index)                                            
          do 242 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 242                                         
            mhiirf(i,j)=mask                                                   
  242     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=13                 ! characteristic 13 => molec cloud mass        
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 233 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(mcoref(i,j),year(j))                                    
  233     continue                                                             
          call decr(jmx,year,index)                                            
          do 243 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 243                                         
            mcoref(i,j)=mask                                                   
  243     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=14                 ! characteristic 14 => dust mass               
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 234 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(mdsref(i,j),year(j))                                    
  234     continue                                                             
          call decr(jmx,year,index)                                            
          do 244 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 244                                         
            mdsref(i,j)=mask                                                   
  244     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=15                 ! characteristic 15 => visual extinction       
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 235 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(avref(i,j),year(j))                                     
  235     continue                                                             
          call decr(jmx,year,index)                                            
          do 245 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 245                                         
            avref(i,j)=mask                                                    
  245     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=16                 ! characteristic 16 => color excess            
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 236 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(cexref(i,j),year(j))                                    
  236     continue                                                             
          call decr(jmx,year,index)                                            
          do 246 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 246                                         
            cexref(i,j)=mask                                                   
  246     continue                                                             
        endif                                                                  
c                                                                              
c  steps for chronological masking of next cluster characteristic (see above   
c  for explanatory comments)                                                   
        ichr=17                 ! characteristic 17 => MS turnoff color        
        jmx=nvalus(i,ichr)                                                     
        if (jmx.gt.nunmsk) then                                                
          do 237 j=1,jmx                                                       
            index(j)=jmx                                                       
            call refyr(turref(i,j),year(j))                                    
  237     continue                                                             
          call decr(jmx,year,index)                                            
          do 247 j=1,jmx                                                       
            imsk=index(j)+nunmsk                                               
            if (imsk.gt.jmx) go to 247                                         
            turref(i,j)=mask                                                   
  247     continue                                                             
        endif                                                                  
  120   continue                                                               
        go to 10                                                               
c                                                                              
c  -------------------------------------------------------------               
c          SECOND TYPE OF MASKING (SPECIFIED REFERENCES)                       
c  _____________________________________________________________               
c  Rules: mask all database entries except those from reference(s)             
c  specified in character strings ref1 and ref2.  nrefs determines             
c  the number of references to escape masking (1 => only ref1;                 
c  2 => both ref1 and ref2)                                                    
   30   continue                                                               
        mskd = 1       ! flag to indicate that database is masked              
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 1:  
c  (see above for meanings of cluster characteristics)                         
        jmx=nvalus(i,1)                                                        
        do 301 j=1,jmx                                                         
          if (vstref(i,j).eq.ref1) go to 301                                   
          if (nrefs.gt.1.and.vstref(i,j).eq.ref2) go to 301                    
          vstref(i,j)=mask                                                     
  301   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 2:  
        jmx=nvalus(i,2)                                                        
        do 302 j=1,jmx                                                         
          if (vhiirf(i,j).eq.ref1) go to 302                                   
          if (nrefs.gt.1.and.vhiirf(i,j).eq.ref2) go to 302                    
          vhiirf(i,j)=mask                                                     
  302   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 3:  
        jmx=nvalus(i,3)                                                        
        do 303 j=1,jmx                                                         
          if (vcoref(i,j).eq.ref1) go to 303                                   
          if (nrefs.gt.1.and.vcoref(i,j).eq.ref2) go to 303                    
          vcoref(i,j)=mask                                                     
  303   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 4:  
        jmx=nvalus(i,4)                                                        
        do 304 j=1,jmx                                                         
          if (muref(i,j).eq.ref1) go to 304                                    
          if (nrefs.gt.1.and.muref(i,j).eq.ref2) go to 304                     
          muref(i,j)=mask                                                      
  304   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 5:  
        jmx=nvalus(i,5)                                                        
        do 305 j=1,jmx                                                         
          if (disref(i,j).eq.ref1) go to 305                                   
          if (nrefs.gt.1.and.disref(i,j).eq.ref2) go to 305                    
          disref(i,j)=mask                                                     
  305   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 6:  
        jmx=nvalus(i,6)                                                        
        do 306 j=1,jmx                                                         
          if (angref(i,j).eq.ref1) go to 306                                   
          if (nrefs.gt.1.and.angref(i,j).eq.ref2) go to 306                    
          angref(i,j)=mask                                                     
  306   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 7:  
        jmx=nvalus(i,7)                                                        
        do 307 j=1,jmx                                                         
          if (ldref(i,j).eq.ref1) go to 307                                    
          if (nrefs.gt.1.and.ldref(i,j).eq.ref2) go to 307                     
          ldref(i,j)=mask                                                      
  307   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 8:  
        jmx=nvalus(i,8)                                                        
        do 308 j=1,jmx                                                         
          if (ageref(i,j).eq.ref1) go to 308                                   
          if (nrefs.gt.1.and.ageref(i,j).eq.ref2) go to 308                    
          ageref(i,j)=mask                                                     
  308   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 9:  
        jmx=nvalus(i,9)                                                        
        do 309 j=1,jmx                                                         
          if (sptref(i,j).eq.ref1) go to 309                                   
          if (nrefs.gt.1.and.sptref(i,j).eq.ref2) go to 309                    
          sptref(i,j)=mask                                                     
  309   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 10: 
        jmx=nvalus(i,10)                                                       
        do 310 j=1,jmx                                                         
          if (mstref(i,j).eq.ref1) go to 310                                   
          if (nrefs.gt.1.and.mstref(i,j).eq.ref2) go to 310                    
          mstref(i,j)=mask                                                     
  310   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 11: 
        jmx=nvalus(i,11)                                                       
        do 311 j=1,jmx                                                         
          if (mhiref(i,j).eq.ref1) go to 311                                   
          if (nrefs.gt.1.and.mhiref(i,j).eq.ref2) go to 311                    
          mhiref(i,j)=mask                                                     
  311   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 12: 
        jmx=nvalus(i,12)                                                       
        do 312 j=1,jmx                                                         
          if (mhiirf(i,j).eq.ref1) go to 312                                   
          if (nrefs.gt.1.and.mhiirf(i,j).eq.ref2) go to 312                    
          mhiirf(i,j)=mask                                                     
  312   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 13: 
        jmx=nvalus(i,13)                                                       
        do 313 j=1,jmx                                                         
          if (mcoref(i,j).eq.ref1) go to 313                                   
          if (nrefs.gt.1.and.mcoref(i,j).eq.ref2) go to 313                    
          mcoref(i,j)=mask                                                     
  313   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 14: 
        jmx=nvalus(i,14)                                                       
        do 314 j=1,jmx                                                         
          if (mdsref(i,j).eq.ref1) go to 314                                   
          if (nrefs.gt.1.and.mdsref(i,j).eq.ref2) go to 314                    
          mdsref(i,j)=mask                                                     
  314   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 15: 
        jmx=nvalus(i,15)                                                       
        do 315 j=1,jmx                                                         
          if (avref(i,j).eq.ref1) go to 315                                    
          if (nrefs.gt.1.and.avref(i,j).eq.ref2) go to 315                     
          avref(i,j)=mask                                                      
  315   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 16: 
        jmx=nvalus(i,16)                                                       
        do 316 j=1,jmx                                                         
          if (cexref(i,j).eq.ref1) go to 316                                   
          if (nrefs.gt.1.and.cexref(i,j).eq.ref2) go to 316                    
          cexref(i,j)=mask                                                     
  316   continue                                                               
c                                                                              
c  steps to perform Specified References masking of cluster characteristic 17: 
        jmx=nvalus(i,17)                                                       
        do 317 j=1,jmx                                                         
          if (turref(i,j).eq.ref1) go to 317                                   
          if (nrefs.gt.1.and.turref(i,j).eq.ref2) go to 317                    
          turref(i,j)=mask                                                     
  317   continue                                                               
   10 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE MSKRUL                                                        
c  **************************************************************************  
c  ***   this routine displays the rules used in the masking procedure    ***  
c  **************************************************************************  
      write(6,1000)                                                            
 1000 format(1h0,'MASKING is the procedure by which some database'/            
     *' entries can be ignored in subsequent operations (e.g.,'/               
     *' averaging).  MASKED references are the ones that are'/                 
     *' ignored and UNMASKED references are the ones that are'/                
     *' included.  Since the masking operation alters the arrays'/             
     *' of references, you may desire to RESTORE the initial'/                 
     *' database for later operations (see main menu).'/)                      
      write(6,2000)                                                            
 2000 format(1h0,'CHRONOLOGICAL MASKING:'/)                                    
      write(6,2001)                                                            
 2001 format(1h ,                                                              
     *5x,'Rules:  Mask all but the most current database entries'/             
     *5x,'for each cluster characteristic.  Enter the number of'/              
     *5x,'references to leave unmasked.  More than that number of'/            
     *5x,'entries can remain unmasked if the database contains'/               
     *5x,'multiple entries for the same (most current) year.')                 
      write(6,3000)                                                            
 3000 format(1h0,'MASKING OF ALL BUT SPECIFIC REFERENCES')                     
      write(6,3001)                                                            
 3001 format(1h ,                                                              
     *5x,'Rules: mask all database entries except the one (or'/                
     *5x,'two) specified.'/)                                                   
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE DECR(JMAX,YR,IND)                                             
c  **************************************************************************  
c  ***  this routine calculates the chronological ranks of citations to   ***  
c  ***  be used, e.g., in Chronological Masking (see subroutine MASKER for***  
c  ***  explanation).  Rank of citation is decreased if citation is older ***  
c  ***  than other citations in list for a given cluster and cluster      ***  
c  ***  characteristic.                                                   ***  
c  **************************************************************************  
      integer ind(18),yr(18)                                                   
      do 10 j1=1,jmax                                                          
        do 20 j2=1,jmax                                                        
          if (j2.eq.j1) go to 20                                               
          if (yr(j2).gt.yr(j1)) ind(j1)=ind(j1)-1                              
   20   continue                                                               
   10 continue                                                                 
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE AVERAG(IUNIT,ISERNO,NCL)                                      
c  **********************************************************************      
c  ***  this routine computes averages and standard deviations of     ***      
c  ***  those cluster characteristics for which the database contains ***      
c  ***  multiple, unmasked entries.  The parameter 'ichr' determines  ***      
c  ***  which characteristic is to be averaged.                       ***      
c  **********************************************************************      
      common/data/oclno,name,sharp,west,assoc,name2,glon,glat,                 
     *ra1,ra2,dec1,dec2,vst,vhii,vco,mux,muy,dist,ang,ldiam,                   
     *age,espt,mst,mhi,mhii,mco,mdust,prio,obs,avis,colexc,                    
     *nvalus,turnof                                                            
      common/refs/vstref,vhiirf,vcoref,muref,disref,angref,ldref,              
     *ageref,sptref,mstref,mhiref,mhiirf,mcoref,mdsref,avref,                  
     *cexref,turref                                                            
      integer iserno(150),oclno(150),sharp(150),west(150),                     
     *prio(150),obs(150),nvalus(150,17)                                        
      real glon(150),glat(150),ra1(150),ra2(150),dec1(150),                    
     *dec2(150),vst(150,14),vhii(150,14),vco(150,14),mux(150,3),               
     *muy(150,3),dist(150,18),ang(150,8),ldiam(150,7),age(150,14),             
     *mst(150,6),mhi(150,6),mhii(150,6),mco(150,6),mdust(150,6),               
     *avis(150,5),colexc(150,14),turnof(150,7)                                 
      character*5 vstref(150,14),vhiirf(150,14),vcoref(150,14),                
     *muref(150,3),disref(150,18),angref(150,8),ldref(150,7),                  
     *ageref(150,14),espt(150,8),sptref(150,8),mstref(150,6),                  
     *mhiref(150,6),mhiirf(150,6),mcoref(150,6),mdsref(150,6),                 
     *avref(150,5),cexref(150,14),turref(150,7)                                
      character*10 name(150),name2(150),assoc(150)                             
      character*5 mask                                                         
      integer nvals(150)                                                       
      real avg(150),sd(150)                                                    
      data mask/'XXXXX'/                                                       
c                                                                              
c  select parameter to be averaged                                             
    2   write(6,3000)                                                          
 3000   format(1h0,'Select parameter to be averaged:'/                         
     *  5x,'1 => stellar radial velocity'/                                     
     *  5x,'2 => H II region radial velocity'/                                 
     *  5x,'3 => molecular cloud radial velocity'/                             
     *  5x,'4 => cluster proper motion'/                                       
     *  5x,'5 => cluster distance'/                                            
     *  5x,'6 => cluster angular diameter'/                                    
     *  5x,'7 => cluster linear diameter'/                                     
     *  5x,'8 => cluster age'/                                                 
     *  5x,'9 => main sequence turnoff color'/                                 
     *  4x,'10 => stellar mass'/                                               
     *  4x,'11 => associated H I mass'/                                        
     *  4x,'12 => associated ionized gas mass'/                                
     *  4x,'13 => associated molecular cloud mass'/                            
     *  4x,'14 => associated dust mass'/                                       
     *  4x,'15 => visual extinction'/                                          
     *  4x,'16 => reddening')                                                  
        read(5,*)ichr                                                          
        if (ichr.lt.1.or.ichr.gt.16.or.ichr.eq.90) then                        
          write(6,3001)                                                        
 3001     format(1h ,'Selected parameter type is invalid.',                    
     *    '  Try again.'/)                                                     
          go to 2                                                              
        endif                                                                  
c                                                                              
c  consider only selected clusters (according to value of iserno)              
    1 do 5 i=1,ncl                                                             
        if (iserno(i).eq.0) go to 5                                            
c                                                                              
c  initialize count, sum(x) and sum(x*x)                                       
        nvals(i)=0                                                             
        sumx=0.0                                                               
        sumxx=0.0                                                              
        if (ichr.ne.45) then                                                   
          go to (10,20,30,40,50,60,70,80,90,100,                               
     *           110,120,130,140,150,160),ichr                                 
        else                                                                   
          go to 45                                                             
        endif                                                                  
c                                                                              
c  sum stellar radial velocities                                               
   10   continue                                                               
        jmx=nvalus(i,1)                                                        
        if (jmx.eq.0) go to 180                                                
        do 11 j=1,jmx                                                          
          if (vstref(i,j).eq.mask) go to 11                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+vst(i,j)                                                   
          sumxx=sumxx+vst(i,j)*vst(i,j)                                        
   11   continue                                                               
        go to 180                                                              
c                                                                              
c  sum H II region radial velocities                                           
   20   continue                                                               
        jmx=nvalus(i,2)                                                        
        if (jmx.eq.0) go to 180                                                
        do 21 j=1,jmx                                                          
          if (vhiirf(i,j).eq.mask) go to 21                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+vhii(i,j)                                                  
          sumxx=sumxx+vhii(i,j)*vhii(i,j)                                      
   21   continue                                                               
        go to 180                                                              
c                                                                              
c  sum CO radial velocities                                                    
   30   continue                                                               
        jmx=nvalus(i,3)                                                        
        if (jmx.eq.0) go to 180                                                
        do 31 j=1,jmx                                                          
          if (vcoref(i,j).eq.mask) go to 31                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+vco(i,j)                                                   
          sumxx=sumxx+vco(i,j)*vco(i,j)                                        
   31   continue                                                               
        go to 180                                                              
c                                                                              
c  sum proper motions                                                          
   40   continue                                                               
        jmx=nvalus(i,4)                                                        
        if (jmx.eq.0) go to 180                                                
        do 41 j=1,jmx                                                          
          if (muref(i,j).eq.mask) go to 41                                     
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mux(i,j)                                                   
          sumxx=sumxx+mux(i,j)*mux(i,j)                                        
   41   continue                                                               
        go to 180                                                              
   45   continue                                                               
        jmx=nvalus(i,4)                                                        
        if (jmx.eq.0) go to 180                                                
        do 46 j=1,jmx                                                          
          if (muref(i,j).eq.mask) go to 46                                     
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+muy(i,j)                                                   
          sumxx=sumxx+muy(i,j)*muy(i,j)                                        
   46   continue                                                               
        go to 180                                                              
c                                                                              
c  sum distances                                                               
   50   continue                                                               
        jmx=nvalus(i,5)                                                        
        if (jmx.eq.0) go to 180                                                
        do 51 j=1,jmx                                                          
          if (disref(i,j).eq.mask) go to 51                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+dist(i,j)                                                  
          sumxx=sumxx+dist(i,j)*dist(i,j)                                      
   51   continue                                                               
        go to 180                                                              
c                                                                              
c  sum angular diameters                                                       
   60   continue                                                               
        jmx=nvalus(i,6)                                                        
        if (jmx.eq.0) go to 180                                                
        do 61 j=1,jmx                                                          
          if (angref(i,j).eq.mask) go to 61                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+ang(i,j)                                                   
          sumxx=sumxx+ang(i,j)*ang(i,j)                                        
   61   continue                                                               
        go to 180                                                              
c                                                                              
c  sum linear diameters                                                        
   70   continue                                                               
        jmx=nvalus(i,7)                                                        
        if (jmx.eq.0) go to 180                                                
        do 71 j=1,jmx                                                          
          if (ldref(i,j).eq.mask) go to 71                                     
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+ldiam(i,j)                                                 
          sumxx=sumxx+ldiam(i,j)*ldiam(i,j)                                    
   71   continue                                                               
        go to 180                                                              
c                                                                              
c  sum ages                                                                    
   80   continue                                                               
        jmx=nvalus(i,8)                                                        
        if (jmx.eq.0) go to 180                                                
        do 81 j=1,jmx                                                          
          if (ageref(i,j).eq.mask) go to 81                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+age(i,j)                                                   
          sumxx=sumxx+age(i,j)*age(i,j)                                        
   81   continue                                                               
        go to 180                                                              
c                                                                              
c  sum main sequence turnoff color values                                      
   90   continue                                                               
        jmx=nvalus(i,17)                                                       
        if (jmx.eq.0) go to 180                                                
        do 91 j=1,jmx                                                          
          if (turref(i,j).eq.mask) go to 91                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+turnof(i,j)                                                
          sumxx=sumxx+turnof(i,j)*turnof(i,j)                                  
   91   continue                                                               
        go to 180                                                              
c                                                                              
c  sum stellar mass values                                                     
  100   continue                                                               
        jmx=nvalus(i,10)                                                       
        if (jmx.eq.0) go to 180                                                
        do 101 j=1,jmx                                                         
          if (mstref(i,j).eq.mask) go to 101                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mst(i,j)                                                   
          sumxx=sumxx+mst(i,j)*mst(i,j)                                        
  101   continue                                                               
        go to 180                                                              
c                                                                              
c  sum estimates for mass in H I clouds                                        
  110   continue                                                               
        jmx=nvalus(i,11)                                                       
        if (jmx.eq.0) go to 180                                                
        do 111 j=1,jmx                                                         
          if (mhiref(i,j).eq.mask) go to 111                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mhi(i,j)                                                   
          sumxx=sumxx+mhi(i,j)*mhi(i,j)                                        
  111   continue                                                               
        go to 180                                                              
c                                                                              
c  sum estimates for ionized mass                                              
  120   continue                                                               
        jmx=nvalus(i,12)                                                       
        if (jmx.eq.0) go to 180                                                
        do 121 j=1,jmx                                                         
          if (mhiirf(i,j).eq.mask) go to 121                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mhii(i,j)                                                  
          sumxx=sumxx+mhii(i,j)*mhii(i,j)                                      
  121   continue                                                               
        go to 180                                                              
c                                                                              
c  sum estimates for mass in CO clouds                                         
  130   continue                                                               
        jmx=nvalus(i,13)                                                       
        if (jmx.eq.0) go to 180                                                
        do 131 j=1,jmx                                                         
          if (mcoref(i,j).eq.mask) go to 131                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mco(i,j)                                                   
          sumxx=sumxx+mco(i,j)*mco(i,j)                                        
  131   continue                                                               
        go to 180                                                              
c                                                                              
c  sum estimates for mass in the form of dust                                  
  140   continue                                                               
        jmx=nvalus(i,14)                                                       
        if (jmx.eq.0) go to 180                                                
        do 141 j=1,jmx                                                         
          if (mdsref(i,j).eq.mask) go to 141                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+mdust(i,j)                                                 
          sumxx=sumxx+mdust(i,j)*mdust(i,j)                                    
  141   continue                                                               
        go to 180                                                              
c                                                                              
c  sum visual extinction values                                                
  150   continue                                                               
        jmx=nvalus(i,15)                                                       
        if (jmx.eq.0) go to 180                                                
        do 151 j=1,jmx                                                         
          if (avref(i,j).eq.mask) go to 151                                    
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+avis(i,j)                                                  
          sumxx=sumxx+avis(i,j)*avis(i,j)                                      
  151   continue                                                               
        go to 180                                                              
c                                                                              
c  sum color excess values                                                     
  160   continue                                                               
        jmx=nvalus(i,16)                                                       
        if (jmx.eq.0) go to 180                                                
        do 161 j=1,jmx                                                         
          if (cexref(i,j).eq.mask) go to 161                                   
          nvals(i)=nvals(i)+1                                                  
          sumx=sumx+colexc(i,j)                                                
          sumxx=sumxx+colexc(i,j)*colexc(i,j)                                  
  161   continue                                                               
        go to 180                                                              
c                                                                              
c  compute average and standard deviation of parameter                         
  180   continue                                                               
        if (nvals(i).eq.0) then                                                
          avg(i)=999.                                                          
          sd(i)=999.                                                           
        else                                                                   
          avg(i)=sumx/float(nvals(i))                                          
          sd(i)=0.0                                                            
          if (nvals(i).ge.2) then                                              
            arg=(sumxx-2.0*avg(i)*sumx+float(nvals(i))*avg(i)*                 
     *          avg(i))/float(nvals(i)-1)                                      
            if (arg.ge.0.0.or.abs(arg).ge.1.0e-5) sd(i)=sqrt(arg)              
          endif                                                                
        endif                                                                  
    5 continue                                                                 
c                                                                              
c  tabulate computed averages:                                                 
      if (ichr.ne.45) write(iunit,4500)                                        
 4500 format(1h1,'TABLE OF AVERAGED PARAMETERS:'/)                             
      if (iunit.ne.6.and.ichr.ne.45)write(6,4501)iunit                         
 4501 format(1h0,'Table of averaged parameters written to unit',i3)            
      if (ichr.eq.1)write(iunit,4110)                                          
 4110 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '  Cl RV ',1x,'s.d. (km/s)'/)                                 
      if (ichr.eq.2)write(iunit,4120)                                          
 4120 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'H II  RV',1x,'s.d. (km/s)'/)                                 
      if (ichr.eq.3)write(iunit,4130)                                          
 4130 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           ' CO  RV ',1x,'s.d. (km/s)'/)                                 
      if (ichr.eq.4)write(iunit,4140)                                          
 4140 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '   MU X ',1x,'s.d. ("/100yr)'/)                              
      if (ichr.eq.45)write(iunit,4145)                                         
 4145 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '   MU Y ',1x,'s.d. ("/100yr)'/)                              
      if (ichr.eq.5)write(iunit,4150)                                          
 4150 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '      d ',1x,'s.d. (kpc)'/)                                  
      if (ichr.eq.6)write(iunit,4160)                                          
 4160 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'Ang Diam',1x,'s.d. (arcmin)'/)                               
      if (ichr.eq.7)write(iunit,4170)                                          
 4170 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'Lin Diam',1x,'s.d. (pc)'/)                                   
      if (ichr.eq.8)write(iunit,4180)                                          
 4180 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '    Age ',1x,'s.d. (Myr)'/)                                  
      if (ichr.eq.9)write(iunit,4190)                                          
 4190 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           ' (B-V)t ',1x,'s.d. (mag)'/)                                  
      if (ichr.eq.10)write(iunit,4200)                                         
 4200 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           ' Cl Mass',1x,'s.d. (Mo)'/)                                   
      if (ichr.eq.11)write(iunit,4210)                                         
 4210 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'H I Mass',1x,'s.d. (Mo)'/)                                   
      if (ichr.eq.12)write(iunit,4220)                                         
 4220 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'HII Mass',1x,'s.d. (Mo)'/)                                   
      if (ichr.eq.13)write(iunit,4230)                                         
 4230 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           ' H2 Mass',1x,'s.d. (Mo)'/)                                   
      if (ichr.eq.14)write(iunit,4240)                                         
 4240 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           'Dst Mass',1x,'s.d. (Mo)'/)                                   
      if (ichr.eq.15)write(iunit,4250)                                         
 4250 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '    AV  ',1x,'s.d. (mag)'/)                                  
      if (ichr.eq.16)write(iunit,4260)                                         
 4260 format(1h0,'DB#',2X,'OCL#',5X,'NAME',6x,'N',3x,                          
     *           '  E(B-V)',1x,'s.d. (mag)'/)                                  
      do 300 i=1,ncl                                                           
        if (iserno(i).eq.0) go to 300                                          
        if (nvals(i).eq.0) then                                                
          write(iunit,4000)i,oclno(i),name(i)                                  
 4000     format(1h ,i3,2x,i4,2x,a10,2x,                                       
     *               'no database entries to average')                         
        elseif(nvals(i).eq.1) then                                             
          write(iunit,4001)i,oclno(i),name(i),nvals(i),avg(i)                  
 4001     format(1h ,i3,2x,i4,2x,a10,i5,2x,f8.2,3x,                            
     *               'only one entry => no s.d.')                              
        else                                                                   
          write(iunit,4002)i,oclno(i),name(i),nvals(i),                        
     *                     avg(i),sd(i)                                        
 4002     format(1h ,i3,2x,i4,2x,a10,i5,2x,f8.2,1x,f8.2)                       
        endif                                                                  
  300 continue                                                                 
      if (ichr.eq.4) then  ! if averaging proper motions, then                 
        ichr = 45        ! return to calculate proper motion in declination    
        go to 1                                                                
      endif                                                                    
      return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE REFYR(REFDUM,YR)                                              
c  ************************************************************************    
c  ***  this routine extracts the last two digits from a reference code ***    
c  ***  to specify the year in which the corresponding reference was    ***    
c  ***  published.                                                      ***    
c  ************************************************************************    
      character*5 refdum                                                       
      integer check,yr,y1,y10                                                  
      character*1 dgchk1,dgchk2,digit(10)                                      
      data digit/'0','1','2','3','4','5','6','7','8','9'/                      
      check=0                                                                  
c                                                                              
c  initialize yr to zero (this is the value returned if at least one of        
c  the last two digits of the reference code is non-numeric)                   
      yr = 0                                                                   
c                                                                              
c  extract the single years digit                                              
      decode(10,1015,refdum)dgchk1                                             
 1015 format(4x,a1)                                                            
c                                                                              
c  extract the tens of years digit                                             
      decode(10,1016,refdum)dgchk2                                             
 1016 format(3x,a1)                                                            
c                                                                              
c  check for non-numeric characters (check non-zero => numeric)                
      do 18 i=1,10                                                             
        if (dgchk1.ne.digit(i)) go to 18                                       
        check=1                                                                
        y1 = i - 1       ! integer equivalent of digit(i)                      
        go to 19                                                               
   18 continue                                                                 
   19 if (check.ne.1) go to 20     ! no calculation if non-numeric             
c                                                                              
c                                                                              
      do 17 i=1,10                                                             
        if (dgchk2.ne.digit(i)) go to 17                                       
        check=2                                                                
        y10 = i - 1      ! integer equivalent of digit(i)                      
        go to 16                                                               
   17 continue                                                                 
   16 if (check.ne.2) go to 20     ! no calculation if non-numeric             
c                                                                              
c  calculate value of publication year                                         
      yr = 10*y10 + y1                                                         
   20 return                                                                   
      end                                                                      
                                                                               
      SUBROUTINE FILER(FNAME)                                                  
c  *************************************************************************   
c  ***  this routine enables user to specify name of a disk data file    ***   
c  ***  to create for output.                                            ***   
c  *************************************************************************   
      character*80 fname                                                       
 1010 write(*,1011)                                                            
 1011 format(' ENTER FILE NAME: ',$)                                           
      read(*,1012,end=99,err=1010)len,fname                                    
 1012 format(q,a)                                                              
   99 if (len.eq.0) go to 1010                                                 
      return                                                                   
      end                                                                      
