cb::compgb 
c 
      program compgb                                                     
c
c********1*********2*********3*********4*********5*********6*********7**
c Name:        compgb
c Version:     1.1  (9001.12)
c Written by:  ___________ & TJ Cacanindin 
c Purpose:     This program compares a complete B-file (GPS Project and
c              Station Occupation Data) and a complete G-file (GPS
c              Vector Data Transfer file) against a definitive station
c              list (SERFIL) and each other in order to check  
c              consistency and uniqueness of station IDs and serial 
c              numbers.
c
c  Local Variables and Constants:
c  ------------------------------
c bfile               : user defined name of bfile
c b25()               : holds bfile *25* sess
c b80                 : bfile *80* station names
c card                : generic record read from a file 
c ch                  : single-digit character 
c day                 : UTC day of year baseline vector observed 
c dayi()              : dayi(1) day observed
c                       dayi(2) number of sess on a particular line 
c                               (< 17; max line length of direct access
c                                      files is 90)   
c dayprev             : day read before current one
c done1(90)           : indicate whether bfile *25* sess/station IDs are
c                       origin stations for the gfile baseline vectors
c done2(90)           : indicate whether bfile *25* sess/station IDs are 
c                       differential stations for gfile baseline vectors
c errday              : day of record to appear in output error message
c errsess             : sess/sta ID of record to appear in output errmsg
c first               : line index for single mode processing
c flag                : indicates existence of error condition
c found               : indicates whether a position is found to insert
c                       bfile *25* sess in an existing line or whether a
c                       new line must be established
c gfile               : user defined name of gfile
c ios                 : I/O status indicator of control info list
c                          ios=0  : successful op; no error/no eof
c                          ios=-1 : eof condition occurred/no error;
c                                   occurs only for READ operations
c                          ios>0  : error condition occurred; error
c                                   stat codes are in RM/FORTRAN Manual
c ktemp               : previously loaded SSN of station ID retrieved
c                       when a duplicate exists
c k25()               : holds line numbers of bfile *25* records
c k80                 : line numbers of bfile *80* records
c maxln               : max number of lines in dayif
c maxvln              : max number of vectors calculated in vectorf
c maxv2ln             : max number of sess in intermediate step of 
c                       single mode calculations
c mode                : 1-char mode indicator
c mmode               : indicates multi (or session) mode
c origin()            : holds gfile origin stations
c ostaprev            : value of gfile origin station read just before
c                       current one
c outfile             : user defined name of output file
c second              : line index for single mode processing
c seen()              : seen(1) -- indicates whether SSN/station ID     
c                                  match in gfile corresponds to 
c                                  station file match
c                     : seen(2) -- indicates whether SSN/station ID     
c                                  match in bfile corresponds to 
c                                  station file match
c                     : seen(3) -- indicates whether each station in the        
c                                  station file has a bfile *80* record 
c sernum1             : origin station serial number (SSN) 
c sernum2             : differential station serial number (SSN)
c sess                : sess(1:1)=session; sess(2:5)=station ID
c sfile               : user dfned name of definitive station list
c smode               : indicates single mode
c sta                 : definitive station list of SSNs and assigned 4-char
c                       station identifications
c statemp             : previously loaded station ID which has been 
c                       retrieved to test whether a duplicate exists
c station             : 4-char station ID read from sta file      
c testline1           : origin sess/sta (1:5)//diff. sess/sta (6:10) 
c testline2           : diff. sess/sta (1:5)//origin sess/sta (6:10)
c
c 
c  Global Variables and Constants:
c  -------------------------------
c baseline(366,90)    : array of all baseline vectors in gfile indexed
c                       by day (90 vectors/day are allowed)
c max                 : maximum number of records in error files
c
c
c  This Module Called By : none
c
c  This Module Calls  : checkgf, look, title
c
c  Include Files Used : none
c
c  Common Blocks Used : /globls/
c
c  References:  RM/FORTRAN Manual, COMPGB User's Documentation, OMNI
c               Programming Standards
c  
c  Comments: - (n = no. of stations)
c              single mode : (n(n-1))/2 = vectors/session
c              multi (or session) mode: n-1 = vectors/session
c            - baseline() handles up to 90 baseline vectors/day 
c            - RM/FORTRAN has limitation of 14 access files 
c********1*********2*********3*********4*********5*********6*********7**
c    Modification History:
c::9001.12, TJC, 
c::   Station serial number fields expanded to 4 digits
c::   Max number of baseline vectors increased to 90 per day
c::   Printing of program title
c::   User prompts for I/O files
c::   Improved error handling/trapping
c::   Between session vector checking removed
c::   OMNI documentation standards
c::   Calculations for multi and single baseline mode reductions
c::
c::9703.31, version 1.2, JBM,
c::   modified 90 vectors per day to 5999 vectors per G-file by:
c::   character*10 baseline(366,90) array changed to integer baselind(5999)
c::   = day and character*10 baseline(5999) = baseline arrays.  add integer
c::   basecnt as array counter
c::   increase character*1 done1(90),done2(90) arrays to done1(5999),done2(5999)
c::   and make them global variables: add common/globs2/done1,done2.
c::   removed files donef1 and donef2.
c::   removed subroutine title and added logical function dup.
c::   allowed gfile F records
c:: 
c********1*********2*********3*********4*********5*********6*********7**
ce::compgb

      integer*4    ios 
      integer*2    b25f,b80f,d,day,dayi(2),dayif,dayprev,donef1,
     $             donef2,errday,errf1,errf2,first,i,idup,j,k,kprev,
     $             ktemp,k25(16),k25f,k80,look,max,maxln,maxvln,
     $             maxv2ln,o,originf,outf,rn,second,seenf,sernum1,
     $             sernum2,sta,tempf,vectorf
      integer*2    basecnt
      character*80 card
      character*30 b80
      character*15 bfile,gfile,sfile,outfile
      character*10 testline1,testline2,vector
      character*10 baseline(5999)
      integer*2    baselind(5999)
      character*5  b25(16),errsess,one,origin(7),ostaprev,sess,two
      character*4  statemp,station 
      character*1  ch,done1(5999),done2(5999),mode,seen(3)
      logical      dup25,flag,found,mmode,smode
      logical      dup
       
      common/globls/baselind,baseline,basecnt,max 
      common/globls2/done1,done2
 
      data b25f,b80f,dayif,donef1,donef2/400,410,420,430,440/,
     $     errf1,errf2,k25f,originf,outf/450,460,470,480,490/,
     $     seenf,sta,tempf,vectorf/500,510,520,530/,
     $     kprev,station/0,'    '/,
     $     dayi/0,0/
      max=0
      basecnt = 0
      mmode=.false.
      smode=.false.
      print *        
      print *,'Welcome to program compgb version 1.2'
      print * 
      print *,'Initializing program............'
      print *

