C++*********************************************************************
C
C  TRAF.F         LONG FILE NAMES JAN 89 ARDEAN LEITH
C                 FRAME INTRODUCED   ml 
C                 OPTC NSAM BUG FIXED & USED OPFILE  JUL 99 ARDEAN LEITH
C                 OPFILEC                            FEB 03 ARDEAN LEITH
C                 SETPRMB PARAMETERS                 MAY 09 ARDEAN LEITH
C                  
C **********************************************************************
C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM.   AUTHOR: J.FRANK  *
C=* Copyright (C) 1985-2009  Health Research Inc.                      *
C=*                                                                    *
C=* HEALTH RESEARCH INCORPORATED (HRI),                                *   
C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455.                   *
C=*                                                                    *
C=* Email:  spider@wadsworth.org                                       *
C=*                                                                    *
C=* This program is free software; you can redistribute it and/or      *
C=* modify it under the terms of the GNU General Public License as     *
C=* published by the Free Software Foundation; either version 2 of the *
C=* License, or (at your option) any later version.                    *
C=*                                                                    *
C=* This program is distributed in the hope that it will be useful,    *
C=* but WITHOUT ANY WARRANTY; without even the implied warranty of     *
C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU  *
C=* General Public License for more details.                           *
C=*                                                                    *
C=* You should have received a copy of the GNU General Public License  *
C=* along with this program; if not, write to the                      *
C=* Free Software Foundation, Inc.,                                    *
C=* 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.      *
C=*                                                                    *
C **********************************************************************
C
C   TRAF(LUN)
C
C   LUN    LOGICAL UNIT NUMBER OF FILE
C
C--*******************************************************************

        SUBROUTINE TRAF(LUN)

        INCLUDE 'CMBLOCK.INC'
        INCLUDE 'CMLIMIT.INC' 
 
        CHARACTER(LEN=MAXNAM) ::  FILNAM
 
	REAL          B(512)
        COMMON        B

        CHARACTER     NULL,ANS,E,S,OPTC
	REAL          LAMBDA,KM

        NULL = CHAR(0)

	CALL FILERD(FILNAM,NLET,NULL,'OUTPUT',IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

	CALL RDPRM(CS,NOT_USED,'CS')

	CALL RDPRM(LAMBDA,NOT_USED,'LAMBDA')

	CALL RDPRM(DZ1,NOT_USED,'LOWER DEFOCUS LIMIT')

	CALL RDPRM(DZ2,NOT_USED,'UPPER DEFOCUS LIMIT')

	CALL RDPRMI(NSAM,NROW,NOT_USED,
     &	           'NUMBER OF SP. FREQ. PTS & DEFOCUS GRID POINTS')

	CALL RDPRM(KM,NOT_USED,'MAXIMUM SPATIAL FREQUENCY[A-1]')

	CALL RDPRM(Q,NOT_USED,'SOURCE SIZE[A-1]')

	CALL RDPRM(DS,NOT_USED,'DEFOCUS SPREAD[A]')

        CALL RDPRM2(WGH,ENV,NOT_USED,
     &   'AMPL. CONTRAST RATIO [0-1], GAUSSIAN ENV. HALFW [FOU. UNITS]')
        IF (WGH .LT. 0.0 .OR. WGH .GT. 1.0) THEN
           CALL ERRT(31,'TRAF',NE)
           RETURN
        ENDIF

	ENV = 1.0 / ENV**2
	CALL RDPRMC(ANS,NCHAR,.TRUE.,
     &     '(D)IFFRACTOGRAM / (E)NVELOPE / (S)TRAIGHT',NULL,IRTFLG)
	IF (ANS .EQ. 'E') IE = 1

        CALL RDPRMC(OPTC,NCHAR,.TRUE.,'FRAME? (Y/N)',NULL,IRTFLG)

	DZ  = DZ1
	DDZ = (DZ2-DZ1) / FLOAT(NROW)

C       FRAME OPTION
        IF (OPTC .EQ. 'Y') THEN
c          copied next two lines from above ml 2/2/95
           NSAMT    = NSAM + 2
           NROWT    = NROW + 2
           IOFF     = 1
           B(1)     = 1
           B(NSAMT) = 1
           IFRAME   = 1
        ELSE
           IOFF     = 2
           IFRAME   = 0
           NSAMT    = NSAM
           NROWT    = NROW
        ENDIF

C       OPEN CONVERTED TO OPEN3 JUNE 88 al
	MAXIM  = 0
        IFORM  = 1
        NSLICE = 1
        CALL OPFILEC(0,.FALSE.,FILNAM,LUN,'U',IFORM,NSAMT,NROWT,NSLICE,
     &                   MAXIM,' ',.FALSE.,IRTFLG)
        IF (IRTFLG .NE. 0) RETURN

        IDONE = 0
	DO  I=1,NROW
	  CALL TF(B(2),CS,DZ,LAMBDA,KM,NSAM,Q,DS,IE,WGH,ENV)
          IF (OPTC .EQ. 'Y') B(NSAMT)=1

C         ZERO DEFOCUS LINE AS PART OF FRAME
          IF (OPTC.EQ.'Y' .AND. ABS(DZ) .LT. DDZ .AND.I DONE.EQ.0) THEN
            DO  K=1,NSAMT
               B(K) = 1
            END DO
            IDONE = 1
          ENDIF
C
          IF (ANS .NE. 'S') THEN
	      DO  IA=2,NSAM+1
	         B(IA) = B(IA)*B(IA)
	      ENDDO
           ENDIF

           CALL WRTLIN(LUN,B(IOFF),NSAMT,I+IFRAME)
           DZ = DZ + DDZ
	ENDDO

        IF (OPTC .EQ. 'Y') THEN
           DO  K=1,NSAMT
             B(K) = 1
	   ENDDO
           CALL WRTLIN(LUN,B(IOFF),NSAMT,1)
           CALL WRTLIN(LUN,B(IOFF),NSAMT,NROWT)
        ENDIF

	CALL SETPRMB(LUN, 0.,0. ,0.,0.)
        RETURN
	END