                            Program XLAT                                XLAT001
c-----------------------------------------------------------------------XLAT002
c    XLAT - a least squares refinement program of cell constants        XLAT003
c                                                                       XLAT004
c               (C) Copyright 1988 Bernhard Rupp                        XLAT005
c           c/o       University of California                          XLAT006
c                       Livermore, CA 94551                             XLAT007
c-----------------------------------------------------------------------XLAT008
c             Generic version for both machines, VAX and IBM            XLAT009
c      To change to VAX version, replace all end of record-edit         XLAT010
c      backslashes (MS-Fortran) into $-signs. Remove the comment C's    XLAT011
c      for the VAX and comment the PC-lines out (Search vor string VAX) XLAT012
c-----------------------------------------------------------------------XLAT013
c       Set the parameters for computer and version # if revisions      XLAT014
c       are made. Last revison version 4.0 includes reprint             XLAT015
c       of the XLAT manual.                                             XLAT016
c       ---------------------------------------                         XLAT017
c       Revision 4.1 : Added sdev for c/a ratio                         XLAT018
c       ---------------------------------------                         XLAT019
c       Revision 4.2 : 32-bit version MS Fortran, May 1994              XLAT020
c       ----------------------------------------                        XLAT021
c ----------------------------------------------------------------------XLAT022
       Parameter  (ns=30, nl=150, iver='4.2',ipmax=3,isysmx=4)          XLAT023
       parameter  (imak='IBM ',icomp='PC  ')                            XLAT024
c      parameter  (imak='DEC ',icomp='VAX ')                            XLAT025
c ----------------------------------------------------------------------XLAT026
c       ns    = number of standard lines                                XLAT027
c       nl    = number of reflections hkl                               XLAT028
c       iver  = version number                                          XLAT029
c       ipmax = maximum number of independend cell parameters           XLAT030
c       isysmx= largest allowed system code isys                        XLAT031
c       icomp = computer                                                XLAT032
c       imak  = make                                                    XLAT033
c ----------------------------------------------------------------------XLAT034
                                                                        XLAT035
      character symb*4,anode*2,radsym*2,itext*70,itim*8,idat*11         XLAT036
      integer H(nl)                                                     XLAT037
      real lamda                                                        XLAT038
      logical wrong                                                     XLAT039
                                                                        XLAT040
C ---- dimensions                                                       XLAT041
                                                                        XLAT042
      dimension K(nl),L(nl),theta(nl),thetao(nl),wgt(nl),thetac(nl)     XLAT043
      dimension sinqc(nl),dsin2(nl)                                     XLAT044
      dimension iskip(nl), dev(nl), gl(ipmax+2,nl), stapar(0:2)         XLAT045
      dimension cf(ns-1), a(ipmax+1,ipmax+2), ipar(isysmx)              XLAT046
      dimension parcal(ipmax),parobs(ipmax),sumdev(ipmax)               XLAT047
      dimension sigma(ipmax), delpar(ipmax,nl), icont(ipmax,nl)         XLAT048
                                                                        XLAT049
C ---- constants (data statements)                                      XLAT050
                                                                        XLAT051
      data ipar/1,2,2,3/                                                XLAT052
      data stapar/5.657906,5.431065,3.16480/                            XLAT053
      data rad/57.29577951/                                             XLAT054
      icom=icomp                                                        XLAT055
                                                                        XLAT056
c --- get date and time, uncomment also subrt VAXDAT --                 XLAT057
c     call vaxdat(begsec,itim,idat)                                     XLAT058
      call pcdat (begsec,itim,idat)                                     XLAT059
                                                                        XLAT060
c ---- write date & time on screen                                      XLAT061
       write(*,'(a,a3,a,a,a,/,a,a,a,a)')'  XLAT (C) Version ',iver,     XLAT062
     & ' for the ',imak,icomp,'  called on ',idat,' at ',itim           XLAT063
                                                                        XLAT064
c ---- open default files --                                            XLAT065
                                                                        XLAT066
      open(5,file='GIT.INP', err=9994, status='old')                    XLAT067
      open(6,file='GIT.OUT', err=9993, status='unknown')                XLAT068
                                                                        XLAT069
C --- read input line 1 --                                              XLAT070
      read (5,'(a)') itext                                              XLAT071
                                                                        XLAT072
C --- read input line 2 --                                              XLAT073
      read (5,*,err=9918) isys,itech,iord,istd,instd,icor               XLAT074
                                                                        XLAT075
