!+ Program to tidy a spectral file.
!
! Method:
!	A menu of operations on a spectral file is displayed. The
!	user selects those which are to be carried out. The
!	modified spectral file is written out.
!
! 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 TIDY
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_spc_io.icf'
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/continuum.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DECLARATION OF VARIABLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      CHARACTER
     &     FILE_SPECTRAL*80
!             NAME OF SPECTRAL FILE
     &   , CHAR_QNA*1
!             CHARACTER RESPONSE VARIABLE
     &   , CHAR_YN*1
!             CHARACTER RESPONSE VARIABLE
      INTEGER
     &     IERR
!             ERROR FLAG
!
      INTEGER
     &     I_PROCESS
!             PROCESS TO BE CARRIED OUT
     &   , IOS
!             ERROR FLAG
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , I_GAS
!             SPECIES OF GAS
      LOGICAL
     &     L_EXIST
!             EXISTENCE FLAG
!
!     INCLUDE DECLARATIONS OF SPECTRAL DATA.
      INCLUDE 'dec_spec.finc'
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     IN_SPECTRUM, OUT_SPECTRUM, REMOVE_WEAK, SUM_UNITY
     &   , REMOVE_NEGATIVE_GAS
     &   , REMOVE_WEAK_CONT, REMOVE_NEGATIVE_CONT
!
!
!     INITIALIZE TO CONDITION OF NO ERRORS.
      DATA IERR/I_NORMAL/
      DATA L_SURFACE/NPD_SURFACE*.FALSE./
     &   , L_DROP_TYPE/NPD_DROP_TYPE*.FALSE./
!
!
!
100   WRITE(IU_USER, '(/A)')
     &   'NAME OF SPECTRAL FILE ?'
      READ(IU_STDIN, '(A)') FILE_SPECTRAL
!
      INCLUDE 'read_spec.finc'
!
      IF (IERR.NE.I_NORMAL) THEN
         IF (IERR.EQ.I_ERR_EXIST) THEN
!           RESET THE ERROR FLAG TO THE NORMAL CONDITION SINCE
!           CORRECTIVE ACTION IS ABOUT TO BE TAKEN.
            IERR=I_NORMAL
            GOTO 100
         ELSE
            STOP
         ENDIF
      ENDIF
!
!     DETERMINE WHETHER DATA ARE TO BE APPENDED TO THE OLD FILE,
!     OR WHETHER A NEW FILE IS TO BE WRITTEN.
      WRITE(IU_USER, '(/A)') 'TYPE'
      WRITE(IU_USER, '(6X, A)')
     &   '"O" TO OVERWRITE THE EXISTING FILE;'
      WRITE(IU_USER, '(6X, A)')
     &   '"N" TO CREATE A NEW FILE;'
      WRITE(IU_USER, '(6X, A)')
     &   '"Q" TO QUIT.'
      WRITE(IU_USER, '(/)')
1     READ(IU_STDIN, '(A)') CHAR_QNA
      IF ( (CHAR_QNA.EQ.'O').OR.(CHAR_QNA.EQ.'o') ) THEN
         CONTINUE
      ELSE IF ( (CHAR_QNA.EQ.'N').OR.(CHAR_QNA.EQ.'n') ) THEN
         WRITE(IU_USER, '(A)') 'ENTER THE NAME OF THE NEW FILE'
2        READ(IU_STDIN, '(A)') FILE_SPECTRAL
!        CHECK FOR EXISTENCE OF FILE.
         INQUIRE(FILE=FILE_SPECTRAL, EXIST=L_EXIST)
         IF (L_EXIST) THEN
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error_main.finc'
            ELSE
               WRITE(IU_USER, '(/A)') 'THIS FILE ALREADY EXISTS: '
     &            //'DO YOU WISH TO OVERWRITE? (Y/N)'
