SURFEX v7.3
General documentation of Surfex
|
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