!+ Program to format a distribution of particle sizes.
!
! Method:
!	Directives are inserted into a file of raw data conrtaining
!	size spectra. This program reads the file and formats
!	the output for the scattering program.
!
! Current Owner of Code: J. M. Edwards
!
! History:
!	Version		Date		Comment
!	1.0		12-04-95	First Version under RCS
!					(J. M. Edwards)
!
! Description of Code:
!   FORTRAN 77 with extensions listed in documentation.
!
!- ---------------------------------------------------------------------
      PROGRAM FORMAT_SIZE
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/def_data_in.icf'
      INCLUDE 'incl/dimensions_pp.ucf'
!
!     DECLARATION OF VARIABLES
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , IOS
!             I/O ERROR FLAG
     &   , LENGTH_BASE
!             LENGTH OF BASE FILE NAME
     &   , N_DISTRIBUTION
!             NUMBER OF DISTRIBUTIONS
     &   , N_RADIUS
!             NUMBER OF RADII
     &   , N_SIZE
!             NUMBER OF BIN SIZES
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , I_ZERO
!             POSITION OF 0 IN COLLATING SEQ.
     &   , N1
!             WORK VARIABLE
     &   , N2
!             WORK VARIABLE
      LOGICAL
     &     L_SET_RADIUS
!             TRUE IF RADII ARE SET
     &   , L_SET_SIZE
!             TRUE IF SIZES OF BINS ARE SET
      REAL*8
     &     RADIUS(NPD_SIZE)
!             RADII OF BINS
     &   , NUMBER(NPD_SIZE)
!             NUMBERS WITHIN BINS
     &   , BIN_SIZE(NPD_SIZE)
!             SIZES OF BINS
      CHARACTER
     &     BASE_NAME*80
!             BASE NAME FOR OUTPUT FILES
     &   , FILE_NAME*80
!             NAME OF OUTPUT FILE
     &   , TITLE*80
!             TITLE OF DISTRIBUTION
     &   , LINE*80
!             LINE OF INPUT
     &   , SHAPE*10
!             SHAPE OF PARTICLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_IN
!
!
!
!     FIND THE LOCATION OF 0 IN THE COMPILER'S COLLATING SEQUENCE.
      I_ZERO=ICHAR('0')
!
!     OPEN INPUT FILE.
      CALL OPEN_FILE_IN(IERR, IU_RAW_IN
     &   , 'ENTER THE NAME OF THE INPUT FILE OF SIZE DISTRIBUTIONS.')
      IF (IERR.EQ.I_ERR_FATAL) STOP
!
      WRITE(IU_USER, '(A)')
     &   'ENTER THE BASE NAME OF THE OUTPUT FILES.'
      READ(IU_STDIN, '(A)') BASE_NAME
!     FIND LENGTH OF BASE NAME.
      J=0
      LENGTH_BASE=0
1     J=J+1
      IF (BASE_NAME(J:J).NE.' ') THEN
         LENGTH_BASE=LENGTH_BASE+1
         GOTO 1
      ENDIF
!
      WRITE(IU_USER, '(A)')
     &   'ENTER THE SHAPE OF THE PARTICLES.'
      READ(IU_STDIN, '(A)') SHAPE
!
      N_DISTRIBUTION=0
      L_SET_RADIUS=.FALSE.
!     READ EACH LINE UNTIL A DIRECTIVE IS FOUND.
2     READ(IU_RAW_IN, '(A)', END=3) LINE
      IF (LINE(1:11).EQ.'*BIN_RADIUS') THEN
         READ(IU_RAW_IN, '(A)') TITLE
         READ(IU_RAW_IN, *) N_RADIUS
         IF (N_RADIUS.GT.NPD_SIZE) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: NUMBER OF RADII EXEEDS PERMITTED MAXIMUM.'
            STOP
         ENDIF
         READ(IU_RAW_IN, *) (RADIUS(I), I=1, N_RADIUS)
