!+ Subroutine to convert data to SAMSON format.
!
!
! Method:
!	An input file with embedded directives is read. This file
!	is processed to generate a number of profiles.
!
! 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 RAW_INPUT
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/error.pcf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/gas_list.pcf'
      INCLUDE 'incl/input_head.pcf'
      INCLUDE 'incl/def_data_in.icf'
      INCLUDE 'incl/dimensions_field.ucf'
!
!     DECLARATION OF VARIABLES
      INTEGER
     &     IERR
!             ERROR FLAG
     &   , LENGTH_BASE
!             LENGTH OF BASE FILE NAME
     &   , N_PROFILE
!             NUMBER OF PROFILES READ IN
     &   , I_ZERO
!             POSITION OF 0 IN COLLATING SEQ.
     &   , IOS
!             I/O ERROR FLAG
     &   , N_LEVEL_PROFILE(NPD_IN_PROFILE)
!             NUMBER OF LEVELS IN PROFILES
     &   , N_COLUMN_PROFILE(NPD_IN_PROFILE)
!             NUMBER OF COLUMNS IN PROFILES
     &   , I_DATA_GROUP(NPD_DATA_COLUMN, NPD_IN_PROFILE)
!             GROUPS OF TYPES OF DATA IN COLUMNS
     &   , I_DATA_TYPE(NPD_DATA_COLUMN, NPD_IN_PROFILE)
!             TYPES OF DATA WITHIN GROUPS
     &   , LENGTH_NAME_PROFILE
!             LENGTH OF PROFILE NAME
     &   , N_LEVEL_REF
!             NUMBER OF LEVELS IN REFERENCE
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
      LOGICAL
     &     L_REFERENCE
!             TRUE IF REFERENCE PROFILE PRESENT
     &   , L_REMOVE_MISSING
!             TRUE TO REMOVE MISSING DATA
      REAL*8
     &     PROFILE(NPD_LAYER+1, NPD_PHYS_TYPE, NPD_IN_PROFILE)
!             INITIAL PROFILES
     &   , P_REF(NPD_LAYER+1)
!             REFERENCE PRESSURE
     &   , Z_REF(NPD_LAYER+1)
!             REFERENCE HEIGHT
     &   , MISSING_DATA_FLAG
!             MISSING DATA FLAG
      CHARACTER
     &     BASE_NAME*80
!             BASE NAME FOR OUTPUT FILES
     &   , NAME_PROFILE*80
!             NAME OF PROFILE
     &   , LINE*80
!             LINE OF INPUT
     &   , CHAR_YN*1
!             CHARACTER RESPONSE VARIABLE
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_IN, READ_RAW_PROFILE, SORT_RAW_PROFILE
     &   , SET_STATE, WRITE_PROFILE
!
!
!
!     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 RAW INPUT FILE.')
      IF (IERR.NE.I_NORMAL) STOP
!
      WRITE(IU_USER, '(A)')
     &   'ENTER THE BASE NAME OF THE OUTPUT FILE.'
      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
!
!     SET THE TREATMENT OF MISSING DATA.
      WRITE(IU_USER, '(/A)') 'DO YOU WISH TO REMOVE MISSING DATA? (Y/N)'
2     READ(IU_STDIN, '(A)') CHAR_YN
      IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
         L_REMOVE_MISSING=.TRUE.
         WRITE(IU_USER, '(/A)') 'ENTER THE MISSING DATA FLAG'
3        READ(IU_STDIN, *, IOSTAT=IOS) MISSING_DATA_FLAG
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A)')
     &         '+++ UNRECOGNIZED RESPONSE: PLEASE REENTER'
            GOTO 3
         ENDIF
      ELSE IF ( (CHAR_YN.EQ.'N').OR.(CHAR_YN.EQ.'n') ) THEN
         L_REMOVE_MISSING=.FALSE.
      ELSE
         WRITE(IU_ERR, '(/A)') '+++ ILLEGAL RESPONSE: PLEASE REENTER'
         GOTO 2
      ENDIF
!
      N_PROFILE=0
!     READ EACH LINE UNTIL A DIRECTIVE IS FOUND.
4     READ(IU_RAW_IN, '(A)', END=5) LINE
      IF (LINE(1:8).EQ.'*PROFILE') THEN
         N_PROFILE=N_PROFILE+1
         CALL READ_RAW_PROFILE(IERR
     &      , L_REMOVE_MISSING, MISSING_DATA_FLAG
     &      , N_LEVEL_PROFILE(N_PROFILE), N_COLUMN_PROFILE(N_PROFILE)
     &      , I_DATA_GROUP(1, N_PROFILE), I_DATA_TYPE(1, N_PROFILE)
     &      , PROFILE(1, 1, N_PROFILE)
     &      )
         IF (IERR.NE.I_NORMAL) STOP
         CALL SORT_RAW_PROFILE(IERR
     &      , N_LEVEL_PROFILE(N_PROFILE), N_COLUMN_PROFILE(N_PROFILE)
     &      , I_DATA_TYPE(1, N_PROFILE), I_DATA_GROUP(1, N_PROFILE)
     &      , PROFILE(1, 1, N_PROFILE)
     &      )
         IF (IERR.NE.I_NORMAL) STOP
      ELSE IF (LINE(1:10).EQ.'*ATM_STATE') THEN
         CALL SET_STATE(IERR
     &      , N_LEVEL_PROFILE(N_PROFILE), N_COLUMN_PROFILE(N_PROFILE)
     &      , I_DATA_TYPE(1, N_PROFILE), PROFILE(1, 1, N_PROFILE)
     &      , L_REFERENCE, N_LEVEL_REF, P_REF, Z_REF
     &      )
         IF (IERR.NE.I_NORMAL) STOP
      ELSE IF (LINE(1:1).EQ.'*') THEN
         WRITE(IU_ERR, '(/A, /A)') 
     &      '*** ERROR: UNRECOGNIZED *-DIRECTIVE IN INPUT.'
     &      , 'PROGRAM ABORTED.'
         STOP
      ENDIF
      GOTO 4
!
5     CLOSE(IU_RAW_IN)
!
!     WRITE OUT EACH PROFILE IN TURN.
      DO I=1, N_PROFILE
         NAME_PROFILE(1: LENGTH_BASE+2)=BASE_NAME(1: LENGTH_BASE)
     &      //'_'//CHAR(I+I_ZERO)
         LENGTH_NAME_PROFILE=LENGTH_BASE+2
         CALL WRITE_PROFILE(IERR
     &      , N_LEVEL_PROFILE(I), N_COLUMN_PROFILE(I)
     &      , I_DATA_GROUP(1, I), I_DATA_TYPE(1, I), PROFILE(1, 1, I)
     &      , L_REFERENCE, N_LEVEL_REF, P_REF, Z_REF
     &      , NAME_PROFILE, LENGTH_NAME_PROFILE
     &      )
         IF (IERR.NE.I_NORMAL) STOP
      ENDDO
!
!
      STOP
      END
