SURFEX v7.3
General documentation of Surfex
 All Classes Files Functions Variables Typedefs
/home/dasprezs/EXPORT_v7_3/src/SURFEX/put_zs_naturen.F90
Go to the documentation of this file.
00001 !     ###########################################
00002       SUBROUTINE PUT_ZS_NATURE_n(HPROGRAM,KI,PZS)
00003 !     ###########################################
00004 !
00005 !!****  *PUT_ZS_SURF_ATM_n* - routine to modify nature oropgraphy using atmospheric
00006 !                    model orography
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 !!      P. Le Moigne   *Meteo France*   
00028 !!
00029 !!    MODIFICATIONS
00030 !!    -------------
00031 !!      Original    05/2007
00032 !-------------------------------------------------------------------------------
00033 !
00034 !*       0.    DECLARATIONS
00035 !              ------------
00036 !
00037 USE MODI_GET_LUOUT
00038 !
00039 USE MODD_ISBA_n,     ONLY : XZS
00040 !
00041 !
00042 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00043 USE PARKIND1  ,ONLY : JPRB
00044 !
00045 USE MODI_ABOR1_SFX
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*       0.1   Declarations of arguments
00050 !              -------------------------
00051 !
00052  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM
00053 INTEGER,             INTENT(IN)  :: KI      ! horizontal dim. of cover
00054 REAL, DIMENSION(KI), INTENT(IN)  :: PZS     ! orography
00055 !
00056 !
00057 !*       0.2   Declarations of local variables
00058 !              -------------------------------
00059 !
00060 INTEGER :: ILUOUT
00061 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00062 !
00063 !-------------------------------------------------------------------------------
00064 IF (LHOOK) CALL DR_HOOK('PUT_ZS_NATURE_N',0,ZHOOK_HANDLE)
00065  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00066 !-------------------------------------------------------------------------------
00067 !
00068 IF ( SIZE(PZS) /= SIZE(XZS) ) THEN
00069   WRITE(ILUOUT,*) 'try to get ZS field from atmospheric model, but size is not correct'
00070   WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PZS) :', SIZE(PZS)
00071   WRITE(ILUOUT,*) 'size of field over nature                       (XZS) :', SIZE(XZS)
00072   CALL ABOR1_SFX('PUT_ZS_NATUREN: GET ZS FROM ATMOSPHERIC MODEL: SIZE NOT CORRECT')
00073 ELSE
00074   XZS = PZS
00075 END IF
00076 IF (LHOOK) CALL DR_HOOK('PUT_ZS_NATURE_N',1,ZHOOK_HANDLE)
00077 !
00078 !==============================================================================
00079 !
00080 END SUBROUTINE PUT_ZS_NATURE_n