SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/subscale_z0eff_1d.F90
Go to the documentation of this file.
00001 !     ######################################################################
00002       SUBROUTINE SUBSCALE_Z0EFF_1D(PAOSIP,PAOSIM,PAOSJP,PAOSJM,            &
00003                                 PHO2IP,PHO2IM,PHO2JP,PHO2JM,PZ0VEG,        &
00004                                 PZ0EFFIP,PZ0EFFIM,PZ0EFFJP,PZ0EFFJM,       &
00005                                 OMASK                                      )
00006 !     ######################################################################
00007 !
00008 !!*SUBSCALE_Z0EFF  computes an effective roughness lenght deduced
00009 !!                 from the subgrid-scale orography.
00010 !!
00011 !!
00012 !!    METHOD
00013 !!    ------
00014 !!    See M.Georgelin and al. July 1994, Monthly Weather Review.
00015 !!   
00016 !!    EXTERNAL
00017 !!    --------
00018 !!
00019 !!    IMPLICIT ARGUMENTS
00020 !!    ------------------
00021 !!
00022 !!
00023 !!    REFERENCE
00024 !!    ---------
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!
00029 !!    M. Georgelin      Laboratoire d'Aerologie
00030 !!
00031 !!    MODIFICATION
00032 !!    ------------
00033 !!
00034 !!    Original    18/12/95
00035 !!                22/12/97 (V Masson) call with dummy arguments
00036 !!                24/08/12 (B Decharme) optimization (loop into subroutine)
00037 !!
00038 !----------------------------------------------------------------------------
00039 !
00040 !*    0.     DECLARATION
00041 !            -----------
00042 !
00043 USE MODD_SURF_PAR, ONLY : XUNDEF
00044 USE MODD_CSTS,     ONLY : XKARMAN
00045 USE MODD_ISBA_PAR, ONLY : XCDZ0EFF
00046 !
00047 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00048 USE PARKIND1  ,ONLY : JPRB
00049 !
00050 IMPLICIT NONE
00051 !
00052 !*    0.1    Declaration of dummy arguments
00053 !            ------------------------------
00054 !
00055 REAL, DIMENSION(:), INTENT(IN)  :: PAOSIP  ! A/S for increasing x
00056 REAL, DIMENSION(:), INTENT(IN)  :: PAOSIM  ! A/S for decreasing x
00057 REAL, DIMENSION(:), INTENT(IN)  :: PAOSJP  ! A/S for increasing y
00058 REAL, DIMENSION(:), INTENT(IN)  :: PAOSJM  ! A/S for decreasing y
00059 REAL, DIMENSION(:), INTENT(IN)  :: PHO2IP  ! h/2 for increasing x
00060 REAL, DIMENSION(:), INTENT(IN)  :: PHO2IM  ! h/2 for decreasing x
00061 REAL, DIMENSION(:), INTENT(IN)  :: PHO2JP  ! h/2 for increasing y
00062 REAL, DIMENSION(:), INTENT(IN)  :: PHO2JM  ! h/2 for decreasing y
00063 REAL, DIMENSION(:), INTENT(IN)  :: PZ0VEG  ! vegetation roughness length
00064 !
00065 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIP! roughness length for increasing x
00066 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFIM! roughness length for decreasing x
00067 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJP! roughness length for increasing y
00068 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0EFFJM! roughness length for decreasing y
00069 !
00070 LOGICAL, DIMENSION(:), INTENT(IN), OPTIONAL :: OMASK ! mask where computations
00071                                                        ! are done
00072 !
00073 !*    0.2    Declaration of other local variables
00074 !            ------------------------------------
00075 !
00076 LOGICAL, DIMENSION(SIZE(PZ0EFFIM)) :: GMASK
00077 !
00078 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00079 !----------------------------------------------------------------------------
00080 !
00081 IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D',0,ZHOOK_HANDLE)
00082 IF (PRESENT(OMASK)) THEN
00083   GMASK=OMASK
00084 ELSE
00085   GMASK=(PAOSIP/=XUNDEF)    ! computations always performed where SSO data exist
00086   PZ0EFFIP = XUNDEF
00087   PZ0EFFIM = XUNDEF
00088   PZ0EFFJP = XUNDEF
00089   PZ0EFFJM = XUNDEF
00090 END IF
00091 !
00092 !*    1.     Computations from A/S and h/2
00093 !            -----------------------------
00094 !      
00095  CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2JP(:),PAOSJP(:),PZ0EFFJP(:))
00096  CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2JM(:),PAOSJM(:),PZ0EFFJM(:))
00097  CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2IM(:),PAOSIM(:),PZ0EFFIM(:))
00098  CALL GET_Z0EFF(GMASK(:),PZ0VEG(:),PHO2IP(:),PAOSIP(:),PZ0EFFIP(:))
00099 !
00100 IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D',1,ZHOOK_HANDLE)
00101 !-------------------------------------------------------------------------------
00102 CONTAINS
00103 !
00104 SUBROUTINE GET_Z0EFF(OCOMPUT,PZ0,PHO,PAO,PZ0EFF)
00105 !
00106 IMPLICIT NONE
00107 !
00108 LOGICAL, DIMENSION(:), INTENT(IN) :: OCOMPUT
00109 REAL,    DIMENSION(:), INTENT(IN) :: PZ0
00110 REAL,    DIMENSION(:), INTENT(IN) :: PHO
00111 REAL,    DIMENSION(:), INTENT(IN) :: PAO
00112 REAL,    DIMENSION(:), INTENT(OUT):: PZ0EFF
00113 !
00114 LOGICAL, DIMENSION(SIZE(PZ0)) :: LWORK1
00115 !
00116 REAL    :: ZLOC1,ZLOC2,ZLOC3
00117 INTEGER :: JJ, INI
00118 !
00119 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00120 !
00121 IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D:GET_ZOEFF',0,ZHOOK_HANDLE)
00122 !
00123 INI=SIZE(PZ0)
00124 !
00125 LWORK1(:)=(PHO(:)>PZ0(:).AND.(PZ0(:)/=0.0.OR.PAO(:)/=0.0))
00126 !
00127 DO JJ=1,INI
00128   IF (OCOMPUT(JJ)) THEN
00129     IF (LWORK1(JJ)) THEN 
00130       ZLOC1  = (XCDZ0EFF/(2.*XKARMAN**2))*PAO(JJ)
00131       IF ( PZ0(JJ) > 0. ) THEN
00132         ZLOC2 = 1./(ALOG(PHO(JJ)/PZ0(JJ)))**2
00133       ELSE
00134         ZLOC2 = 0.
00135       ENDIF 
00136       ZLOC3  = SQRT(1./(ZLOC1+ZLOC2))
00137       PZ0EFF(JJ) = PHO(JJ) * EXP(-ZLOC3)
00138     ELSE
00139       PZ0EFF(JJ) = PZ0(JJ) 
00140     ENDIF
00141   ENDIF
00142 ENDDO
00143 !
00144 IF (LHOOK) CALL DR_HOOK('SUBSCALE_Z0EFF_1D:GET_ZOEFF',1,ZHOOK_HANDLE)
00145 !
00146 END SUBROUTINE GET_Z0EFF
00147 ! 
00148 END SUBROUTINE SUBSCALE_Z0EFF_1D