      program t2compare
c     ******************************************************************
c     UNIX Version:  16 February 1993
c
c     this program is an adaptation of the harwell subroutine oe05a
c     as described in ukaea report aere-r 8971 (jan. 1978), by s. marlow
c     and j. k. reid.   the fortran source for oe05a was obtained from
c     rebecca huebler of the nesc on november 5, 1982.
c
c     this program includes tests to detect whether or not fort.1 is
c     njoy or gnash output.  if it is, then discrepancies in the run-
c     ning times are ignored.
c
c     in addition, floating point data are recognized and trimmed to a
c     user-specified significance level.  this is by-passed by specifying
c     zero significant figures.  data may be of form 1.23E+4, 1.23E-4,
c     1.23+4, 1.23-4, 1.23 E+4, 1.23 E-4, but must have + or - sign.
c
c     if the output has a mixture of "with-E" and without-E" formats,
c     then a good practice is to replace all patterns "E+" with "+" and
c     "E-" with "-" using a text editor.  then the answer to the prompt
c     question regarding format is that this file does NOT have "E"s.
c
c     this version includes the capability of splitting the input records
c     in two before submitting them to oe05a for analysis.  this permits
c     a clearer display of the discrepancies on small monitors and simple
c     printers.  as a by-product of this feature, files with long lines,
c     (up to 240 characters per line) can be processed (using lrec=-30).
c     ******************************************************************
      data nin1,nin2,nout/1,2,3/
c
    5 continue
      write(*,90)
      lrec=0
      ndig=0
      read (*,*) lrec, ndig
      if (iabs(lrec).gt.30) write (*,91)
   91 format(/' Maximum number of words per line or half-line is 30')
      if (iabs(lrec).gt.30) go to 5
      if (lrec.eq.0) lrec=-16
      isplit=0
      if (lrec.lt.0) isplit=1
      if (lrec.lt.0) lrec=-lrec
      nchars=lrec*4*(isplit+1)
      write(*,10) lrec,ndig,isplit,nchars
   10 format(/,' lrec =',i3,'    ndig =',i2,'    isplit =',i2,
     1 '    nchars =',i4)
      if (ndig.gt.0) call fuzz(nin1,nin2,lrec,ndig,isplit)
      if (isplit.eq.1) call split(nin1,nin2,lrec)
c
c     open output  unit
c      open(nout,file='tape3.dat',status='new')
      call oe05a(nin1,nin2,lrec)
      stop
c
   90 format (/,' COMFUZZ ... Compare fort.1 with fort.2',/,
     1 ' A complete list of discrepancies is written on fort.3',//,
     2 ' READ (*,*) number of 4-character'
     3 ' words to be examined per line or half-line',/,
     z ' (0 same as -16;',
     x ' use negative values to trigger processing of'
     y ' half-lines)',/,' and number'
     4 ' of signif. figures to be used for compare (0 same as all)')
      end
c
      subroutine fuzz(nout1,nout2,lrec,ndig,isplit)
c
c     function of routine.  remove trailing digits from the two input
c     tapes, so as to suppress insignificant differences.
c
      dimension ia(240),ifn(2),inin(2)
      data i1hy,i1hn,i1he,i1hdot,i1hplu,i1hmin/1hy,1hn,1hE,1h.,1h+,1h-/
      data i1hbla/1h /
c
      nc=lrec*4*(isplit+1)
      write(*,90)
   90 format(/,' Subroutine FUZZ called to trim away'
     1 ' insignificant digits.')
    8 continue
      write(*,10)
   10 format(/,' Do numbers have ',3h'E',' in the exponent? (y or n)')
      read(*,15) iyn
   15 format(a1)
      if (iyn.ne.i1hy.and.iyn.ne.i1hn) go to 8
      ie=1
      if (iyn.eq.i1hn) ie=0
      write(*,25)
   25 format(/,' READ (*,*) max. no. characters to be blanked in any ',
     1 'field. (0 same as 7)')
      read (*,*) nbmax
      if (nbmax.eq.0) nbmax=7
      write(*,60) nbmax
   60 format(i8)
      inin(1)=nout1
      inin(2)=nout2
c
c     begin loop over input tapes
      do 100 nin=1,2
      ninp=inin(nin)
      nout=nin+50