c --- check, if input reasonable --                                     XLAT076
 7001 if (isys.gt.4) then                                               XLAT077
 0001    write (*,'(a$)') '  Invalid system - enter new isys (1-4) : '  XLAT078
         read (*,*,err=0001) isys                                       XLAT079
         goto 7001                                                      XLAT080
      end if                                                            XLAT081
 7002 if (itech.gt.4) then                                              XLAT082
 0002    write (*,'(a$)') '  Invalid device - enter new itech (0-4) : ' XLAT083
         read (*,*,err=0002) itech                                      XLAT084
         goto 7002                                                      XLAT085
      end if                                                            XLAT086
 7003 if (istd.gt.3) then                                               XLAT087
 0003    write (*,'(a$)')'  Invalid standard - enter new istd (0-3) : ' XLAT088
         read (*,*,err=0003) istd                                       XLAT089
         goto 7003                                                      XLAT090
      end if                                                            XLAT091
                                                                        XLAT092
c --- re-read record if external standard cell parameter                XLAT093
      if (istd.eq.3) then                                               XLAT094
         backspace 5                                                    XLAT095
         read (5,*,err=9928) isys,itech,iord,istd,instd,icor,stgipa     XLAT096
 7004    if (stgipa.lt.2.0) then                                        XLAT097
 0004    write(*,'(a$)') '  Invalid standard - enter cell constant : '  XLAT098
         read (*,*,err=0004) stgipa                                     XLAT099
            goto 7004                                                   XLAT100
         else                                                           XLAT101
            gipa=stgipa                                                 XLAT102
         end if                                                         XLAT103
      else                                                              XLAT104
         gipa=stapar(istd)                                              XLAT105
      endif                                                             XLAT106
                                                                        XLAT107
c --- check drift constant range                                        XLAT108
 7005 if (icor.lt.0.or.icor.gt.2) then                                  XLAT109
 0005    write(*,'(a$)')'  Invalid drift correction - new icor (0-2) : 'XLAT110
         read (*,*,err=0005) icor                                       XLAT111
         goto 7005                                                      XLAT112
      end if                                                            XLAT113
                                                                        XLAT114
c --- check for invalid combination of techniques                       XLAT115
      if ((itech.eq.2.or.itech.eq.4).and.(icor.ne.2)) then              XLAT116
        write(*,*)' Warning: using drift in conjunction with standard'  XLAT117
      end if                                                            XLAT118
                                                                        XLAT119
c --- check to high polynomial degree                                   XLAT120
      if (itech.eq.2.or.itech.eq.4) then                                XLAT121
         print*, ' Checking standards'                                  XLAT122
 7006    if (iord.gt.(instd-1)) then                                    XLAT123
            print*,' Polynomial order exceeds number of standard lines' XLAT124
 0006       write(*,'(a,i1,a$)')'  Please enter order of fit (1-',      XLAT125
     &             instd-1,      ') : '                                 XLAT126
            read (*,*,err=0006) iord                                    XLAT127
            goto 7006                                                   XLAT128
         end if                                                         XLAT129
      end if                                                            XLAT130
                                                                        XLAT131
C ---   read input line 3                                               XLAT132
        read (5,*,err=2001) lamda, schr, dmax                           XLAT133
        iwavel=1                                                        XLAT134
        goto 2002                                                       XLAT135
                                                                        XLAT136
c ---   read once more if symbol found                                  XLAT137
 2001   backspace 5                                                     XLAT138
        read (5,'(a4,2(1x,f4.2))',err=9938) symb,schr,dmax              XLAT139
        iwavel=0                                                        XLAT140
        call upstrg (symb,4)                                            XLAT141
C ---   retrive wavelength symbol                                       XLAT142
        read (symb,'(a2,a2)') anode,radsym                              XLAT143
        call chkwav (anode,ianode,wrong,5)                              XLAT144
        call chkwav (radsym,irad,wrong,6)                               XLAT145
        if (wrong) then                                                 XLAT146
           write (*,*)' Tilt - unable to interpret wavelength symbol ', XLAT147
     &                 radsym                                           XLAT148
 0009     write(*,'(/a$)')' Please enter the wavelength in Angstroem : 'XLAT149
           read (*,'(f8.6)',err=0009)  lamda                            XLAT150
           if (lamda.le.0.20.or.lamda.gt.5.0) then                      XLAT151
             write (*,*) 'Ehh ?'                                        XLAT152
             goto 0009                                                  XLAT153
           endif                                                        XLAT154
        else                                                            XLAT155
           call wavlen (ianode,irad,lamda)                              XLAT156
        end if                                                          XLAT157
                                                                        XLAT158
