SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/canopy_grid

Go to the documentation of this file.
00001 !     #########################################
00002       SUBROUTINE CANOPY_GRID_UPDATE(KI,KLVL,PH,PZFORC,PZ,PZF,PDZ,PDZF)
00003 !     #########################################
00004 !
00005 !!****  *CANOPY_GRID_UPDATE* - set the upper levels at and just below forcing level
00006 !!                        
00007 !!
00008 !!    PURPOSE
00009 !!    -------
00010 !!
00011 !!**  METHOD
00012 !!    ------
00013 !!
00014 !!    EXTERNAL
00015 !!    --------
00016 !!
00017 !!
00018 !!    IMPLICIT ARGUMENTS
00019 !!    ------------------
00020 !!
00021 !!    REFERENCE
00022 !!    ---------
00023 !!
00024 !!
00025 !!    AUTHOR
00026 !!    ------
00027 !!      V. Masson   *Meteo France*      
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    07/2006 
00032 !!      S. Riette   Oct 2010 Vectorisation
00033 !-------------------------------------------------------------------------------
00034 !
00035 !*       0.    DECLARATIONS
00036 !              ------------
00037 !
00038 !
00039 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00040 USE PARKIND1  ,ONLY : JPRB
00041 !
00042 USE MODI_CANOPY_GRID
00043 !
00044 IMPLICIT NONE
00045 !
00046 !*       0.1   Declarations of arguments
00047 !              -------------------------
00048 !
00049 INTEGER,                  INTENT(IN)    :: KI        ! number of horizontal points
00050 INTEGER,                  INTENT(IN)    :: KLVL      ! number of levels in canopy
00051 REAL, DIMENSION(KI),      INTENT(IN)    :: PH        ! maximum canopy height                 (m)
00052 REAL, DIMENSION(KI),      INTENT(IN)    :: PZFORC    ! height of wind forcing                (m)
00053 REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PZ        ! heights of canopy levels              (m)
00054 REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PZF       ! heights of bottom of canopy levels    (m)
00055 REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PDZ       ! depth   of canopy levels              (m)
00056 REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: PDZF      ! depth between canopy levels           (m)
00057 !
00058 !*       0.2   Declarations of local variables
00059 !              -------------------------------
00060 !
00061 INTEGER, DIMENSION(KI)      :: IL     ! latest level below forcing height
00062 INTEGER, DIMENSION(KI,KLVL) :: ILEVEL ! to test if level is high enough
00063 !
00064 INTEGER :: ICOUNT                 ! number of layers above forcing height, these must be changed
00065 INTEGER :: JLAYER                 ! loop counter on layers
00066 INTEGER :: JI                     ! loop counter on points
00067 REAL    :: ZZTOP                  ! altitude of top of the grid of the initial level
00068 !                                 ! just below forcing height
00069 REAL    :: ZDZ                    ! difference of height between new levels
00070 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00071 !
00072 !-------------------------------------------------------------------------------
00073 !
00074 IF (LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',0,ZHOOK_HANDLE)
00075 IF(ALL(PZ(:,KLVL)==PZFORC(:)) .AND. LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',1,ZHOOK_HANDLE)
00076 IF(ALL(PZ(:,KLVL)==PZFORC(:))) RETURN
00077 !
00078 !-------------------------------------------------------------------------------
00079 !
00080 !*    1.  set upper level to forcing height
00081 !         ---------------------------------
00082 !
00083 PZ(:,KLVL) = PZFORC(:)
00084 !
00085 !*    2.  all canopy levels remaining above forcing height are relocated below
00086 !         --------------------------------------------------------------------
00087 !
00088 ! determination of levels below forcing height, low enough
00089 ILEVEL=0
00090 DO JI=1,KI
00091   DO JLAYER=1,KLVL-1
00092     IF( PZFORC(JI) > PZF(JI,JLAYER+1) + 0.25 * PDZ(JI,JLAYER) .AND. &
00093         PZ(JI,JLAYER) < PZFORC(JI) ) ILEVEL(JI,JLAYER) = JLAYER
00094   ENDDO
00095   ! determination of latest level from the ones selected before
00096   IL(JI)=MAXVAL(ILEVEL(JI,1:KLVL-1))
00097   !
00098   ICOUNT = KLVL-IL(JI)-1
00099   !
00100   !* determination grid top of this level
00101   ZZTOP = PZF(JI,IL(JI)+1) ! ZZTOP=0 for IL=0
00102   ZDZ   = 2. * ( PZ(JI,KLVL)-ZZTOP ) / ( 2*ICOUNT+1 )
00103   DO JLAYER=1,ICOUNT
00104     PZ(JI,JLAYER+IL(JI)) = ZZTOP + (JLAYER-0.5) * ZDZ
00105   END DO
00106 END DO
00107 !
00108 !*    3.  New grid characteristics
00109 !         ------------------------
00110 !
00111  CALL CANOPY_GRID(KI,KLVL,PZ,PZF,PDZ,PDZF)
00112 !
00113 !
00114 !*    5.  at least one canopy level in addition to forcing level must be above canopy top
00115 !         -------------------------------------------------------------------------------
00116 !
00117 DO JI=1,KI
00118   !
00119   !* tests if the level below forcing height is high enough above canopy
00120   IF(PZF(JI,KLVL-1) < PH(JI) ) THEN
00121     !
00122     !* sets bottom of grid box that is below the forcing level one at canopy height
00123     !
00124     PZF(JI,KLVL-1) = PH(JI)
00125     !
00126     !* rebuilds vertical grid from the bottom of each grid
00127     !
00128     PZ(JI,KLVL-2) = 0.5 * ( PZF(JI,KLVL-2) + PZF(JI,KLVL-1) )
00129     PZ(JI,KLVL-1) = ( 2.* PZF(JI,KLVL-1) + PZ (JI,KLVL) ) /3.
00130   END IF
00131 END DO
00132 !
00133 !*    6.  Final grid characteristics
00134 !         --------------------------
00135 !
00136  CALL CANOPY_GRID(KI,KLVL,PZ,PZF,PDZ,PDZF)
00137 !
00138 IF (LHOOK) CALL DR_HOOK('CANOPY_GRID_UPDATE',1,ZHOOK_HANDLE)
00139 !
00140 !-------------------------------------------------------------------------------
00141 END SUBROUTINE CANOPY_GRID_UPDATE