      subroutine lazy(npos,bpos,xyzpos,struct, noisy)
      
C-----******************************************************************MAIN0000
C-----*               *** LNS VAX VERSION 1989                         ***
C-----*               *** with new table of neutron scattering lengths ***
C-----*                                                                *MAIN0002
C-----*                   L  A  Z  Y                                   *MAIN0003
C-----*                                                                *MAIN0005
C-----******************************************************************MAIN0006
C-----*                                                                *MAIN0008
C-----* ROUTINE TO PREPARE THE INPUT FOR  P U L V E R I X              *MAIN0009
C-----* AUTHOR  K. YVON
C-----* LABORATOIRE DE CRISTALLOGRAPHIE AUX RAYONS X ,                 *MAIN0014
C-----* UNIVERSITY OF GENEVA                                           *MAIN0015
C-----* 24 QUAI ERNEST ANSERMET, CH 1211 GENEVA, SWITZERLAND           *MAIN0016
C-----* TEL 022 219355                                                 *MAIN0017
C-----******************************************************************MAIN0020
C
c Modified by Tanya Riseman, Nov. 2001, NIST Center for Neutron Research.
c to allow free format reads on some cards (CELL, ATOM) and
c and modify CONDIT's format statement so that this routine can read in
c output from WWW Lazy program. Should make it easier to edit by LPI files
c by hand. However all parameters are now required by CELL and ATOM.
c Added error catching on read statements.
c 
C Adapted and tested by Carl Adams, Oct. 1998, NIST Center for
C Neutron Research for a Linux machine with a fort77 compiler
C
C Modified by Carl Adams, Nov. 1998 to upgrade the calculation
C of atomic positions to double precision variables.
C variables effected: ts, fs

	implicit none
	include 'arraysize.inc'
      include 'io_files.inc'
	
c...	common blocks
c   	Change COMPND to a string from an integer array
      character*76 COMPND
      character*4 elemt(16)
      real FOCCU(50,16), FMULT(50,16)
      real FNEUT(16)
      real A,B,C,ALPHA,BETA,GAMMA
      real SYMSY				!! Unused in code
      integer ISYMCE, NCOMPO
      integer NA(16)
      real wl, TL,TH, AGUIN, BGUIN
      real BTEMP(50,16), DELFR(16), DELFI(16)
      integer IMAGE, ns
      character*4 norm,iano
      COMMON /INPUT/ COMPND,ELEMT,FOCCU,FMULT,FNEUT,A,B,C,ALPHA,BE
     1TA,GAMMA,SYMSY,ISYMCE,NCOMPO,NA,WL,TL,TH,NORM,IMAGE,AGUIN,BG
     2UIN,BTEMP,DELFR,DELFI,IANO,NS


      character*2 symlp
      character*1 symbr
      character*4 symwl
      COMMON /INPUTCHAR/ SYMLP,SYMBR,symwl

      double precision x(50,16),y(50,16),z(50,16)
      common /inputdoub/ x,y,z

      integer ICR,IPR,ILU
      COMMON /UNITS/ ICR,IPR,ILU

      double precision rn(3),rd(3),s1(3),s2(3),s3(3)
      COMMON /POSITNUM/ RN,RD,S1,S2,S3 

      character*45 igr
c01Dec      character*1 igr(45)
      common /POSITCHAR/ IGR

      real del1, del2
      COMMON /ANOMAL/ DEL1,DEL2

      real FNEU
      COMMON /NEU/ FNEU

      real FA(4,16),FB(4,16), FC(16)
      COMMON /SCAT/ FA,FB,FC

      integer ibravl, isystm
      common /cell/ ibravl,isystm
      
      integer IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,LAUE,ITRIG
      COMMON /EXTI/ IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,LAUE,ITRIG
      
      double precision ts(3,24),fs(3,3,24)
      COMMON /EQUO/ TS,FS

C      COMMON /BURCDP/ TSS /BURCI/ SS
      double precision tss(24,3)
      INTEGER SS(24,3,3)
      COMMON /BURC/ TSS,SS

      character*1 ip(8,3)
      COMMON /SLAS/ IP
c0111      COMMON /SLAS/ IP(8,3)



c...	functions
	logical	extractfirstword
    	logical isblank
	integer lp
	real wave
	integer ilen


c...	passed variables	
      integer npos
      real bpos(natoms_max)
      logical noisy
c changed xyzpos to double prec CPA 8-01-00
      double precision xyzpos(natoms_max,3)
      logical struct


c...	local variables
      integer IDE(50,16) 
      integer njob,igroup
      character*2 isymlp
      character*4 elemt1, asymb
c01Dec      DIMENSION FA(4,16),
c01Dec     1 FB(4,16), FC(16),
c01Nov     2 COMPND(19),
c01Dec     3 FOCCU(50,16), FMULT(50,16), FNEUT(16), NA(16),
c01Dec     4 BTEMP(50,16), DELFR(16), DELFI(16), IDE(50,16)

C change just a bit here to find the problem
      double precision xyz(3)
      integer bra
      character*4 isymwl,cen, isyb
      integer ILV, LIMIT2, LIMIT3, LIMIT4
      integer i, j, k, m, ij, ik
      integer ijob, isyst, ipnch, nc, icode, isy
      real tl1, th1, thg, ide1, b1, foccu1, ano
      integer KODLP, inorm, ng

C
      character*2 ipos(45)
      character*2 car(9),indf
      character*4 iblnk
      character*80 aline, aword, lastOK
      character*80 aError

c      BLOCK DATA
C
C  Many of these declarations need to be replaced with character statements.
C  Dimension statement is obselete.
C  length set to maximum that is going in data statements
      
C-----CONTAINS LITERAL DATA FOR LAZY                                    BLKD0001
      character*1 n3(20)
      COMMON /ND/ N3

      character*4 mw(20)
      common /WAVEL/ MW

      integer ib(8)
      common /BRAFNUM/IB 

      character*1 ct(8)
      common /BRAFCHAR/ CT 

      integer lpf(6)
      common /FLORNUM/ LPF 

      character*2 cv(6)
      common /FLORCHAR/ CV

c23456789_123456789_123456789_123456789_123456789_123456789_123456789_12
      DATA  N3(1)/'1'/, N3(2)/'2'/,  N3(3)/'3'/,  N3(4)/'4'/, 
     &      N3(5)/'5'/, N3(6)/'6'/,  N3(7)/'A'/,  N3(8)/'B'/,
     &      N3(9)/'C'/, N3(10)/'D'/, N3(11)/'M'/, N3(12)/'N'/,
     &      N3(13)/'P'/,N3(14)/'CU  '/,N3(15)/'/'/,N3(16)/'-'/,
     &      N3(17)/' '/, N3(18)/'  '/,N3(19)/'    '/,N3(20)/'SP'/