c
c     open scratch  units (51,52).  units are destroyed at job end.
      open(nout,status='scratch')
   20 read (ninp,30,end=40) (ia(i),i=1,nc)
   50 idot=0
c     examine new line
      do 70 ik=2,nc
      if (ia(ik).eq.i1hdot) idot=ik
      if (ia(ik).ne.i1hplu.and.ia(ik).ne.i1hmin) go to 70
      if (idot.eq.0) go to 70
      if (ie.eq.0) go to 55
      if (ia(ik-1).ne.i1he) go to 70
   55 nblank=ik-idot-ndig-ie
      if (nblank.gt.nbmax) go to 70
      if (nblank.lt.1) go to 70
c     now blank out the uninteresting digits
      do 80 iff=1,nblank
      ia(ik-ie-iff)=i1hbla
   80 continue
c     re-initialize decimal-point locator
      idot=0
   70 continue
      write (nout,30) (ia(i),i=1,nc)
   30 format(240a1)
      go to 20
c     close input unit
   40 close(ninp)
  100 continue
      nout1=51
      nout2=52
      rewind nout1
      rewind nout2
      return
      end
c
      subroutine split(nout1,nout2,lrec)
c
c     function of routine.  split records in half for clearer display of
c     discrepancies in the distant columns.  lrec in this case is the
c     number of words processed in each half-record.
c
      dimension ic(120,2),inin(2)
c
      write(*,90)
   90 format(/,' Subroutine SPLIT called to break records in half for'
     1 ' clearer display.')
      nc=lrec*4
      inin(1)=nout1
      inin(2)=nout2
c
c     begin loop over input tapes
      do 100 nunit=1,2
      ninp=inin(nunit)
      nout=nunit+40
c     open scratch  units (41,42).  units are destroyed at job end.
      open(nout,status='scratch')
   20 read (ninp,30,end=40) ((ic(i,n),i=1,nc),n=1,2)
   30 format(240a1)
      do 50 nloop=1,2
      write (nout,60) (ic(i,nloop),i=1,nc)
   60 format(120a1)
   50 continue
      go to 20
c     close input unit
   40 close(ninp)
  100 continue
      nout1=41
      nout2=42
      rewind nout1
      rewind nout2
      return
      end
c
      subroutine oe05a(in1,in2,lrec)                                           1
c     in1,in2 contain the values of the input stream numbers for the           2
c             two input files.                                                 3
c     lrec    is the number of integers used to hold each record.              4
      integer cand                                                             5
      integer infile(2),record,hash                                            6
      common /oe05g/lhash,nr,lf,lpd,lp,short,lswtch                            7
      common /oe05h/hash(2048)                                                 8
      common/oe05k/cand(3000)                                                  9
      common /oe05j/split,mcand,limit                                         10
c     note that the array record must be at least nr*(lrec+3)+7*lf+3long      11
      common /oe05i/record(21003)                                             12
      common /oe05l/idc(3),icom,ibuf                                          13
      logical short,lswtch                                                    14
      infile(1)=in1                                                           15
      infile(2)=in2                                                           16
      lf1=lf+1                                                                17
      lf2=lf+lf                                                               18
      lf4=lf2+lf2                                                             19
      lpe=lf4+nr+1                                                            20
      lmatch=lpe+2*nr                                                         21
      lthr=lmatch+lf1                                                         22
      llink=lthr+lf1                                                          23
      lrd=llink+lf1                                                           24
      idc(1)=0                                                                25
      idc(2)=0                                                                26
      idc(3)=0                                                                27
      icom=0                                                                  28
      ibuf=2                                                                  29
      call oe05b(record(lrd),lrec,nr,record(lf2+1),lf*2,hash,lhash            30
     1          ,record(lf4+1),record(1),record(lpe),infile,cand(1)           31
     2          ,cand(mcand+1),cand(2*mcand+1),mcand,record(llink)            32
     3          ,lf1,record(lthr),record(lmatch),split,limit,lpd)             33
      return                                                                  34
      end                                                                     35
      subroutine oe05b(record,lrec,nr,file,lf2,hash,lhash,sameh,samer         36
     1                ,pfile,infile,icand,jcand,lcand,mcand,link,lf1          37
     2                ,ithr,matchl,split,limit,lpd)                           38
      common /oe05l/idc(3),icom,ibuf                                          39
      integer record(lrec,nr)                                                 40