c........ 1.0 Opens direct access files
      open(b25f,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=80)
      open(b80f,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=30)
      open(dayif,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=35)
      open(errf1,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=3)
      open(errf2,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=5)
      open(k25f,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=80)
      open(originf,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=35)
      open(seenf,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=3)
      open(sta,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=4)
      open(tempf,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=30)
      open(vectorf,status='SCRATCH',access='DIRECT',form='FORMATTED',
     $     recl=10)

c........ 2.0 Initializes arrays and direct access files
      do 2000 i=1,3
         seen(i)='f'
 2000 continue

      do 2010 i=5999
         done1(i)='f'
         done2(i)='f'
 2010 continue

      do 2015 i=1,16
         b25(i)='     '
         k25(i)=0
 2015 continue

      i=0
      do 2040 sernum1=1,9999 
         write(sta,rec=sernum1,fmt=2020)station
 2020    format(a4)
         write(seenf,rec=sernum1,fmt=2030)seen
 2030    format(3a1)
         write(tempf,rec=sernum1,fmt=2035)i
 2035    format(i5)
 2040 continue

      origin(1)='eoln '
      do 2060 day=1,366
         write(originf,rec=day,fmt=2051)origin
 2051    format(7a5)
 2060 continue

      do 2080 i=1,5999
            baseline(i)='          '
	    baselind(i) = 0
 2080 continue

c........ 3.0 Prints program title and prompts user for I/O files and 
c             processing options 
c         i: allows user to change echoed filename (error recovery)
c         j: assigned goto index                                  
c         k: errormsg counter; when k>2, program execution halted

      i=1
      j=1
      k=1
 3000 print *,'Please enter station filename (serfil):  '
      read(5,'(a15)') sfile
      if (i .le. 2) then
         print *,sfile,' entered as the correct station file? (y/n):  '
         read(5,'(a1)') ch
         if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
            i=i+1
            goto 3000
         endif
      endif
      open (100,file=sfile,iostat=ios,err=3030,status='old')
      i=1
      j=2
      k=1
 3010 print *,'Please enter G-filename:  '
      read(5,'(a15)') gfile
      if (i .le. 2) then
         print *,gfile,' entered as the correct gfile? (y/n):  '
         read(5,'(a1)') ch
         if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
            i=i+1
            goto 3010
         endif
      endif
      open (200,file=gfile,iostat=ios,err=3030,status='old')
      i=1
      j=3
      k=1
 3020 print *,'Please enter B-filename:  '
      read(5,'(a15)') bfile
      if (i .le. 2) then
         print *,bfile,' entered as the correct bfile? (y/n):  '
         read(5,'(a1)') ch
         if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
             i=i+1
             goto 3020
         endif
      endif
      open (300,file=bfile,iostat=ios,err=3030,status='old')
 3030 if (ios .ne. 0) then
         if (k .le. 2) then         
            print *,'Error condition occurred while trying to open',
     $              ' file.'
            print *,'Verify existence of filename.ext'
            print *
            k=k+1
            goto (3000,3010,3020) j
         else  
            stop 'Input file not found'
         endif       
      endif

      i=1
 3040 print *,'Please enter name of output file:  '
      read(5,'(a15)') outfile
      if (i .le. 2) then
         print *,outfile,' entered as correct output file? (y/n):  '
         read(5,'(a1)') ch
         if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
             i=i+1
             goto 3040
         endif
      endif
      open (outf,file=outfile,iostat=ios,err=3040,status='unknown')
 
      i=1
 3050 print *,'Checking of single- or multi-session mode reductions?',
     $         ' (s/m/n=no checking):  '
      read(5,'(a1)') mode
      if (i .le. 2) then
         if ((mode .eq. 'S') .or. (mode .eq. 's')) then
            print *,'Single-session mode reductions selected? (y/n):  '
         elseif ((mode .eq. 'M') .or. (mode .eq. 'm')) then
            print *,'Multi-session mode reductions selected?  (y/n):  '
         elseif ((mode .eq. 'N') .or. (mode .eq. 'n')) then
            print *,'Mode reductions not calculated?  (y/n):  '
         else
	    i=i+1
	    print *,'Invalid response, try again'
	    goto 3050
         endif
         read(5,'(a1)') ch
         if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
             i=i+1
             goto 3050
         endif
      endif
      if ((mode .eq. 'S') .or. (mode .eq. 's')) then
         smode=.true.
      elseif ((mode .eq. 'M') .or. (mode .eq. 'm')) then
         mmode=.true.
      else
         print *,'Single/multi not selected -- mode reductions will ',
     $         'not be calculated.'
      endif

      print *,'Continue with program? (y/n):  '
 3055 read(5,'(a1)') ch
      if ((ch .eq. 'N') .or. (ch .eq. 'n')) then
	  stop 'Execution terminated'
      else if (.not.((ch .eq. 'Y') .or. (ch .eq. 'y'))) then
          print *, 'invalid response, try y or n:  '
	   goto 3055
      else
	   continue
      endif

      write(outf,3059) outfile
 3059 format(' Program compgb version 1.2 (9703.31) output file: ',a15)
      write(outf,3060) sfile,gfile,bfile
 3060 format(' input files',/,7x,'station file:  ',a15,/,7x,'gfile',
     $      7x,':  ',a15,/,7x,'bfile',7x,':  ',a15)
      if (smode) then
         write(outf,3062) 
 3062    format(' Calculations of single mode reductions')
      elseif (mmode) then
         write(outf,3064) 
 3064    format(' Calculations of multi mode reductions')
      else
         write(outf,3066)
 3066    format(' Mode reductions not calculated')
      endif
      write(outf,3068)
 3068 format(' * * * * * *')

c........ 4.0 STATION FILE PROCEDURE.  Sets up sta file with valid 
c             station IDs from the station file 
c         k: record counter
 
      print *,'* * * * * *'  
      print *
      print *,'Loading ',sfile,' station file records into program ... '
      write(outf,4000) sfile
 4000 format(/,' Loading ',a15,' station file records into program ...') 
      k=0                                            
 4001 read(100,'(a4,3x,i4)',iostat=ios,end=4010,err=4010)station,sernum1 
      k=k+1
 4010 if (ios .gt. 0) then
         k=k+1
         write(6,4020) k,sfile
 4020    format(/,' Error occurred with record ',i5,' of ',a15)
         stop 'Error while reading station ID and serial number'
      elseif (ios .eq. -1) then
         if (k .eq. 0) then
            print *
            print *,sfile,' contains no records'
            stop 'Empty station file'
         else
            close(100,iostat=ios)
            if (ios .gt. 0) then
               print *
               print *,'Error condition occurred while closing ',sfile
            else
               print *
               print *,'At end of ',sfile
               write(outf,4025) sfile
 4025          format(/,' At end of ',a15,/,' * * * * * *')
            endif
         endif
      elseif ((ios .eq. 0) .and. (sernum1 .le. 0)) then
         write(outf,4030) sernum1,k,sfile
 4030    format(/,1x,i4.4,' is an illegal station number which occurs',
     $         ' in record ',i5,' of',/,'    ',a15,'.  Illegal value',
     $         ' disregarded.  Valid range is 1:9999') 
         goto 4001
      elseif ((ios .eq. 0) .and. (sernum1 .ge. 1)) then
         flag=.false.