c...	Maybe problem is with n3(15)?
c?      DATA  N3(1)/1H1/, N3(2)/1H2/,  N3(3)/1H3/,  N3(4)/1H4/, 
c?     &      N3(5)/1H5/, N3(6)/1H6/,  N3(7)/1HA/,  N3(8)/1HB/,
c?     &      N3(9)/1HC/, N3(10)/1HD/, N3(11)/1HM/, N3(12)/1HN/,
c?     &      N3(13)/1HP/,N3(14)/4HCU  /,N3(15)/1H//,N3(16)/1H-/,
c?     &      N3(17)/1H /, N3(18)/2H  /,N3(19)/4H    /,N3(20)/2HSP/

c0111      DATA  N3(1)/1H1/, N3(2)/1H2/, N3(3)/1H3/, N3(4)/1H4/, N3(5)/1H5/,
c0111     1N3(6)/1H6/,N3(7)/1HA/,N3(8)/1HB/,N3(9)/1HC/,N3(10)/1HD/,N3(11)/1HM
c0111     2/,N3(12)/1HN/,N3(13)/1HP/,N3(14)/4HCU  /,N3(15)/1H//,N3(16)/1H-/,
c0111     3N3(17)/1H /, N3(18)/2H  /,N3(19)/4H    /,N3(20)/2HSP/

      DATA LPF(1)/0/,LPF(2)/1/,LPF(3)/2/,LPF(4)/3/,LPF(5)/4/,LPF(6)/0/

      DATA CV(1)/2HDS/,CV(2)/2H 1/,CV(3)/2HNE/,CV(4)/2HGN/,CV(5)/2HGH/,C
     1V(6)/2H  /

      DATA IB(1)/1/,IB(2)/1/,IB(3)/2/,IB(4)/3/,IB(5)/4/,IB(6)/5/,IB(7)/6
     1/,IB(8)/7/

      DATA CT(1)/1H /,CT(2)/1HP/,CT(3)/1HI/,CT(4)/1HR/,CT(5)/1HF/,CT(6)/
     11HA/,CT(7)/1HB/,CT(8)/1HC/

      DATA MW(1)/4HCRA1/,MW(2)/4HCRA2/,MW(3)/4HCRB /,MW(4)/4HCR  /,MW(5)
     1/4HFEA1/,MW(6)/4HFEA2/,MW(7)/4HFEB /,MW(8)/4HFE  /,MW(9)/4HCUA1/,
     2MW(10)/4HCUA2/,MW(11)/4HCUB /,MW(12)/4HCU  /,MW(13)/4HMOA1/,MW(14)
     3/4HMOA2/,MW(15)/4HMOB /,MW(16)/4HMO  /,MW(17)/4HAGA1/,MW(18)/4HAGA
     42/,MW(19)/4HAGB /,MW(20)/4HAG  /

      DATA CAR(1)/2HTI/,CAR(2)/2HAT/,CAR(3)/2HCE/,CAR(4)/2HLA/,CAR(5)/2H
     1SY/,CAR(6)/2HCO/,CAR(7)/2HSP/,CAR(8)/2HEN/,CAR(9)/2HFI/
      DATA IBLNK/4HBBBB/

C  end of data, common, and declarations -> beginning of program
C
C  default state is that lazy is able to read in the parameters
      struct=.true.

C-----SET LOGICAL UNIT NUMBERS                                          MAIN0088
C
      icr = unitlpi
      ilv = unitlpitemp
      ipr = unitlog
c...	ILU is unused
      	
c01Dec      ICR=4     ! CPA changed from 5 to 4
c01Dec      IPR=2     ! CPA changed from 6 to 2
c01DecC-CDC-IPR=61                                                            MAIN0092
c01Dec      ILU=11
c01DecC-CDC-ILU=51                                                            MAIN0094
c01Dec      ILV=12
c01DecC-CDC-ILV=52                                                            MAIN0096

C-----SET PROGRAM LIMITS                                                MAIN0097
      LIMIT2=16    ! number of atom kinds
      LIMIT3=50    ! number of atoms of one kind
      LIMIT4=24    ! number of equiv positions
C-VAX-
C-VAX-EQUIVALENCE LOGICAL UNIT NUMBERS WITH I/O FILES.
C-VAX-
C  Open input file.

      OPEN (UNIT=ICR,FILE=file_lpi,STATUS='OLD',ACCESS='SEQUENTIAL',
     1      FORM='FORMATTED',err=64)
c      OPEN (UNIT=ICR,FILE='LPI',STATUS='OLD',ACCESS='SEQUENTIAL',
c     1      FORM='FORMATTED',err=64)
      write(*,*) 'Opened: ', 'Lazy-Pulverix input (LPI) file: ',
     &		file_lpi(1:ilen(file_lpi))


C  Open temporary storage file.
            
      OPEN (UNIT=ILV,FILE=file_lpitemp,STATUS='unknown',
     1	ACCESS='SEQUENTIAL', FORM='FORMATTED',err=63)
c      OPEN (UNIT=ILV,FILE='LPS',STATUS='unknown',ACCESS='SEQUENTIAL',
c     1FORM='FORMATTED',err=63)
      write(*,*) 'Opened: ', 'Lazy-Pulverix temporary file: ',
     &		file_lpitemp(1:ilen(file_lpitemp))
     
      write (unitlog,*) 'Lazy: noisy = ', noisy

C  Open an output file for structural and reflection information.
      
C      open (unit=7,file='structinfo.out',status='unknown')
c01Dec      write(*,'(a)') 'Structural information in structinfo.out'
      write(*,*) 'Structural information in ',
     &      file_structout(1:ilen(file_structout))

C-----                                                                  MAIN0101
C-----READ INPUT FOR SEVERAL JOBS                                       MAIN0102
C-----                                                                  MAIN0103

      NJOB=0
C      WRITE (IPR,38)
C-----READ FIRST CARD OF EACH SET                                       MAIN0106
 1    READ (ICR,39,err=639) (IPOS(I),I=1,40)
C-----CHECK FOR FINISH CARD                                             MAIN0108
cDuplicative      call supper(ipos(1))		! added by Tanya Riseman, Nov 29, 2001
      IF (IPOS(1).EQ.CAR(9)) then
