!+ Subroutine to control fitting of cloud properties across bands.
!
! Method:
!	A file is opened to hold the fit, the type of fit required
!	and other information are acquired, and a fit is performed
!	in each band.
!
! 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.
!
!- ---------------------------------------------------------------------
      SUBROUTINE CLOUD_FIT(IERR, N_BAND, N_DATA
     &   , VOL_FRACTION, RADIUS_EFFECTIVE
     &   , SCATTERING_BAND, ABSORPTION_BAND, ASYMMETRY_BAND
     &   )
!
!
!
      IMPLICIT NONE
!
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/dimensions_spec.ucf'
      INCLUDE 'incl/dimensions_pp.ucf'
      INCLUDE 'incl/opt_variable.pcf'
      INCLUDE 'incl/cloud_parametrization.pcf'
      INCLUDE 'incl/cloud_parametrization.ncf'
      INCLUDE 'incl/def_std_io.icf'
      INCLUDE 'incl/def_sct_io.icf'
      INCLUDE 'incl/file_type.pcf'
      INCLUDE 'incl/error.pcf'
!
!     DUMMY VARIABLES.
      INTEGER	!, INTENT(OUT)
     &     IERR
!             ERROR FLAG
      INTEGER	!, INTENT(IN)
     &     N_BAND
!             NUMBER OF SPECTRAL BANDS
     &   , N_DATA
!             NUMBER OF DATA BLOCKS
      REAL*8	!, INTENT(IN)
     &     VOL_FRACTION(N_DATA)
!             VOLUME FRACTION OF ABSORBER
     &   , RADIUS_EFFECTIVE(N_DATA)
!             EFFECTIVE RADIUS
     &   , SCATTERING_BAND(NPD_BAND, NPD_MIE_BLOCK)
!             AVERAGED SCATTERING VALUES
     &   , ABSORPTION_BAND(NPD_BAND, NPD_MIE_BLOCK)
!             AVERAGED ABSORPTION VALUES
     &   , ASYMMETRY_BAND(NPD_BAND, NPD_MIE_BLOCK)
!             AVERAGED ASYMMETRIES
!
!     LOCAL VARIABLES.
!
      LOGICAL
     &     LOCK_CODE
!             LOGICAL TO FORBID INTERACTIVE LOOPING
      EXTERNAL
     &     LOCK_CODE
!
      CHARACTER
     &     CHAR_YN*1
!             RESPONSE VARIABLE
      INTEGER
     &     I_FIT_TYPE
!             TYPE OF FIT REQUIRED
     &   , I
!             LOOP VARIABLE
     &   , J
!             LOOP VARIABLE
     &   , K
!             LOOP VARIABLE
     &   , IOS
!             I/O ERROR FLAG
     &   , N_TOTAL_PARAMETER
!             TOTAL NUMBER OF PARAMETERS
      REAL*8
     &     SCATTERING(NPD_MIE_BLOCK)
!             SCATTERING ARRAY
     &   , ABSORPTION(NPD_MIE_BLOCK)
!             ABSORPTION ARRAY
     &   , ASYMMETRY(NPD_MIE_BLOCK)
!             ASYMMETRY ARRAY
     &   , CLOUD_PARAMETER_LIST(NPD_CLOUD_PARAMETER)
!             LIST OF CLOUD PARAMETERS
     &   , DENSITY_PARTICLE
!             DENSITY OF PARTICLES
!
!     INCLUDE HEADER FILES.
      INCLUDE 'incl/initial.pcf'
      INCLUDE 'incl/cloud_parm_data.dcf'
!
!     SUBROUTINES CALLED:
      EXTERNAL
     &     OPEN_FILE_OUT, CLOUD_FIT_BAND
!
!
!
!     RETURN IF NO FIT IS REQUIRED.
      WRITE(IU_USER, '(/A)')
     &   'DO YOU WHICH TO PARAMETRIZE THESE DATA? (Y/N)'
1     READ(IU_STDIN, '(A)') CHAR_YN
!
      IF ( (CHAR_YN.EQ.'N').OR.(CHAR_YN.EQ.'n') ) THEN
         RETURN