c........ Checks for duplicate 4-char station ID
         do 4070 rn=1,9999
            read(tempf,rec=rn,fmt=4035)i
 4035       format(i5)
            if (i .eq. 0) then
               goto 4075
            else
               read(sta,rec=i,fmt=4040) statemp
 4040          format(a4)
               if (statemp .eq. station) then
                  read(errf2,rec=i,fmt=4050) ktemp
 4050             format(i5)
                  flag=.true.
                  idup=i
                  write(outf,4060) sfile,station,i,ktemp,sernum1,k
 4060             format(/,1x,a15,' assigns 4-char station ID ',a4,
     $                  ' to station serial ',/,'    numbers ',i4.4,
     $                  ' (record ',i5,') and ',i4.4,' (record ',i5,
     $                  ').  The first',/,'    assignment was loaded',
     $                  ' into the program--the second disregarded.') 
               endif
            endif
 4070    continue

c........ Checks for duplicate SSN
 4075    read(sta,rec=sernum1,fmt=4040) statemp
         if ((statemp .eq. '    ') .and. (.not. flag)) then
            write(sta,rec=sernum1,fmt=4040) station
            write(errf2,rec=sernum1,fmt=4050) k
            do 4078 rn=1,9999
               read(tempf,rec=rn,fmt=4035)i
               if (i .eq. 0) then
                  write(tempf,rec=rn,fmt=4035) sernum1
                  goto 4001
               endif
 4078       continue
         elseif ((statemp .eq. '    ') .and. flag) then
            write(outf,4080) sernum1,k,station,idup,ktemp
 4080       format(/,' Station serial number ',i4.4,' (record ',i5,
     $            ') is not a duplicate; however,',/,'    its 4-char',
     $            ' station ID ',a4,' appears previously for serial',
     $            ' number ',/,4x,i4.4,' (record ',i5,').  Due to',
     $            ' error, record not loaded into program.')
         else
            read(errf2,rec=sernum1,fmt=4050) ktemp
            write(outf,4090) sfile,sernum1,statemp,ktemp,station,k
 4090       format(/,1x,a15,' assigns station serial number ',i4.4,
     $            ' to 4-char station',/,'    IDs ',a4,' (record ',i5,
     $            ') and ',a4,' (record ',i5,').  The first',/,    
     $            '    assignment was loaded into the program--the',
     $            ' second disregarded.')
         endif
         goto 4001
      endif

c........ 5.0 GFILE PROCEDURE.  Checks the gfile "C" Member Records 
c             and the "F" Member Records for consistency of station
c             IDs and SSNs with those in the sta file 
c         k: record counter

      print *,'* * * * * *'
      print *
      print *,'Processing the ',gfile,' gfile records ... '
      write(outf,5000) gfile
 5000 format(/,' Processing the ',a15,' gfile records ... ')
      k=0
      ostaprev='     '
      dayprev=0
 5001 read(200,'(a80)',iostat=ios,end=5100,err=5100)card 
      k=k+1
c........ 5.1 Error checking 
 5100 if (ios .gt. 0) then
         k=k+1
         write(6,4020) k,gfile
         print *,'(Maximum length of gfile records is 80 characters)'  
         stop 'Encountered error condition while reading file'
      elseif (ios .eq. -1) then
         if (k .eq. 0) then
            print *
            print *,gfile,' contains no records'
            stop 'Empty gfile'
         else
            close(200,iostat=ios)
            if (ios .gt. 0) then
               print *
               print *,'Error condition occurred while closing ',gfile
            else
               print *
               print *,'At end of ',gfile
               write(outf,5105) gfile
 5105          format(/,' At end of ',a15,/,' * * * * * *')
            endif
            goto 6000
         endif
      endif
    
c........ 5.2 Processes the "C" Member Records of the gfile
      if(card(1:1).eq.'C') then 
         read(card,'(1x,i4,i4)',iostat=ios,err=5200)sernum1,sernum2 
         read(card,'(59x,i3)',iostat=ios,err=5200)day
 5200    if (ios .ne. 0) then
            write(outf,5201) k,gfile
 5201       format(/,' Error condition occurred while reading record ',
     $            i5,' of ',a15,'.',/,'    Problem is with either the',
     $            ' origin (2:5) or differential (6:9) station',/,
     $            '    serial numbers or with the day of the year',
     $            ' observed (60:62).  Due to',/,'    the error,',
     $            ' the record was not processed.')
            goto 5001
         endif

c........ Verifies valid range for day (1:366)
         if ((day .lt. 1) .or. (day .gt. 366)) then
            read(sta,rec=sernum1,fmt=5205)station
            read(sta,rec=sernum2,fmt=5205)statemp
 5205       format(a4)
            write(outf,5206) day,k,sernum1,station,sernum2,statemp
 5206       format(/,' Day ',i3,' for record ',i5,' is out of valid',
     $            ' range 1:366.  Due to error,'/,'    vector',
     $            ' consisting of origin serial number ',i4.4,
     $            ' station ID ',a4,' and',/,'    differential serial',
     $            ' number ',i4.4,' station ID ',a4,' was not',
     $            ' processed.')
            goto 5001
         endif

c........ 5.21 Checks to see if origin SSN/station ID match is 
c              consistent with the station file match.  If not, prints 
c              errmsg; otherwise, marks true in seen array        
         read(sta,rec=sernum1,fmt=5210)station
 5210    format(a4)
         if (station.ne.card(65:68)) then 

            if (station .eq. '    ') then
               write(outf,5212) sernum1
 5212          format(/,' Station serial number ',i4.4,' not loaded',
     $               ' into program from station file.')
            else
               write(outf,5214) station,sernum1
 5214          format(/,' Station ',a4,' is assigned to serial number',
     $               1x,i4.4,' in the station file.')
            endif
            write(outf,5216) card(65:68),day,k
 5216       format('    Station ',a4,' is incorrectly assigned to',
     $            ' this number in the',/,'    gfile (day # ',i3,
     $            ', record # ',i5,').')

            i=look(card(65:68))
            if (i .eq. 0) then 
               write(outf,5217) card(65:68) 
 5217          format('    Station ',a4,' is not in the list of 4-char',
     $               ' IDs loaded into program.')
            else                         
               write(outf,5218) card(65:68),i
 5218          format('    Station ',a4,' is assigned to serial',
     $               ' number ',i4.4,' in the station file.')
            endif

         else
            read(seenf,rec=sernum1,fmt=5219)seen
 5219       format(3a1)
            seen(1)='t'
            write(seenf,rec=sernum1,fmt=5219)seen
         endif 
            