cDebug    	 if (noisy) then
cDebug    	   write (*,*) 'LAZY: copying FINISH Command found = ', IPOS(1), 
cDebug     &	    	' = CAR(', 9, ') = ', CAR(9), '. NJOB = ', NJOB
cDebug    	 endif
         GO TO 4
      endif
C-----COUNT NUMBER OF JOBS                                              MAIN0110
      NJOB=NJOB+1
C      WRITE (IPR,40) NJOB
      GO TO 3
C-----READ REMAINING DATA CARDS                                         MAIN0114
 2    READ (ICR,39,err=639) (IPOS(I),I=1,40)
cDuplicative      call supper(ipos(1))		! added by Tanya Riseman, Nov 29, 2001
 3    continue
C 3    WRITE (IPR,41) (IPOS(I),I=1,40)
C-----WRITE DATA CARDS TWICE ON DISK                                    MAIN0117
      WRITE (ILV,39) (IPOS(I),I=1,40)
      WRITE (ILV,39) (IPOS(I),I=1,40)
C
C-----CHECK FOR END OF JOB                                              MAIN0120
      IF (IPOS(1).NE.CAR(8)) then 
cDebug    	 if (noisy) then
cDebug    	   write (*,*) 'LAZY: copying not END Command found = ', IPOS(1), 
cDebug     &	    	' NE CAR(', 8, ') = ', CAR(8)
cDebug    	 endif
      	GO TO 2
      else
cDebug      	 if (noisy) then
cDebug    	   write (*,*) 'LAZY: copying END Command found = ', IPOS(1), 
cDebug     &	    	' = CAR(', 8, ') = ', CAR(8)
cDebug    	 endif
C        WRITE (IPR,42)
        GO TO 1
      endif
c      IF (IPOS(1).NE.CAR(8)) GO TO 2
cC      WRITE (IPR,42)
c      GO TO 1
 4    REWIND ILV
C-----                                                                  MAIN0125
C-----START CALCULATION FOR NJOB JOBS                                   MAIN0126
C-----                                                                  MAIN0127
C      WRITE (ILU) NJOB
C
C    !!big loop!!
C
      DO 37 IJOB=1,NJOB
C-----                                                                  MAIN0130
C-----SET DEFAULT VALUES                                                MAIN0131
C-----                                                                  MAIN0132
         ISYMWL=N3(14)
         SYMBR=N3(13)
         ISYMLP=N3(18)
         CEN=N3(7)
         NORM=N3(17)
         WL=1.5418
         TL1=0.
         TH1=89.
         THG=45.
         IMAGE=2
         IANO=N3(17)
C-----                                                                  MAIN0144
C-----SET PARAMETERS BACK TO ORIGINAL VALUE                             MAIN0145
C-----                                                                  MAIN0146
         LAUE=0
         ITRIG=3
         IHOO=1
         IOKO=1
         IOOL=1
         IHHL=1
         IHOL=1
         IOKL=1
         IHKO=1
         NCOMPO=1
         TH=TH1
         TL=TL1
         SYMWL=ISYMWL
         NS=0
         IGROUP=0
         ISYST=0
         ISYMCE=0
         IPNCH=0
         A=0.
C-----SET ARRAYS BACK ZERO                                              MAIN0165
         DO 5 I=1,45
            IGR(I:I)=N3(17)
c01Dec            IGR(I)=N3(17)
 5       continue
         DO 6 I=1,LIMIT2
            ELEMT(I)=IBLNK
            FNEUT(I)=0.
            DELFR(I)=0.
            DELFI(I)=0.
            FC(I)=0.
            DO 6 J=1,4
               FA(J,I)=0.
               FB(J,I)=0.
               NA(I)=0
 6       continue
         DO 7 I=1,3
            DO 7 J=1,3
               DO 7 K=1,LIMIT4
                  TS(I,K)=0.0d0 ! double precision
                  FS(I,J,K)=0.0d0
 7       CONTINUE

	aError = 'lazy: No error yet'
C
C  Beginning of calculations
C
C  FS for storage of equivalent point positions
C  -FS changed to double precision
C
C-----TRIVIAL POSITION X,Y,Z                                            MAIN0184
         FS(1,1,1)=1.0d0
         FS(2,2,1)=1.0d0
         FS(3,3,1)=1.0d0
C-----LOOP OVER ALL DATA CARDS ON FILE ILV FOR ONE SET                  MAIN0188
 8       READ (ILV,43, err=643) INDF
C-----READ FIRST RECORD TO IDENTIFY FORMAT                              MAIN0190

C  Recall CAR(J=1,9): TItle ATom CE LA SY CO SP EN FI 
    	 call supper(INDF)  	    !! convert to upper case. TR Nov, 30, 2001
         DO 9 J=1,8
            IF (INDF.NE.CAR(J)) GO TO 9
            M=J
            GO TO 10
 9       CONTINUE
C     WRITE (IPR,44) INDF
    	 if (noisy) then
	    write (*,*) 'LAZY: Error, unrecognised command ', INDF
	    write (unitlog,*) 'LAZY: Error, unrecognised command ', INDF
	 endif
         GO TO 35
C-----READ SECOND RECORD WITH CORRECT FORMAT                            MAIN0198
C  this is a computed go to statement.  Will go to the item
C  specified by integer M, these are the reading statements
C
 10      CONTINUE
    	 if (noisy) then
    	   write (unitlog,*) 'LAZY: Command found = ', INDF, 
     &	    	'=CAR(', M, ') = ', CAR(M)
    	 endif
    	 GO TO (11,12,16,18,19,23,24,26), M
C
C-----T I T L E  CARD                                                   MAIN0200
C
 11      READ (ILV, 45,err=645) COMPND
c01Nov 11      READ (ILV,45,err=645) (COMPND(I),I=1,19)
cLog    	 if (noisy) then
    	    write (unitlog,*) '.. COMPND="', COMPND(1:65), '"'
c01Nov    	    write (*,*) '.. COMPND="', (COMPND(I),I=1,19), '"'
cLog	 endif
         GO TO 8
C
C-----A T O M  CARD                                                     MAIN0203
C
C  Here is where variables really start going in
C  the symbol of element, an ID number, 8 characters for each
C  of the x,y,z cell coordinates, Debye Waller factor, and
C  occupation factor.
C 
 12      continue
    	 READ (ILV,fmt=('(5x,a75)'),err=646,end=646) aline

	 aword = ' '
    	 lastOK = 'Last part of ATOM that was OK: <NONE>'