!        CONVERT FROM MICRONS.
         DO I=1, N_RADIUS
            RADIUS(I)=1.0D-06*RADIUS(I)
         ENDDO
         L_SET_RADIUS=.TRUE.
!
      ELSE IF (LINE(1:11).EQ.'*BIN_SIZE') THEN
         READ(IU_RAW_IN, '(A)') TITLE
         READ(IU_RAW_IN, *) N_SIZE
         IF (N_SIZE.GT.NPD_SIZE) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: NUMBER OF SIZES EXCEEDS PERMITTED MAXIMUM.'
            STOP
         ENDIF
         READ(IU_RAW_IN, *) (BIN_SIZE(I), I=1, N_SIZE)
!        CONVERT FROM MICRONS.
         DO I=1, N_RADIUS
            BIN_SIZE(I)=1.0D-06*BIN_SIZE(I)
         ENDDO
         L_SET_SIZE=.TRUE.
!
!
      ELSE IF (LINE(1:11).EQ.'*BIN_NUMBER') THEN
         IF (.NOT.L_SET_RADIUS) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: RADII FOR BINS ARE NOT SET: '
     &         , 'SPECIFY RADII AT TOP OF FILE.'
            STOP
         ENDIF
         IF (.NOT.L_SET_SIZE) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: SIZES FOR BINS ARE NOT SET: '
     &         , 'SPECIFY SIZES AT TOP OF FILE.'
            STOP
         ENDIF
         IF (N_RADIUS.NE.N_SIZE) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: NUMBER OF RADII AND NUMBER OF SIZES '
     &         //'DO NOT MATCH.'
            STOP
         ENDIF
         READ(IU_RAW_IN, '(A)') TITLE
         READ(IU_RAW_IN, *, IOSTAT=IOS) (NUMBER(I), I=1, N_RADIUS)
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A, 1X, I5, A)')
     &         '*** ERROR: DISTRIBUTION', N_DISTRIBUTION
     &         , ' COULD NOT BE READ.'
            STOP
         ENDIF
         N_DISTRIBUTION=N_DISTRIBUTION+1
         IF (N_DISTRIBUTION.GT.99) THEN
            WRITE(IU_ERR, '(/A)')
     &         '*** ERROR: TOO MANY DISTRIBUTIONS FOR FILE '
     &         //'NAMING CONVENTION.'
            STOP
         ENDIF
!
!        WRITE OUT THE SIZE DISTRIBUTION IN THE FORM ACCEPTABLE TO THE
!        MIE CODE.
         N1=N_DISTRIBUTION/10
         N2=N_DISTRIBUTION-10*N1
         FILE_NAME(1: LENGTH_BASE+3)=BASE_NAME(1: LENGTH_BASE)
     &      //'_'//CHAR(N1+I_ZERO)//CHAR(N2+I_ZERO)
         OPEN(FILE=FILE_NAME(1: LENGTH_BASE+3)
     &     , STATUS='NEW', UNIT=IU_DATA_OUT)
         WRITE(IU_DATA_OUT, '(A)') 'Observational Size Distribution.'
         WRITE(IU_DATA_OUT, '(A)') TITLE
         WRITE(IU_DATA_OUT, '(A)') SHAPE
         WRITE(IU_DATA_OUT, '(A)') '*BEGIN_DATA'
         DO I=1, N_RADIUS
!           CONVERT TO ACTUAL NUMBER TO A NUMBER PER UNIT RANGE OF SIZES.
            WRITE(IU_DATA_OUT, '(2(5X, 1PE13.6))')
     &         RADIUS(I), NUMBER(I)/BIN_SIZE(I)
         ENDDO
         WRITE(IU_DATA_OUT, '(A)') '*END'
         CLOSE(IU_DATA_OUT)
!
      ELSE IF (LINE(1:1).EQ.'*') THEN
         WRITE(IU_ERR, '(/A)')
     &      '*** ERROR: UNRECOGNIZED *-DIRECTIVE IN INPUT.'
         STOP
      ENDIF
      GOTO 2
!
3     CLOSE(IU_RAW_IN)
!
!
      STOP
      END