c........ 5.22 Checks to see if differential SSN/station ID match is 
c              consistent with the station file match.  If not, prints 
c              errmsg; otherwise, marks true in seen array
         read(sta,rec=sernum2,fmt=5210)station
         if (station.ne.card(75:78)) then 

            if (station .eq. '    ') then
               write(outf,5212) sernum2
            else
               write(outf,5214) station,sernum2
            endif
            write(outf,5216) card(75:78),day,k 

            i=look(card(75:78))
            if (i .eq. 0) then 
               write(outf,5217) card(75:78) 
            else                         
               write(outf,5218) card(75:78),i
            endif

         else  
            read(seenf,rec=sernum2,fmt=5219)seen
            seen(1)='t'
            write(seenf,rec=sernum2,fmt=5219)seen
         endif 
 
c........ 5.23 Converts lowercase characters in string to uppercase
         do 5230 i=64,68
            ch=card(i:i)
            if (ch .ge. 'a') then
               ch=char(ichar(ch)-32)
               card(i:i)=ch
            endif
 5230    continue
         do 5235 i=74,78
            ch=card(i:i)
            if (ch .ge. 'a') then
               ch=char(ichar(ch)-32)
               card(i:i)=ch
            endif
 5235    continue

c........ 5.24 Loads originf with origin stations (baseline(day,i)(1:5), 
c              if mmode) or origin sessions (baseline(day,i)(1:1), if
c              smode)
         flag=.false.
         if (day .ne. dayprev) then
            ostaprev='     '
         endif
         if (((day .eq. dayprev) .and. 
     $       ((mmode .and. (ostaprev .ne. card(64:68))) .or.
     $        (smode .and. (ostaprev .ne. card(64:64))))) .or.
     $       (day .ne. dayprev)) then
            read(originf,rec=day,fmt=5240) origin
 5240       format(7a5)
            do 5242 i=1,7
               if (mmode) then
                  if (origin(i) .eq. card(64:68)) then
                     flag=.true.
                  elseif (origin(i) .eq. 'eoln ') then
                     goto 5244
                  endif
               elseif (smode) then
                  if (origin(i)(1:1) .eq. card(64:64)) then
                     flag=.true.
                  elseif (origin(i) .eq. 'eoln ') then
                     goto 5244
                  endif
               endif
 5242       continue
 5244       if (.not. flag) then
               if ((origin(i) .eq. 'eoln ') .and. (i .lt. 7)) then
                  if (mmode) then
                     origin(i)=card(64:68)
                     ostaprev=card(64:68)
                  elseif (smode) then
                     origin(i)(1:1)=card(64:64)
                     ostaprev=card(64:64)
                  endif
                  origin(i+1)='eoln '
                  write(originf,rec=day,fmt=5240) origin
                  dayprev=day
               endif
            endif
         endif

c........ 5.25 Searches for appropriate place in baseline array to 
c              insert the record's baseline vector 
         testline1=card(64:68)//card(74:78) 
         testline2=card(74:78)//card(64:68) 

c........ 5.251 check if duplicate baseline exists for the day
            if (dup(day,testline1,testline2)) then
               write(outf,5252) testline1,day,k
 5252          format(/,' Baseline vector ',a10,' already exists for',
     $               ' day ',i5,'.  Duplicate',/,'    vector exists',
     $               ' for same day in gfile record ',i5,'.')
c........ 5.252 check if vector limit exceeded. 
            elseif (basecnt.ge.5999) then
               write(outf,5253) testline1,k,day
 5253          format(/,' Program holds a max of 5999 gfile baseline',
     $               ' vectors.  Any vector',/,'    exceeding',
     $               ' the 5999 vector limit will not be processed. ',
     $               ' Vector',/,4x,a10,' (record ',i5,') for day ',i5,
     $               ' exceeds this limit.')
            else

c........ 5.253 add baseline to array

	    basecnt = basecnt + 1
	    baselind(basecnt) = day
	    baseline(basecnt) = testline1
            endif
	    goto 5001

c........ 5.6 Processes the "F" Member Records of the gfile
      elseif(card(1:1).eq.'F') then 
         read(card,'(1x,i4,i4)',iostat=ios,err=5600)sernum1,sernum2 
         read(card,'(65x,i3)',iostat=ios,err=5600)day
 5600    if (ios .ne. 0) then
           write(outf,5601) k,gfile
 5601      format(/,' Error condition occurred while reading F record ',
     $           i5,' of ',a15,'.',/,'    Problem is with either the',
     $           ' origin (2:5) or differential (6:9) station',/,
     $           '    serial numbers or with the day of the year',
     $           ' observed (66:68).  Due to',/,'    the error,',
     $           ' the record was not processed.')
           goto 5001
         endif

c........ Verifies valid range for day (1:366)
         if ((day .lt. 1) .or. (day .gt. 366)) then
            read(sta,rec=sernum1,fmt=5605)station
            read(sta,rec=sernum2,fmt=5605)statemp
 5605       format(a4)
            write(outf,5606) day,k,sernum1,station,sernum2,statemp
 5606       format(/,' Day ',i3,' for record ',i5,' is out of valid',
     $            ' range 1:366.  Due to error,'/,'    vector',
     $            ' consisting of origin serial number ',i4.4,
     $            ' station ID ',a4,' and',/,'    differential serial',
     $            ' number ',i4.4,' station ID ',a4,' was not',
     $            ' processed.')
            goto 5001
         endif

c........ 5.61 match F record origin ssn with station file ssn and assign
c              corresponding station file station ID to the F record
c              mark true in seen array

         read(sta,rec=sernum1,fmt=5610)station
 5610    format(a4)
         read(seenf,rec=sernum1,fmt=5619)seen
 5619    format(3a1)
         seen(1)='t'
         write(seenf,rec=sernum1,fmt=5219)seen
            