cDebug	 write (*,*) 'lazy: pre-elemnt1: aline=', aline 
	 if (extractfirstword(aline, aword, ',')) then
cDebug	    write (*,*) 'Lazy: extractfirstword returned true'
     	    read (aword, fmt=('(A)'), err=646,end=646) ELEMT1
cOKonLinux     	    read (aword, *, err=646,end=646) ELEMT1
    	    lastOK = 'Last part of ATOM that was OK ELEMT1='//aword(1:20)
cDebug    	    write (*,*) 'Lazy: ATOM OK ELEMT1=', ELEMT1
cDebug	    write (*,*) 'mt1 = "', ELEMT1, '"', aword
	 else 
cDebug	    write (*,*) 'Lazy: extractfirstword returned false'
	    goto 646
	 endif
	 
	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       IDE1 = 0.0
     	    else 
	       read (aword, *, err=646,end=646) IDE1
	    endif
    	    lastOK = 'Last part of ATOM that was OK IDE1='//aword(1:20)
cDebug    	    write (*,*) 'Lazy: ATOM OK IDE1=', IDE1
	 else 
	    goto 646
	 endif
	 
	 do j = 1, 3     ! x, y, z
	   if (extractfirstword(aline, aword, ',')) then
     	     read (aword, fmt=('(8A1)'), err=646,end=646) 
     &	    	    (IP(I,J),I=1,8)
    	    lastOK = 'Last part of ATOM that was OK xyz='
     &	    	    //char(j)//' ='//aword(1:20)
cDebug    	    write (*,*) 'Lazy: ATOM OK J=', j, ' ', (IP(I,J),I=1,8)
	   else 
	     goto 646
	   endif
    	 enddo
	 
	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       B1 = 0.0
     	    else 
     	       read (aword, *, err=646,end=646) B1
	    endif
    	    lastOK = 'Last part of ATOM that was OK B1='//aword(1:20)
cDebug    	    write (*,*) 'Lazy: ATOM OK B1=', B1
	 else 
    	     B1 = 0.0
	     FOCCU1 = 0.0
	 endif
	 
	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       FOCCU1 = 0.0
     	    else 
     	       read (aword, *, err=646,end=646) FOCCU1
    	    endif
    	    lastOK = 'Last part of ATOM that was OK FOCCU1='//aword(1:20)
cDebug    	    write (*,*) 'Lazy: ATOM OK FOCCU1=', FOCCU1
	 else 
	    FOCCU1 = 0.0
	 endif

C  A blank FOCCU1 will be taken as full occupancy.
C
         IF (FOCCU1.EQ.0.) FOCCU1=1.

cLog    	 if (noisy) then
    	   write (unitlog,*) '.. ELEMT1="', ELEMT1, '" IDE1="', IDE1, '"' 
    	   write (unitlog,*) '.. X= "', (IP(I,1),I=1,8),'" Y= "', 
     &	    	    	(IP(I,2),I=1,8),'" Z= "', (IP(I,3),I=1,8),'"'
    	   write (unitlog,*) '.. B1=', B1, ' FOCCU1=', FOCCU1 
cLog	 endif
cWrong 	 READ (aline,*,err=646,end=646) ELEMT1,IDE1,
cWrong     &		((IP(I,J),I=1,8),J=1,3), B1,FOCCU1
c01Nov 12      READ (ILV,46) ELEMT1,IDE1,((IP(I,J),I=1,8),J=1,3),B1,FOCCU1
C
C  SLASH is able to handle fraction and decimal data in the IP
C
         CALL SLASH (XYZ)
C      write(*,'(3d14.8)') (xyz(j),j=1,3)
C
cMoveC  A blank FOCCU1 will be taken as full occupancy.
cMoveC
cMove         IF (FOCCU1.EQ.0.)FOCCU1=1.
C
         DO 13 I=1,NCOMPO       ! just 1 the first time
            NC=I                ! nc is index of atom kinds
C-----ADD ATOM TO SAME ATOM KIND                                        MAIN0209
            IF (ELEMT1.EQ.ELEMT(NC)) GO TO 14
 13      CONTINUE
C-----STORE ATOM AS NEW ATOMKIND                                        MAIN0212
         IF (NA(1).EQ.0) GO TO 14 ! aren't any atoms yet
         NCOMPO=NCOMPO+1        ! increase # of atom types
         NC=NCOMPO
         IF (NCOMPO.LE.LIMIT2) GO TO 14 ! check to make sure we are below limit
C     WRITE (IPR,47) LIMIT2
	 if (noisy) then
	    write (*,*) 'Lazy: ATOM Error (NCOMPO.GT.LIMIT2)', 
     &      	    NCOMPO, LIMIT2
	    write (unitlog,*) 'Lazy: ATOM Error (NCOMPO.GT.LIMIT2)', 
     &      	    NCOMPO, LIMIT2
	 endif
         GO TO 35
 14      NA(NC)=NA(NC)+1        ! NA is # of atoms of kind NC
         I=NA(NC)

         IF (NA(NC).LE.LIMIT3) GO TO 15 ! another limit check
C     WRITE (IPR,48) NA(NC),ELEMT1,LIMIT3
	 if (noisy) then
	   write (*,*) 'Lazy: ATOM Error (NA(NC).GT.LIMIT3)', 
     &	    	NC, NA(NC), LIMIT3
	   write (unitlog,*) 'Lazy: ATOM Error (NA(NC).GT.LIMIT3)', 
     &	    	NC, NA(NC), LIMIT3
	 endif
         GO TO 35

C put in x,y,z and other info for row na(nc) and column nc
      
 15      X(I,NC)=XYZ(1)  
         Y(I,NC)=XYZ(2)
         Z(I,NC)=XYZ(3)
         ELEMT(NC)=ELEMT1
         IDE(I,NC)=IDE1
         FOCCU(I,NC)=FOCCU1
         BTEMP(I,NC)=B1
         GO TO 8
C
C-----C E L L  CARD                                                     MAIN0232
 16      continue
    	 READ (ILV,fmt=('(5x,a75)'),err=649) aline
c01Nov 	 READ (aline,*,err=649,end=649)  A,B,C,ALPHA,BETA,GAMMA

    	 lastOK = 'Last part of CELL that was OK: <NONE>'
	 if (extractfirstword(aline, aword, ',')) then
cDebug	    write (*,*) 'Lazy: extractfirstword returned true'
	    read (aword, *, err=649,end=649) A
    	    lastOK = 'Last part of CELL that was OK A='//aword(1:20)
	 else 