c ---   proceed here --                                                 XLAT159
 2002   continue                                                        XLAT160
                                                                        XLAT161
 7007   if (dmax.eq.0.0) then                                           XLAT162
 0007    write(*,'(a$)')'  Non zero value required for dmax (.05,eg): ' XLAT163
         read (*,*,err=0007) dmax                                       XLAT164
           goto 7007                                                    XLAT165
        end if                                                          XLAT166
                                                                        XLAT167
      if (itech.eq.2.or.itech.eq.4) then                                XLAT168
c ------ call standard calculation                                      XLAT169
         call stdard(iord,istd,instd,itech,itext,lamda,gipa,cf,iver,    XLAT170
     &               stapar)                                            XLAT171
      else if (instd.ne.0) then                                         XLAT172
c ------ issue warning, if standard values not allowed                  XLAT173
         write(*,'(/a,a/)')'  Warning - no standard lines allowed',     XLAT174
     &                     ' for this device'                           XLAT175
      end if                                                            XLAT176
                                                                        XLAT177
c ---- read reflections data set                                        XLAT178
       n=0                                                              XLAT179
       do 1001 j = 1 , nl                                               XLAT180
          read(5,*,err=9948,end=1002)  H(J), K(J), L(J),theta(J)        XLAT181
 1001  n=n+1                                                            XLAT182
                                                                        XLAT183
c ---- loop over all input data                                         XLAT184
 1002  do 1003 I=1,n                                                    XLAT185
c ------- normalize to 1 theta                                          XLAT186
          thetao(I) = theta(I)                                          XLAT187
          if(itech.EQ.2) then                                           XLAT188
             theta(I)=theta(I)/4                                        XLAT189
          else if(itech.EQ.1.OR.itech.EQ.3.OR.itech.EQ.4) then          XLAT190
             theta(I)=theta(I)/2                                        XLAT191
          end if                                                        XLAT192
c ------- initialize contribution indicator, weight, iskip              XLAT193
          do 1021 j=1,ipmax                                             XLAT194
 1021       icont(j,i)=0                                                XLAT195
          wgt(i)=1.0                                                    XLAT196
          iskip(i)=0                                                    XLAT197
c ------- calculate deviations from polynomial fit and correct thetas   XLAT198
          if (itech.eq.2.or.itech.eq.4) then                            XLAT199
             do 1004 j=1, iord+1                                        XLAT200
 1004           dev(i)=dev(i)+cf(j)*(theta(i)**(j-1))                   XLAT201
             theta(i)=theta(i)+dev(i)                                   XLAT202
          end if                                                        XLAT203
c ------- use shrinkage, if entered                                     XLAT204
          if (schr.ne.0.0) theta(I)=theta(I)*(1.0+schr/90.0)            XLAT205
 1003  continue                                                         XLAT206
                                                                        XLAT207
c ---- check if enough reflections entered                              XLAT208
       if (n.lt.(ipar(isys)+1)) goto 9996                               XLAT209
                                                                        XLAT210
c ---- initialize valid reflections nref and set sumwgt = n             XLAT211
       nref=n                                                           XLAT212
       sumwgt=float(nref)                                               XLAT213
c ---- initialize iteration counter                                     XLAT214
       iter=0                                                           XLAT215
                                                                        XLAT216
c ----------------------------------------------------------------      XLAT217
c      label 3333 is entry point for repeated iterations                XLAT218
c ----------------------------------------------------------------      XLAT219
 3333  continue                                                         XLAT220
                                                                        XLAT221
c ---- set iteration counter                                            XLAT222
       iter=iter+1                                                      XLAT223
                                                                        XLAT224
c ---- set up normal equations                                          XLAT225
       call normal(h,k,l,ipar,isys,icor,n,m,ipmax,gl,theta,a,wgt)       XLAT226
                                                                        XLAT227
c ---- m=ipar(isys)+2                                                   XLAT228
c ---- solve normal equation by matinv                                  XLAT229
       write (*,'(/,a20,i1)')'  Solving LSQ cycle ',iter                XLAT230
       irow=m-1                                                         XLAT231
