c...File: makepixb5a.for. Program makepixb, version 5a, March 2002 c Version 5a2. PROGRAM MAKEPIXB CHARACTER*30 PIXBITFILE INTEGER NMAXBEADS,NMAXBIT8 PARAMETER(NMAXBEADS=800000,NMAXBIT8=NMAXBEADS/8) INTEGER*1 PIXBIT8(NMAXBIT8) INTEGER BIT8I(8) INTEGER I,J,K,KK,NX,NY,NZ,NTOT,ICOUNT,NPLUS INTEGER IPIX,IPIXTOT LOGICAL CONDITION REAL SPACING,XMAX,YMAX,ZMAX,X,Y,Z REAL D12,D22 PRINT *,' Introduce the name of the PIXBITFILE to be produced' PRINT *,' (For instance, mypixbit.pxb)' READ(*,101) PIXBITFILE 101 FORMAT(A30) WRITE(*,501) PIXBITFILE 501 FORMAT('PIXBIT file to be generated:',a30) c----------------------------------------------------------------- INCLUDE 'maxdims.for' c----------------------------------------------------------------- NX=XMAX/SPACING+0.45 NY=YMAX/SPACING+0.45 NZ=ZMAX/SPACING+0.45 NTOT=NX*NY*NZ WRITE(*,502) XMAX,YMAX,ZMAX WRITE(*,503) SPACING 502 FORMAT(' BOX DIMENSIONS X,Y,Z:',3F7.2) 503 FORMAT(' SPACING', F7.3) IF(ABS(NX*SPACING-XMAX)/XMAX.GT.0.01) THEN WRITE(*,601)XMAX,SPACING 601 FORMAT(' **** ERROR: XMAX=',F6.1, & ' IS NOT INTEGER MULTIPLE OF SPACING=',F6.1) STOP ENDIF IF(ABS(NY*SPACING-YMAX)/YMAX.GT.0.01) THEN WRITE(*,602) YMAX,SPACING 602 FORMAT(' **** ERROR: YMAX=',F6.1, & ' IS NOT INTEGER MULTIPLE OF SPACING=',F6.1) STOP ENDIF IF(ABS(NZ*SPACING-ZMAX)/ZMAX.GT.0.01) THEN WRITE(*,603) ZMAX,SPACING 603 FORMAT(' **** ERROR: ZMAX=',F6.1, & ' IS NOT INTEGER MULTIPLE OF SPACING=',F6.1) STOP ENDIF IPIXTOT=NTOT/8 IF(IPIXTOT*8.NE.NTOT) THEN WRITE(*,508) 508 FORMAT(' **** ERROR:',/ & ' TOTAL NUMBER OF PIXELS IS NOT MULTIPLE OF 8') STOP ENDIF WRITE(*,509) 509 FORMAT(' COMPUTING COORDINATES AND PIXEL VALUES......') NPLUS=0 IPIX=0 ICOUNT=0 DO 10 K=1,NZ Z=(K-0.5)*SPACING DO 10 J=1,NY Y=(J-0.5)*SPACING DO 10 I=1,NX X=(I-0.5)*SPACING ICOUNT=ICOUNT+1 BIT8I(ICOUNT)=0 C--------------------------------------------------------------------- INCLUDE 'conditions.for' C--------------------------------------------------------------------- IF(CONDITION) BIT8I(ICOUNT)=1 IF(CONDITION) NPLUS=NPLUS+1 IF(ICOUNT.EQ.8) THEN IPIX=IPIX+1 PIXBIT8(IPIX)=0 DO KK=1,8 PIXBIT8(IPIX)=PIXBIT8(IPIX)+BIT8I(KK)*2**(8-KK) ENDDO ICOUNT=0 ENDIF 10 CONTINUE WRITE(*,510) NPLUS 510 FORMAT(' NUMBER OF (+) PIXELS',I7) WRITE(*,511) PIXBITFILE 511 FORMAT(' Writing pixel values to file ',A30) UNPBX=1 OPEN(UNPBX,FILE=PIXBITFILE,FORM='UNFORMATTED') WRITE(UNPBX) XMAX,YMAX,ZMAX,SPACING DO IPIX=1,IPIXTOT WRITE(UNPBX) PIXBIT8(IPIX) ENDDO CLOSE(UNPBX) STOP END