      subroutine pulverix(hkl,absent)
C-----******************************************************************PULV0000
C-----*          *** LNS VAX VERSION 1989 ***
C-----*          *** including modifications for profile plot
C-----*              and profile refinement
C-----*              - fo 2500 hkl ***
C-----*                                                                *
C-----*              P  U  L  V  E  R  I  X                            *
C-----*                                                                *
C-----******************************************************************
C-----*                                                                *
C-----* ROUTINE TO CALCULATE THEORETICAL POWDER PATTERNS               *
C-----* USING THE DATA FILE PREPARED BY  L  A  Z  Y                    *
C-----*                                                                *
C-----* AUTHORS                                                        *
C-----* K.YVON, W.JEITSCHKO  AND E.PARTHE                              *
C-----* modified  3.87 to prepare CPDF/PROFIL input file by P.ZOLLIKER *

      implicit none
c...	common blocks

c	Dec 4, 2001. TR. Added common block /INPUT/ so have access to ISYMCE
      character*76 COMPND
      character*4 ielmt(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, SL,SH, AGUIN, BGUIN
      real BTEMP(50,16), DELFR(16), DELFI(16)
      integer IMAGE, ns
      character*4 norm,iano
      COMMON /INPUT/ COMPND,IELMT,FOCCU,FMULT,FNEUT,
     &		A,B,C,ALPHA,BETA,GAMMA,
     &		SYMSY,ISYMCE,NCOMPO,NA,WL,SL,SH,NORM,IMAGE,AGUIN,
     &		BGUIN,BTEMP,DELFR,DELFI,IANO,NS

      integer ibravl,isystm
      common /cell/ ibravl,isystm

      integer ihoo,ioko,iool,ihko,ihol,iokl,ihhl,ilau,itrig
      COMMON /EXTI/ IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,ILAU,ITRIG

c...	passed variables
      integer hkl(3)
      logical absent
cCommonBlock      integer ISYMCE

c...	local variables
       real xh, xk, xl 
       real testbr, facehk,  HKO, FIHKO,  FIOKL, OKL, FIHOL, HOL 
       real FIHHL, HOO,  FIHOO, FIOOL, oko, fioko, ool, temp
       integer n
       
C      integer limit1 
C      parameter (limit1=24)
C      integer yh(limit1),yk(limit1),yl(limit1)
C      real q(limit1)


C      ipr=2
      absent=.true.
C      write(*,*) 'i am in pulverix ',ibravl,isystm
C      write(*,'(a,3i3,a)') '(',hkl(1),hkl(2),hkl(3),')'
C      write(*,'(9i3)') IHOO,IOKO,IOOL,IHKO,IHOL,IOKL,IHHL,ILAU,ITRIG
      xh=float(hkl(1))
      xk=float(hkl(2))
      xl=float(hkl(3))
      
C-----OMIT HKL VALUES CORRESPONDING TO BRAVAIS LATTICE EXTINCTIONS      PULV0352
C recall: 1) primitive, 2) body-centred, 3) rhombohedral, 4) face-centred
C         5) a-centred, 6) b-centred, 7) c-centred

 32   GO TO (40,33,34,35,36,37,38), IBRAVL
 33   TESTBR=(XH+XK+XL)/2.                       ! I
      GO TO 39
 34   TESTBR=(-XH+XK+XL)/3.                      ! R
      GO TO 39
 35   FACEHK=(XH+XK)/2.                          ! F (at least h+k even)
      IF ((AINT(FACEHK)-FACEHK).NE.0.) GO TO 38  ! (to 38 from 39) if not even jump ahead
 36   TESTBR=(XK+XL)/2.                          ! A
      GO TO 39
 37   TESTBR=(XH+XL)/2.                          ! B
      GO TO 39
 38   TESTBR=(XH+XK)/2.                          ! C

 39   IF ((AINT(TESTBR)-TESTBR).NE.0.) GO TO 68  ! absent reflection

C-----OMIT HKL VALUES CORRESPONDING TO EXTINCTIONS                      PULV0366
C  these exinctions were calculted by EXTINC.F in lazy and are
C  contained in the ihko type of variables

C ihko: 1: no conditions   2,4: h+k=IHKO*n
C       3: k=2n              5: h=2n
 40   IF (XL.EQ.0.) GO TO (41,50,49,50,47), IHKO

C iokl: 1: no conditions   2,4: k+l=IOKL*n
C       3: l=2n              5: k=2n
 41   IF (XH.EQ.0.) GO TO (42,54,53,54,51), IOKL

C ihol: 1: no conditions   2,4: h+l=IHOL*n
C       3: l=2n              5: h=2n
 42   IF (XK.EQ.0.) GO TO (43,58,57,58,55), IHOL

C these next hhl conditions for cubic system don't make
C allowance for (h -h l) which is identical for these
C systems (hopefully)