c     record     is used to store records in source form.just one copy        41
c                of each distinct record is held.                             42
c     lrec       is the length in fortran storage units of each               43
c                source record.                                               44
c     nr         is the largest number of source records that can be          45
c                held at once.                                                46
      integer file(lf2)                                                       47
c     file       contains pointers to source records held in array            48
c                record.the first half is a compact representation of         49
c                part(or all) of file 1 and the second half is a compact      50
c                representation of part(or all) of file 2.                    51
c     lf2        is the length of array file.lf=lf2/2 is the maximum          52
c                number of records of either file that can be held at         53
c                once.                                                        54
      integer start(2),lfile(2),lact(2)                                       55
      logical endf(2)                                                         56
c     start(l)   ,l=1,2 is the position in array file of the start of         57
c                file l.wrap-round is included so that records may be         58
c                in positions start(1),start(1)+1,.....lf,1,2,... and         59
c                start(2),start(2)+1,....,lf2,lf+1,lf+2,...                   60
c     lfile(l)   ,l=1,2 is the length of the part of file l currently         61
c                stored.                                                      62
c     lact(l)    ,l=1,2 is the length of the currently stored part of         63
c                file l over which correspondences have been established      64
c     endf(l)    ,l=1,2 is .true. only if the end of file l has been          65
c                reached.                                                     66
      integer hash(lhash),sameh(nr)                                           67
c     hash(i)    points to the first record with hash code i,or is zero       68
c                if there are none.                                           69
c     lhash      is the maximal possible value of a hash code.                70
c     sameh      is used to link records with the same hash code and to       71
c                link free records.sameh(i) points to the next record         72
c                with the same hash code or to the next free record           73
c                unless record i is the last in its list,in which case        74
c                sameh(i)=0                                                   75
c     ifree points to the start of the list of free records                   76
      integer samer(lf2),pfile(nr,2),infile(2)                                77
c     samer(i)   points to the next entry in the same file that is            78
c                identical with that stored in file(i),unless there is        79
c                none in which case it points to the first such entry.        80
c     pfile(i,l) points to the last entry in file l that corresponds to       81
c                record(i,.),or is zero if there is none.                     82
c     infile(l)  ,l=1,2 is the unit number for file l.                        83
      integer icand(mcand),jcand(mcand),lcand(mcand),link(lf1)                84
c     icand(i)   ) are used to hold positions in files 1 and 2 of             85
c     jcand(i)   ) candidate correspondence i.                                86
c     lcand(i)   points to the previous correspondence in a maximal           87
c                common subsequence of leading parts of the two files         88
c                or is zero for the first such correspondence.                89
c     mcand      is the maximum number of candidate correspondences           90
c                that can be stored.                                          91
c     link(i)    points to the end of a maximal common subsequence            92
c                of length i-1.                                               93
c     lf1        =lf+1                                                        94
      integer ithr(lf1),matchl(lf1)                                           95
c     ithr(i)    holds the distance in file 2 that has to be traversed        96
c                to find a subsequence of length i common with the            97
c                current part of file 1 (its ii records).                     98
c     matchl     is used to hold a list of pointers to records in             99
c                file 2 identical with the current record in file 1,         100
c                and later to hold a list of pointers to candidate           101
c                correspondences that form a maximal common subsequence.     102
c     split      is the ratio of the number of correspondences used to       103
c                the number found if the search for a maximal common         104
c                subsequence is not completed for any reason.                105
c     limit      is the maximal number of candidate correspondences that     106
c                are permitted to be considered before output                107
c                recommences.                                                108
c     lpd        is the stream number for printing messages.                 109
      logical oe05e                                                          110
      data maxlp/1000000/                                                    111
c                                                                            112
c     set data structure to empty state                                      113
      do 100 l=1,2                                                           114
      lfile(l)=0                                                             115
      endf(l)=.false.                                                        116
  100 lact(l)=0                                                              117
      lf=lf2/2                                                               118
      start(1)=1                                                             119
      start(2)=lf+1                                                          120
      do 110 i=1,lhash                                                       121
  110 hash(i)=0                                                              122
      ifree=3                                                                123
      do 120 i=1,nr                                                          124
  120 sameh(i)=i+1                                                           125
      sameh(nr)=0                                                            126
