From: BIGVAX::edu%"toby%xtal.dnet@ttown.msc.edu" 10-MAR-1992 16:18:43.44 To: snyder@ttown.apci.com CC: Subj: type sys$input ! FILE(S) [-.XFER]*.* ENCLOSED Received: From UMNACVX(SMTPUSER) by CERAMICS with Jnet id 2393 for SNYDER@CERAMICS; Tue, 10 Mar 1992 16:16 EST Received: from noc.msc.edu by vx.acs.umn.edu; Tue, 10 Mar 92 15:19 CST Received: from ttown.apci.com by noc.msc.edu (5.65/MSC/v3.0(901107)) id AA28269; Tue, 10 Mar 92 15:15:06 -0600 Received: from XTAL.DECnet MAIL11D_V3 by ttown.apci.com (5.57/Ultrix3.0-C) id AA22985; Tue, 10 Mar 92 16:14:26 -0500 Date: Tue, 10 Mar 92 16:14:26 -0500 From: toby%xtal.dnet@ttown.msc.edu Subject: type sys$input ! FILE(S) [-.XFER]*.* ENCLOSED To: snyder@ttown.apci.com Message-id: <9203102114.AA22985@ttown.apci.com> X-Envelope-to: snyder@CERAMICS.BITNET $ copy/log sys$input 1README.1ST;1 $deck/dollars=$EODBHTCOPY** +-------------------------+ Installation Instructions +-------------------------+ To install VAXCONV, load the files into directory, keeping the same directory structure, e.g. use $ BACKUP saveset/sav dev:[dir...] It is recommended that one recompile and relink the programs when the software is installed. Use: $ SET DEF dev:[dir.VAXCONV] $ @VAXCONV If you do not have a FORTRAN compiler, you can only link the software. Use: $ SET DEF dev:[dir.VAXCONV] $ @LINK_VAXCONV The software can optionally be compiled to read GSAS histogram files. To do this the GSAS software must be loaded on the local system, and the GSAS object library files must not be deleted following the GSAS installation. To include GSAS support in VAXCONV: 1) edit file LINK_GSAS.COM and change the line with "gsaslib/lib" to reflect the location of the GSAS library. 2) compile and link the entire program, as above $ SET DEF dev:[dir.VAXCONV] $ @VAXCONV 3) compile and add the GSAS read routines $ @LINK_VAXCONV ------------------------------------- Note that in the above "dir" should be replaced with the root directory for the software and "dev" the device. For example: $ SET DEF $DISK1:[PUBLIC.VAXCONV] $EODBHTCOPY** $ copy/log sys$input CHANGES.LOG;6 $deck/dollars=$EODBHTCOPY** ====================================================================== Modifications 3/10/92 -- BH Toby ====================================================================== New/changed files: 1README.1ST FILECONV.CBS VAXCONV.FOR SUBS.COM VAXCONV.COM LINK_GSAS.COM [.SUBS]FILECONV.CBS [.SUBS]DATCOD.FOR [.SUBS]rdisas.for (dummy routine) [.subs]RPLSHA.FOR (see below) [.GSAS]rdwsas.for (GSAS routine) [.GSAS]rdisas.for (GSAS routine) Changes made to VAXCONV. 1. remove common blocks from VAXCONV, using INCLUDE 'FILECONV.CBS' N.B. common blocks removed were out of date! 2. Variable REFRSH added to FILECONV.CBS & VAXCONV.FOR, this is because the GSAS subroutines may change the screen during read. REFRSH tells VAXCONV to update the screen after reading in a file. 3. DATCOD -- fix month 4. RPLSHA.FOR has compile errors, fixed as best as I could guess 5. File VAXCONV.COM modified, SUBS.COM created -- neaten up compilation & linking 6. File LINK_GSAS.COM created for adding GSAS file support. N.B. using the GSAS routines requires linking to GSAS library files. Since not everyone will have this file, I have created a dummy version of the subroutines that does not require this library. To use the GSAS version, use @LINK_GSAS.COM This file will need to be edited to include the location of the GSAS library file. See the installation instructions (1README.1ST) Warnings: DIADIF.FOR, RRWDPC.FOR, SCREEN.FOR, SHOWPS.FOR, WRW5000.FOR have INCLUDE statement commented out, and have the .CBS file hard coded in. Bad news! the FILECONV.CBS files were not the same in the main directory & the [.SUBS] directory! ====================================================================== $EODBHTCOPY** $ copy/log sys$input FILECONV.CBS;9 $deck/dollars=$EODBHTCOPY** C================================================================== C C COMMON BLOCKS FOR PROGRAM FILECONV C C================================================================== C C GENERAL BLOCKS... C PARAMETER DTOR= 0.8726646259E-2, RTOD= 114.591559 COMMON /GENRAL/ IREC,REFRSH LOGICAL REFRSH C C IREC ----- READ RECORD POINTER (FOR DEBUGING PURPOSE) C REFRSH --- SET TO TRUE IF SCREEN NEEDS TO BE UPDATED (BHT) C================================================================== C C INPUT/OUTPUT BLOCKS... C PARAMETER IINP= 1, IOUT= 2, NTYP= 60 CHARACTER FILTYP(NTYP)*24 CHARACTER FILINP*32, FILOUT*32 COMMON/IOFILE/IERR,JFIL,IFLI,IFLO,ITYI,ITYO,FILINP,FILOUT,FILTYP C C IERR --- ERROR FLAG: C FROM READ: 0=NO ERROR, 1=ERROR DURING READ, 2=OPEN FAILURE C 3=BAIL OUT C FROM WRITE: 0=NO ERROR, 1=ERROR DURING WRITE OR OPEN FAILURE C 3=BAIL OUT C JFIL ----- FILE TYPE NOT SUPPORTED YET C IFLI ----- INPUT FILE TYPE C IFLO ----- OUTPUT FILE TYPE C ITYI ----- INPUT FILE CATEGORY C 1=RAW, 2=DIF, 3=PLT, 4=DAT C ITYO ----- OUTPUT FILE CATEGORY C 1=RAW, 2=DIF, 3=PLT, 4=DAT C IINP ----- LOGICAL UNIT NUMBER FOR INPUT DATA FILE C IOUT ----- LOGICAL UNIT NUMBER FOR OUTPUT DATA FILE C FILINP --- INPUT DATA FILENAME C FILOUT --- OUTPUT DATA FILENAME C NTYP ----- MAX NUMBER OF FILE TYPES CONVERTABLE C FILTYP --- CHARACTER ARRAY THAT STORES THE FILE TYPE NAME C================================================================== C C FILE HEADER BLOCK... C INTEGER*2 ITYP COMMON /FILHED/ ITYP, NHDB, ISBF, LENG C C ITYP --- DATA FILE TYPE C NHDB --- NUMBER OF RECORDS IN THE HEADER BLOCK C ISBF --- STARTING RECORD OF SPECIFICATION BLOCK REFERENCES C LENG --- LENGTH OF SPECIFICATION BLOCK REFERENCES C================================================================== C C FILE BLOCK REFERENCES... C PARAMETER NSBR= 12 CHARACTER IRLR(NSBR)*4 COMMON /FILRFR/ IRPR(NSBR,2), IRLR C C NSBR --- NUMBER OF SPECIFICATION BLOCK REFERENCES C IRPR --- SPECIFICATION BLOCK REFERENCES (POINTERS AND LENGTH) C IRLR --- LABEL OF SPECIFICATION BLOCK REFERENCES C================================================================== C C FILE DESCRIPTION BLOCK... C INTEGER*2 FTYP, MTYP, NREP, MPRO, NRNG CHARACTER NAME(3)*4, SCAN*1, STYP*1, SLID(20)*4 COMMON /FILDES/ NAME, DATM, TIMM, FTYP, MTYP, NREP, 1 MPRO, NRNG, SCAN, STYP, SLID C C NAME --- OPERATOR NAME C DATM --- ENCODED DATE C TIMM --- ENCODED TIME C FTYP --- FILE TYPE C MTYP --- METHOD OF ANALYSIS C NREP --- NUMBER OF SERIES OF MEASUREMENTS C MPRO --- MEASUREMENT PROCEDURE C NRNG --- NUMBER OF SCAN RANGES C SCAN --- SCAN MODE C STYP --- SERIES TYPE C SLID --- SAMPEL ID C================================================================== C C LINE MEASUREMENT BLOCK... C COMMON /LINEMM/ BANG(14), DANG(14) C C BANG(1) --- STARTING ANGLE C BANG(2) --- ENDING ANGLE C BANG(3) --- STEP WIDTH C BANG(4) --- MAX COUNTS C BANG(5) --- TWO-THETA OF MAX COUNTS C BANG(6) --- MIN COUNTS C BANG(7) --- TWO-THETA OF MIN COUNTS C BANG(8) --- RESERVED C BANG(9) --- NUMBER OF OSCILLATIONS C BANG(10)--- COUNT TIME (SEC) FOR PEAK C BANG(11)--- COUNT TIME FOR BACKGROUND C BANG(12)--- RESERVED C BANG(13)--- DELAY TIME C BANG(14)--- FIXED ANGLE OF MEASUREMENT C DANG(*) --- USER MODIFIABLE SET OF BANG(*) C================================================================== C C INSTRUMENTATION BLOCK... C INTEGER*2 DIFNUM, CHRLIN CHARACTER ANODE(6)*2,DIFVER*1,GONINT*1,ELEMT*2 REAL*4 WAVE COMMON /INSTRU/ IELE,WAVE(5,6),ANODE, DIFNUM,DIFVER,GONINT & ,ELEMT,CHRLIN C C IELE -------- TARGET ELEMENT (DEFAULT=4,Cu) C WAVE(*,1) --- Cr C WAVE(*,2) --- Fe C WAVE(*,3) --- Co C WAVE(*,4) --- Cu C WAVE(*,5) --- Mo C WAVE(*,6) --- USER SPECIFIED C WAVE(1,*) --- WAVELENGTH OF K-ALPHA 1 C WAVE(2,*) --- WAVELENGTH OF K-ALPHA 2 C WAVE(3,*) --- WAVELENGTH OF K-ALPHA C WAVE(4,*) --- WAVELENGTH OF K-BETA C WAVE(5,*) --- KA1/KA2 RATIO C================================================================== C C INTENSITY DATA BLOCK... C PARAMETER MNP= 10000 COMMON /COUNTS/ MODE, NPTS, XOBS(MNP), YOBS(MNP) C C MNP ---- MAXIMUM NUMBER OF DATA POINTS ALLOWED C MODE --- 0 = X --- TWO-THETA C 1 = X --- D-SPACING C 2 = X --- Q-SCAN (Q=2PI/D=4PI*SIN(THETA)/LAMDA) C NPTS --- TOTAL NUMBER OF DATA POINTS STORED IN YOBS C XOBS --- ARRAY TO STORE THE X-VALUES C YOBS --- ARRAY TO STORE THE RAW COUNTS C================================================================== C C DIFILE BLOCK... C PARAMETER MNK= 500 CHARACTER PEAK(MNK)*4 C INTEGER*4 PHKL(3,MNK) * INTEGER*2 PHKL(3,MNK) ! S.Z. for d5000 format INTEGER*2 PHKL(4,MNK) ! D.P.M. COMMON /DIFILE/ NPKS, IRES, JRES, CUTI(2), CUTF(2), 1 F2TH(MNK), FDSP(MNK), C2TH(MNK), CDSP(MNK), 1 PHGH(MNK), AREA(MNK,2), RELA(MNK), 1 FWHM(MNK), PHKL, PEAK C C MNK ---- MAXIMUM NUMBER OF PEAKS ALLOWED C NPKS --- TOTAL NUMBER OF PEAKS STORED C IRES --- RESIDUAL PATTERN FLAG: 0=CONTAINED, 1=NOT CONTAINED C JRES --- USE THE RESIDUAL PATTERN: 1=NO, 2=YES C CUTI --- INTENSITY CUTOFFS (%) C CUTF --- FWHM CUTOFFS (D) C F2TH --- OBSERVED TWO-THETA C FDSP --- OBSERVED D-SPACING C C2TH --- CORRECTED TWO-THETA C CDSP --- CORRECTED D-SPACING C PHGH --- PEAK HEIGHT (CPS) C AREA(*,1) --- INTEGRATED INTENSITY C AREA(*,2) --- RESIDUAL INTENSITY C RELA --- RELATIVE INTENSITY C FWHM --- FULL WIDTH AT HALF MAXIMUM C PHKL --- REFLECTION HKL C PEAK --- PEAK TYPE LABEL C================================================================== $EODBHTCOPY** $ copy/log sys$input LINK_GSAS.COM;2 $deck/dollars=$EODBHTCOPY** $! $! LINK, and COPY "VAXCONV" to execution directory $! $! SET DEF POWD:[PUBLIC.SOURCE.VAXCONV] $ IF F$SEARCH("VAXCONV.OBJ") .EQS. "" THEN fort VAXCONV.FOR $ IF F$SEARCH("VAXCONV.OLB") .EQS. "" THEN LIBR VAXCONV [.SUBS]*.OBJ/LOG $ fort [.GSAS]RDISAS $ fort [.GSAS]RRWSAS $ LINK VAXCONV, RDISAS, RRWSAS, VAXCONV/LIB, - usp:[gsas.libs]gsaslib/lib ! change this as needed for $ ! your local system. $! COPY VAXCONV.EXE POWD:[PUBLIC.EXE.VAXCONV]vaxconv.exe $EODBHTCOPY** $ copy/log sys$input LINK_VAXCONV.COM;3 $deck/dollars=$EODBHTCOPY** $! $! LINK, and COPY "VAXCONV" to execution directory $! $! SET DEF POWD:[PUBLIC.SOURCE.VAXCONV] $! LIBR VAXCONV [.SUBS]*.OBJ/LOG $ LINK VAXCONV, VAXCONV/LIB $! COPY VAXCONV.EXE POWD:[PUBLIC.EXE.VAXCONV]vaxconv.exe $EODBHTCOPY** $ copy/log sys$input SUBS.COM;3 $deck/dollars=$EODBHTCOPY** $ FORT/obj=[.subs] [.subs]CLEARS.FOR $ FORT/obj=[.subs] [.subs]CODDAT.FOR $ FORT/obj=[.subs] [.subs]CODTIM.FOR $ FORT/obj=[.subs] [.subs]COLORS.FOR $ FORT/obj=[.subs] [.subs]COMMAS.FOR $ FORT/obj=[.subs] [.subs]CURSOR.FOR $ FORT/obj=[.subs] [.subs]DATCOD.FOR $ FORT/obj=[.subs] [.subs]DATUNK.FOR $ FORT/obj=[.subs] [.subs]DEFEXT.FOR $ FORT/obj=[.subs] [.subs]DIADIF.FOR $ FORT/obj=[.subs] [.subs]DIARAW.FOR $ FORT/obj=[.subs] [.subs]GRADAT.FOR $ FORT/obj=[.subs] [.subs]GRAHKL.FOR $ FORT/obj=[.subs] [.subs]HEADER.FOR $ FORT/obj=[.subs] [.subs]INICOM.FOR $ FORT/obj=[.subs] [.subs]LAMDAP.FOR $ FORT/obj=[.subs] [.subs]LDIGIT.FOR $ FORT/obj=[.subs] [.subs]LPRINT.FOR $ FORT/obj=[.subs] [.subs]MARGIN.FOR $ FORT/obj=[.subs] [.subs]NALPHA.FOR $ FORT/obj=[.subs] [.subs]NAMEXT.FOR $ FORT/obj=[.subs] [.subs]NBLANK.FOR $ FORT/obj=[.subs] [.subs]NOTWRN.FOR $ FORT/obj=[.subs] [.subs]PAUSES.FOR $ FORT/obj=[.subs] [.subs]PUTEXT.FOR $ FORT/obj=[.subs] [.subs]PUTFFL.FOR $ FORT/obj=[.subs] [.subs]PUTGFL.FOR $ FORT/obj=[.subs] [.subs]PUTIFL.FOR $ FORT/obj=[.subs] [.subs]RDI011.FOR $ FORT/obj=[.subs] [.subs]RDI05A.FOR $ FORT/obj=[.subs] [.subs]RDI05S.FOR $ FORT/obj=[.subs] [.subs]RDI500.FOR $ FORT/obj=[.subs] [.subs]RDIAID.FOR $ FORT/obj=[.subs] [.subs]RDIKEY.FOR $ FORT/obj=[.subs] [.subs]RDIMDI.FOR $ FORT/obj=[.subs] [.subs]RDINIC.FOR $ FORT/obj=[.subs] [.subs]RDIRIG.FOR $ FORT/obj=[.subs] [.subs]RDISAS.FOR ! added 3/6/92 BHT $ FORT/obj=[.subs] [.subs]RDISPP.FOR $ FORT/obj=[.subs] [.subs]RDITAG.FOR $ FORT/obj=[.subs] [.subs]RDIUNK.FOR $ FORT/obj=[.subs] [.subs]RLSNBS.FOR $ FORT/obj=[.subs] [.subs]RLSUNK.FOR $ FORT/obj=[.subs] [.subs]RLSXRR.FOR $ FORT/obj=[.subs] [.subs]RPLNBS.FOR $ FORT/obj=[.subs] [.subs]RPLSHA.FOR $ FORT/obj=[.subs] [.subs]RPLUNK.FOR $ FORT/obj=[.subs] [.subs]RPLXRR.FOR $ FORT/obj=[.subs] [.subs]RRW011.FOR $ FORT/obj=[.subs] [.subs]RRW05A.FOR $ FORT/obj=[.subs] [.subs]RRW05S.FOR $ FORT/obj=[.subs] [.subs]RRW500.FOR $ FORT/obj=[.subs] [.subs]RRW5000.FOR !added 9/20/90 ABM $ FORT/obj=[.subs] [.subs]RRWMDI.FOR $ FORT/obj=[.subs] [.subs]RRWNBS.FOR $ FORT/obj=[.subs] [.subs]RRWNIC.FOR $ FORT/obj=[.subs] [.subs]rrwnsy.for $ FORT/obj=[.subs] [.subs]RRWPDF.FOR $ FORT/obj=[.subs] [.subs]RRWRIG.FOR $ FORT/obj=[.subs] [.subs]RRWRIO.FOR $ FORT/obj=[.subs] [.subs]RRWSAS.FOR $ FORT/obj=[.subs] [.subs]RRWSHA.FOR $ FORT/obj=[.subs] [.subs]RRWSPP.FOR $ FORT/obj=[.subs] [.subs]RRWTAG.FOR $ FORT/obj=[.subs] [.subs]RRWUNK.FOR $ FORT/obj=[.subs] [.subs]RRWX3.FOR $ FORT/obj=[.subs] [.subs]RRWX7.FOR $ FORT/obj=[.subs] [.subs]RRWXRR.FOR $ FORT/obj=[.subs] [.subs]SCREEN.FOR $ FORT/obj=[.subs] [.subs]SHOWPN.FOR $ FORT/obj=[.subs] [.subs]SHOWPS.FOR $ FORT/obj=[.subs] [.subs]SPAWNS.FOR $ FORT/obj=[.subs] [.subs]TIMCOD.FOR $ FORT/obj=[.subs] [.subs]WDI011.FOR $ FORT/obj=[.subs] [.subs]WDI05A.FOR $ FORT/obj=[.subs] [.subs]WDI05S.FOR $ FORT/obj=[.subs] [.subs]WDI500.FOR $ FORT/obj=[.subs] [.subs]WDIAID.FOR $ FORT/obj=[.subs] [.subs]WDIKEY.FOR $ FORT/obj=[.subs] [.subs]WDIMDI.FOR $ FORT/obj=[.subs] [.subs]WDINIC.FOR $ FORT/obj=[.subs] [.subs]WDIRIG.FOR $ FORT/obj=[.subs] [.subs]WDISPP.FOR $ FORT/obj=[.subs] [.subs]WDITAG.FOR $ FORT/obj=[.subs] [.subs]WDIUNK.FOR $ FORT/obj=[.subs] [.subs]WRW011.FOR $ FORT/obj=[.subs] [.subs]WRW05A.FOR $ FORT/obj=[.subs] [.subs]WRW05S.FOR $ FORT/obj=[.subs] [.subs]WRW500.FOR $ FORT/obj=[.subs] [.subs]WRW5000.FOR !added 9/20/90 ABM $ FORT/obj=[.subs] [.subs]WRWMDI.FOR $ FORT/obj=[.subs] [.subs]WRWNBS.FOR $ FORT/obj=[.subs] [.subs]WRWNIC.FOR $ FORT/obj=[.subs] [.subs]wrwnsy.for $ FORT/obj=[.subs] [.subs]WRWPDF.FOR $ FORT/obj=[.subs] [.subs]WRWRIG.FOR $ FORT/obj=[.subs] [.subs]WRWRIO.FOR $ FORT/obj=[.subs] [.subs]WRWSAS.FOR $ FORT/obj=[.subs] [.subs]WRWSHA.FOR $ FORT/obj=[.subs] [.subs]WRWSPP.FOR $ FORT/obj=[.subs] [.subs]WRWTAG.FOR $ FORT/obj=[.subs] [.subs]WRWUNK.FOR $ FORT/obj=[.subs] [.subs]WRWX3.FOR $ FORT/obj=[.subs] [.subs]WRWX7.FOR $ FORT/obj=[.subs] [.subs]WRWXRR.FOR $ FORT/obj=[.subs] [.subs]RDI5000.FOR !added 3/6/92 BHT $ FORT/obj=[.subs] [.subs]RPLSHD.FOR !added 3/6/92 BHT $ FORT/obj=[.subs] [.subs]WDI5000.FOR !added 3/6/92 BHT $ FORT/obj=[.subs] [.subs]WRWDBW.FOR !added 3/6/92 BHT $ FORT/obj=[.subs] [.subs]WRWMAC.FOR !added 3/6/92 BHT $EODBHTCOPY** $ copy/log sys$input VAXCONV.COM;7 $deck/dollars=$EODBHTCOPY** $! $! FORT AND LINK vaxconv $! $! SET DEF POWD:[PUBLIC.SOURCE.VAXCONV] $! compile the main routine $ del [...]*.obj;*/nolog/noconf $ fort vaxconv $! compile all subroutines $ @subs $ flag = "" $ if F$search("vaxconv.olb") .eqs. "" then flag = "/create" $ LIBR'flag' VAXCONV [.SUBS]*.OBJ/LOG $ LINK VAXCONV, VAXCONV/LIB $! COPY VAXCONV.EXE POWD:[PUBLIC.EXE.VAXCONV]vaxconv.exe $EODBHTCOPY** $ copy/log sys$input VAXCONV.FOR;62 $deck/dollars=$EODBHTCOPY** C======================================================= C PROGRAM VAXCONV C C PROGRAMMER: Rongsheng Zhou C ALFRED UNIVERSITY, FEB-1987 C Modified continuously by R. L. Snyder C C AN INTEGRATED FILE FORMAT CONVERSION ROUTINE C MAINLY FOR X-RAY DIFFRACTION ANALYSIS PROGRAMS C C======================================================= INCLUDE 'FILECONV.CBS' PARAMETER LINE= 22 PARAMETER IRAW1= 1, IRAW2= 19 PARAMETER IDIF1= 21, IDIF2= 32 PARAMETER IPLT1= 41, IPLT2= 43 PARAMETER ILIS1= 46, ILIS2= 47 PARAMETER IDAT1= 51, IDAT2= 52 CHARACTER TEXT*80, DEFFIL*32, FILNUM(NTYP)*4 DIMENSION IL(NTYP), IC(NTYP) DATA FILTYP(1) / 'Diffrac-5000 ....... RAW' / DATA FILTYP(2) / 'Diffrac-500 ........ RAW' / DATA FILTYP(3) / 'Diffrac-11 ......... RAW' / DATA FILTYP(4) / 'Diffrac-5(Alfred) .. RAW' / DATA FILTYP(5) / 'Specplot ........... RAW' / DATA FILTYP(6) / 'Nicolet ............ RAW' / DATA FILTYP(7) / 'Scintag ............ RAW' / DATA FILTYP(8) / 'Rigaku ............. RAW' / DATA FILTYP(9) / 'DuPont ............. RAW' / DATA FILTYP(10) / 'MDI ................ RAW' / DATA FILTYP(11) / 'GSAS Rietveld....... RAW' / DATA FILTYP(12) / 'Shadow / Rietveld .. RAW' / DATA FILTYP(13) / 'DBW Rietveld ....... RAW' / DATA FILTYP(14) / 'NBS Rietveld ....... RAW' / DATA FILTYP(15) / 'NSLS-X7 (BNL) ...... RAW' / DATA FILTYP(16) / 'NSLS-X3 (SUNY) ..... RAW' / DATA FILTYP(17) / 'JCAMP - PDF3 ....... RAW' / DATA FILTYP(18) / 'Socabin ............ RAW' / DATA FILTYP(18) / 'ASCII UPLOAD........ RAW' / DATA FILTYP(60) / 'Line Printer ....... LP ' / DATA FILNUM(1) / '[ 1]' / DATA FILNUM(2) / '[ 2]' / DATA FILNUM(3) / '[ 3]' / DATA FILNUM(4) / '[ 4]' / DATA FILNUM(5) / '[ 5]' / DATA FILNUM(6) / '[ 6]' / DATA FILNUM(7) / '[ 7]' / DATA FILNUM(8) / '[ 8]' / DATA FILNUM(9) / '[ 9]' / DATA FILNUM(10) / '[10]' / DATA FILNUM(11) / '[11]' / DATA FILNUM(12) / '[12]' / DATA FILNUM(13) / '[13]' / DATA FILNUM(14) / '[14]' / DATA FILNUM(15) / '[15]' / DATA FILNUM(16) / '[16]' / DATA FILNUM(17) / '[17]' / DATA FILNUM(18) / '[18]' / DATA FILNUM(60) / '[60]' / DATA FILTYP(21) / 'Diffrac-5000 ....... DIF' / DATA FILTYP(22) / 'Diffrac-500 ........ DIF' / DATA FILTYP(23) / 'Diffrac-11 ......... DIF' / DATA FILTYP(24) / 'Diffrac-5(Alfred) .. DIF' / DATA FILTYP(25) / 'Specplot ........... DIF' / DATA FILTYP(26) / 'Nicolet ............ DIF' / DATA FILTYP(27) / 'Scintag ............ DIF' / DATA FILTYP(28) / 'Rigaku ............. DIF' / CBHT DATA FILTYP(29) / '?????? ............. DIF' / DATA FILTYP(29) / 'GSAS Refl. File .... DIF' / DATA FILTYP(30) / 'MDI ................ DIF' / DATA FILTYP(31) / 'AIDS ............... DIF' / DATA FILTYP(32) / 'Keyboard ........... DIF' / DATA FILTYP(41) / 'Shadow ............. PLT' / DATA FILTYP(42) / 'X-ray Rietveld ..... PLT' / DATA FILTYP(43) / 'NBS/DBW Rietveld ... PLT' / DATA FILTYP(46) / 'X-ray Rietveld ..... LIS' / DATA FILTYP(47) / 'NBS Rietveld ....... LIS' / DATA FILTYP(51) / 'GRAFIT ............. DAT' / DATA FILTYP(52) / 'GRAFIT ............. HKL' / DATA FILNUM(21) / '[21]' / DATA FILNUM(22) / '[22]' / DATA FILNUM(23) / '[23]' / DATA FILNUM(24) / '[24]' / DATA FILNUM(25) / '[25]' / DATA FILNUM(26) / '[26]' / DATA FILNUM(27) / '[27]' / DATA FILNUM(28) / '[28]' / DATA FILNUM(29) / '[29]' / DATA FILNUM(30) / '[30]' / DATA FILNUM(31) / '[31]' / DATA FILNUM(32) / '[32]' / DATA FILNUM(41) / '[41]' / DATA FILNUM(42) / '[42]' / DATA FILNUM(43) / '[43]' / DATA FILNUM(46) / '[46]' / DATA FILNUM(47) / '[47]' / DATA FILNUM(51) / '[51]' / DATA FILNUM(52) / '[52]' / C C IL is the line number for each of the menu labels C DATA IL / 1 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1 12, 13, 14, 15, 16, 17, 18, 19, 0, 0, 1 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 1 12, 13, 0, 0, 0, 0, 0, 0, 0, 0, 1 14, 15, 16, 0, 0, 17, 18, 0, 0, 0, 1 19, 20, 0, 0, 0, 0, 0, 0, 0, 20 / C C IC is the column number for each of the menu labels C DATA IC / 1 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 1 11, 11, 11, 11, 11, 11, 11, 11, 0, 0, 1 51, 51, 51, 51, 51, 51, 51, 51, 51, 51, 1 51, 51, 0, 0, 0, 0, 0, 0, 0, 0, 1 51, 51, 51, 0, 0, 51, 51, 0, 0, 0, 1 51, 51, 0, 0, 0, 0, 0, 0, 0, 11 / DATA WAVE/ 1 2.289700, 2.293606, 2.291000, 2.084870, 2.0, 1 1.936042, 1.939980, 1.937355, 1.756610, 2.0, 1 1.788965, 1.792850, 1.790260, 1.620790, 2.0, 1 1.540562, 1.544390, 1.541838, 1.392218, 2.0, 1 0.709300, 0.713590, 0.710730, 0.632288, 2.0, 1 0.000000, 0.000000, 0.000000, 0.000000, 0.0 / DATA ANODE / 'CR', 'FE', 'CO', 'CU', 'MO', 'US' / C C DISPLAY THE MAIN MENU... C 1 CALL CLEARS( 0) !CLEAR THE SCREEN CALL COLORS(-1) !REVERSE VIDEO CALL COLORS(80) !INTENSE PRINT TEXT='VAXCONV --- The Alfred File Format Conversion Routine ' CALL HEADER( TEXT ) CALL COLORS(1) WRITE(6,1000) 1000 FORMAT( 16X,'[ 1]',29X,'<*>',4X,'[21]'/6X,'[ 2]',29X,'<*>',4X,'[22]'/ 16X,'[ 3]',29X,'<*>',4X,'[23]'/6X,'[ 4]',29X,'<*>',4X,'[24]'/ 16X,'[ 5]',29X,'<*>',4X,'[25]'/6X,'[ 6]',29X,'<*>',4X,'[26]'/ 16X,'[ 7]',29X,'<*>',4X,'[27]'/6X,'[ 8]',29X,'<*>',4X,'[28]'/ 16X,'[ 9]',29X,'<*>',4X,'[29]'/6X,'[10]',29X,'<*>',4X,'[30]'/ 16X,'[11]',29X,'<*>',4X,'[31]'/6X,'[12]',29X,'<*>',4X,'[32]'/ 16X,'[13]',29X,'<*>',4X,'[41]'/6X,'[14]',29X,'<*>',4X,'[42]'/ 16X,'[15]',29X,'<*>',4X,'[43]'/6X,'[16]',29X,'<*>',4X,'[46]'/ 16X,'[17]',29X,'<*>',4X,'[47]'/6X,'[18]',29X,'<*>',4X,'[51]'/ 16X,'[60]',29X,'<*>',4X,'[52]') CALL COLORS(-1) WRITE(6,1002) 1002 FORMAT(' Enter CTRL_Z wherever you wish to quit; ? or', 1' HELP if you need any help ') CALL COLORS(1) DO 5 I=1, NTYP IF( I.GT.IRAW2 .AND. I.LT.IDIF1 ) GOTO 5 IF( I.GT.IDIF2 .AND. I.LT.IPLT1 ) GOTO 5 IF( I.GT.IPLT2 .AND. I.LT.ILIS1 ) GOTO 5 IF( I.GT.ILIS2 .AND. I.LT.IDAT1 ) GOTO 5 IF( I.GT.IDAT2 .AND. I.LT.NTYP ) GOTO 5 CALL PUTEXT( FILTYP(I), 24, IL(I), IC(I) ) 5 CONTINUE 9 IFLI = 0 !INPUT FILE TYPE IFLO = 0 !OUTPUT FILE TYPE C C GET THE CONVERSION COMBINATION... C 100 IF( IFLI.GT.IDIF2 ) GOTO 120 CALL COLORS(1) TEXT = ' ' IF( IFLI.EQ.0 ) THEN CALL PUTEXT( TEXT, 40, LINE, 1 ) TEXT = ' Input File Type(#): ' CALL PUTEXT( TEXT, 21, LINE, 1 ) ENDIF IF( IFLI.GT.0 ) THEN CALL PUTEXT( TEXT, 40, LINE+1, 1 ) TEXT = 'Output File Type(#): ' CALL PUTEXT( TEXT, 21, LINE+1, 1 ) ENDIF READ(5,101,ERR=444,END=444) TEXT 101 FORMAT(A) IF( TEXT.EQ.' ' ) GOTO 444 NCH = NBLANK( TEXT, 10 ) IF( NCH.GT.0 ) TEXT = TEXT(NCH+1:) NCH = NALPHA( TEXT, -4 ) IF( TEXT(1:2).EQ.'EX' .OR. TEXT(1:2).EQ.'QU' ) GOTO 444 DECODE( NCH, 102, TEXT, ERR=333 ) IQS 102 FORMAT(I) CALL CURSOR( 24, 1 ) CALL CLEARS( 6 ) IF( IQS.LT.IRAW1 .OR. IQS.GT.NTYP ) GOTO 111 IF( IQS.GT.IRAW2 .AND. IQS.LT.IDIF1 ) GOTO 111 IF( IQS.GT.IDIF2 .AND. IQS.LT.IPLT1 ) GOTO 111 IF( IQS.GT.IPLT2 .AND. IQS.LT.ILIS1 ) GOTO 111 IF( IQS.GT.ILIS2 .AND. IQS.LT.IDAT1 ) GOTO 111 IF( IQS.GT.IDAT2 .AND. IQS.LT.NTYP ) GOTO 111 GOTO 150 120 IF( IFLI.LT.ILIS1 ) IQS = 51 !DEFAULT TO GRAFIT "DAT" IF( IFLI.GT.IPLT2 ) IQS = 52 !DEFAULT TO GRAFIT "HKL" 150 IF( IFLI.EQ.0 ) THEN C C NO INPUT "DAT" FILE CONVERSION.... C IF( IQS.GT.ILIS2 ) GOTO 222 IFLI = IQS CALL COLORS(-1) CALL PUTEXT( FILTYP(IFLI), 24, IL(IFLI), IC(IFLI) ) ELSE IF( IQS.EQ.IFLI .AND. IQS.GT.IDIF2 ) GOTO 222 IF( IFLI.EQ.ILIS2 ) THEN IF( IQS.LT.IDAT1 .OR. IQS.GT.IDAT2 ) GOTO 222 ENDIF C C NO OUTPUT "PLT" OR "LIS" FILE CONVERSION... C IF( IQS.GT.IDIF2 .AND. IQS.LT.IDAT1 ) GOTO 222 C C NO "RAW" TO "DIF" OR "HKL" FILE CONVERSION... C IF( IFLI.LT.IDIF1 ) THEN IF( IQS.GT.IRAW2 .AND. IQS.LT.IPLT1 ) GOTO 222 IF( IQS.EQ.IDAT1+1 ) GOTO 222 ENDIF C C NO "DIF" TO "RAW" FILE CONVERSION... C IF( IFLI.GT.IRAW2 .AND. IFLI.LT.IPLT1 ) THEN IF( IQS.LT.IDIF1 ) GOTO 222 ENDIF IFLO = IQS IF( IFLI.NE.IFLO ) THEN CALL COLORS(-1) CALL PUTEXT( FILTYP(IFLO), 24, IL(IFLO), IC(IFLO) ) ENDIF ENDIF IF( IFLO.EQ.0 ) GOTO 100 GOTO 200 C C ERROR TRANSFER... C 111 CALL COLORS(-1) CALL PUTEXT( 'ERROR: undefined file type.', 27, 24, 1 ) GOTO 100 222 CALL COLORS(-1) CALL PUTEXT( 'ERROR: invalid file conversion route.', 37,24,1 ) GOTO 100 333 IF( TEXT(1:1).EQ.'?' ) GOTO 555 IF( TEXT(1:4).EQ.'HELP' ) GOTO 555 CALL CURSOR( 24, 1 ) CALL CLEARS( 6) CALL COLORS(-1) CALL PUTEXT( 'ERROR: invalid entry.', 21,24,1 ) GOTO 100 444 IF( IFLI.EQ.0 ) GOTO 999 445 CALL PUTEXT( FILTYP(IFLI), 24, IL(IFLI), IC(IFLI) ) CALL PUTEXT( FILNUM(IFLI), 4, IL(IFLI), IC(IFLI)-5 ) IF( IFLO.GT.0 ) THEN CALL PUTEXT( FILTYP(IFLO), 24, IL(IFLO), IC(IFLO) ) CALL PUTEXT( FILNUM(IFLO), 4, IL(IFLO), IC(IFLO)-5 ) ENDIF CALL CURSOR(LINE,1) CALL CLEARS( 2) GOTO 9 C C DISPLAY HELP ON FILE TYPES... C 555 CALL CURSOR( 2, 1 ) CALL CLEARS( 2) WRITE(6,556) 556 FORMAT(' VAXCONV supports the following types of files:'/ 16x'RAW --- Raw data or pattern scan file (max 10,000 points).'/ 16x'DIF --- Peak D-spacing and Intensity file (max 500 peaks).'/ 16x'PLT --- Output data file written for plotting.'/ 16x'LIS --- Output log file written for list of results.'/ 16x'DAT --- Data file ready to be plotted by GRAFIT.'/ 16x'HKL --- HKL and D-spacing file to be overlaid by GRAFIT.'/ 16x'LP --- ASCII list file for line printer.'/ 2' The following file conversion routes are implemented:'/ 26x'[1] RAW ===> RAW [6] DIF ===> DIF'/ 26x'[2] RAW ===> DAT [7] DIF ===> DAT'/ 26x'[3] RAW ===> LP [8] DIF ===> LP'/ 26x'[4] LIS ===> HKL [9] DIF ===> HKL'/ 26x'[5] LIS ===> DAT [10] PLT ===> DAT'/ 3' "Keyboard_DIF" is an editor written d/I file which consists'/ 3' of peak entries in one of the two line formats:'/ 3' 1) d-spacing(A), intensity(%), FWHM, H, K, L'/ 3' 2) 2-theta(deg), intensity(%), FWHM, H, K, L'/ 3' where FWHM and H,K,L are optional.'/ 3' When entering a filename for either input or output, file', 3' extension is'/' optional with its file type as its default', 3' file extension.') CALL COLORS(-1) WRITE(6,446) 446 FORMAT('$Hit RETURN to continue...') READ(5,101,ERR=1,END=1) TEXT GOTO 1 C C DETERMINE THE INPUT/OUTPUT FILE CATEGORY... C 200 IF( IFLI.GE.IRAW1 .AND. IFLI.LE.IRAW2 ) ITYI = 1 IF( IFLI.GE.IDIF1 .AND. IFLI.LE.IDIF2 ) ITYI = 2 IF( IFLI.GE.IPLT1 .AND. IFLI.LE.IPLT2 ) ITYI = 3 IF( IFLI.GE.ILIS1 .AND. IFLI.LE.ILIS2 ) ITYI = 4 IF( IFLO.GE.IRAW1 .AND. IFLO.LE.IRAW2 ) ITYO = 1 IF( IFLO.GE.IDIF1 .AND. IFLO.LE.IDIF2 ) ITYO = 2 IF( IFLO.EQ.IDAT1 ) ITYO = 5 IF( IFLO.EQ.IDAT1+1) ITYO = 6 IF( IFLO.EQ.IDAT1+2) ITYO = 7 IF( IFLO.EQ.NTYP ) ITYO = 99 GOTO 220 C C GET THE INPUT FILENAME... C 210 IF(IFLI.NE.IFLO) CALL PUTEXT(FILNUM(IFLO),4,IL(IFLO),IC(IFLO)-5) 220 CALL CURSOR(LINE,1) CALL CLEARS( 2) 300 CALL COLORS(-1) CALL COLORS(9) CALL PUTEXT( FILNUM(IFLI), 4, IL(IFLI), IC(IFLI)-5 ) CALL COLORS(1) TEXT = ' ' CALL PUTEXT( TEXT, 80, LINE, 1 ) TEXT = 'Enter input filename: ' CALL PUTEXT( TEXT, 23, LINE, 1 ) READ(5,2001,ERR=445,END=445) FILINP 2001 FORMAT(A) IF( FILINP.EQ.' ' ) GOTO 445 C C LOOK FOR DEFAULT FILE EXTENSION... C IF( ITYI.EQ.1 ) CALL DEFEXT( FILINP, 'RAW' ) IF( ITYI.EQ.2 ) CALL DEFEXT( FILINP, 'DIF' ) IF( ITYI.EQ.3 ) CALL DEFEXT( FILINP, 'PLT' ) IF( ITYI.EQ.4 ) CALL DEFEXT( FILINP, 'LIS' ) NCH = NALPHA( FILINP, -32 ) !CONVERT UPPERCASES C C GET THE OUTPUT FILENAME... C IF( IFLI.NE.IFLO ) THEN CALL PUTEXT( FILNUM(IFLI), 4, IL(IFLI), IC(IFLI)-5 ) CALL COLORS(-1) CALL COLORS(9) CALL PUTEXT( FILNUM(IFLO), 4, IL(IFLO), IC(IFLO)-5 ) ENDIF 301 TEXT = ' ' CALL COLORS(1) CALL PUTEXT( TEXT, 80, LINE+1, 1 ) IF( ITYI.EQ.ITYO ) THEN 3011 TEXT = 'Enter output filename: ' CALL PUTEXT( TEXT, 23, LINE+1, 1 ) READ(5,2001,ERR=210,END=210) FILOUT IF( FILOUT.EQ.' ' ) GOTO 210 ELSE TEXT = ' ' TEXT(1:22) = 'Enter output filename<' IF( ITYO.EQ.1 ) CALL NAMEXT( FILINP, DEFFIL, 'RAW' ) IF( ITYO.EQ.2 ) CALL NAMEXT( FILINP, DEFFIL, 'DIF' ) IF( ITYO.EQ.5 ) CALL NAMEXT( FILINP, DEFFIL, 'DAT' ) IF( ITYO.EQ.6 ) CALL NAMEXT( FILINP, DEFFIL, 'HKL' ) IF( ITYO.EQ.7 ) CALL NAMEXT( FILINP, DEFFIL, 'DAT' ) IF( ITYO.EQ.99) CALL NAMEXT( FILINP, DEFFIL, 'LP' ) IF( DEFFIL.EQ.FILINP ) GOTO 3011 TEXT(23: ) = DEFFIL(1: ) NCH = NALPHA( TEXT(1: ), 80 ) TEXT(NCH+1: ) = '>: ' CALL PUTEXT( TEXT(1: ), NCH+3, LINE+1, 1 ) READ(5,2001,ERR=210,END=210) FILOUT IF( FILOUT.EQ.' ' ) FILOUT = DEFFIL ENDIF C C LOOK FOR DEFAULT FILE EXTENSION... C IF( ITYO.EQ.1 ) CALL DEFEXT( FILOUT, 'RAW' ) IF( ITYO.EQ.2 ) CALL DEFEXT( FILOUT, 'DIF' ) IF( ITYO.EQ.5 ) CALL DEFEXT( FILOUT, 'DAT' ) IF( ITYO.EQ.6 ) CALL DEFEXT( FILOUT, 'HKL' ) IF( ITYO.EQ.7 ) CALL DEFEXT( FILOUT, 'DAT' ) IF( ITYO.EQ.99) CALL DEFEXT( FILOUT, 'LP' ) NCH = NALPHA( FILOUT, -32 ) !CONVERT UPPERCASES IF( FILINP.NE.FILOUT ) GOTO 302 CALL COLORS(-1) CALL PUTEXT('ERROR: no duplicating filename allowed.',39,24,1) GOTO 301 302 CALL COLORS(1) CALL PUTEXT( FILNUM(IFLO), 4, IL(IFLO), IC(IFLO)-5 ) CALL CURSOR( 24, 1 ) CALL CLEARS( 6) IF( ITYI.NE.3 ) THEN CALL COLORS(-1) CALL PUTEXT('Reading the input file... Please wait...',40,24,1) ENDIF C C INITIALIZE THE COMMON BLOCKS... C IF( ITYI.NE.3 ) CALL INICOM !INITIALIZE THE COMMON BLOCKS IERR = 0 !ERROR FLAG OFF JFIL = IFLI !FILE TYPE NOT SUPPORTED C C READ FROM THE INPUT FILE AND STORE IN THE COMMON BLOCKS... C REFRSH = .FALSE. ! set REFRSH to .TRUE. if the screen is changed IF( IFLI.EQ.1 ) CALL RRW5000 !DIFFRAC-5000 RAW IF( IFLI.EQ.2 ) CALL RRW500 !DIFFRAC-500 RAW IF( IFLI.EQ.3 ) CALL RRW011 !DIFFRAC-11 RAW IF( IFLI.EQ.4 ) CALL RRW05A !DIFFRAC-5 (ALFRED) RAW c IF( IFLI.EQ.4 ) CALL RRW05S !DIFFRAC-5 (SIEMENS) RAW IF( IFLI.EQ.5 ) CALL RRWSPP !SPECPLOT RAW IF( IFLI.EQ.6 ) CALL RRWNIC !NICOLET RAW IF( IFLI.EQ.7 ) CALL RRWTAG !SCINTAG RAW IF( IFLI.EQ.8 ) CALL RRWRIG !RIGAKU (ASCII) RAW * IF( IFLI.EQ.9 ) CALL RRWDUP !Harlow's SDupont formatRAW c IF( IFLI.EQ.9 ) CALL RRWRIO !RIGAKU OLD BINARY RAW IF( IFLI.EQ.10 ) CALL RRWMDI !MDI (ASCII) RAW IF( IFLI.EQ.11 ) CALL RRWSAS !GSAS RIETVELD (ASCII) RAW IF( IFLI.EQ.12 ) CALL RRWXRR !SHADOW / Rietveld RAW * rrwdbw not written yet (maybe never -dpm) * IF( IFLI.EQ.13 ) CALL RRWDBW !DBW Rietveld RAW IF( IFLI.EQ.14 ) CALL RRWNBS !NBS RIETVELD RAW IF( IFLI.EQ.15 ) CALL RRWX7 !NSLS-X7 (BNL) RAW IF( IFLI.EQ.16 ) CALL RRWX3 !NSLS-X3 (SUNY) RAW IF( IFLI.EQ.17 ) CALL RRWPDF !JCAMP-PDF3 RAW * IF( IFLI.EQ.18 ) CALL RRWNSY !NUSY SEARCH RAW IF( IFLI.EQ.21 ) CALL RDI5000 !DIFFRAC-5000 DIF IF( IFLI.EQ.22 ) CALL RDI500 !DIFFRAC-500 DIF IF( IFLI.EQ.23 ) CALL RDI011 !DIFFRAC-11 DIF IF( IFLI.EQ.24 ) CALL RDI05A !DIFFRAC-5 (ALFRED) DIF c IF( IFLI.EQ.24 ) CALL RDI05S !DIFFRAC-5 (SIEMENS) DIF IF( IFLI.EQ.25 ) CALL RDISPP !SPECPLOT DIF IF( IFLI.EQ.26 ) CALL RDINIC !NICOLET DIF IF( IFLI.EQ.27 ) CALL RDITAG !SCINTAG DIF IF( IFLI.EQ.28 ) CALL RDIRIG !RIGAKU DIF CBHT IF( IFLI.EQ.29 ) CALL RDIUNK !UNKNOWN DIF IF( IFLI.EQ.29 ) CALL RDISAS !GSAS REFLECTION FILE DIF IF( IFLI.EQ.30 ) CALL RDIMDI !MDI DIF IF( IFLI.EQ.31 ) CALL RDIAID !AIDS DIF IF( IFLI.EQ.32 ) CALL RDIKEY !KEYBOARD DIF IF( IFLI.EQ.41 ) CALL RPLSHD !SHADOW (new) PLT IF( IFLI.EQ.42 ) CALL RPLXRR !X-RAY RIETVELD PLT IF( IFLI.EQ.43 ) CALL RPLNBS !NBS/DBW RIETVELD PLT C IF( IFLI.EQ.44 ) CALL RPLUNK !UNKNOWN PLT IF( IFLI.EQ.46 ) CALL RLSXRR !X-RAY RIETVELD LIS IF( IFLI.EQ.47 ) CALL RLSNBS !NBS RIETVELD LIS C IF( IFLI.EQ.48 ) CALL RLSUNK !UNKNOWN LIS C CLOSE( UNIT=IINP ) IF( IERR.GT.0 ) GOTO 777 IF( ITYI.EQ.1 .AND. NPTS.EQ.0 ) GOTO 777 IF( ITYI.NE.3 ) GOTO 400 IF( IERR.LT.0 ) GOTO 888 GOTO 500 C C CONDUCT THE DIALOGUE... C 400 IF( ITYI.EQ.1 ) CALL DIARAW IF( ITYI.EQ.2 .OR. ITYI.EQ.4 ) CALL DIADIF IF( IERR.GT.0 ) GOTO 1 !BAIL OUT IF( ITYO.EQ.5 ) GOTO 410 IF( IFLO.EQ.3 .OR. IFLO.EQ.4 ) GOTO 410 IF( IFLO.EQ.12.OR. IFLO.EQ.13) GOTO 410 CALL COLORS(-1) CALL PUTEXT('Writing the output file... Please wait...',41,24,1) C C WRITE TO THE OUTPUT FILE FROM THE COMMON BLOCKS... C 410 IERR = 0 !ERROR FLAG OFF JFIL = IFLO !FILE TYPE NOT SUPPORTED IF( IFLO.EQ.1 ) CALL WRW5000 !DIFFRAC-5000 RAW IF( IFLO.EQ.2 ) CALL WRW500 !DIFFRAC-500 RAW IF( IFLO.EQ.3 ) CALL WRW011 !DIFFRAC-11 RAW IF( IFLO.EQ.4 ) CALL WRW05A !DIFFRAC-5 (ALFRED) RAW IF( IFLO.EQ.5 ) CALL WRWSPP !SPECPLOT RAW IF( IFLO.EQ.6 ) CALL WRWNIC !NICOLET RAW IF( IFLO.EQ.7 ) CALL WRWTAG !SCINTAG RAW IF( IFLO.EQ.8 ) CALL WRWRIG !RIGAKU RAW * IF( IFLO.EQ.9 ) CALL WRWdup !RIGAKU RAW IF( IFLO.EQ.10 ) CALL WRWMDI !MDI RAW IF( IFLO.EQ.11 ) CALL WRWSAS !GSAS RAW IF( IFLO.EQ.12 ) CALL WRWXRR !SHADOW / Rietveld RAW IF( IFLO.EQ.13 ) CALL WRWDBW !DBW Rietveld RAW IF( IFLO.EQ.14 ) CALL WRWNBS !NBS RIETVELD RAW IF( IFLO.EQ.15 ) CALL WRWX7 !NSLS-X7 RAW IF( IFLO.EQ.16 ) CALL WRWX3 !NSLS-X3 RAW IF( IFLO.EQ.17 ) CALL WRWPDF !JCAMP-PDF3 RAW IF( IFLO.EQ.18 ) CALL WRWmac !Mac upload file RAW IF( IFLO.EQ.21 ) CALL WDI5000 !DIFFRAC-5000 DIF IF( IFLO.EQ.22 ) CALL WDI500 !DIFFRAC-500 DIF IF( IFLO.EQ.23 ) CALL WDI011 !DIFFRAC-11 DIF IF( IFLO.EQ.24 ) CALL WDI05A !DIFFRAC-5 (ALFRED) DIF IF( IFLO.EQ.25 ) CALL WDISPP !SPECPLOT DIF IF( IFLO.EQ.26 ) CALL WDINIC !NICOLET DIF IF( IFLO.EQ.27 ) CALL WDITAG !SCINTAG DIF IF( IFLO.EQ.28 ) CALL WDIRIG !RIGAKU DIF IF( IFLO.EQ.29 ) CALL WDIUNK !UNKNOWN DIF IF( IFLO.EQ.30 ) CALL WDIMDI !MDI DIF IF( IFLO.EQ.31 ) CALL WDIAID !AIDS DIF IF( IFLO.EQ.32 ) CALL WDIKEY !KEYBOARD DIF IF( IFLO.EQ.51 ) CALL GRADAT !GRAFIT DAT IF( IFLO.EQ.52 ) CALL GRAHKL !GRAFIT HKL C IF( IFLO.EQ.53 ) CALL DATUNK !UNKNOWN DAT IF( IFLO.EQ.60 ) CALL LPRINT !LINE PRINTER LP IF( IERR.GT.0 ) GOTO 888 !ERROR DURING WRITE 500 CALL COLORS(-1) CALL CLEARS( 6) CALL PUTEXT( 'File conversion OK!', 20, 24, 1 ) CLOSE( UNIT=IOUT ) CALL PAUSES( 1 ) GOTO 1 !BACK THE MAIN MENU C C ERROR FILE FORMAT IN THE INPUT FILE... C 777 IF( IERR.EQ.3 ) GOTO 1 CALL COLORS(-1) CALL CLEARS( 6) IF( IERR.EQ.1 ) THEN CALL PUTEXT('ERROR: invalid file format in input file.', 1 41, 24, 1 ) ENDIF IF( IERR.EQ.2 ) THEN TEXT = 'ERROR: can not find/open file' TEXT(31:) = FILINP NCH = NALPHA( TEXT, 80 ) CALL PUTEXT( TEXT, NCH, 24, 1 ) ENDIF CLOSE( UNIT=IINP ) IF (REFRSH) THEN WRITE(6,'(A)') '$Press RETURN to return to main menu...' READ(5,'(A)',err=1) i GOTO 1 ENDIF GOTO 300 C C RUN OUT OF DISK QUOTA OR NO PRIVILEGE FOR WRITE... C 888 IF( IERR.EQ.3 ) GOTO 1 CALL COLORS(-1) CALL CLEARS( 6) CALL PUTEXT('ERROR during write (disk quota/privilege?).', 1 43, 24, 1 ) CLOSE( UNIT=IOUT ) C C FINALLY... C 999 CALL CLEARS(2) CALL COLORS(1) CALL EXIT END $EODBHTCOPY**