!-------------------------------------- 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 MIN_PRES(MINP,PMIN,DT1, ps,tau,plev,cldflag,nlev,nchn,nprf,imodtop)

#if defined (DOC)
!***********************************************************************
!
!**ID MIN_PRES -- FIND MINIMUM HEIGHT LEVEL OF SENSITIVITY
!
!       AUTHOR:   L. GARAND                   May 2004
!                 A. BEAULNE (CMDA/SMC)     March 2006  (ADAPT TO 3DVAR)                 
!
!       REVISION:
!
!       OBJECT:   FROM TOTAL TRANSMITTANCE ARRAY, FIND MINIMUM HEIGHT 
!          LEVEL OF SENSITIVITY FOR A NUMBER OF PROFILES AND CHANNELS.
!          THIS MAY BE USED TO SELECT FOR ASSIMILATION ONLY THE
!          OBSERVATIONS WITHOUT SENSITIVITY TO CLOUDS, THAT IS THE
!          RESPONSE FUNCTION SIGNIFICANT ONLY ABOVE CLOUD LEVEL.
!          THE CRITERION IS THAT dTAU/dPLEV > 0.01 FOR A 100 MB LAYER.
!
!       ARGUMENTS:
!          INPUT:
!            -PS(NPRF)            : SURFACE PRESSURE (HPA)
!            -TAU(NCHN,NPRF,NLEV) : LAYER TO SPACE TRANSMITTANCES (0.-1.)
!            -PLEV(NLEV)          : PRESSURE LEVELS (HPA)
!            -CLDFLAG(NPRF)       : (0) CLEAR, (1) CLOUDY, (-1) UNDEFINED PROFILE
!            -NLEV                : NUMBER OF VERTICAL LEVELS
!            -NCHN                : NUMBER OF CHANNELS
!            -NPRF                : NUMBER OF PROFILES
!            -IMODTOP             : RT MODEL LEVEL NEAREST TO MODEL TOP
!
!          OUTPUT:
!            -PMIN(NCHN,NPRF)     : MINIMUM HEIGHT OF SENSITIVITY (HPA)
!            -MINP(NCHN,NPRF)     : VERTICAL LEVEL CORRESPONDING TO PMIN
!            -DT1(NCHN,NPRF)      : VALUE OF 'DTAU/DPLEV PER 100MB' AT MODEL TOP
!
!
***********************************************************************
#endif


      IMPLICIT NONE

      INTEGER   :: J,JC,NCHN,JN,NPRF,NLEV,IMODTOP
      INTEGER   :: MINP(NCHN,NPRF),CLDFLAG(NPRF)
      REAL(8)   :: PMIN(NCHN,NPRF)
      REAL(8)   :: DT1(NCHN,NPRF),WFUNC(NLEV-1)
      REAL(8)   :: TAU(NCHN,NPRF,NLEV),PLEV(NLEV),PS(NPRF)


      MINP(:,:) = -1
      PMIN(:,:) = -1.
      DT1(:,:)  = -1.


      channels: DO JC = 1, NCHN
        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


          DO J = 1, NLEV
            IF ( TAU(JC,JN,J) < 0.) CYCLE profiles
          END DO

          MINP(JC,JN) = NLEV
          PMIN(JC,JN) = MIN(PLEV(NLEV),PS(JN))


!*        COMPUTE ENTIRE ARRAY OF dTAU/dPLEV PER 100 MB LAYER

          DO J = 1, NLEV-1
            WFUNC(J) = (TAU(JC,JN,J)-TAU(JC,JN,J+1)) / (PLEV(J+1)-PLEV(J)) * 100.
          END DO
       
          DT1(JC,JN) = WFUNC(IMODTOP)


!*        IF CHANNEL SEES THE SURFACE, DON'T RECALCULATE MINP AND PMIN

          IF ( TAU(JC,JN,NLEV) > 0.01 ) CYCLE profiles


!*        IF CHANNEL DOESN'T SEE THE SURFACE, SEE WHERE dTAU/dPLEV BECOMES IMPORTANT
!*        FOR RECOMPUTATION OF MINP AND PMIN.

          DO J = NLEV-1, 1, -1
            IF (ABS(WFUNC(J)) > 0.01) THEN
              MINP(JC,JN) = J+1
              PMIN(JC,JN) = MIN(PLEV(J+1),PS(JN))
              EXIT
            END IF
          END DO
    
        END DO profiles
      END DO channels


      END SUBROUTINE MIN_PRES