c                                                                            127
c     each execution of this loop results in an insertion,deletion or        128
c     correspondence being output.                                           129
      do 610 mloop=1,maxlp                                                   130
      if(lact(1).gt.0 .or. lact(2).gt.0)go to 490                            131
c                                                                            132
c     read more records until data structure full                            133
       do 190 ir=1,lf2                                                       134
c     set if to the file number of the shorter non-empty file.               135
      if=1                                                                   136
      if(lfile(2) .lt. lfile(1))if=2                                         137
      if(endf(if))if=3-if                                                    138
c     jump if both files have been read.                                     139
      if(endf(if))go to 200                                                  140
c     jump if array file or array record is full.                            141
      if(lfile(if).ge.lf.or.ifree.eq.0)go to 200                             142
c     set js to next available position in file,allowing for wrap-round.     143
      js=start(if)+lfile(if)                                                 144
      if(js.gt.if*lf)js=js-lf                                                145
      jf=ifree                                                               146
c     read next record.                                                      147
      call oe05c(infile(if),record(1,jf),lrec,endf(if))                      148
c     jump if there was no next record to read.                              149
      if(endf(if))go to 190                                                  150
c     set ih to hash code for new record.                                    151
      call oe05f(ih,record(1,jf),lrec)                                       152
c     test record for being identical with one of those already read.        153
c     note that we only test those with the same hash code.                  154
      jh=hash(ih)                                                            155
      do 130 i=1,nr                                                          156
      if(jh.eq.0)go to 170                                                   157
      if(oe05e(record(1,jf),record(1,jh),lrec))go to 140                     158
      jh=sameh(jh)                                                           159
  130 continue                                                               160
c     insert new record in circular list of identical records                161
  140 is=pfile(jh,if)                                                        162
      if(is.ne.0)go to 150                                                   163
      is=js                                                                  164
      go to 160                                                              165
  150 samer(js)=samer(is)                                                    166
  160 file(js)=jh                                                            167
      pfile(jh,if)=js                                                        168
      samer(is)=js                                                           169
      go to 180                                                              170
c     add new record to part of list with identical hash codes               171
  170 ifree=sameh(jf)                                                        172
      jh=hash(ih)                                                            173
      hash(ih)=jf                                                            174
      sameh(jf)=jh                                                           175
c     make new circular list of identical records                            176
      samer(js)=js                                                           177
      file(js)=jf                                                            178
      pfile(jf,if)=js                                                        179
      l3=3-if                                                                180
      pfile(jf,l3)=0                                                         181
  180 lfile(if)=lfile(if)+1                                                  182
  190 continue                                                               183
c                                                                            184
c     test for termination.                                                  185
  200 if(lfile(1).eq.0.and.lfile(2).eq.0)go to 620                           186
c     test top records.icase=1 for insertion,=2 for deletion,                187
c                           =3 for common line                               188
      icase=3                                                                189
      do 210 l=1,2                                                           190
      if(lfile(l).eq.0)go to 210                                             191
      is=start(l)                                                            192
      l3=3-l                                                                 193
c     find the earliest record of file l3 that is identical                  194
c     with first record of file l                                            195
      ir=file(is)                                                            196
      ir=pfile(ir,l3)                                                        197
      if(ir.le.0)go to 540                                                   198
      ir=samer(ir)                                                           199
c     if ir is first record then top records correspond.                     200
      if(ir.eq.start(l3))go to 550                                           201
  210 continue                                                               202
c     each top record is identical with one in other file.                   203
c     set up list of as many essential candidates as possible                204
      k=1                                                                    205
      mm=lfile(1)                                                            206
      nn=lfile(2)                                                            207
      nn1=nn+1                                                               208
c     initialise threshold values                                            209
      do 220 jj=1,nn                                                         210
      ithr(jj+1)=nn1                                                         211
  220 continue                                                               212
      ithr(1)=0                                                              213
      lcsp=0                                                                 214
c     initialise link pointer to end of candiate list                        215
      link(1)=0                                                              216
      ncand=0                                                                217
      icount=0                                                               218
c     loop over first file                                                   219
      do 330 ii=1,mm                                                         220
      is=start(1)+ii-1                                                       221
      if(is.gt.lf)is=is-lf                                                   222