c........ 5.62 match F record differential ssn with station file ssn and  
c              assign corresponding station file station ID to the  F record
c              mark true in seen array

         read(sta,rec=sernum2,fmt=5610)statemp
         read(seenf,rec=sernum2,fmt=5619)seen
         seen(1)='t'
         write(seenf,rec=sernum2,fmt=5619)seen
 
c........ 5.63 Converts lowercase characters in string to uppercase

            ch=card(70:70)
            if (ch .ge. 'a') then
               ch=char(ichar(ch)-32)
               card(70:70)=ch
            endif
            ch=card(76:76)
            if (ch .ge. 'a') then
               ch=char(ichar(ch)-32)
               card(76:76)=ch
            endif

c........ 5.24 Loads originf with origin stations (baseline(day,i)(1:5), 
c              if mmode) or origin sessions (baseline(day,i)(1:1), if
c              smode)
         flag=.false.
         if (day .ne. dayprev) then
            ostaprev='     '
         endif
         if (((day .eq. dayprev) .and. 
     $       ((mmode .and. (ostaprev .ne. card(70:70)//station)) .or.
     $        (smode .and. (ostaprev .ne. card(70:70))))) .or.
     $       (day .ne. dayprev)) then
            read(originf,rec=day,fmt=5640) origin
 5640       format(7a5)
            do 5642 i=1,7
               if (mmode) then
                  if (origin(i) .eq. card(70:70)//station) then
                     flag=.true.
                  elseif (origin(i) .eq. 'eoln ') then
                     goto 5644
                  endif
               elseif (smode) then
                  if (origin(i)(1:1) .eq. card(70:70)) then
                     flag=.true.
                  elseif (origin(i) .eq. 'eoln ') then
                     goto 5644
                  endif
               endif
 5642       continue
 5644       if (.not. flag) then
               if ((origin(i) .eq. 'eoln ') .and. (i .lt. 7)) then
                  if (mmode) then
                     origin(i)=card(70:70)//station
                     ostaprev=card(70:70)//station
                  elseif (smode) then
                     origin(i)(1:1)=card(70:70)
                     ostaprev=card(70:70)
                  endif
                  origin(i+1)='eoln '
                  write(originf,rec=day,fmt=5640) origin
                  dayprev=day
               endif
            endif
         endif

c........ 5.65 Searches for appropriate place in baseline array to 
c              insert the record's baseline vector 
         testline1=card(70:70)//station//card(76:76)//statemp 
         testline2=card(76:76)//statemp//card(70:70)//station 

c........ 5.651 check if duplicate baseline exists for the day

            if (dup(day,testline1,testline2)) then
               write(outf,5652) testline1,day,k
 5652          format(/,' Baseline vector ',a10,' already exists for',
     $               ' day ',i5,'.  Duplicate',/,'    vector exists',
     $               ' for same day in gfile record ',i5,'.')
c........ 5.652 check if vector limit exceeded. 
            elseif (basecnt.ge.5999) then
               write(outf,5653) testline1,k,day
 5653          format(/,' Program holds a max of 5999 gfile baseline',
     $               ' vectors.  Any vector',/,'    exceeding',
     $               ' the 5999 vector limit will not be processed. ',
     $               ' Vector',/,4x,a10,' (record ',i5,') for day ',i5,
     $               ' exceeds this limit.')
            else

c........ 5.653 add baseline to array

	    basecnt = basecnt + 1
	    baselind(basecnt) = day
	    baseline(basecnt) = testline1
            endif
	    goto 5001

      else 
         goto 5001 
      endif     

c........ 6.0 BFILE PROCEDURE.  Checks the bfile *25* records for 
c             consistency of station IDs and SSNs with those in the 
c             sta file and baseline array (gfile vectors); assures two
c             *27* records for each *25*; verifies existence of one 
c             *80* per station; loads dayif and b25f in preparation
c             for reduction processing.       
c         k  : record counter
c         kprev: *25* record line counter

 6000 print *,'* * * * * *'
      print *
      print *,'Processing the ',bfile,' bfile records ... '
      write(outf,6001) bfile
 6001 format(/,' Processing the ',a15,' bfile records ... ')
      i=1
      k=0
      maxln=0
c........ 6.1 Error checking
 6100 read(300,'(a80)',iostat=ios,end=6110,err=6110)card 
      k=k+1 
 6110 if (ios .gt. 0) then
         k=k+1
         write(6,4020) k,bfile
         print *,'(Maximum length of bfile records is 80 characters)'
         stop 'Encountered error condition while reading file'
      elseif (ios .eq. -1) then
         if (k .eq. 0) then
            print *
            print *,bfile,' contains no records'
            stop 'Empty Bfile'
         else
            close(300,iostat=ios)
            if (ios .gt. 0) then
               print *
               print *,'Error condition occurred while closing ',bfile
            else
               do 6150 rn=1,max
                  read(errf1,rec=rn,fmt=6120)errday
 6120             format(i3)
                  read(errf2,rec=rn,fmt=6130)errsess
 6130             format(a5)
                  write(outf,6140)errday,errsess(1:1),errsess(2:5)
 6140             format(/,' No gfile "C/F" member record for day/',
     $                   'station: ',i3,a1,'  ',a4)
 6150          continue
               print *
               print *,'At end of ',bfile
               write(outf,6160) bfile
 6160          format(/,' At end of ',a15,/,' * * * * * *')
            endif
            goto 7000
         endif
      endif

c........ 6.2 Processes *25* records
      if (card(8:9).eq.'25') then 
         read(card,'(10x,i4,1x,i3,1x,a5)')sernum1,day,sess 

c........ Verifies valid range for day (1:366)
         if ((day .lt. 1) .or. (day .gt. 366)) then
            write(outf,6200) day,k,sernum1,sess
 6200       format(/,' Day ',i3,' for record ',i5,' is out of valid',
     $            ' range 1:366.  Due to error,'/,'    vector',
     $            ' consisting of station serial number ',i4.4,
     $            ', sess/station ID',/,4x,a5,' was not processed.')
            goto 6100
         endif

c........ 6.21 Checks to see if the SSN/station ID match is consistent 
c              with the station file match.  If not, prints errmsg; 
c              otherwise, marks true in seen array
         read(sta,rec=sernum1,fmt=5210)station
         if (station.ne.card(21:24)) then 

            if (station .eq. '    ') then
               write(outf,6210) sernum1
 6210          format(/,' Station serial number ',i4.4,' not loaded',
     $               ' into program from station file.')
            else
               write(outf,6211) station,sernum1
 6211          format(/,' Station ',a4,' is assigned to serial number',
     $               1x,i4.4,' in the station file.')
            endif
            write(outf,6212) card(21:24),day,k
 6212       format('    Station ',a4,' is incorrectly assigned to',
     $            ' this number in the',/,'    bfile (day # ',i3,
     $            ', record # ',i5,').')

            i=look(card(21:24))
            if (i .eq. 0) then 
               write(outf,6213) card(21:24)
 6213          format('    Station ',a4,' is not in the list of 4-char',
     $               ' IDs loaded into program.')
            else
               write(outf,6214) card(21:24),i
 6214          format('    Station ',a4,' is assigned to serial',
     $               ' number ',i4.4,' in the station file.')
            endif
         
         else
           read(seenf,rec=sernum1,fmt=6215)seen
 6215      format(3a1) 
           seen(2)='t'
           write(seenf,rec=sernum1,fmt=6215)seen
         endif

c........ 6.22 Converts lowercase characters in string to uppercase
         do 6220 i=20,24
            ch=card(i:i)
            if (ch .ge. 'a') then
               ch=char(ichar(ch)-32)
               card(i:i)=ch
            endif
 6220    continue

c........ 6.23 Checks gfile for occurrences of station occupation data
c              in the bfile with no corresponding vector data in the
c              gfile
         i=0
         n=0
         dup25=.false.
 6230    call checkgf(card(20:24),day,k,dup25)  
         kprev=k

c........ Loads dayif and b25f in preparation for mode reductions
         found=.false.
         if (.not. dup25) then
            if (maxln .eq. 0) then
               maxln=1
               rn=1
               dayi(1)=day
               i=1
               dayi(2)=i
               write(dayif,rec=rn,fmt=6231)dayi
 6231          format(2i5)
               b25(i)=card(20:24)
               k25(i)=k
               write(b25f,rec=rn,fmt=6232)b25
 6232          format(16a5)
               write(k25f,rec=rn,fmt=6233)k25
 6233          format(16i5)
            else
               do 6234 rn=1,maxln
                  read(dayif,rec=rn,fmt=6231)dayi
                  if (dayi(1) .eq. day) then
                     i=dayi(2)
                     if (i .lt. 16) then
                        found = .true.
                        i = i + 1
                        dayi(2)=i
                        write(dayif,rec=rn,fmt=6231)dayi
                        read(b25f,rec=rn,fmt=6232)b25
                        read(k25f,rec=rn,fmt=6233)k25
                        b25(i)=card(20:24)
                        k25(i)=k
                        write(b25f,rec=rn,fmt=6232)b25
                        write(k25f,rec=rn,fmt=6233)k25
                     endif
                  endif
 6234          continue
               if (.not. found) then
                  maxln=maxln+1
                  dayi(1)=day
                  i=1
                  dayi(2)=i
                  write(dayif,rec=maxln,fmt=6231)dayi
                  b25(i)=card(20:24)
                  k25(i)=k
                  write(b25f,rec=maxln,fmt=6232)b25
                  write(k25f,rec=maxln,fmt=6233)k25
               endif
            endif

         elseif (dup25) then
            do 6238 rn=1,maxln
               read(dayif,rec=rn,fmt=6231)dayi
               if ((dayi(1) .eq. day) .and. (.not. found)) then
                  i=dayi(2)
                  read(b25f,rec=rn,fmt=6232)b25
                  do 6236 n=1,i
                     if (b25(n) .eq. card(20:24)) then
                        found=.true.
                        read(k25f,rec=rn,fmt=6233)k25
                        write(outf,6235) k25(n),k,day,card(20:20),
     $                        card(21:24)
 6235                   format(/,' Duplicate bfile *25* records',
     $                        ' (lines ',i5,',',i5,') for ',i3,a1,'  ',
     $                        a4)
                     endif
 6236             continue
               endif
 6238       continue
         endif

         goto 6100 
 
c........ 6.3 Verifies existence of two *27* records for each station in each 
c             session. 
      elseif(card(8:9) .eq. '27') then 
         read(card,'(t11,i4)')sernum2
         if (sernum2 .eq. sernum1) then
            read(300,'(a80)') card
            k=k+1
            read(card,'(t11,i4)')sernum2
            if ((card(8:9).ne.'27').or.(sernum2 .ne. sernum1)) then
               write(outf,6300)kprev,sernum1,sess(1:1),sess(2:5)
 6300          format(/,' Insufficient number of *27* records for *25*', 
     $               ' record (line ',i4,') ',i4,a1,'  ',a5)
            endif
         else
            write(outf,6300)kprev,sernum1,sess(1:1),sess(2:5)
         endif
         goto 6100

c........ 6.4 Verifies existence of one *80* record per station. 
      elseif(card(8:9).eq.'80') then 
         read(card,'(10x,i4)')sernum1 
         read(sta,rec=sernum1,fmt=5210)station
         if (station.eq.'    ') then 
            write(outf,6400) sernum1,k,card(15:44) 
 6400       format(/,' Station serial number ',i4.4,' was not loaded',
     $            ' into the program from the',/,4x,'station file,',
     $            ' but is assigned to bfile *80* (record ',i5,
     $            ') station',/,4x,'name ',a30)
         else  
            read(seenf,rec=sernum1,fmt=6410)seen
 6410       format(3a1)
            ch=seen(3)
            if (ch .eq. 't') then
               read(b80f,rec=sernum1,fmt=6411)b80
 6411          format(a30)
               read(vectorf,rec=sernum1,fmt=6412)k80
 6412          format(i5)
               if (b80 .eq. card(15:44)) then
                  write(outf,6413)k80,k,sernum1
 6413             format(/,' Duplicate bfile *80* records (lines ',i5,
     $                  ',',i5,') for serial number ',i4.4)
               else
                  write(outf,6414)k80,k,sernum1
 6414             format(/,' Bfile *80* records (lines ',i5,',',i5,
     $                  ') both assigned to serial number',/,4x,i4.4,
     $                  ', but have different 30-char station names.')
               endif
            else
               seen(3)='t'
               write(seenf,rec=sernum1,fmt=6410)seen
               b80=card(15:44)
               write(b80f,rec=sernum1,fmt=6411) b80
               k80=k
               write(vectorf,rec=sernum1,fmt=6412) k80
            endif
         endif   
         goto 6100 
      
c........ 6.5 Not *25*, *27*, or *80* so read next record.
      else 
         goto 6100 
      endif 


c........ 7.0  Calculates mode reductions indicating which vectors have
c              been omitted from the gfile
 7000 print *,'* * * * * *'
      print * 

      if (.not. (smode .or. mmode)) then
         goto 7100
      endif
      do 7090 day=1,366
         read(originf,rec=day,fmt=7005)origin
 7005    format(7a5)
         do 7080 o=1,7
            if (origin(o) .eq. 'eoln ') then
               goto 7090
            else
               maxvln=0
               maxv2ln=0
               do 7030 d=1,maxln
                  read(dayif,rec=d,fmt=7010)dayi
 7010             format(2i5)
                  if (dayi(1) .eq. day) then
                     i=dayi(2)
                     read(b25f,rec=d,fmt=7015)b25
 7015                format(16a5)
                     do 7025 j=1,i
                        if (mmode) then
                           if ((origin(o)(1:1) .eq. b25(j)(1:1)) .and.
     $                           (origin(o) .ne. b25(j))) then
                              maxvln=maxvln+1
                              vector=origin(o)//b25(j)
                              write(vectorf,rec=maxvln,fmt=7020)vector
 7020                         format(a10)
                           endif
                        elseif (smode) then
                           if (origin(o)(1:1) .eq. b25(j)(1:1)) then
                              maxv2ln=maxv2ln+1
                              write(tempf,rec=maxv2ln,fmt=7022)b25(j)
 7022                         format(a5)
                           endif
                        endif
 7025                continue
                  endif
 7030          continue
               if (smode) then
                  first=1
 7032             if (first .lt. maxv2ln) then
                     read(tempf,rec=first,fmt=7034)one
 7034                format(a5)
                     do 7038 second=first+1,maxv2ln
                        read(tempf,rec=second,fmt=7022)two
                        vector=one//two
                        maxvln=maxvln+1
                        write(vectorf,rec=maxvln,fmt=7036)vector
 7036                   format(a10)
 7038                continue
                     first=first+1
                     goto 7032
                  endif
               endif

               do 7060 i=1,basecnt
                  if (baselind(i) .eq. day) then
                     do 7050 j=1,maxvln
                        read(vectorf,rec=j,fmt=7040)vector
 7040                   format(a10)
                        if (mmode) then
                           if (baseline(i) .eq. vector) then
                              vector(1:1)='9'
                              write(vectorf,rec=j,fmt=7040)vector
                              goto 7060
                           endif
                        elseif (smode) then
                           testline1=vector
                           testline2=vector(6:10)//vector(1:5)
                           if ((baseline(i) .eq. testline1) .or.
     $                           (baseline(i) .eq. testline2)) then
                              vector(1:1)='9'
                              write(vectorf,rec=j,fmt=7040)vector
                              goto 7060
                           endif
                        endif
 7050                continue
                  endif
 7060          continue

               do 7070 i=1,maxvln
                  read(vectorf,rec=i,fmt=7040)vector
                  if (vector(1:1) .ne. '9') then
                     write(outf,7065) vector,day
 7065                format(/,1x,a10,' omitted from gfile baseline', 
     $                     ' vectors for day ',i5)
                  endif
 7070          continue
            endif
 7080    continue
 7090 continue


c........ 7.1 Reports inconsistencies of station ID/SSN match between 
c             gfile and bfile when compared to the station file and 
c             whether there exists an *80* for each station.  
 7100 do 7120 sernum1=1,9999

         read(sta,rec=sernum1,fmt=7101)station
 7101    format(a4)
         if(station.ne.'    ') then 
            read(seenf,rec=sernum1,fmt=7110)seen
 7110       format(3a1)
            if ((seen(1).eq.'f') .and. (seen(2).eq.'f')) then
               write(outf,7111)sernum1,station
 7111          format(/,' Serial number ',i4.4,' station ',a4,' not in',
     $               ' gfile or bfile.')
            elseif ((seen(1).eq.'f') .and. (seen(2).eq.'t')) then
               write(outf,7112)sernum1,station
 7112          format(/,' Serial number ',i4.4,' station ',a4,' in',
     $               ' bfile, but not in gfile.')                
            elseif ((seen(1).eq.'t') .and. (seen(2).eq.'f')) then
               write(outf,7113)sernum1,station
 7113          format(/,' Serial number ',i4.4,' station ',a4,' in',
     $               ' gfile, but not in bfile.') 
            endif

            if ((seen(3).eq.'f') .and. (seen(1).eq.'t')) then  
               write(outf,7114)sernum1,station
 7114          format(/,' No bfile *80* entry for serial number ',i4.4,
     $               ' station ',a4,'.')
            endif
         endif 

 7120 continue 

c........ 7.2 Checks whether there exists a bfile *25* record for each
c             gfile origin and differential station
      max=0
      rn=1

      do 7270 i=1,basecnt
            if (baselind(i).ne.0 ) then 
	       day = baselind(i)
               if (done1(i).ne.'t') then
                  sess=baseline(i)(1:5)
                  if (max .eq. 0) then
                     write(errf1,rec=rn,fmt=7210) day
 7210                format(i3)
                     write(errf2,rec=rn,fmt=7220) sess
 7220                format(a5)
                     max=1
                  else
                     do 7230 rn=1,max
                        read(errf1,rec=rn,fmt=7210) errday
                        read(errf2,rec=rn,fmt=7220) errsess
                        if ((errday.eq.day).and.(errsess.eq.sess)) then
                           goto 7240
                        endif
 7230                continue
                     max=max+1
                     write(errf1,rec=max,fmt=7210) day
                     write(errf2,rec=max,fmt=7220) sess
                  endif
               endif

 7240          if (done2(i).ne.'t') then
                  sess=baseline(i)(6:10)
                  if (max .eq. 0) then
                     write(errf1,rec=rn,fmt=7210) day
                     write(errf2,rec=rn,fmt=7220) sess
                     max=1
                  else
                     do 7250 rn=1,max
                        read(errf1,rec=rn,fmt=7210) errday
                        read(errf2,rec=rn,fmt=7220) errsess
                        if ((errday.eq.day).and.(errsess.eq.sess)) then
                           goto 7270
                        endif
 7250                continue
                     max=max+1
                     write(errf1,rec=max,fmt=7210) day
                     write(errf2,rec=max,fmt=7220) sess
                  endif
               endif
            endif
 7270 continue

      do 7290 rn=1,max
         read(errf1,rec=rn,fmt=7210) errday
         read(errf2,rec=rn,fmt=7220) errsess
         write(outf,7280)errday,errsess(1:1),errsess(2:5)
 7280    format(/,' No bfile *25* record for day/station: ',
     $          i3,a1,'  ',a4)
 7290 continue 

      print *,'* * * * * *'
      print *
      print *,'At end of compgb'
      print *,'output written to file ',outfile
      write(outf,7292)
 7292 format(' * * * * * *',/,/,' At end of compgb')
      close(outf)
      stop
      end 
 
cb::look
c
      function look(stacalled) 
c
c********1*********2*********3*********4*********5*********6*********7**
c Name:        look
c Version:     1.1  (9001.12)
c Written by:  ____________ & TJ Cacanindin 
c Purpose:     This subprogram accepts a station ID from the calling 
c              unit to find its appropriate station file SSN match in
c              the sta file.
c
c  Local Variables and Constants:
c  ------------------------------
c sernum              : station serial number (SSN)
c stacalled           : station ID sent by the calling unit
c station             : station ID read from sta file      
c 
c  Global Variables and Constants:
c  -------------------------------
c sta                 : var containing the unit number assigned to the  
c                       direct access file consisting of the 
c                       definitive station list of SSNs and their
c                       assigned station IDs 
c
c
c  This Module Called By : compgb
c
c  This Module Calls  : none
c
c  Include Files Used : none
c
c  Common Blocks Used : none
c
c  References:  RM/FORTRAN Manual, COMPGB User's Documentation
c  
c  Comments:  none
c
c********1*********2*********3*********4*********5*********6*********7**
c    Modification History:
c::9001.12, TJC, Station serial number field expanded to 4 digits
c********1*********2*********3*********4*********5*********6*********7**
ce::look

      integer*2 look,sta,sernum
      character*4 station,stacalled 
      sta=510

      do 100 sernum=1,9999 
        read(sta,rec=sernum,fmt=50)station
  50    format(a4)
        if (station.eq.stacalled) then 
            look=sernum
            goto 110
        endif 
 100  continue 
 
      look=0 
 110  return 
 
      end 
 

    
cb::checkgf
c
      subroutine checkgf(station,day,k,dup25)                                  
c
c********1*********2*********3*********4*********5*********6*********7**
c Name:        checkgf
c Version:     1.1  (9001.12)
c Written by:  ______________ & TJ Cacanindin 
c Purpose:     This subprogram checks the gfile to see if session and
c              station ID of the current bfile record are in the set
c              of allowable baseline vector entries for the day.
c
c  Local Variables and Constants:
c  ------------------------------
c ch                  : 't'/'f' value which indicates whether a certain
c                       bfile *25* record has previously appeared
c day                 : UTC day of year baseline vector observed 
c done1(90)           : indicate whether bfile *25* sess/station IDs are
c                       origin stations for the gfile baseline vectors
c done2(90)           : indicate whether bfile *25* sess/station IDs are 
c                       differential stations for gfile baseline vectors
c dup25               : indicates whether duplicate *25* exists for day
c errday              : day of record to appear in output error message
c errsess             : sess/sta ID of record to appear in output errmsg
c ingfile             : indicates whether a certain bfile vector is 
c                       recorded in the gfile    
c int                 : represents the starting position of "station" 
c                       within the baseline(day,i) character string
c k                   : record line counter
c rn                  : record number of the direct access file
c station             : station ID read from sta file     
c 
c  Global Variables and Constants:
c  -------------------------------
c baseline(366,90)    : array of all baseline vectors in gfile indexed
c                       by day (90 vectors/day are allowed) 
c max                 : maximum number of records in error files
c
c
c  This Module Called By : compgb
c
c  This Module Calls  : none
c
c  Include Files Used : none
c
c  Common Blocks Used : /globls/
c
c  References:  RM/FORTRAN Manual, COMPGB User's Documentation
c
c  Comments:  none
c
c********1*********2*********3*********4*********5*********6*********7**
c    Modification History:
c::9001.12, TJC, Flags duplicate bfile *25*s and errmsgs
c********1*********2*********3*********4*********5*********6*********7**
ce::checkgf
 
      integer*2 day,i,donef1,donef2,int,max,rn,k,errf1,errf2,errday
      integer*2 basecnt
      character*10 baseline(5999)
      integer*2    baselind(5999)
      character*5 station,errsess
      character*1 done1(5999),done2(5999),ch 
      logical dup25,ingfile
       
      common/globls/baselind,baseline,basecnt,max 
      common/globls2/done1,done2
 
      data donef1,donef2,errf1,errf2/430,440,450,460/
      ingfile=.false.
      dup25=.false.

      do 20 i=1,basecnt
	if(baselind(i) .eq. day) then
          if (index(baseline(i),station).ne.0) then 
           int=index(baseline(i),station)
           if (int .eq. 1) then
               ch=done1(i)
               if (ch .eq. 't') then
                  dup25=.true.
               else
                  done1(i)='t'
               endif
           else
               ch=done2(i)
               if (ch .eq. 't') then
                  dup25=.true.
               else
                  done2(i)='t'
               endif
           endif
           ingfile=.true. 
          endif 
        endif
  20  continue 
 
c........ Loads errf1,errf2 so that "No gfile "C/F" member record for 
c         day\station" message appears
      rn=1
      if (.not.ingfile) then
         if (max .eq. 0) then
            write(errf1,rec=rn,fmt=25)day
  25        format(i3)
            write(errf2,rec=rn,fmt=27)station
  27        format(a5)
            max=1
         else
            do 30 rn=1,max
               read(errf1,rec=rn,fmt=25)errday
               read(errf2,rec=rn,fmt=27)errsess
               if ((errday .eq. day) .and. (errsess .eq. station)) then
                  dup25=.true.
                  goto 40
               endif
  30        continue
            max=max+1
            write(errf1,rec=max,fmt=25)day
            write(errf2,rec=max,fmt=27)station
         endif
      endif
  40  return
      end 


cb::dup    
c
      logical function dup (day,testline1,testline2)                              
c
c********1*********2*********3*********4*********5*********6*********7**
c Name:        dup    
c Version:     1.2  (9703.14)
c Written by:  JBM 
c Purpose:     This logical function checks if day,testline1,and
C              testline2 are in the baselind and baseline arrays
c
c  Local Variables and Constants:
c  ------------------------------
c day                 : UTC day of year baseline vector observed 
c                       within the baseline(day,i) character string
c 
c  Global Variables and Constants:
c  -------------------------------
c baseline(5999)      : array of all baseline vectors in gfile 
c baselind(5999)      : array of days 
c basecnt             : array count
c
c  This Module Called By : compgb
c
c  This Module Calls  : none
c
c  Include Files Used : none
c
c  Common Blocks Used : /globls/
c
c  References:  RM/FORTRAN Manual, COMPGB User's Documentation
c
c  Comments:  none
c
c********1*********2*********3*********4*********5*********6*********7**
ce: dup
 
      integer*2 day,i,max
      integer*2 basecnt
      character*10 testline1,testline2
      character*10 baseline(5999)
      integer*2    baselind(5999)
       
      common/globls/baselind,baseline,basecnt,max 

      dup = .false. 
      do 10 i = 1,basecnt
	if(baselind(i) .eq. day) then
	  if((baseline(i) .eq. testline1) .or.
     $    (baseline(i) .eq. testline2)) then
	     dup = .true.
	     return
          endif
        endif
 10   continue
      return
      end
