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

Go to the documentation of this file.
00001 !     #################################################
00002       SUBROUTINE PUT_ZS_INLAND_WATER_n(HPROGRAM,KI,PZS,HWATER)
00003 !     #################################################
00004 !
00005 !!****  *PUT_ZS_INLAND_WATER_n* - routine to modify inland water 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 !
00040 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00041 USE PARKIND1  ,ONLY : JPRB
00042 !
00043 USE MODI_ABOR1_SFX
00044 !
00045 IMPLICIT NONE
00046 !
00047 !*       0.1   Declarations of arguments
00048 !              -------------------------
00049 !
00050  CHARACTER(LEN=6),    INTENT(IN)  :: HWATER ! name of the scheme for inland water
00051  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM
00052 INTEGER,             INTENT(IN)  :: KI      ! horizontal dim. of cover
00053 REAL, DIMENSION(KI), INTENT(IN)  :: PZS     ! orography
00054 !
00055 !
00056 !*       0.2   Declarations of local variables
00057 !              -------------------------------
00058 !
00059 INTEGER :: ILUOUT
00060 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00061 !
00062 IF (LHOOK) CALL DR_HOOK('PUT_ZS_INLAND_WATER_N',0,ZHOOK_HANDLE)
00063 IF (HWATER=='FLAKE ') THEN
00064    CALL PUT_ZS_FLAKE_n
00065 ELSE
00066    CALL PUT_ZS_WATFLX_n
00067 END IF
00068 !
00069 IF (LHOOK) CALL DR_HOOK('PUT_ZS_INLAND_WATER_N',1,ZHOOK_HANDLE)
00070 CONTAINS
00071 !
00072 !------------------------------------------------------------------------------
00073 !------------------------------------------------------------------------------
00074 !
00075 SUBROUTINE PUT_ZS_WATFLX_n
00076 !
00077 USE MODD_WATFLUX_n,     ONLY : XZS
00078 !
00079 !-------------------------------------------------------------------------------
00080 
00081 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00082 
00083 IF (LHOOK) CALL DR_HOOK('PUT_ZS_WATFLX_N',0,ZHOOK_HANDLE)
00084  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00085 !-------------------------------------------------------------------------------
00086 !
00087 IF ( SIZE(PZS) /= SIZE(XZS) ) THEN
00088   WRITE(ILUOUT,*) 'try to get ZS field from atmospheric model, but size is not correct'
00089   WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PZS) :', SIZE(PZS)
00090   WRITE(ILUOUT,*) 'size of field for inland water (WATFLX)         (XZS) :', SIZE(XZS)
00091   CALL ABOR1_SFX('PUT_ZS_INLAND_WATERN (WATFLX): GET ZS FROM ATMOSPHERIC MODEL: SIZE NOT CORRECT')
00092 ELSE
00093   XZS = PZS
00094 END IF
00095 IF (LHOOK) CALL DR_HOOK('PUT_ZS_WATFLX_N',1,ZHOOK_HANDLE)
00096 !
00097 END SUBROUTINE PUT_ZS_WATFLX_n
00098 !
00099 !------------------------------------------------------------------------------
00100 !------------------------------------------------------------------------------
00101 !
00102 SUBROUTINE PUT_ZS_FLAKE_n
00103 !
00104 USE MODD_FLAKE_n,     ONLY : XZS
00105 !
00106 !-------------------------------------------------------------------------------
00107 
00108 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00109 
00110 IF (LHOOK) CALL DR_HOOK('PUT_ZS_FLAKE_N',0,ZHOOK_HANDLE)
00111  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00112 !-------------------------------------------------------------------------------
00113 !
00114 IF ( SIZE(PZS) /= SIZE(XZS) ) THEN
00115   WRITE(ILUOUT,*) 'try to get ZS field from atmospheric model, but size is not correct'
00116   WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (PZS) :', SIZE(PZS)
00117   WRITE(ILUOUT,*) 'size of field for inland water (FLAKE)          (XZS) :', SIZE(XZS)
00118   CALL ABOR1_SFX('PUT_ZS_INLAND_WATERN (FLAKE): GET ZS FROM ATMOSPHERIC MODEL: SIZE NOT CORRECT')
00119 ELSE
00120   XZS = PZS
00121 END IF
00122 IF (LHOOK) CALL DR_HOOK('PUT_ZS_FLAKE_N',1,ZHOOK_HANDLE)
00123 !
00124 END SUBROUTINE PUT_ZS_FLAKE_n
00125 !==============================================================================
00126 !
00127 END SUBROUTINE PUT_ZS_INLAND_WATER_n