c     does the ii th record in the file have any correspondences in          223
c     the second file                                                        224
      js=file(is)                                                            225
      ks=pfile(js,2)                                                         226
      if(ks.le.0)go to 330                                                   227
c     store in matchl list of records in second file which are identical     228
c     to present record in first file.                                       229
      js=ks                                                                  230
      do 230 nir=1,nn                                                        231
      js=samer(js)                                                           232
      matchl(nir)=js                                                         233
      if(js.eq.ks)go to 240                                                  234
  230 continue                                                               235
c     initialise upper bound of search                                       236
c     jcn is used to detect and eliminate  non essential candidates          237
  240 jcn=-1                                                                 238
      jq=nn1                                                                 239
      do 320 kj=1,nir                                                        240
c     pick up correspondences in 2nd file in reverse order                   241
c     allow for wraparound                                                   242
      ms=nir+1-kj                                                            243
      jj=matchl(ms)-start(2)+1                                               244
      if(jj.le.0)jj=jj+lf                                                    245
      if(jj.ge.ithr(jq))go to 320                                            246
c     scan threshold values by binary search                                 247
c     initialise lower bound of search                                       248
      iq=1                                                                   249
      do 280 is=1,nn                                                         250
      if(jq.le.iq+1)go to 290                                                251
      k=(iq+jq)/2                                                            252
      if(jj-ithr(k))250,260,270                                              253
c     reset upper bound of search                                            254
  250 jq=k                                                                   255
      go to 280                                                              256
  260 jq=k                                                                   257
      go to 320                                                              258
c     reset lower bound of search                                            259
  270 iq=k                                                                   260
  280 continue                                                               261
c     ignore non essential candidates                                        262
  290 if(jcn.eq.jq)go to 310                                                 263
c     store candidate and link to previous candidate                         264
c     check that space is available                                          265
      if(ncand.lt.mcand)go to 300                                            266
c     set flag if space is unavailable                                       267
      lcsp=-1                                                                268
      go to 340                                                              269
  300 ncand=ncand+1                                                          270
      icand(ncand)=ii                                                        271
      lcand(ncand)=link(jq-1)                                                272
      link(jq)=ncand                                                         273
      jcn=jq                                                                 274
c     update file 2 part of candidate pair                                   275
  310 jcand(ncand)=jj                                                        276
c     update threshold                                                       277
      ithr(jq)=jj                                                            278
  320 continue                                                               279
      icount=icount+nir                                                      280
      if(icount.lt.limit)go to 330                                           281
      lcsp=1                                                                 282
      go to 340                                                              283
  330 continue                                                               284
c                                                                            285
c     find the largest k such that ithr(k).lt.nn1                            286
  340 iq=1                                                                   287
      jq=nn1                                                                 288
      k=jq                                                                   289
      if(nn.ge.ithr(jq))go to 390                                            290
      do 370 is=1,nn                                                         291
      if(jq.le.iq+1)go to 380                                                292
      k=(iq+jq)/2                                                            293
      if(nn-ithr(k))350,390,360                                              294
  350 jq=k                                                                   295
      go to 370                                                              296
  360 iq=k                                                                   297
  370 continue                                                               298
  380 k=iq                                                                   299
c     link(k) points to the head of a list linked structure of k-1 pairs     300
c     (i,j) representing a common subsequence of length k-1,in reverse       301
c     order                                                                  302
  390 l=link(k)                                                              303
      kand=k-1                                                               304
c     store in matchl the positions of the maximal common subsequence        305
      do 400 ii=1,kand                                                       306
      ir=kand+1-ii                                                           307
      matchl(ir)=l                                                           308
      l=lcand(l)                                                             309
  400 continue                                                               310
      if(lcsp)410,430,440                                                    311
  410 if(lpd.gt.0)write(lpd,420)                                             312
  420 format(30h oe05b candidate space is full)                              313
      go to 460                                                              314
  430 if(.not.(endf(1).and.endf(2)))go to 460                                315
      lact(1)=lfile(1)                                                       316
      lact(2)=lfile(2)                                                       317
      go to 480                                                              318
  440 if(lpd.gt.0)write(lpd,450)icount                                       319
  450 format(43h oe05b no of correspondences considered is  ,i6,             320
     1   28h ,this exceeds default value  )                                  321
  460 if(lpd.gt.0)write(lpd,470)kand                                         322
  470 format(46h oe05b length of maximal common subsequence is,i6,           323
     1   27h ,the files are being split)                                     324
      kand=max0(1,int(split*float(kand)))                                    325
      l=matchl(kand)                                                         326
      lact(1)=icand(l)                                                       327
      lact(2)=jcand(l)                                                       328
  480 icorr=1                                                                329
      ll=matchl(1)                                                           330
      l1=lact(1)+1                                                           331
      l2=lact(2)+1                                                           332
