       subroutine stdard(iord,istd,instd,itech,itext,                   STDA001
     &                   lamda,gitp,cf,iver,st)                         STDA002
c ---------------------------------------------------------------       STDA003
c      evaluates the standard correction of internal standard           STDA004
c      uses STPLRG, MATINV, REVERS, NSWAP, REGPLT                       STDA005
c ---------------------------------------------------------------       STDA006
c      version 4.2 last revised 01.5.92 PhysiSoft Corp                  STDA007
c ---------------------------------------------------------------       STDA008
       parameter (ns=30,ipl=6)                                          STDA009
       real*4 lamda                                                     STDA010
       integer hh(ns)                                                   STDA011
       character*70 itext                                               STDA012
       dimension kk(ns),ll(ns),thth(ns),the(ns),st(0:2),thesav(ns)      STDA013
       dimension delth(ns), aa(ns+1,ns+2), cf(1), del(ns)               STDA014
                                                                        STDA015
       rad=180.0/3.1415927                                              STDA016
                                                                        STDA017
c --------- read lines 4 - standard values                              STDA018
       do 11 i=1,instd                                                  STDA019
   11     read (5,*,err=9998) HH(i), KK(i),LL(i),THE(i)                 STDA020
                                                                        STDA021
c -------- calculation of theor. values of std thth(i),                 STDA022
c -------- normalize the THE(i)'s to 1 theta and calculate deltas WMW   STDA023
        do 22 i=1,instd                                                 STDA024
           sumhkl=hh(i)**2+kk(i)**2+ll(i)**2                            STDA025
           thth(i)=asin(sqrt(((lamda/(2*gitp))**2)*sumhkl))*rad         STDA026
           thesav(i)=the(i)                                             STDA027
           if (itech.EQ.2) then                                         STDA028
              the(i) = the(i)/4                                         STDA029
           else if (itech.EQ.1.OR.itech.EQ.3.OR.itech.EQ.4) then        STDA030
              the(i)=the(i)/2                                           STDA031
           end if                                                       STDA032
  22    delth(i)=thth(i)-the(i)                                         STDA033
                                                                        STDA034
c ---- call lsq for polynomial fit:                                     STDA035
c      general purpose routine STPLRG, calls to MATINV                  STDA036
c      These are Standard-Routines adapted to free parameter choice     STDA037
c      -------------------------------------------------------------    STDA038
c      instd: number of Observations M                                  STDA039
c      the  : observed theta-values, independend variables X(i)         STDA040
c      delth: deviations from thth, dependend observations Y(i)         STDA041
c      iord : order of polynomial                                       STDA042
c      cf   : the coefficients (returned in reverse order)              STDA043
c      iflag: 1 if ok else shit                                         STDA044
c      aa   : coefficient matrix AA(iord+1,iord+2)                      STDA045
c      -------------------------------------------------------------    STDA046
c      sbr revers puts array cf in proper order                         STDA047
                                                                        STDA048
       do 33 i=1,iord+1                                                 STDA049
   33     cf(i)=0                                                       STDA050
                                                                        STDA051
       call stplrg(instd,the,delth,iord,cf,iflag,aa)                    STDA052
       if (iflag.ne.1) then                                             STDA053
           write(*,*)' Error in solving polynomial fit '                STDA054
           stop                                                         STDA055
       end if                                                           STDA056
       call revers(cf,iord+1)                                           STDA057
                                                                        STDA058
C ------ calculate deviations from standard reflections                 STDA059
       do 44 j=1, instd                                                 STDA060
          del(j)=0                                                      STDA061
          do 44 i=1, iord+1                                             STDA062
             del(j)=del(j)+cf(i)*(the(j)**(i-1))                        STDA063
   44  continue                                                         STDA064
                                                                        STDA065
                                                                        STDA066
C ---- write page header                                                STDA067
      write(ipl,'(/a,a3,a,a,//)')' XLAT (C) Version ',iver,' - Least',  STDA068
     & ' squares refinement of cell constants'                          STDA069
                                                                        STDA070
c ----- write polynomial graph header                                   STDA071
      write(ipl,'(a/)')' Internal Standard Correction for '             STDA072
      write(ipl,'(1x,a)')  itext                                        STDA073
      write(ipl,'(1x,45(1H=),/)')                                       STDA074
                                                                        STDA075
c ----- write type of standard                                          STDA076
      if (istd.EQ.0) then                                               STDA077
         write(ipl,'(a,f9.6,/)') ' Standard: Germanium   A = ',st(istd) STDA078
      else if (istd.EQ.1)  then                                         STDA079
         write(ipl,'(a,f9.6,/)') ' Standard: Silicon     A = ',st(istd) STDA080
      else if (istd.EQ.2) then                                          STDA081
         write(ipl,'(a,f9.6,/)') ' Standard: Tungsten    A = ',st(istd) STDA082
      else                                                              STDA083
         write(ipl,'(a,f9.6,/)')' Standard: user defined     A = ',gitp STDA084
      end if                                                            STDA085
      write (ipl,'(a/)')' Statistical weight 1.0 for all reflections of STDA086
     &standard'                                                         STDA087
                                                                        STDA088
c ----- write table of standard values and deviations                   STDA089
      write(ipl,'(a,a)')' H  K  L    theta      theta      theta',      STDA090
     &'     delta     correction'                                       STDA091
      write(ipl,'(a,a)')'          observed   (1 theta)  theorie',      STDA092
     &'     theta     fct. value'                                       STDA093
      write(ipl,'(1x,65(''-''))')                                       STDA094
      do 55 i=1,instd                                                   STDA095
         write(ipl,'(1x,3(i1,2x),3(f8.3,2X),F10.5,3X,F10.5)')           STDA096
     &   hh(i),kk(i),ll(i),thesav(i),the(i),thth(i),delth(i),del(i)     STDA097
   55 continue                                                          STDA098
      write(ipl,'(1x,65(''-''))')                                       STDA099
                                                                        STDA100
c ----- output polynom and coefficients                                 STDA101
      write(ipl,'(a)')' Fitting polynomial used :'                      STDA102
      write(ipl,'(1x,27(''-''),/,a,/)')'    Delta(theta) = '            STDA103
      do 66 i=1, iord                                                   STDA104
   66    write(ipl,'(1x,e12.5,a,i1,a)') cf(i),' * theta**',i-1,' +'     STDA105
      write(ipl,'(1x,e12.5,a,i1,a)') cf(i),' * theta**',i-1             STDA106
      write(ipl,'(1x,27(''-''),//)')                                    STDA107
                                                                        STDA108
c ----- call plot routine for polynomial graph line print               STDA109
      write(*,'(/a)')'  Calculating polynomial regression '             STDA110
      call regplt (delth,the,instd,cf,itech,iord)                       STDA111
                                                                        STDA112
      goto 9999                                                         STDA113
 9998 write ( *, '(/a)')'  error reading standard reflections'          STDA114
      stop 1                                                            STDA115
 9999 return                                                            STDA116
      end                                                               STDA117
                                                                        STDA118