C ihhl: 1: no conditions   2: l=2n
C       3: 2h+l=4n
 43   IF (abs(XH).EQ.abs(XK)) GO TO (44,59,61), IHHL

C ihkk and cubic : 1: no conditions   2: h=2n
C                  3: h+2k=4n         4: switched cubic ? was 44
      IF ((abs(XK).EQ.abs(XL)).AND.(ISYSTM.EQ.5))
     &   GO TO (44,62,63), IHHL

C added this condition which was previously missing
C ihkh and cubic : 1: no conditions   2: k=2n
C                  3: 2h+k=4n         4: switched cubic ? was 44
      IF ((abs(XH).EQ.abs(XL)).AND.(ISYSTM.EQ.5))
     &   GO TO (44,162,163), IHHL


C line 133 is an error message for an impossible condition
 44   IF (XK.EQ.0..AND.XL.EQ.0.) GO TO (45,64,133,64), IHOO
 45   IF (XH.EQ.0..AND.XL.EQ.0.) GO TO (46,65,133,65), IOKO
 46   IF (XH.EQ.0..AND.XK.EQ.0.) GO TO (67,66,66,66,133,66), IOOL
      GO TO 67

C  testing!

 47   FIHKO=XH/2.         ! h=2n condition  (hko=5)
 48   IF (AINT(FIHKO)-FIHKO) 68,41,68   ! 68 says its absent (h does not = 2n)
 49   FIHKO=XK/2.         ! k=2n condition  (hko=3)
      GO TO 48
 50   HKO=IHKO            ! h+k= hko*n      (hko=2,4)
      FIHKO=(XH+XK)/HKO
      GO TO 48

 51   FIOKL=XK/2.         ! 
 52   IF (AINT(FIOKL)-FIOKL) 68,42,68
 53   FIOKL=XL/2.
      GO TO 52
 54   OKL=IOKL
      FIOKL=(XK+XL)/OKL
      GO TO 52

 55   FIHOL=XH/2.
 56   IF (AINT(FIHOL)-FIHOL) 68,43,68
 57   FIHOL=XL/2.
      GO TO 56
 58   HOL=IHOL
      FIHOL=(XH+XL)/HOL
      GO TO 56

 59   FIHHL=XL/2.
 60   IF (AINT(FIHHL)-FIHHL) 68,44,68
 61   FIHHL=(2.*XH+XL)/4.
      GO TO 60
 62   FIHHL=XH/2.
      GO TO 60
 63   FIHHL=(2.*XL+XH)/4.   ! h and l switched for this cubic system
      GO TO 60
 162  FIHHL=XK/2.
      GO TO 60
 163  FIHHL=(2.*XH+XK)/4.   ! k and l switched for this cubic system
      GO TO 60

 64   HOO=IHOO
      FIHOO=XH/HOO
      IF (AINT(FIHOO)-FIHOO) 68,45,68
C 65   FIOKO=XK/2.    ! won't work if oko is 4 (a possibility)
 65   oko=ioko
      fioko=xk/oko
      IF (AINT(FIOKO)-FIOKO) 68,46,68
 66   OOL=IOOL
      FIOOL=XL/OOL
      IF ((AINT(FIOOL)-FIOOL).NE.0.) GO TO 68
C-----STORE HKL AND SIN2THETA VALUES OF F VALUES  TO BE CALCULATED      PULV0413
C at this point one really has a reflection
 67   absent=.false.
C      N=N+1
C-----CHECK IF NUMBER OF REFLECTIONS TOO LARGE                          PULV0415
C      IF (N.GT.LIMIT1) GO TO 72
C      Q(N)=ATEST
C      YH(N)=XH
C      YK(N)=XK
C      YL(N)=XL
C      JJ=N
C      J=JJ-1

c01Dec Zh, ZK, ZL are not initialized.
 68   IF (ILAU.EQ.2) GO TO 9
      GO TO (9,9,9,69,70,69,9), ISYSTM
 69   continue
 70   continue
c01DecC-----SKIP REFLECTIONS RELATED BY LAUE SYMMETRY                         PULV0423
c01Dec 68   IF ((ILAU.EQ.2).OR.(ZH.EQ.XK)) GO TO 9
c01Decc      GO TO (9,9,9,69,70,69,9), ISYSTM
c01Dec 69   IF ((ZH.GT.ZK).AND.(ZK.GT.0.)) GO TO 71
c01Dec      GO TO 9
c01Dec 70   IF ((ZH.GT.ZK).AND.(ZK.GT.ZL)) GO TO 71
      GO TO 9
C hmm, a little switch-aroo
 71   TEMP=XH
      XH=XK
      XK=TEMP
C back to beginning of loop
      GO TO 32
 72   continue
 73   continue
C-----PRINT HEX AND TETRAG LATTICE CONSTANTS, END OF HKL GENER.LOOP     PULV0434
  9   continue
  716 FORMAT(8F10.3)
