SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE GET_LCOVER_n(HPROGRAM,KCOVER,OCOVER) 00003 ! ######################################## 00004 ! 00005 !!**** *GET_LCOVER_n* - routine to get some surface fields 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 !! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! EXTERNAL 00014 !! -------- 00015 !! 00016 !! 00017 !! IMPLICIT ARGUMENTS 00018 !! ------------------ 00019 !! 00020 !! REFERENCE 00021 !! --------- 00022 !! 00023 !! 00024 !! AUTHOR 00025 !! ------ 00026 !! V. Masson *Meteo France* 00027 !! 00028 !! MODIFICATIONS 00029 !! ------------- 00030 !! Original 01/2004 00031 !------------------------------------------------------------------------------- 00032 ! 00033 !* 0. DECLARATIONS 00034 ! ------------ 00035 ! 00036 USE MODI_GET_LUOUT 00037 ! 00038 USE MODD_SURF_ATM_n, ONLY : LCOVER 00039 ! 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 USE MODI_ABOR1_SFX 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 Declarations of arguments 00049 ! ------------------------- 00050 ! 00051 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM 00052 INTEGER, INTENT(IN) :: KCOVER ! number of covers 00053 LOGICAL, DIMENSION(KCOVER), INTENT(OUT) :: OCOVER ! cover types 00054 ! 00055 ! 00056 !* 0.2 Declarations of local variables 00057 ! ------------------------------- 00058 ! 00059 INTEGER :: ILUOUT 00060 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00061 ! 00062 !------------------------------------------------------------------------------- 00063 IF (LHOOK) CALL DR_HOOK('GET_LCOVER_N',0,ZHOOK_HANDLE) 00064 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00065 !------------------------------------------------------------------------------- 00066 ! 00067 IF ( SIZE(OCOVER) /= SIZE(LCOVER) ) THEN 00068 WRITE(ILUOUT,*) 'try to get COVER field from atmospheric model, but size is not correct' 00069 WRITE(ILUOUT,*) 'size of field expected by the atmospheric model (OCOVER) :', SIZE(OCOVER) 00070 WRITE(ILUOUT,*) 'size of field inthe surface (LCOVER) :', SIZE(LCOVER) 00071 CALL ABOR1_SFX('GET_LCOVERN: (1) LCOVER SIZE NOT CORRECT') 00072 ELSE 00073 OCOVER = LCOVER 00074 END IF 00075 IF (LHOOK) CALL DR_HOOK('GET_LCOVER_N',1,ZHOOK_HANDLE) 00076 ! 00077 !============================================================================== 00078 ! 00079 END SUBROUTINE GET_LCOVER_n