!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!


      SUBROUTINE SELTOP ( ETOP,VTOP,ECF,VCF,NGOOD, he,ht,cf,cfsub,ptop_mb,ps,cldflag,gncldflag,nprf,nco2 ) 2,1

#if defined (DOC)
!***********************************************************************
!
!**ID SELTOP -- SELECT CLOUD TOP
!
!       AUTHOR:   L. GARAND                  July 2004
!                 A. BEAULNE (CMDA/SMC)     March 2006  (ADAPT TO 3DVAR)                 
!
!       REVISION:
!
!       OBJECT:   SELECT CLOUD TOP BY AVERAGING CO2-SLICING RESULTS
!          JUDGED CORRECT. ALL MISSING VALUES ARE -1.
!
!       ARGUMENTS:
!          INPUT:
!            -HE(NPRF)      : EQUIVALENT CLOUD TOP HEIGHTS 
!                              FROM A WINDOW CHANNEL (HPA)
!            -HT(NCO2,NPRF) : CLOUD TOPS FROM CO2-SLICING (HPA)
!            -CF(NCO2,NPRF) : EFFECTIVE CLOUD FRACTION FOR CO2-SLICING
!            -CFSUB(NPRF)   : visible ("subpixel") cloud fraction
!            -PTOP_MB(NPRF) : height (mb) from cloud_height subroutine           
!            -PS(NPRF)      : SURFACE PRESSURE IN (HPA)
!            -CLDFLAG(NPRF) : (0) CLEAR, (1) CLOUDY, (-1) UNDEFINED PROFILE
!            -NPRF          : NUMBER OF PROFILES
!            -NCO2          : NUMBER OF CO2-SLICING ESTIMATES
!
!          OUTPUT:
!            -ETOP(NPRF)    : CONSENSUS CLOUD TOP (HPA)
!            -VTOP(NPRF)    : CORRESPONDING VARIANCE ON ETOP (HPA)
!            -ECF(NPRF)     : CONSENSUS EFFECTIVE CLOUD FRACTION
!            -VCF(NPRF)     : CORRESPONDING VARIANCE ON ECF
!            -NGOOD(NPRF)   : NUMBER OF GOOD ESTIMATES
!
!
!***********************************************************************
#endif


      IMPLICIT NONE

      INTEGER    :: JN,NPRF,N,JCH,NCO2
      INTEGER    :: NGOOD(NPRF), CLDFLAG(NPRF), GNCLDFLAG(NPRF)
      REAL(8)    :: ETOP(NPRF),VTOP(NPRF),ECF(NPRF),VCF(NPRF)
      REAL(8)    :: HE(NPRF),HT(NCO2,NPRF),CF(NCO2,NPRF),PS(NPRF),CFSUB(NPRF)
      REAL(8)    :: PTOP_MB(NPRF)
      REAL(8)    :: H(NCO2),F(NCO2)


      ETOP(:) = -1.D0
      VTOP(:) = -1.D0
      ECF(:)  = -1.D0
      VCF(:)  = -1.D0
      NGOOD(:)= 0


      profiles: DO JN = 1, NPRF

!**     profile not assimilated if data from 2 windows channels bad
!**     and/or if data from 2 reference co2 channels bad

        IF ( CLDFLAG(JN) == -1 ) CYCLE profiles

        N = 0
        H(:) = 0.
        F(:) = 0.

        DO JCH = 1, NCO2

!*        CHECK FOR ZERO CLOUD FRACTION

          IF ( CF(JCH,JN) > -0.9 .AND. CF(JCH,JN) < 1.D-6 ) THEN
            N = N + 1
            H(N) = PS(JN)
            F(N) = 0.
          ELSE


!*        CONSIDER ONLY VALID VALUES OF CLOUD FRACTION ABOVE SOME THRESHOLD

!         IMPORTANT LOGIC: FOR VALUES ABOVE 1.0 OF CO2-SLICING CLOUD FRACTION,
!         SET IT TO 1.0 AND FORCE THE TOP EQUAL TO THE EFFECTIVE HEIGHT HE.
!         CO2-SLICING NOT ALLOWED TO GIVE ESTIMATES BELOW HE, WHICH HAPPENS
!         FOR CLOUD FRACTION CF > 1.0.

          IF ( HT(JCH,JN) > 0.0 ) THEN
            N=N+1
            H(N) = HT(JCH,JN)
            F(N) = MIN(CF(JCH,JN), 1.0D0)
            F(N) = MAX(F(N), 0.D0)
            IF ( CF(JCH,JN) > 1.0 ) H(N) = HE(JN)
          END IF
	 ENDIF

        ENDDO


        NGOOD(JN) = N

!*      COMPUTE MEAN AND VARIANCE

        IF ( N >= 1 ) THEN
         
!         ETOP(JN) = SUM(H(1:N)) / N
!         ECF(JN)  = SUM(F(1:N)) / N

         call calcul_median_fast(N,NCO2,H,F,ETOP(JN),ECF(JN))

         VTOP(JN) = SQRT ( SUM((H(1:N)-ETOP(JN))**2)/N )
         VCF(JN)  = SQRT ( SUM((F(1:N)- ECF(JN))**2)/N )         

         IF ( N == 1 ) THEN
            VTOP(JN) = 50.
            VCF(JN)  = 0.20
          END IF

        ELSE

!*      IF NO SOLUTION FROM CO2-SLICING, AND NOT PREDETERMINED CLEAR, 
!*      ASSUME CLOUDY WITH TOP EQUAL TO EFFECTIVE HEIGHT HE;
!*      HOWEVER IF HE IS VERY CLOSE TO SURFACE PRESSURE PS, ASSUME CLEAR.

          ETOP(JN) = HE(JN)
          ECF(JN)  = 1.0
          IF (CFSUB(JN)>=0.05) THEN
             ECF(JN)=CFSUB(JN)
             ETOP(JN)=MIN(MIN(HE(JN),PTOP_MB(JN)),PS(JN)-50.0)
          ENDIF
          VTOP(JN) = 50.
          VCF(JN)  = 0.30
          IF ( HE(JN) > (PS(JN)-10.) ) ECF(JN) = 0.
	  IF ( GNCLDFLAG(JN) == 0 ) THEN
	     ECF(JN)=0.0
	     ETOP(JN)=PS(JN)
	  ENDIF
        END IF

        IF ( ECF(JN) < 0.05 ) THEN
	     ECF(JN)=0.0
	     ETOP(JN)=PS(JN)
        ENDIF
      END DO profiles


      END SUBROUTINE SELTOP