3              READ(IU_STDIN, '(A)') CHAR_YN
               IF ( (CHAR_YN.EQ.'N').OR.(CHAR_YN.EQ.'n') ) THEN
                  WRITE(IU_USER, '(A)') 'PLEASE SPECIFY ANOTHER FILE.'
                  GOTO 2
               ELSE IF ( (CHAR_YN.NE.'Y').AND.(CHAR_YN.NE.'y') ) THEN
                  WRITE(IU_USER, '(A)')
     &               '+++ ILLEGAL RESPONSE: PLEASE RETYPE.'
                  GOTO 3
               ENDIF
            ENDIF
         ENDIF
      ELSE IF ( (CHAR_QNA.EQ.'Q').OR.(CHAR_QNA.EQ.'q') ) THEN
         STOP
      ELSE
         WRITE(IU_ERR, '(A)') '+++ ERRONEOUS RESPONSE:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
            GOTO 1
         ENDIF
      ENDIF
!
!     NOW DECIDE WHICH PROCESSES ARE NEEDED.
4     WRITE(IU_USER, '(/A)')
     &   'SELECT FROM THE FOLLOWING LIST OF OPERATIONS.'
!
      WRITE(IU_USER, '(/6X, A)')
     &   '1.   REMOVE GASES FROM BANDS WHERE THEY ARE WEAK.'
      WRITE(IU_USER, '(6X, A)')
     &   '2.   FORCE THE SUM OF ESFT WEIGHTS TO BE 1.'
      WRITE(IU_USER, '(6X, A)')
     &   '3.   REMOVE NEGATIVE PRESSURE SCALINGS FROM ESFT DATA.'
      WRITE(IU_USER, '(6X, A)')
     &   '4.   REMOVE CONTINUA FROM BANDS WHERE THEY ARE WEAK.'
      WRITE(IU_USER, '(6X, A)')
     &   '5.   REMOVE NEGATIVE PRESSURE SCALINGS CONTINUUM DATA.'
      WRITE(IU_USER, '(/5X, A//)')
     &   '-1.  TO FINISH.'
5     READ(IU_STDIN, *, IOSTAT=IOS) I_PROCESS
      IF (IOS.NE.0) THEN
         WRITE(IU_ERR, '(A)') '+++ ERRONEOUS INPUT:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
            GOTO 5
         ENDIF
      ENDIF
!
!     FOR EACH VALID PROCESS CALL THE APPROPRIATE ROUTINE.
      IF (I_PROCESS.EQ.-1) THEN