cDebug	    write (*,*) 'Lazy: extractfirstword returned false'
	    goto 649
	 endif
	 
	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       B = 0.0
     	    else 
     	       read (aword, *, err=649,end=649) B
	    endif
    	    lastOK = 'Last part of ATOM that was OK B='//aword(1:20)
	 else 
	    B = 0.0
	    C = 0.0
	    ALPHA = 0.0
	    BETA = 0.0
	    GAMMA = 0.0
	 endif

	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       C = 0.0
     	    else 
     	       read (aword, *, err=649,end=649) C
	    endif
    	    lastOK = 'Last part of ATOM that was OK C='//aword(1:20)
	 else 
	    C = 0.0
	    ALPHA = 0.0
	    BETA = 0.0
	    GAMMA = 0.0
	 endif


	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       alpha = 0.0
     	    else 
     	       read (aword, *, err=649,end=649) alpha
	    endif
    	    lastOK = 'Last part of ATOM that was OK Alpha='//aword(1:20)
	 else 
	    alpha = 0.0
	    BETA = 0.0
	    GAMMA = 0.0
	 endif


	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       beta = 0.0
     	    else 
     	       read (aword, *, err=649,end=649) beta
	    endif
    	    lastOK = 'Last part of ATOM that was OK beta='//aword(1:20)
	 else 
	    BETA = 0.0
	    GAMMA = 0.0
	 endif

	 if (extractfirstword(aline, aword, ',')) then
    	    if (isblank(aword)) then 
	       gamma = 0.0
     	    else 
     	       read (aword, *, err=649,end=649) gamma
	    endif
    	    lastOK = 'Last part of ATOM that was OK gamma='//aword(1:20)
	 else 
	    GAMMA = 0.0
	 endif

cLog    	 if (noisy) then
    	    write (unitLog,*) '.. A=', A, ' B=', B, ' C=', C
    	    write (unitLog,*) '.. Alpha=', alpha, ' Beta=', beta, 
     &      	    ' Gamma=', gamma
cLog	 endif
c01Nov 16      READ (ILV,49) A,B,C,ALPHA,BETA,GAMMA
C I want to adapt this so it can read in the data from
C the qbuffer.buf
C     CALL QBUFIN(a,aa,h,hs,fe,ec,u,v)


C-----CRYSTAL SYSTEM                                                    MAIN0234
         ISYSTM=2               ! orthorhombic
         IF (B.NE.0.) GO TO 17
         IF (GAMMA.EQ.0.) ISYSTM=4 ! tetragonal
         IF (GAMMA.EQ.120.) ISYSTM=6 ! hexagonal (maybe rhombo)
         IF (C.EQ.0.) ISYSTM=5  ! cubic or isometric
 17      IF (BETA.NE.0.) ISYSTM=1 ! monoclinic
C
C  must be triclinic
C
         IF ((BETA.NE.0.).AND.(ALPHA.NE.0.)) ISYSTM=7

    	 if (noisy) then
    	    call reportsymmetry(ISYSTM)

c    	    if (ISYSTM .eq. 1) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is monoclinic'
c    	    else if (ISYSTM .eq. 2) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is orthorhombic'
c    	    else if (ISYSTM .eq. 4) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is tetragonal'
c    	    else if (ISYSTM .eq. 5) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is cubic or isometric'
c    	    else if (ISYSTM .eq. 6) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is hexagonal (maybe rhombo)'
c    	    else if (ISYSTM .eq. 7) then
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is triclinic'
c    	    else 
c	      write(*,*) '.. ISYSTM = ', ISYSTM, ' is unrecognized'
c	    endif
	 endif
    	 
         GO TO 8

C
C-----L A T I C E  CARD                                                 MAIN0243
C
 18    	 READ (ILV,fmt=('(6x,a74)'),err=650) aline

    	 lastOK = 'Last part of LATICE that was OK <NONE>' 
	 if (extractfirstword(aline, aword, ',')) then
     	       read (aword, FMT=('(A)'), err=650,end=650) CEN
    	    lastOK = 'Last part of LATICE that was OK CEN='//aword(1:20)
	 else 
    	    go to 650
	 endif

	 if (extractfirstword(aline, aword, ',')) then
     	    read (aword, FMT=('(A)'), err=650,end=650) SYMBR
    	    lastOK = 'Last part of LATICE that was OK SYMBR='//aword(1:20)
	 else 
    	    SYMBR = ' '     !! OK if left blank
    	    go to 650
	 endif

c01Nov 18      READ (ILV,50,err=650) CEN,SYMBR
c01Nov 18      READ (ILV,50) CEN,SYMBR
         IF (CEN.EQ.N3(9)) ISYMCE=1
cLog    	 if (noisy) then
    	    write (unitlog,*) '.. CEN="', cen, '" SYMBR= "', SYMBR, 
     &	    	    '" ISYMCE=', ISYMCE
cLog	 endif
         GO TO 8
C
C-----S Y M T R Y  CARD                                                 MAIN0247
C
 19      READ (ILV,51,err=651) IGR
c01Dec 19      READ (ILV,51,err=651) (IGR(J),J=1,45)
c01Nov 19      READ (ILV,51) (IGR(J),J=1,45)
	 call supper(IGR)
cLog    	 if (noisy) then
    	    write (unitlog,*) '.. IGR="', IGR, '"'
c01Dec    	    write (*,*) '.. IGR="', (IGR(J),J=1,45), '"'
cLog	 endif
         CALL EQVP
C  an error indicator
         IF (RN(1).EQ.999.9) then
	   if (noisy) then
	      write (*,*) 'Lazy: SYMTRY Error (RN(1).EQ.999.9)', RN(1)
	   endif
	   write (unitlog,*) 'Lazy: SYMTRY Error (RN(1).EQ.999.9)', RN(1)
    	   GO TO 35
	 endif
c01Nov         IF (RN(1).EQ.999.9) GO TO 35
         NS=NS+1
C  continue if # of equivalent postions in less than limit
         IF (NS.LE.LIMIT4) GO TO 20
C      WRITE (IPR,52) LIMIT4
c	 if (noisy) then
	   write (*,*) 'Lazy: SYMTRY Error (NS.GT.LIMIT4)', NS, LIMIT4
c	 endif
	 write (unitlog,*) 'Lazy: SYMTRY Error (NS.GT.LIMIT4)', NS, LIMIT4
         GO TO 35