c ---- minus m, - sign is a flag that no inverse is to be calculated    XLAT232
       icol=-m                                                          XLAT233
       idim=ipmax+1                                                     XLAT234
c ---- on error, uncomment next lines and link subroutine xdebug.for    XLAT235
c       imat=0                                                          XLAT236
c       call xdebug(imat,n,m,gl,a)                                      XLAT237
                                                                        XLAT238
       call matinv(iflag,idflag,irow,icol,a,idim,kwa,det)               XLAT239
                                                                        XLAT240
c ---- on error, uncomment next line                                    XLAT241
c       imat=1                                                          XLAT242
c       call xdebug(imat,n,m,gl,a)                                      XLAT243
                                                                        XLAT244
c ---- solutions are in a(1,m) a(2,m) etc,                              XLAT245
c ---- rearrange into a(1,1), a(2,1), a(3,1) etc and                    XLAT246
c ---- exit on error, if a needed cell parameter is nonpositive         XLAT247
       do 1006 i=1,m-1                                                  XLAT248
 1006     a(i,1)=a(i,m)                                                 XLAT249
       do 1026 i=1,m-2                                                  XLAT250
c ------- uncomment, if troubles occur (range about 10E-3 to 10E-2)     XLAT251
c         write(*,*) ' A(',i,',1)=',a(i,1)                              XLAT252
 1026     if (a(i,1).le.0.0) goto 9995                                  XLAT253
                                                                        XLAT254
c ---- evaluate parameters and deviations from solution vector A(i,1)   XLAT255
c ---- using coefficient equations gl(i,j)                              XLAT256
                                                                        XLAT257
c ---- calc. cell constant, initialize sum of deviations                XLAT258
       do 3001 ik=1,m-2                                                 XLAT259
          sumdev(ik)=0.0                                                XLAT260
 3001     parcal(ik)=lamda/sqrt(4*a(ik,1))                              XLAT261
                                                                        XLAT262
c ---- loop over all reflections                                        XLAT263
       do 3002 i=1,n                                                    XLAT264
          sinqc(i)=0.0                                                  XLAT265
c ------- calculate sin**2(thetac(i))                                   XLAT266
          do 3003 j=1,m-1                                               XLAT267
 3003        sinqc(i)=sinqc(i)+a(j,1)*gl(j,i)                           XLAT268
c ------- loop over all parameters ik (note : a=1,c=2,b=3)              XLAT269
          do 3004 ik=1,m-2                                              XLAT270
             if (gl(ik,i).eq.0.0) then                                  XLAT271
                delpar(ik,i)=0.0                                        XLAT272
                icont(ik,i)=1                                           XLAT273
             else                                                       XLAT274
                temp=0.0                                                XLAT275
c ------------- calc 'obs.' cell parameters                             XLAT276
                if (ik.eq.1) then                                       XLAT277
                   do 3005 j=2,m-1                                      XLAT278
 3005                 temp=temp+gl(j,i)*a(j,1)                          XLAT279
                   parobs(ik)=(gl(m,i)-temp)/gl(1,i)                    XLAT280
                   jk=ik                                                XLAT281
                else if (ik.eq.2) then                                  XLAT282
                   if (ipar(isys).eq.2) then                            XLAT283
                      parobs(ik)=(gl(4,i)-gl(3,i)*a(3,1)-gl(1,i)*a(1,1))XLAT284
     &                          /gl(2,i)                                XLAT285
                      jk=ik                                             XLAT286
c ---------------- a little bit tricky : swap pars 2<==>3 if ortho      XLAT287
                   else                                                 XLAT288
                      parobs(ik+1)=(gl(5,i)-gl(4,i)*a(4,1)-gl(3,i)      XLAT289
     &                             *a(3,1)-gl(1,i)*a(1,1))/gl(2,i)      XLAT290
                      jk=ik+1                                           XLAT291
                   end if                                               XLAT292
                else                                                    XLAT293
                   parobs(ik-1)=(gl(5,i)-gl(4,i)*a(4,1)-gl(2,i)*a(2,1)- XLAT294
     &                        gl(1,i)*a(1,1))/gl(3,i)                   XLAT295
                   jk=ik-1                                              XLAT296
                end if                                                  XLAT297
