CHARACTER*40 INFILE,FILENAME LOGICAL EFLG real*8 M1(3),d(100) INTEGER*4 I,J,k 1200 FORMAT(A) c6 WRITE(6,*) 'ENTER NAME OF .FRC coordinates file (atom recds only):' c READ(5,1200) INFILE c IF (INFILE(:5).EQ.' ') STOP c INQUIRE(FILE=INFILE, NAME=FILENAME,EXIST=EFLG) c IF (.NOT.EFLG) GOTO 6 c OPEN (UNIT=2,FILE=INFILE,STATUS='OLD',READONLY) write(6,*)'DERIV wave1' write(6,*)'!EXCLUDE SIGFP 2.' write(6,*)'! RESO 38.35 3.00' write(6,*)'!SCALE FPH4 1.0 0.0' write(6,*)'DCYCLE PHASE ALL REFCYC ALL KBOV ALL' write(6,*)'!ISOE 00.00 00.00 00.00 00.00 00.00 00.00 00.00 00.00' write(6,*)'!ANOE 00.00 00.00 00.00 00.00 00.00 00.00 00.00 00.00' c read coord 50 read(5,52,end=1160) (m1(i),I=1,3) 52 format (5x,3d10.5,2f6.2) do 70 I=1,3 IF (M1(I).GE.1.0) M1(I)=M1(I)-1. 70 IF (M1(I).LE.0.0) M1(I)=M1(I)+1. write(6,111) (m1(i),I=1,3),1.0,0.0,30.0 write(6,*)'ATREF X ALL Y ALL Z ALL OCC ALL AOCC ALL BFAC ALL' 111 format (' ATOM SE ',5f8.4,' BFAC',2F8.4) goto 50 1160 CLOSE(UNIT=2) END