C  this data will be in groups of 3
 20      DO 22 J=1,3
            IF (RD(J).EQ.0.0d0) GO TO 21 ! no fraction present
            RD(J)=RN(J)/RD(J)   ! calculate the fraction
 21         TS(J,NS)=RD(J)      ! store number in TS
            FS(1,J,NS)=S1(J)    ! put XYZ info in FS where NS is
            FS(2,J,NS)=S2(J)    ! the equivalent position #
            FS(3,J,NS)=S3(J)    ! also appears that negative signs
                                ! are associated with X,Y,Z
 22      CONTINUE
         GO TO 8                ! return to beginning of card reader
C
C-----C O N D I T  CARD                                                 MAIN0264
C
 23      READ (ILV,53,err=653) SYMWL,WL,TL,TH,NORM,IMAGE,SYMLP,
     &		IANO,IPNCH,ICODE
c01Nov 23      READ (ILV,53) SYMWL,WL,TL,TH,NORM,IMAGE,SYMLP,IANO,IPNCH,ICODE
ccc 53   FORMAT (10X,A4,F8.0,F3.0,F5.0,1X,A1,I2,A2,1X,A1,2I2)
cLog    	 if (noisy) then
    	    write (unitlog,*) '.. SYMWL="',  SYMWL, '"'    	    	! A4
    	    write (unitlog,*) '.. WL=', WL, ' TL=', TL, 'TH=', TH 	! F8.0,F3.0,F5.0
    	    write (unitlog,*) '.. NORM="', NORM, '" IMAGE=', IMAGE, 	
     &	    	    ' SYMLP= "', SYMLP, '" IANO="', IANO, '"'	! A1,I2,A2,1X,A1,
     	    write (unitlog,*) '.. IPNCH=', IPNCH, ' ICODE =', ICODE	! 2I2
cLog	 endif
C-----REPLACE BLANKS BY DEFAULT SYMBOLS                                 MAIN0266
         IPNCH=1
         ICODE=1
         IF (SYMWL.EQ. N3(19) ) SYMWL=ISYMWL
c0111         IF (SYMWL.EQ.4h    ) SYMWL=ISYMWL
         IF(TH.EQ.0.) TH=TH1
         IF(TH.GT.TH1) TH=TH1
         IF(TH.LT.TL)  TH=TL
clog    	 if (noisy) then
    	    write (unitlog,*) '.. update SYMWL="',  SYMWL, '"'
    	    write (unitlog,*) '.. update  TH=', TH 	
     	    write (unitlog,*) '.. update IPNCH=', IPNCH, ' ICODE =', ICODE
clog	 endif

         GO TO 8
C
C-----S P C G R P  CARD                                                 MAIN0272
C
C  this should essentially return the information that is in
C  the LATTICE and the SYMTRY cards: SYMBR (Bravais lattice
C  indicator), ISYMCE (Centric or Acentric)
C  ISYST (crystal system indicator) will have been picked up by
C  CELL card.
C
 24      READ (ILV,54,err=654) IGR
c01Dec 24      READ (ILV,54,err=654) (IGR(I),I=1,36)
c01Nov 24      READ (ILV,54) (IGR(I),I=1,36)
	 call supper(IGR)
cLog    	 if (noisy) then
    	    write (unitlog,*) '.. IGR="', IGR, '"'
c01Dec    	    write (*,*) '.. IGR="', (IGR(I),I=1,19), '"'
cLog	 endif
         ISYST=0
         IGROUP=1

         CALL BURZ (ISYST,ISY,ISYB,NG)
         NS=NG                  ! the number of equivalent positions
         SYMBR=ISYB
         ISYMCE=ISY
C-----MAKE ARRAY FROM BURZ COMPATIBLE WITH P U L V E R I X              MAIN0280
         DO 25 I=1,3
            DO 25 IJ=1,3
               DO 25 IK=1,NS
                  FS(I,IJ,IK)=dble(SS(IK,IJ,I))
                  TS(IJ,IK)=TSS(IK,IJ)
 25      CONTINUE

C      write(*,*) 'in LAZY:'
C      do i=1,ns
C         do j=1,3
C            write(*,*) (fs(k,j,i),k=1,3),ts(j,i)
C         enddo
C      enddo


         call printequiv(fs,ts,ns)
         
         GO TO 8
C
C-----END OF FORMAT INTERPRETATION                                      MAIN0288
C
 26      READ (ILV,43,err=743) INDF
c01Nov 26      READ (ILV,43) INDF
C-----CHECK FOR CELL AND ATOM CARD                                      MAIN0290
         IF (NA(1).NE.0) GO TO 27
C      WRITE (IPR,55)
	aError = 'Lazy: No atom card was found'
         GO TO 36
 27      IF (A.NE.0.) GO TO 28
C      WRITE (IPR,56)
	 aError = 'Lazy: No cell card was found'
         GO TO 36
C-----LORENTZ POLARISATION FACTOR                                       MAIN0297
 28      KODLP=LP(SYMLP)
C-----CENTER OF SYMMETRY AT ORIGIN                                      MAIN0299
         IF (CEN.EQ.N3(9)) ISYMCE=1
C-----WAVELENGTH                                                        MAIN0301
         IF (WL.LT.0.02) WL=WAVE(SYMWL)
C-----LIMIT UPPER SIN**2 THETA VALUE FOR GUINIER CAMERA                 MAIN0303
         IF ((KODLP.GT.2).AND.(TH.GT.45.)) TH=THG
C-----TABULAR OUTPUT FEATURE                                            MAIN0305
         IF (NORM.EQ.N3(17)) INORM=0
         IF ((IANO.EQ.N3(17)).AND.(ISYMCE.EQ.0).AND.(KODLP.NE.2)) 
     &        INORM=2
         IF (NORM.EQ.N3(7)) INORM=1
         IF (NORM.EQ.N3(12)) INORM=3
C-----DEFAULT SYMMETRY OPERATOR                                         MAIN0310
         IF (NS.EQ.0) NS=1
C-----DERIVE BRAVAIS LATTICE INDICATOR                                  MAIN0312
         IBRAVL=BRA(SYMBR)
C-----CALCULATE MULTIPLICITIES OF SPECIAL ATOM POSITIONS                MAIN0314
C -I am also calling ANOMA-> NEUTF in this routine to find the
C  scattering lengths.
         CALL MULTF(elemt,kodlp,npos,bpos,xyzpos,natoms_max)
c01Dec         CALL MULTF(elemt,kodlp,npos,bpos,xyzpos,nmax)
C  I will modify the scattering lengths here for fractional 
C  occupancy.
C      do i=1,ncompo
C         bpos(i)=bpos(i)*foccu(1,i)
C      enddo