c ------------- sum up deviations for calculation of sigma              XLAT298
c               and fill array delpar with deviations for error figure  XLAT299
                if (parobs(jk).gt.0.0) then                             XLAT300
                   parobs(jk)=lamda/sqrt(4*parobs(jk))                  XLAT301
                   delpar(jk,i)=parcal(ik)-parobs(jk)                   XLAT302
                   sumdev(jk)=sumdev(jk)+delpar(jk,i)**2*wgt(i)         XLAT303
                else                                                    XLAT304
                   delpar(jk,i)=0.0                                     XLAT305
                   icont(jk,i)=2                                        XLAT306
                end if                                                  XLAT307
             end if                                                     XLAT308
 3004     continue                                                      XLAT309
                                                                        XLAT310
c ------- calculate sin**2(thetao(i))-sin**2(thetac(i))                 XLAT311
          dsin2(i)=gl(m,i)-sinqc(i)                                     XLAT312
 3002  continue                                                         XLAT313
                                                                        XLAT314
c ----- calculate sigmas ----------------------------------------       XLAT315
c       THIS WAS WRONG IN OLD VERSIONS OF XLAT and is wrong             XLAT316
c       in Gitter (used at Univ. of Vienna)                             XLAT317
c       sigma was to small by a factor (nref-ipar(isys))/nref)          XLAT318
c --------------------------------------------------------------        XLAT319
       do 1007 ik=1,m-2                                                 XLAT320
          temp=sumwgt*(nref-ipar(isys))                                 XLAT321
          if (temp.le.0.0) then                                         XLAT322
             write(*,*)'  Warning: not enough values - sigma infinite'  XLAT323
             sigma(ik)=999.9999                                         XLAT324
          else                                                          XLAT325
             sigma(ik)=sqrt(sumdev(ik)/temp)                            XLAT326
          end if                                                        XLAT327
 1007  continue                                                         XLAT328
                                                                        XLAT329
c ---- calculate cell volume and c/a sigma                              XLAT330
       if (isys.eq.1) then                                              XLAT331
          vol=parcal(1)**3                                              XLAT332
          sigvol=2*parcal(1)**2*sigma(1)                                XLAT333
       else if (ipar(isys).eq.2) then                                   XLAT334
          if (isys.eq.3) parcal(1)=parcal(1)*1.1547005                  XLAT335
          covera=parcal(2)/parcal(1)                                    XLAT336
          sigca=covera**2 * ((sigma(2)/parcal(2))**2 +                  XLAT337
     &    (sigma(1)/parcal(1))**2)                                      XLAT338
          sigca=sqrt(sigca)                                             XLAT339
          vol=parcal(1)**2*parcal(2)                                    XLAT340
          sigvol=vol*sqrt((2*sigma(1)/parcal(1))**2+                    XLAT341
     &                      (sigma(2)/parcal(2))**2)                    XLAT342
          if (isys.eq.3) then                                           XLAT343
             vol=vol*0.866025                                           XLAT344
             sigvol=sigvol*0.866025                                     XLAT345
          end if                                                        XLAT346
       else                                                             XLAT347
c ---- re-swap parcal(2<=>3) if orthorhombic                            XLAT348
          call nswap(parcal(2),parcal(3))                               XLAT349
          vol=parcal(1)*parcal(2)*parcal(3)                             XLAT350
          sigvol=vol*sqrt((sigma(1)/parcal(1))**2 +                     XLAT351
     &           (sigma(2)/parcal(2))**2+(sigma(3)/parcal(3))**2)       XLAT352
       end if                                                           XLAT353
                                                                        XLAT354
c ---- write output now -------------------------------------------     XLAT355
c ---- if first iteration write output table header                     XLAT356
       if (iter.eq.1) then                                              XLAT357
          call tabhed(itext,lamda,isys,dmax,icor,schr,itech,iver)       XLAT358
       end if                                                           XLAT359
                                                                        XLAT360
c ---- write tabular output                                             XLAT361
       m=ipar(isys)+1                                                   XLAT362
       call table(n,m,a,ipmax,gl,lamda,rad,thetao,theta,iskip,          XLAT363
     & icor,isys,parcal,sigma,covera,sigca,vol,sigvol,dev,sinqc,h,k,l)  XLAT364
                                                                        XLAT365
c ---- plotting error figure                                            XLAT366
       call errfig (ipmax,iter,H,K,L,THETA,delpar,N,icont,              XLAT367
     &              isys,wgt,itext)                                     XLAT368
c ------------------------------------------------------------------    XLAT369
                                                                        XLAT370