C-----PRINT LAUE SYMMETRY                                               PULV0448
C recall isystm: 1: monoclinic  2: orthorhomic  3: trigonal
C                4: tetragonal  5: isometric    6: hexagonal    
C                7: triclinic
  804 IF (ISYSTM.LT.3) GO TO 74
      N=10     ! low Laue symmetry (really for triclinic?)
      IF (ILAU.EQ.2) N=11  ! high Laue symmetry
c01Dec      IF (LAUE.EQ.2) N=11  ! high Laue symmetry
C      WRITE (IPR,145) ITIT(N)
 74   N=12                     ! no Laue symmetry
C-----PRINT SYMMETRY CENTER                                             PULV0454
      IF (ISYMCE.EQ.1) N=13
C      WRITE (IPR,146) ITIT(N)
C-----PRINT BRAVAIS LATTICE AND EXTINCTIONS                             PULV0457
      N=IBRAVL*3-2
C      WRITE (IPR,147) JB(N),JB(N+1),JB(N+2)
 81   CONTINUE
      return
C-----
C-CDC-CALL EXIT                                                         PULV0825

 133  write(*,194)
      write(*,*) 'finished pulverix'
      return

C-----                                                                  PULV0826
 138  FORMAT (   ///,23H START  P U L V E R I X     )
 139  FORMAT (/39H B Y E  B Y E  L A Z Y  P U L V E R I X  )
 140  FORMAT (4H JOB  ,I5,40H IS BAD DUE TO ERROR IN PREVIOUS PROGRAM,/1
     16H GO TO NEXT JOB ,//)
 141  FORMAT (1H //////)
 142  FORMAT (4H JOB,I5/ )
 143  FORMAT (/2X,9H DIAMETER,F9.4,3H MM,/2X,60H ANGLE BETWEEN NORMAL TO
     1 PLANE OF SPECIMEN AND INCIDENT BEAM,F7.2,5H DEG.,/2X,27H D-SPACIN
     2G OF MONOCHROMATOR,F7.3,9H ANGSTROM)
 144  FORMAT ( /12H SPACE GROUP,A4,22H GIVEN ON SPCGRP-CARD ,36A1)
 145  FORMAT (/1X,A4,14H LAUE SYMMETRY)
 146  FORMAT (/10H THERE IS ,A2,30H SYMMETRY CENTRE AT THE ORIGIN)
 147  FORMAT (/1X,3A4,16H BRAVAIS LATTICE)
 148  FORMAT ( /41H CONDITIONS LIMITING POSSIBLE REFLECTIONS  /)
 174  FORMAT (19H HKO WITH H=2N ONLY)
 175  FORMAT (19H HKO WITH K=2N ONLY)
 176  FORMAT (14H HKO WITH H+K=,I1,6HN ONLY)
 177  FORMAT (19H OKL WITH K=2N ONLY)
 210  FORMAT (19H OKL WITH L=2N ONLY)
 178  FORMAT (14H OKL WITH K+L=,I1,6HN ONLY)
 179  FORMAT (19H HOL WITH H=2N ONLY)
 180  FORMAT (19H HOL WITH L=2N ONLY)
 181  FORMAT (14H HOL WITH H+L=,I1,6HN ONLY)
 182  FORMAT (19H HHL WITH L=2N ONLY)
 183  FORMAT (22H HHL WITH 2H+L=4N ONLY)
 184  FORMAT (12H HOO WITH H=,I1,6HN ONLY)
 185  FORMAT (19H OKO WITH K=2N ONLY)
 186  FORMAT (12H OOL WITH L=,I1,6HN ONLY)
 187  FORMAT (/21H MONOCLINIC STRUCTURE)
 188  FORMAT (/20H TRICLINIC STRUCTURE)
 189  FORMAT (/23H ORTHORHOMBIC STRUCTURE)
 190  FORMAT (/19H TRIGONAL STRUCTURE)
 191  FORMAT (/21H TETRAGONAL STRUCTURE)
 192  FORMAT (/16H CUBIC STRUCTURE)
 193  FORMAT (/20H HEXAGONAL STRUCTURE)
 194  FORMAT(/53H SOMETHING VERY BAD HAPPENED. CALL THE AUTHORS PLEASE)
 208  FORMAT(10H HKL  NONE)
 209  FORMAT(21H HKL WITH K+L=2N ONLY)
 215  FORMAT(21H HKL WITH H+L=2N ONLY)
 211  FORMAT(21H HKL WITH H+K=2N ONLY)
 212  FORMAT(40H HKL WITH H,K,L ALL EVEN OR ALL ODD ONLY )
 213  FORMAT(23H HKL WITH H+K+L=2N ONLY)
 214  FORMAT(24H HKL WITH -H+K+L=3N ONLY)
C220  FORMAT(4I5)
 220  FORMAT(5I5)
      END