C-----ANOMALOUS  DISPERSION INDICATOR                                   MAIN0316
         ANO=0.
         IF ((IANO.EQ.N3(17)).AND.(KODLP.NE.2)) ANO=1.
C-----CHECK CRYSTAL SYSTEM                                              MAIN0319
         IF (ISYST.EQ.0) GO TO 29
         IF (ISYST.EQ.ISYSTM) GO TO 29
C     WRITE (IPR,57)
C-----TAKE CRYSTAL SYSTEM FROM GROUP CARD                               MAIN0323
         ISYSTM=ISYST

C-----CALCULATE EXTINCTIONS,LAUE GROUP AND TRIGONAL SYMMETRY INDICATOR  MAIN0325
C  isymce indicates if lattice is centrosymmetric and ns is the number
C  sites not including Bravais lattice or inversion symmetry
 29      CALL EXTINC (ISYMCE,NS)
         IF (ISYSTM.EQ.6) ISYSTM=ITRIG ! allowance for hexagonal system

C-----RETRIEVE SCATTERING FACTORS FOR X RAY,NEUTRON AND ANOM.DISP.      MAIN0328
         DO 33 I=1,NCOMPO
            FNEU=0.
            NC=I
            DELFR(I)=0.
            ASYMB=ELEMT(NC)
            DELFI(I)=0.
            IF (KODLP.NE.2) GO TO 31
C-----RETRIEVE NEUTRON SCATTERING LENGTH                                MAIN0336
	    CALL supper(ELEMT(NC))		!! Convert to uppercase
            CALL ANOMA (SYMWL,ELEMT(NC),KODLP)
            IF (FNEU.NE.0.) GO TO 30
C     WRITE (IPR,58) ELEMT(NC)
	     aError = 'Lazy: Neutron scattering length for symbol '//
     &	      	ELEMT(NC)//' has not been found. Check ATOM command'
            GO TO 36
 30         FNEUT(NC)=foccu(1,nc)*FNEU
C     write(*,*) nc,i,fneu,foccu(1,nc),fneut(nc)
            GO TO 33
 31         IF ( ANO .EQ.0.) GO TO 32
C-----RETRIEVE ANOMALOUS DISPERSION COEFFICIENTS                        MAIN0344
            CALL ANOMA (SYMWL, ASYMB   ,KODLP)
            DELFR(NC)=DEL1
            DELFI(NC)=DEL2
C-----RETRIEVE CROMER-MANN COEFFICIENTS                                 MAIN0348
 32         CALL FSC (ASYMB,NC)
            IF (FC(NC).EQ.999.9) then
		aError = 'lazy: Error with the Cromer-Mann coefficients' 
	    	GO TO 36
	    endif
 33      CONTINUE
C-----WRITE DATA FOR FOLLOWING PROGRAM PULVR2 ON UNIT ILU               MAIN0352

C this is having some problems CPA
C      WRITE (ILU) (COMPND(I),I=1,19),A,B,C,ALPHA,BETA,GAMMA,WL,(IGR(I),I
C     1=1,36),IGROUP, SYMWL, SYMLP
C      WRITE (ILU) ISYSTM,ISYMCE,IBRAVL,NS,TL,TH,INORM,IMAGE,ANO,KODLP,NC
C     1OMPO,(NA(I),I=1,16),IHOO,IOKO,IOOL,IHHL,IHOL,IHKO,IOKL,LAUE,
C     2 IPNCH,ICODE
C     WRITE (ILU) ((TS(I,II),(FS(K,I,II),K=1,3),I=1,3),II=1,NS)
C     DO 34 M=1,NCOMPO
C        NL=NA(M)
C        WRITE (ILU) DELFR(M),DELFI(M)
C        WRITE (ILU) ELEMT(M),(FA(I,M),FB(I,M),I=1,4),FC(M),FNEUT(M)
C        WRITE (ILU) (ELEMT(M),IDE(I,M),X(I,M),Y(I,M),Z(I,M),FMULT(I,M),FOC
C     1  CU(I,M),BTEMP(I,M),I=1,NL)
C 34  CONTINUE
C      WRITE (IPR,59) IJOB
         GO TO 37
C-----SKIP RECORDS UNTIL END CARD                                       MAIN0367
 35      READ (ILV,43,err=843) INDF
c01Nov 35      READ (ILV,43) INDF
         IF (INDF.NE.CAR(8)) then
    	   if (noisy) then
    	     write (*,*) 'LAZY: not END Command found = ', INDF, 
     &	    	' NE CAR(', 8, ') = ', CAR(8)
    	   endif
    	   write (unitlog,*) 'LAZY: not END Command found = ', INDF, 
     &	    	' NE CAR(', 8, ') = ', CAR(8)
	   GO TO 35
	 endif
         READ(ILV,43,err=843) INDF
c01Nov        READ(ILV,43) INDF
 36      continue
C     WRITE (IPR,60) IJOB
	 if (noisy) then
	     write (*,*) aError
	 endif
	 write (unitlog,*) aError
         IF(NJOB.GT.1) GO TO 65
C-VAX-
C-VAX-IF ERROR, END JOB AND CLOSE AND DELETE I/O FILES
C-VAX-
C      CLOSE (UNIT=IPR,STATUS='KEEP')
C      CLOSE (UNIT=ILU,STATUS='DELETE')
         CLOSE (UNIT=ILV,STATUS='DELETE')
         CLOSE (UNIT=ICR,STATUS='KEEP')
C     close (unit=3)
          struct=.false.
c     	 if (noisy) then
    	    write (*,*) 'Lazy: Error so end job. STRUCT=', struct
c    	 endif
    	 write (unitlog,*) 'Lazy: Error so end job. STRUCT=', struct
         GO TO 70
C-VAX-
 65      CONTINUE
C-----WRITE ONE DUMMY RECORD FOR BAD JOB                                MAIN0372
         A=-1.
C      WRITE (ILU) (COMPND(I),I=1,19),A,B,C,ALPHA,BETA,GAMMA,WL,(IGR(I),I
C     1=1,36),IGROUP
 37   CONTINUE   !  end of long loop
C-----END OF DATA PREPARATION                                           MAIN0377
C      REWIND ILU
C      WRITE (IPR,61)
C-VAX-
C-VAX-CLOSE I/O FILES.
C-VAX-
      CLOSE (UNIT=ICR,STATUS='KEEP')