c --- detecting lines delta(theta) > dmax                               XLAT371
c --- set a maximim value for iterations, i.e. 6                        XLAT372
      itmax=6                                                           XLAT373
      iworst=0                                                          XLAT374
      worst=0.0                                                         XLAT375
      itflag=0                                                          XLAT376
      do 1008 i=1,n                                                     XLAT377
         if(abs(sinqc(i)).gt.1) then                                    XLAT378
           write(*,'(a,i2,)')' Sin(theta(calc))**2 > 1 at reflexion ',i XLAT379
           stop 1                                                       XLAT380
         end if                                                         XLAT381
         thetac(I)=asin(sqrt(sinqc(i)))*rad                             XLAT382
         delt=(theta(I)-thetac(I))*wgt(i)                               XLAT383
c ------ find worst line                                                XLAT384
         if(abs(delt).gt.worst) then                                    XLAT385
            iworst=i                                                    XLAT386
            worst=abs(delt)                                             XLAT387
         endif                                                          XLAT388
c ------ set skipping indicator and iteration flag                      XLAT389
         if (abs(delt).gt.dmax) then                                    XLAT390
            iskip(i)=1                                                  XLAT391
            if (wgt(i).ne.0) itflag=1                                   XLAT392
         end if                                                         XLAT393
 1008 continue                                                          XLAT394
                                                                        XLAT395
      if (itflag.eq.1) then                                             XLAT396
c ----  reset parameters and restart game                               XLAT397
         iskip(iworst)=2                                                XLAT398
         sumwgt=sumwgt-wgt(iworst)                                      XLAT399
         wgt(iworst)=0.0                                                XLAT400
         nref=nref-1                                                    XLAT401
c ------ exit, if nref (number of contributing reflections) too low     XLAT402
         if (nref.le.(ipar(isys)+1)) goto 9997                          XLAT403
         if (iter.lt.itmax) then                                        XLAT404
            write (6,9001) char(12),iter+1,dmax                         XLAT405
         else                                                           XLAT406
            goto 9997                                                   XLAT407
         end if                                                         XLAT408
         goto 3333                                                      XLAT409
      else                                                              XLAT410
         goto 9999                                                      XLAT411
      end if                                                            XLAT412
                                                                        XLAT413
c ---- some error labels, a format                                      XLAT414
 9001 format(////,a1,/,2x,i1,'. refinement cycle - zero weight for refleXLAT415
     1ctions delta(theta) >',F4.2,' (*) :'//)                           XLAT416
                                                                        XLAT417
 9993 write(*,'(/a/)')'  Tilt - cannot open file GIT.OUT'               XLAT418
      stop 1                                                            XLAT419
 9994 write(*,'(/a/)')'  Tilt - cannot open file GIT.INP'               XLAT420
      stop 1                                                            XLAT421
 9995 write(*,'(/a/)')'  Zap - aborted due to nonpositive cell constant'XLAT422
      stop 1                                                            XLAT423
 9996 write(*,'(/a/)')'  Kaput - not enough reflexions entered'         XLAT424
      stop 1                                                            XLAT425
 9997 write (*,'(/,a,f4.2  )')'  Bad data - too many reflections out of XLAT426
     &theta limit', dmax                                                XLAT427
      write (*,'(a,i1)') '  after refinement cyle ', iter               XLAT428
      goto 9991                                                         XLAT429
 9918 write ( *, '(/a/)')'  Crash - error reading line 2 - terminated'  XLAT430
      stop 1                                                            XLAT431
 9928 write ( *, '(/a/)')'  Crash - error reading line 2a - terminated' XLAT432
      stop 1                                                            XLAT433
 9938 write ( *, '(/a/)')'  Crash - error reading line 3 - terminated'  XLAT434
      stop 1                                                            XLAT435
 9948 write ( *, '(/a/)')'  Crash - error reading sample reflections'   XLAT436
      stop 1                                                            XLAT437
 9999 write(*,'(/a)')'  XLAT successfully terminated '                  XLAT438
                                                                        XLAT439
 9991 continue                                                          XLAT440
                                                                        XLAT441
c --- evaluate elapsed time - uncomment correct version VAX/PC          XLAT442
c     call vaxdat (endsec,itim,idat)                                    XLAT443
      call pcdat (endsec,itim,idat)                                     XLAT444
      call elapsd (endsec,begsec,imin,isec,ihun)                        XLAT445
      call endxla (imin,isec,ihun)                                      XLAT446
      end                                                               XLAT447