c                                                                            333
c     find next line for output.                                             334
c     jump if all identified correspondences have been output.               335
  490 if(icorr.gt.kand)go to 500                                             336
      if(l1-lact(1).lt.icand(ll))go to 510                                   337
      if(l2-lact(2).lt.jcand(ll))go to 520                                   338
      icase=3                                                                339
      icorr=icorr+1                                                          340
      if(icorr.le.kand)ll=matchl(icorr)                                      341
      go to 530                                                              342
  500 if(lact(1).le.0)go to 520                                              343
  510 icase=2                                                                344
      is=start(1)                                                            345
      go to 550                                                              346
  520 icase=1                                                                347
  530 is=start(2)                                                            348
      go to 550                                                              349
  540 icase=l3                                                               350
c                                                                            351
c     print line,then adjust file                                            352
  550 ir=file(is)                                                            353
c     update insertion/deletion/common count.                                354
      idc(icase)=idc(icase)+1                                                355
      call oe05d(icase,record(1,ir),record(1,1),lrec)                        356
      do 600 l=1,2                                                           357
      if(l.eq.icase)go to 600                                                358
c     update start(l),allowing for wrap-round if necessary.                  359
      is=start(l)                                                            360
      js=is                                                                  361
      if(start(l).eq.l*lf)start(l)=(l-1)*lf                                  362
      start(l)=start(l)+1                                                    363
c     update length of file and its active part.                             364
      lfile(l)=lfile(l)-1                                                    365
      lact(l)=lact(l)-1                                                      366
c     find last identical record                                             367
      ir=file(is)                                                            368
      il=pfile(ir,l)                                                         369
c     revise link to skip record removed.                                    370
      samer(il)=samer(is)                                                    371
c     jump if remaining linked list is not empty.                            372
      if(il.ne.is)go to 600                                                  373
      l3=3-l                                                                 374
      pfile(ir,l)=0                                                          375
      if(pfile(ir,l3).ne.0)go to 600                                         376
c     remove record ir                                                       377
c     find the hash code of the record.                                      378
      call oe05f(ih,record(1,ir),lrec)                                       379
      jh=hash(ih)                                                            380
c     jump if at the front of linked list.                                   381
      if(jh.eq.ir)go to 580                                                  382
c     search for previous record in linked list with identical hash code     383
      do 560 i=1,nr                                                          384
      lh=jh                                                                  385
      jh=sameh(jh)                                                           386
      if(jh.eq.ir)go to 570                                                  387
  560 continue                                                               388
c     revise link to skip record removed.                                    389
  570 sameh(lh)=sameh(ir)                                                    390
      go to 590                                                              391
  580 hash(ih)=sameh(ir)                                                     392
  590 sameh(ir)=ifree                                                        393
      ifree=ir                                                               394
  600 continue                                                               395
  610 continue                                                               396
c     check for final record in buffer                                       397
  620 call oe05d(0,record(1,1),record(1,1),lrec)                             398
      return                                                                 399
      end                                                                    400
      block data                                                             401
      common /oe05g/lhash,nr,lf,lpd,lp,short,lswtch                          402
      common /oe05j/split,mcand,limit                                        403
      logical short,lswtch                                                   404
      data lhash/2047/,lp/3/,nr/500/,lf/500/,lpd/0/,short/.true./            405
c     lp changed from 6 to 3 at lanl 21dec82
      data mcand/1000/,split/.5/,limit/100000/,lswtch/.true./                406
      end                                                                    407
       subroutine oe05c(in,ir,lrec,endf)                                     408
c read a record from file in into array ir.the length of the                 409
c record is lrec*4 characters.                                               410
c it is assumed that four characters fit into an integer.endf must           411
c be set .false. unless end of file has been reached when endf must be       412
c set .true.                                                                 413
      integer ir(lrec)                                                       414
      logical endf                                                           415