C      CLOSE (UNIT=IPR,STATUS='KEEP')
C      CLOSE (UNIT=ILU,STATUS='KEEP')
      CLOSE (UNIT=ILV,STATUS='DELETE')
C      close (unit=3)
C-VAX-
 70   CONTINUE

      return

 63   CLOSE (UNIT=ICR,STATUS='KEEP')
      struct=.false.
      if (noisy) then
    	 write (*,*) 'Lazy: Error opening temporary file ', 
     &		 file_lpitemp(1:ilen(file_lpitemp)) 
       	 write (*,*) 'Lazy: set flag STRUCT=', struct
      endif
      write (unitlog,*) 'Lazy: Error opening temporary file ', 
     &		 file_lpitemp(1:ilen(file_lpitemp)) 
C     close (unit=3)
      GO TO 70

 64   struct=.false.
      if (noisy) then
    	 write (*,*) 'Lazy: Error opening file ', 
     &		 file_lpi(1:ilen(file_lpi)) 
       	 write (*,*) 'Lazy: set flag STRUCT=', struct
ccc    	 write (*,*) 'Lazy: Dead end code? STRUCT=', struct
      endif
      write (unitlog,*) 'Lazy: Error opening file ', 
     &		 file_lpi(1:ilen(file_lpi)) 
      GO TO 70

C-CDC-CALL EXIT                                                         MAIN0381
C38   FORMAT (1H ,//15H START  L A Z Y//)
 38   FORMAT (1H ,//15H START  L A Z Y//
     2' VAX VERSION 1989 OF LNS ETHZ,'/
     3' for max. 2500 hkl, 16 atom kinds, 50 atoms of one type,'/
     4' including generation of files for profile plot and refinement'/
     5' Ref.: K. Yvon, W. Jeitschko and E. Parthe,'/
     6' J. Appl. Cryst. 10, 73 (1977);'/
     7' n scattering amplitudes b: V.F. Sears,'/
     8' Methods of Experimental Physics 23A, 521 (1986)'/
     9' *** b(B) = b(B11)               ***'/
     1' *** b(Pu) = b(Pu239)            ***'/
     2' *** b(Cm) = b(Cm244)            ***'/
     3' *** imaginary b parts neglected ***'//)
 39   FORMAT (40A2)
 40   FORMAT (//12H INPUT CARDS//4H JOB,I6//3H *.,8(10H*********.),1H*)
 41   FORMAT (3H * ,40A2,1H*)
 42   FORMAT (3H *.,8(10H*********.),1H*)
 43   FORMAT (A2)
 44   FORMAT (16H FORMAT LETTERS ,A2,15H NOT RECOGNIZED)
 45   FORMAT (6X,A74)
c01Nov 45   FORMAT (6X,18A4,A2)
 46   FORMAT (7X,A4,A2,3(8A1),F6.2,F5.2)
 47   FORMAT (6H ONLY ,I5,19H ATOM KINDS ALLOWED)
 48   FORMAT (I5,9H ATOMS OF,A4,15H NUMBER ALLOWED,I5)
 49   FORMAT (13X,3F8.0,3F9.0)
c01Nov 50   FORMAT (8X,A1,2X,A1)
 51   FORMAT (6X,A45)
c01Dec 51   FORMAT (6X,45A1)
 52   FORMAT (10H MORE THAN,I5,13H SYMTRY CARDS)
c01Nov Change format statement for CONDIT to match WWW Lazy version.
 53   FORMAT (10X,A4,F8.0,F3.0,F5.0,1X,A1,I2,A2,1X,A1,2I2)
c01Nov 53   FORMAT (10X,A4,F6.0,2F5.0,1X,A1,I2,A2,1X,A1,2I2)
 54   FORMAT (6X,A36)
c01Dec 54   FORMAT (6X,36A1)
 55   FORMAT (23H NO ATOM CARD WAS FOUND)
 56   FORMAT (23H NO CELL CARD WAS FOUND  )
 57   FORMAT (/12H * WARNING */,76H CRYSTAL SYSTEM SPECIFIED ON CELL CAR
     1D AND ON GROUP CARD ARE NOT CONSISTENT  )
 58   FORMAT (37H NEUTRON SCATTERING LENGTH FOR SYMBOL,2X,A4,19H HAS NOT
     1 BEEN FOUND)
 59   FORMAT (/4H JOB,I6,5H OK  /)
 60   FORMAT (/5H JOB ,I5,7H FAILED//)
 61   FORMAT (///16H END OF  L A Z Y)

      goto 999
c	Error handling so that user finds out what caused the crash.

639   write (*,*) 'LAZY: error reading in file FORMAT (40A2). NJOB=', 
     &		NJOB
      write (unitlog,*) 'LAZY: error reading in file FORMAT (40A2).', 
     &		' NJOB=', NJOB
      goto 699
643   write (*,*) 'LAZY: error reading in command. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in command. IJOB=', IJOB
      goto 699
645   write (*,*) 'LAZY: error reading in TITLE. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in TITLE. IJOB=', IJOB
      goto 699

646   write (*,*) 'LAZY: error reading in ATOM. IJOB=', IJOB   
      write (unitlog,*) 'LAZY: error reading in ATOM. IJOB=', IJOB   
      write (unitlog,*) lastOK
      write (unitlog,*) ' aword=', aword(1:20)
      write (unitlog,*) ' remander of line=', aline(1:60)
c      write (*,*) ' aline=', aline(1:60)
      goto 699

649   write (*,*) 'LAZY: error reading in CELL. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in CELL. IJOB=', IJOB
      write (unitlog,*) lastOK
      write (unitlog,*) ' aword=', aword(1:20)
      write (unitlog,*) ' remander of line=', aline(1:60)
      goto 699

650   write (*,*) 'LAZY: error reading in LATICE. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in LATICE. IJOB=', IJOB
      goto 699

651   write (*,*) 'LAZY: error reading in SYMTRY. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in SYMTRY. IJOB=', IJOB
      goto 699
      
653   write (*,*) 'LAZY: error reading in CONDIT. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in CONDIT. IJOB=', IJOB
      goto 699
      
654   write (*,*) 'LAZY: error reading in SPCGRP. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error reading in SPCGRP. IJOB=', IJOB
      goto 699
      
743   write (*,*) 'LAZY: error finding nearly the END. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error finding nearly the END.', 
     &		' IJOB=', IJOB
      goto 699
      
843   write (*,*) 'LAZY: error finding END. IJOB=', IJOB
      write (unitlog,*) 'LAZY: error finding END. IJOB=', IJOB
      goto 699

699   stop
      
999   continue
      END