!        WRITE OUT THE SPECTRAL FILE.
         CALL OUT_SPECTRUM(IERR
     &      , FILE_SPECTRAL, L_PRESENT
     &      , N_BAND, N_ABSORB, N_BAND_ABSORB, INDEX_ABSORB, TYPE_ABSORB
     &      , N_AEROSOL, TYPE_AEROSOL
     &      , N_BAND_CONTINUUM, INDEX_CONTINUUM, INDEX_WATER
     &      , I_BAND_ESFT, K_ESFT, W_ESFT, I_SCALE_ESFT
     &      , I_SCALE_FNC, SCALE_VECTOR, P_REFERENCE, T_REFERENCE
     &      , WAVE_LENGTH_SHORT , WAVE_LENGTH_LONG
     &      , N_BAND_EXCLUDE, INDEX_EXCLUDE
     &      , SOLAR_FLUX_BAND
     &      , N_DEG_FIT, THERMAL_COEFFICIENT, T_REF_PLANCK
     &      , RAYLEIGH_COEFFICIENT
     &      , I_SPEC_SURFACE, SURFACE_ALBEDO, N_DIR_ALBEDO_FIT
     &      , DIRECT_ALBEDO_PARM, EMISSIVITY_GROUND, L_SURFACE
     &      , K_CONTINUUM, I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &      , P_REF_CONTINUUM, T_REF_CONTINUUM
     &      , L_DROP_TYPE, I_DROP_PARAMETRIZATION, DROP_PARAMETER_LIST
     &      , N_DROP_DATA_LAYER, DROP_PRESSURE
     &      , DROP_ABSORPTION, DROP_SCATTERING, DROP_ASYMMETRY
     &      , L_ICE_TYPE, I_ICE_PARAMETRIZATION
     &      , ICE_PARAMETER_LIST
     &      , N_ICE_DATA_LAYER, ICE_PRESSURE
     &      , ICE_ABSORPTION, ICE_SCATTERING
     &      , ICE_ASYMMETRY
     &      , L_AEROSOL_SPECIES, AEROSOL_ABSORPTION
     &      , AEROSOL_SCATTERING, AEROSOL_ASYMMETRY
     &      , NHUMIDITY, HUMIDITIES
     &      , I_AEROSOL_PARAMETRIZATION
     &      , N_AEROSOL_DATA_LAYER, OBS_AEROSOL_PRESSURE
     &      , OBS_AEROSOL_ABSORPTION, OBS_AEROSOL_SCATTERING
     &      , OBS_AEROSOL_ASYMMETRY
     &      , L_DOPPLER_PRESENT, DOPPLER_CORRECTION
     &      )
         WRITE(IU_USER, '(/A/)') 'PROGRAM TERMINATED.'
         CLOSE(IU_SPC)
         STOP
      ELSE IF (I_PROCESS.EQ.1) THEN
         IF (L_PRESENT(5)) THEN
            CALL REMOVE_WEAK(IERR, N_BAND, N_ABSORB, TYPE_ABSORB
     &         , N_BAND_ABSORB, INDEX_ABSORB
     &         , I_BAND_ESFT, W_ESFT, K_ESFT
     &         )
            IF (IERR.NE.I_NORMAL) STOP
         ELSE
            WRITE(IU_ERR,'(/A)')
     &         'THE FILE CONTAINS NO ESFT DATA: THE PROCESS '
     &         //'CANNOT BE CARRIED OUT.'
         ENDIF
      ELSE IF (I_PROCESS.EQ.2) THEN
         IF (L_PRESENT(5)) THEN
            DO I=1, N_BAND
               DO J=1, N_BAND_ABSORB(I)
                  I_GAS=INDEX_ABSORB(J, I)
                  CALL SUM_UNITY(I_BAND_ESFT(I, J), W_ESFT(1, I, J)
     &               , K_ESFT(1, I, J)
     &               )
               ENDDO
            ENDDO
         ELSE
            WRITE(IU_ERR,'(/A)')
     &         'THE FILE CONTAINS NO ESFT DATA: THE PROCESS '
     &         //'CANNOT BE CARRIED OUT.'
         ENDIF
      ELSE IF (I_PROCESS.EQ.3) THEN
         IF (L_PRESENT(5)) THEN
            CALL REMOVE_NEGATIVE_GAS(N_BAND, N_BAND_ABSORB
     &         , INDEX_ABSORB, TYPE_ABSORB
     &         , I_SCALE_FNC, I_BAND_ESFT, SCALE_VECTOR
     &         )
         ELSE
            WRITE(IU_ERR,'(/A)')
     &         'THE FILE CONTAINS NO ESFT DATA: THE PROCESS '
     &         //'CANNOT BE CARRIED OUT.'
         ENDIF
      ELSE IF (I_PROCESS.EQ.4) THEN
         IF (L_PRESENT(9)) THEN
            CALL REMOVE_WEAK_CONT(IERR, N_BAND
     &         , N_BAND_CONTINUUM, INDEX_CONTINUUM, K_CONTINUUM
     &         )
            IF (IERR.NE.I_NORMAL) STOP
         ELSE
            WRITE(IU_ERR,'(/A)')
     &         'THE FILE CONTAINS NO CONTINUUM DATA: THE PROCESS '
     &         //'CANNOT BE CARRIED OUT.'
         ENDIF
      ELSE IF (I_PROCESS.EQ.5) THEN
         IF (L_PRESENT(9)) THEN
            CALL REMOVE_NEGATIVE_CONT(N_BAND, N_BAND_CONTINUUM
     &         , INDEX_CONTINUUM
     &         , I_SCALE_FNC_CONT, SCALE_CONTINUUM
     &         )
         ELSE
            WRITE(IU_ERR,'(/A)')
     &         'THE FILE CONTAINS NO CONTINUUM DATA: THE PROCESS '
     &         //'CANNOT BE CARRIED OUT.'
         ENDIF
      ELSE
         WRITE(IU_ERR, '(A)') '+++ INVALID TYPE OF PROCESS:'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error_main.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-TYPE.'
            GOTO 5
         ENDIF
      ENDIF
      IF (IERR.NE.I_NORMAL) STOP
!
      WRITE(IU_USER, '(/A/)') 'SPECIFY NEXT PROCESS.'
      GOTO 4
!
!
!
      END