c***
      data njpat/4h1***/, init/0/, njoyo/0/
c
c     Valid choice for the February 1993 version of GNASH.
c     Works for positive value of lrec and for lrec=-16 (default).
      data nhpat1/4h Tim/, nhpat2/4hTime/
c***
      endf=.true.                                                           416
      if(lrec.gt.30) stop 707                                               417
c     length of records changed from 32 to 20 at lanl 03feb86
c     length of records changed from 20 to 30 at lanl 03feb86
      read(in,10,end=100)ir
   10 format(30a4)
   20 endf=.false.                                                           420
c***
c     local lanl coding to detect output files from njoy or gnash.
c     if njoy output is detected, all timing information is stripped
c     from the records by subroutine timefx.
c     if, on the other hand, gnash timing lines are detected, timing
c     information is stripped by subroutine gnatfx.
      if (njoyo.eq.1) go to 30
      if (init.eq.1) go to 35
c     on the first record (only) check if this is njoy output
      init=1
      if (ir(1).ne.njpat) go to 40
      if (lrec.ge.20) njoyo=1
      if (lrec.lt.20) write(*,25)
   25 format(/49h cannot fix time lines on njoy output, lrec.lt.20/)
      go to 40
   30 call timefx(ir,lrec)
      go to 40
c     for non-njoy outputs, check for gnash timing line.
   35 if (ir(1).eq.nhpat1.or.ir(1).eq.nhpat2) call gnatfx(ir,lrec)
   40 continue
c***
  100 return                                                                 421
      end                                                                    422
c***
      subroutine timefx(ir,lrec)
      dimension ir(lrec)
      dimension ltpat(10), ktpat(8)
      data (ltpat(i),i=1,10)/4h0s  ,4h1s  ,4h2s  ,4h3s  ,4h4s  ,
     1 4h5s  ,4h6s  ,4h7s  ,4h8s  ,4h9s  /
      data (ktpat(i),i=1,8) /4hp 1 ,4hp 2 ,4hp 3 ,4hp 4 ,4hp 5 ,
     1 4hp 6 ,4hp 7 ,4hp 8 /
      data ntim/10/, nte/8/, ib/4h    /
c
      if (lrec.lt.20) go to 60
      if (ir(20).eq.ib) go to 60
      if (lrec.eq.20) go to 20
      if (ir(21).ne.ib) go to 60
   20 if (ir(17).eq.ib) go to 30
c     treat patterns such as 'temp 1' (from heatr) same as blank
      do 25 i=1,nte
      if (ir(17).eq.ktpat(i)) go to 30
   25 continue
      go to 60
   30 do 40 i=1,ntim
      if (ir(20).ne.ltpat(i)) go to 40
      ir(18)=ib
      ir(19)=ib
      ir(20)=ib
      go to 60
   40 continue
   60 return
      end
      subroutine gnatfx(ir,lrec)
      dimension ir(lrec)
      data iblank/4h    /
      do 10 i=1,lrec
      ir(i)=iblank
   10 continue
      return
      end
c***
      logical function oe05e(ir1,ir2,lrec)                                   423
c     test whether records are identical.                                    424
c arrays ir1 and ir2 contain the two records to be compared.                 425
      integer ir1(lrec),ir2(lrec)                                            426
      oe05e=.false.                                                          427
      do 10 i=1,lrec                                                         428
      if(ir1(i).ne.ir2(i))go to 20                                           429
   10 continue                                                               430
      oe05e=.true.                                                           431
   20 return                                                                 432
       end                                                                   433
      subroutine oe05f(ih,ir,lrec)                                           434
c     calculate hash code in range (1,lhash) for record.                     435
c the array ir contains the record for which a                               436
c hash code is to be calculated.                                             437
c the routine sets in ih the hash value of the record.                       438
      common /oe05g/lhash,nr,lf,lpd,lp,short,lswtch                          439
      integer ir(lrec)                                                       440
      logical short,lswtch                                                   441
      ih=0                                                                   442
      do 1 i=1,lrec                                                          443
1     ih=ih+mod(ir(i),lhash)                                                 444
      ih=mod(iabs(ih),lhash)+1                                               445
      return                                                                 446
      end                                                                    447
      subroutine oe05d(ic,ir,irb,lrec)                                       448
