!-------------------------------------- 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_new(MAXHEIGHT,MINP,PMIN,DT1, ps,tau,plev,cldflag,nlev,nchn,nprf,imodtop) 2 #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/DLOGP' AT MODEL TOP ! -MAXHEIGHT(NCHN,NPRF): Height (hPa) of the maximum of the weighting function ! ! *********************************************************************** #endif IMPLICIT NONE INTEGER ,INTENT(IN) :: NCHN,NPRF,NLEV,IMODTOP,CLDFLAG(NPRF) REAL(8), intent(in) :: PLEV(NLEV),PS(NPRF),TAU(NCHN,NPRF,NLEV) INTEGER, INTENT (out) :: MINP(NCHN,NPRF) REAL(8), intent(out) :: PMIN(NCHN,NPRF), DT1(NCHN,NPRF),MAXHEIGHT(NCHN,NPRF) REAL(8) :: MAXWF INTEGER :: J,JC,JN,ipos(1) REAL(8) :: WFUNC(NLEV-1),RAP(NLEV-1) MINP(:,:) = -1 PMIN(:,:) = -1. DT1(:,:) = -1. DO J = 1, NLEV-1 RAP(J) = LOG( PLEV(J+1) / PLEV(J) ) ENDDO 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/dlog(P) DO J = 1, NLEV-1 ! WFUNC(J) = (TAU(JC,JN,J)-TAU(JC,JN,J+1)) / (PLEV(J+1)-PLEV(J)) * 100. WFUNC(J) = (TAU(JC,JN,J)-TAU(JC,JN,J+1)) / ( RAP(J) ) 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 ! ???????? ! Recherche du maximum IPOS=MAXLOC( WFUNC(:) ) ! Calcul de la valeur du maximum MAXWF = WFUNC(IPOS(1)) ! maximum entre les 2 niveaux puisque WF calculee pour une couche finie ( discutable ?) MAXHEIGHT(JC,JN)= 0.5 * ( PLEV(IPOS(1)) + PLEV(IPOS(1)+1) ) !* IF CHANNEL DOESN'T SEE THE SURFACE, SEE WHERE dTAU/dlog(PLEV) BECOMES IMPORTANT !* FOR RECOMPUTATION OF MINP AND PMIN. DO J = NLEV-1, IPOS(1), -1 IF ( ( WFUNC(J)/ MAXWF ) > 0.01) THEN MINP(JC,JN) = J+1 PMIN(JC,JN) = MIN(PLEV(J+1),PS(JN)) EXIT END IF ENDDO END DO profiles END DO channels END SUBROUTINE MIN_PRES_NEW