!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt !MNH_LIC for details. version 1. !----------------------------------------------------------------- !--------------- special set of characters for RCS information !----------------------------------------------------------------- ! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/free_atm_profile.f90,v $ $Revision: 1.3.4.1.2.3.12.2 $ !----------------------------------------------------------------- ! ############################ MODULE MODI_FREE_ATM_PROFILE ! ############################ INTERFACE SUBROUTINE FREE_ATM_PROFILE(PVAR_MX,PZMASS_MX,PZS_LS,PZSMT_LS,PCLIMGR,& PF_FREE,PZ_FREE) ! REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography REAL, DIMENSION(:,:), INTENT(IN) :: PZSMT_LS ! large scale smooth orography REAL, INTENT(IN) :: PCLIMGR ! climatological gradient ! ! near the ground REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the ! ! thermodynamical field REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z ! ! of the profile on the ! ! flat grid where zs is the ! ! minimum of both orographies END SUBROUTINE FREE_ATM_PROFILE END INTERFACE END MODULE MODI_FREE_ATM_PROFILE ! ############################################################## SUBROUTINE FREE_ATM_PROFILE(PVAR_MX,PZMASS_MX,PZS_LS,PZSMT_LS,PCLIMGR,& PF_FREE,PZ_FREE) ! ############################################################## ! !!**** *FREE_ATM_PROFILE* - Computation of the profile of the free atmospheres !! i.e. without the Boundary layer structures !! !! PURPOSE !! ------- !! This routine computes the profile used for the shift of a variable !! and the altitude of the discretization points of this profile. ! !! CAUTION: !! The shift profile is only defined on the inner vertical points of the grid. !! !!** METHOD !! ------ !! The profile is discretized on the vertical GS grid defined by !! the MESO-NH level array XZHAT and by a constant orography, !! corresponding to the minimum of the Arpege and MESO-NH orographies. !! If necessary, the profile is extrapolated under the minimum !! altitude of the Arpege orography with a climatological vertical !! gradient PCLIMGR (uniform on the whole domain). !! !! EXTERNAL !! -------- !! !! function FMLOOK : to retrieve a logical unit number associated !! with a file !! !! IMPLICIT ARGUMENTS !! ------------------ !! !! Module MODD_CONF : contains configuration variables for all models. !! NVERB : verbosity level for output-listing !! Module MODD_LUNIT : contains logical unit names for all models !! CLUOUT0 : name of output-listing !! Module MODD_GRID1 : contains grid variables for model1 !! XZS : orography of MESO-NH !! XZHAT : GS levels !! Module MODD_PARAMETERS !! JPVEXT !! !! REFERENCE !! --------- !! !! Book 2 !! !! AUTHOR !! ------ !! !! V.Masson Meteo-France !! !! MODIFICATIONS !! ------------- !! Original 26/08/97 !------------------------------------------------------------------------------- ! !* 0. DECLARATIONS ! ------------ ! USE MODI_PGDFILTER USE MODI_COEF_VER_INTERP_LIN USE MODI_VER_INTERP_LIN USE MODI_VERT_COORD ! USE MODE_FMWRIT USE MODE_FM ! USE MODD_CONF ! declaration modules USE MODD_LUNIT USE MODD_LUNIT_n USE MODD_GRID_n USE MODD_PARAMETERS USE MODD_VER_INTERP_LIN !JUAN REALZ USE MODE_MPPDB !JUAN REALZ ! IMPLICIT NONE ! !* 0.1 Declaration of arguments ! ------------------------ REAL, DIMENSION(:,:,:), INTENT(IN) :: PVAR_MX ! thermodynamical field REAL, DIMENSION(:,:,:), INTENT(IN) :: PZMASS_MX ! mass points altitude REAL, DIMENSION(:,:), INTENT(IN) :: PZS_LS ! large scale orography REAL, DIMENSION(:,:), INTENT(IN) :: PZSMT_LS ! large scale smooth orography REAL, INTENT(IN) :: PCLIMGR ! climatological gradient ! ! near the ground REAL, DIMENSION(:,:,:), INTENT(OUT) :: PF_FREE ! mean profile of the ! ! thermodynamical field REAL, DIMENSION(:,:,:), INTENT(OUT) :: PZ_FREE ! discretization in x,y,z ! ! of the profile on the ! ! flat grid where zs is the ! ! minimum of both orographies ! !* 0.2 Declaration of local variables ! ------------------------------ ! REAL, PARAMETER :: XT_CLIM_GRAD = -0.0065! climatological temperature gradient INTEGER :: ILUOUT0 ! output listing logical unit INTEGER :: IIU, IJU, IKB, IKE, IKU ! array dimensions and phys. bound. INTEGER :: JI, JJ, JK ! loop counters INTEGER :: IK350 INTEGER :: IK2000,IK3000,IK4000,IK5000 ! levels just under 2000m, 3000m, ! ! 4000m and 5000m above ground. REAL :: ZFREEGR ! guess of free atmosphere gradient REAL :: ZMIN, ZMAX ! lower and upper values of the ! gradients to verify the test REAL, DIMENSION(SIZE(PZMASS_MX,3)) :: ZGR_MX ! gradients along a vertical LOGICAL, DIMENSION(SIZE(PZMASS_MX,3)) :: GTEST, & ! tests on the gradients GFREE ! .T. : belongs to free atm. INTEGER :: IK_BLTOP ! level just above the BL REAL, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2),SIZE(PZMASS_MX,3)) & :: ZF_FREE_MX ! profile of free atmosphere ! on mixed grid REAL, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) & :: ZFREE_GR ! gradient of low free atm. INTEGER, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) & :: IK_BL_TOP ! level just below the top ! of boundary layer INTEGER, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) & :: IWK_BL_TOP ! work array REAL, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) & :: ZK_BL_TOP ! as K_BL_TOP but real INTEGER :: IIMIN, IIMAX, IJMIN, IJMAX INTEGER :: IRESP ! INTEGER :: IGRID, ILENCH ! CHARACTER(LEN=16) :: YRECFM ! name of field to be recorded CHARACTER(LEN=100):: YCOMMENT ! comment to be recorded REAL, DIMENSION(SIZE(PZMASS_MX,1),SIZE(PZMASS_MX,2)) & :: Z2D ! field to be recorded REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3)) & :: Z3D ! field to be recorded REAL, DIMENSION(SIZE(XZZ,1),SIZE(XZZ,2),SIZE(XZZ,3)) & :: ZZMASS ! MESO-NH output mass grid !------------------------------------------------------------------------------- CALL FMLOOK_ll(CLUOUT0,CLUOUT0,ILUOUT0,IRESP) ! ! IIU=SIZE(PZMASS_MX,1) IJU=SIZE(PZMASS_MX,2) IKB=JPVEXT+1 IKE=SIZE(PZMASS_MX,3)-JPVEXT IKU=SIZE(PZMASS_MX,3) ! !* 1. Computation of the altitude of the grid for the shift profile ! ---------------------------------------------------------------- ! CALL VERT_COORD(LSLEVE,PZS_LS,PZSMT_LS,XLEN1,XLEN2,XZHAT,PZ_FREE) ! !------------------------------------------------------------------------------- ! !* Computations in the following loop are performed on the mixed grid ! DO JI=1,IIU DO JJ=1,IJU ! !------------------------------------------------------------------------------- ! !* 2. Gradient at all levels ! ---------------------- ! ZGR_MX(1:IKE)=( PVAR_MX (JI,JJ,2:IKE+1) & -PVAR_MX (JI,JJ,1:IKE ))& /( PZMASS_MX(JI,JJ,2:IKE+1) & -PZMASS_MX(JI,JJ,1:IKE )) ! ZGR_MX(IKE+1:IKU) = ZGR_MX(IKE) ! !------------------------------------------------------------------------------- ! !* 3. Gradient 5000m above ground ! --------------------------- ! !* 3.1 index of level just under 2000m, 3000m and 5000m ! ------------------------------------------------ ! !* the limits are set in case of high orography ! IK5000=MAX(IKB+2,MIN(IKE-2, & COUNT(PZMASS_MX(JI,JJ,:) Beginning of boundary layer. ! End of the searching. ! IF (.NOT. GTEST(JK) .AND. .NOT. GTEST(JK+1) .AND. .NOT. GTEST(JK+2) & .AND. JK <= IK2000 ) EXIT ! !* Other cases: treated in further loop iteration ! END DO ! !------------------------------------------------------------------------------- ! !* 6. Top of boundary layer ! --------------------- ! !* one level is added to remove the beginings of the boundary layer ! IK_BLTOP = COUNT(.NOT. GFREE) + 2 ! !------------------------------------------------------------------------------- ! !------------------------------------------------------------------------------- ! !* 7. End of loop on the guesses of free gradient ! ------------------------------------------- ! IK_BL_TOP(JI,JJ) = IK_BLTOP ! ! END DO END DO !------------------------------------------------------------------------------- ! !* 8. top of the boundary layer ! ------------------------- ! !* 8.1 remove spurious values of boundary layer top level ! -------------------------------------------------- ! !* small areas of high BL, or limits between two very different areas are ! modified ! IWK_BL_TOP(:,:)=IK_BL_TOP(:,:) ZK_BL_TOP(:,:)=FLOAT(IK_BL_TOP(:,:)) CALL MPPDB_CHECK2D(ZK_BL_TOP,"FREE_ATM_PROFILE:8.1:ZK_BL_TOP",PRECISION) ! !!$DO JI=1,IIU !!$ DO JJ=1,IJU !!$ IIMIN=MAX(JI-2,1) !!$ IIMAX=MIN(JI+2,IIU) !!$ IJMIN=MAX(JJ-2,1) !!$ IJMAX=MIN(JJ+2,IJU) !!$ IF (IWK_BL_TOP(JI,JJ) >= SUM(IK_BL_TOP(IIMIN:IIMAX,IJMIN:IJMAX)) & !!$ / ((IIMAX-IIMIN+1)*(IJMAX-IJMIN+1)) +3 ) & !!$ IWK_BL_TOP(JI,JJ) = SUM(IK_BL_TOP(IIMIN:IIMAX,IJMIN:IJMAX)) & !!$ / ((IIMAX-IIMIN+1)*(IJMAX-IJMIN+1)) !!$ END DO !!$END DO !!$IK_BL_TOP(:,:)=IWK_BL_TOP(:,:) ZK_BL_TOP(:,:)=FLOAT(IK_BL_TOP(:,:)) CALL MPPDB_CHECK2D(ZK_BL_TOP,"FREE_ATM_PROFILE:8.2:ZK_BL_TOP",PRECISION) ! !* 8.2 spatial filtering is applied (4 times) for boundary layer top ! ------------------------------------------------------------- ! ZK_BL_TOP(:,:)=FLOAT(IK_BL_TOP(:,:)) CALL PGDFILTER(ZK_BL_TOP(:,:),4) CALL MPPDB_CHECK2D(ZK_BL_TOP,"FREE_ATM_PROFILE:ZK_BL_TOP",PRECISION) IK_BL_TOP(:,:)=NINT(ZK_BL_TOP(:,:)) ! !------------------------------------------------------------------------------- ! !* 9. Extrapolation of profile from top of the boundary layer ! ------------------------------------------------------- ! !* 9.1 Gradient above boundary layer ! ----------------------------- ! !* We use the points in free atmosphere up to 5000m ! DO JI=1,IIU DO JJ=1,IJU IK5000=MAX(IKB+2,MIN(IKE-2, & COUNT(PZMASS_MX(JI,JJ,:)IKB+1) THEN ZFREE_GR(JI,JJ) = (PVAR_MX (JI,JJ,IK5000) - PVAR_MX (JI,JJ,MIN(IK_BL_TOP(JI,JJ),IK3000)))& / (PZMASS_MX(JI,JJ,IK5000) - PZMASS_MX(JI,JJ,MIN(IK_BL_TOP(JI,JJ),IK3000))) ELSE ZFREE_GR(JI,JJ) = XT_CLIM_GRAD END IF END DO END DO ! !* 9.2 spatial filtering is applied (8 times) for the gradient ! ------------------------------------------------------- ! CALL PGDFILTER(ZFREE_GR(:,:),4) ! !* 9.3 free atmosphere profile is computed ! ----------------------------------- ! DO JI=1,IIU DO JJ=1,IJU ! ZF_FREE_MX(JI,JJ,IK_BL_TOP(JI,JJ):) = PVAR_MX(JI,JJ,IK_BL_TOP(JI,JJ):) ! ZF_FREE_MX(JI,JJ,:IK_BL_TOP(JI,JJ)-1) = ZF_FREE_MX(JI,JJ,IK_BL_TOP(JI,JJ)) & + ZFREE_GR(JI,JJ) * ( PZMASS_MX(JI,JJ,:IK_BL_TOP(JI,JJ)-1)& - PZMASS_MX(JI,JJ, IK_BL_TOP(JI,JJ) ) ) ! END DO END DO ! !* 9.5 profile is modified in case of change of zs upwards ! --------------------------------------------------- ! !* We need to have the constant free atmosphere gradient also above the boundary ! layer, in order to produce a correct shift. The added height where the ! gradient apply is equal to the difference betweeen the two orographies. ! DO JI=1,IIU DO JJ=1,IJU IF (PZS_LS(JI,JJ)