c writes a record of length lrec                                             449
c array ir contains the record to be output.                                 450
c array irb is used to contain the two most recent  records common           451
c           to both files.                                                   452
c it is assumed that four characters are stored per integer.                 453
c lp is the stream number on which the record is to be written.              454
c short is a logical parameter with one of the following vales.              455
c       true. sequences of common records are compressed so that only        456
c             the first and last records are output together with the        457
c             number  of records omitted.                                    458
c       false. every record is output.                                       459
c ic is a parameter which has one of the following values.                   460
c     0 this entry is used to flush out a common record left in buffer       461
c       at the end of comparisions with short true.                          462
c     1 the record is an insertion to file 1.                                463
c     2 the record is a deletion from file 1.                                464
c     3 the record is common to both files.                                  465
      common /oe05g/lhash,nr,lf,lpd,lp,short,lswtch                          466
      common /oe05l/idc(3),icom,ibuf                                         467
      integer xt(3),ir(lrec),irb(lrec,2)                                     468
      logical short,lswh,lswtch                                              469
      data xt(1),xt(2),xt(3)/4h  2 ,4h 1  ,4h 12 /                           470
      lswh=.true.                                                            471
      if(lrec.gt.30 .or. .not.lswtch)lswh=.false.                            472
      inum1=idc(2)+idc(3)                                                    473
      inum2=idc(1)+idc(3)                                                    474
      if(.not.short)go to 155                                                475
      if(ic.ne.3)go to 110                                                   476
      icom=icom+1                                                            477
      if(icom.eq.1)go to 160                                                 478
c     store present record common to both files                              479
      ibuf=3-ibuf                                                            480
      do 100 i=1,lrec                                                        481
      irb(i,ibuf)=ir(i)                                                      482
  100 continue                                                               483
      go to 190                                                              484
  110 im1=icom-2                                                             485
      j1=inum1                                                               486
      j2=inum2                                                               487
      if(ic.eq.2)j1=j1-1                                                     488
      if(ic.eq.1)j2=j2-1                                                     489
      if(im1)150,140,120                                                     490
  120 if(im1.ne.1)go to 125                                                  491
c     output records common to both files at present in buffers              492
      ibuf1=3-ibuf                                                           493
      if(lp.le.0)go to 140                                                   494
      if(lswh)go to 122                                                      495
      write(lp,170)xt(3),(irb(i,ibuf1),i=1,lrec)                             496
      go to 140                                                              497
  122 i1=mod(j1-1,10000)                                                     498
      i2=mod(j2-1,10000)                                                     499
      write(lp,187)i1,i2,(irb(i,ibuf1),i=1,lrec)                             500
      go to 140                                                              501
  125 if(lp.gt.0)write(lp,130)im1                                            502
  130 format(12x,6h******,i6,                                                503
     1  47h records common to both files not listed ******)                  504
  140 if(lp.le.0)go to 150                                                   505
      if(lswh)go to 145                                                      506
      write(lp,170)xt(3),(irb(i,ibuf),i=1,lrec)                              507
      go to 150                                                              508
  145 i1=mod(j1,10000)                                                       509
      i2=mod(j2,10000)                                                       510
      write(lp,187)i1,i2,(irb(i,ibuf),i=1,lrec)                              511
  150 icom=0                                                                 512
  155 if(ic.le.0)go to 190                                                   513
c     output current record.                                                 514
  160 if(lp.le.0)go to 190                                                   515
      if(lswh)go to 180                                                      516
      write(lp,170)xt(ic),ir                                                 517
  170 format(33a4)                                                           518
      go to 190                                                              519
  180 i1=mod(inum1,10000)                                                    520
      i2=mod(inum2,10000)                                                    521
      if(ic-2)182,184,186                                                    522
  182 write(lp,183)i2,ir                                                     523
  183 format(5x,i5,2x,30a4)                                                  524
      go to 190                                                              525
  184 write(lp,185)i1,ir                                                     526
  185 format(i5,7x,30a4)                                                     527
      go to 190                                                              528
  186 write(lp,187)i1,i2,ir                                                  529
  187 format(2i5,2x,30a4)                                                    530
  190 return                                                                 531
      end                                                                    532