!
      ELSE IF ( (CHAR_YN.EQ.'Y').OR.(CHAR_YN.EQ.'y') ) THEN
         CALL OPEN_FILE_OUT(IERR, IU_CLOUD_FIT
     &     , 'ENTER THE NAME OF THE FILE TO CONTAIN THE '
     &      //'FITTING PARAMETERS.')
         IF (IERR.NE.I_NORMAL) RETURN
!
!        OPEN MONITOR FILE FOR DETAILED OUTPUT.
         OPEN(UNIT=IU_MONITOR, FILE='fit.monitor', STATUS='UNKNOWN'
     &      )
!
!        SELECT AN APPROPRIATE FITTING SCHEME.
         WRITE(IU_USER, '(/A/)')
     &      'SELECT A PARAMETRIZATION SCHEME FROM THE LIST BELOW.'
         DO I=1, NPD_CLOUD_FIT
            IF (I.NE.IP_DROP_UNPARAMETRIZED) THEN
               WRITE(IU_USER, '(6X, I4, A2, 1X, A20)')
     &            I, ').', NAME_CLOUD_PARAMETRIZATION(I)
            ENDIF
         ENDDO
3        READ(IU_STDIN, *, IOSTAT=IOS) I_FIT_TYPE
         IF (IOS.NE.0) THEN
            WRITE(IU_ERR, '(/A)') 'UNRECOGNIZED REPONSE.'
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error.finc'
            ELSE
               WRITE(IU_USER, '(/A)') 'PLEASE RE-TYPE.'
               GOTO 3
            ENDIF
         ENDIF
         IF ( (I_FIT_TYPE.NE.IP_SLINGO_SCHRECKER)
     &         .AND.(I_FIT_TYPE.NE.IP_ACKERMAN_STEPHENS)
     &         ) THEN
            WRITE(IU_ERR, '(/A)') 'THIS NUMBER DOES NOT REPRESENT '
     &         //'A VALID SCHEME:'
            IF (LOCK_CODE(.TRUE.)) THEN
               INCLUDE 'batch_error.finc'
            ELSE
               WRITE(IU_ERR, '(/A)') 'PLEASE RE-ENTER.'
               GOTO 3
            ENDIF
         ENDIF
!
!        THE DENSITY OF THE PARTICLES IS REQUIRED FOR LATER CONVERSION.
         WRITE(IU_USER, '(/A)') 'ENTER THE DENSITY OF THE PARTICLES.'
         READ(IU_STDIN, *, IOSTAT=IOS) DENSITY_PARTICLE
!
!        SET THE TOTAL NUMBER OF PARAMETERS NECESSARY FOR THE
!        PARAMETRIZATION SELECTED.
         N_TOTAL_PARAMETER=0
         IF ( (I_FIT_TYPE.EQ.IP_SLINGO_SCHRECKER)
     &         .OR.(I_FIT_TYPE.EQ.IP_ACKERMAN_STEPHENS) ) THEN
            N_TOTAL_PARAMETER=
     &         N_CLOUD_FIT_PARAMETER(I_FIT_TYPE, IP_EXTINCTION)
     &         +N_CLOUD_FIT_PARAMETER(I_FIT_TYPE, IP_SS_ALBEDO)
     &         +N_CLOUD_FIT_PARAMETER(I_FIT_TYPE, IP_ASYMMETRY)
         ENDIF
!
!        WRITE HEADERS TO THE OUTPUT FILE.
         WRITE(IU_CLOUD_FIT, '(A13, I5, //20X, A)') '*FILE_TYPE = '
     &      , IT_FILE_CLOUD_FIT, 'PARAMETERS FITTING MIE DATA'
         WRITE(IU_CLOUD_FIT, '(/A32, 1X, I5, A2, A20)')
     &      'INDEX OF PARAMETRIZATION SCHEME =', I_FIT_TYPE, ': '
     &      , NAME_CLOUD_PARAMETRIZATION(I_FIT_TYPE)
         WRITE(IU_CLOUD_FIT, '(A31, I5, 1X, A14)')
     &      'NUMBER OF FITTING PARAMETERS = ', N_TOTAL_PARAMETER
     &      , 'FOR EACH BAND.'
!
         DO I=1, N_BAND
!
            WRITE(IU_MONITOR, '(/A)')
     &         '=================================================='
            WRITE(IU_MONITOR, '(/A, I5)')
     &         'FITTING IN BAND ',I
!
            DO J=1, N_DATA
               SCATTERING(J)=SCATTERING_BAND(I, J)
               ABSORPTION(J)=ABSORPTION_BAND(I, J)
               ASYMMETRY(J)=ASYMMETRY_BAND(I, J)
            ENDDO
!
            CALL CLOUD_FIT_BAND(IERR
     &         , N_DATA, I_FIT_TYPE
     &         , DENSITY_PARTICLE
     &         , VOL_FRACTION, RADIUS_EFFECTIVE
     &         , SCATTERING, ABSORPTION, ASYMMETRY
     &         , CLOUD_PARAMETER_LIST
     &         )
            IF (IERR.NE.I_NORMAL) RETURN
!
            WRITE(IU_CLOUD_FIT, '(A6, 1X, I5, 5X, A19)')
     &         'BAND =', I, 'FITTING PARAMETERS:'
            WRITE(IU_CLOUD_FIT, '(4(4X, 1PE12.5))')
     &         (CLOUD_PARAMETER_LIST(K), K=1, N_TOTAL_PARAMETER)
!
         ENDDO
!
         WRITE(IU_CLOUD_FIT, '(//)')
         CLOSE(IU_CLOUD_FIT)
         CLOSE(IU_MONITOR)
!
      ELSE
         WRITE(IU_ERR, '(A)') '+++ ILLEGAL RESPOSNSE.'
         IF (LOCK_CODE(.TRUE.)) THEN
            INCLUDE 'batch_error.finc'
         ELSE
            WRITE(IU_USER, '(A)') 'PLEASE RE-ENTER.'
            GOTO 1
         ENDIF
      ENDIF
!
!
      RETURN
      END
