|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_ISBA_GRIB(HPROGRAM,HSURF,HFILE,KLUOUT,PFIELD) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_ISBA_GRIB* - initializes ISBA fields from operational GRIB 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! V. Masson 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 01/2004 00024 !! S. Riette 04/2010 READ_GRIB_WGI_ECMWF interface changed 00025 !!------------------------------------------------------------------ 00026 ! 00027 USE MODE_READ_GRIB 00028 ! 00029 USE MODD_TYPE_DATE_SURF 00030 ! 00031 USE MODI_PREP_GRIB_GRID 00032 USE MODI_INTERP_GRID 00033 ! 00034 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE 00035 USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF 00036 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00037 USE MODD_SURF_PAR, ONLY : XUNDEF 00038 USE MODD_GRID_GRIB, ONLY : CGRIB_FILE, NNI 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 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00051 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00052 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file 00053 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00054 REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally 00055 ! 00056 !* 0.2 declarations of local variables 00057 ! 00058 TYPE (DATE_TIME) :: TZTIME_GRIB ! current date and time 00059 CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates 00060 REAL, DIMENSION(:) , POINTER :: ZMASK => NULL() ! Land mask 00061 REAL, DIMENSION(:,:), POINTER :: ZFIELD => NULL() ! field read 00062 REAL, DIMENSION(:), POINTER :: ZFIELD1D => NULL() ! field read 00063 REAL, DIMENSION(:,:), POINTER :: ZD => NULL() ! depth of field in the soil 00064 INTEGER :: JVEGTYPE ! loop counter on vegtypes 00065 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00066 ! 00067 !------------------------------------------------------------------------------------- 00068 ! 00069 !* 1. Reading of grid 00070 ! --------------- 00071 ! 00072 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_GRIB',0,ZHOOK_HANDLE) 00073 ! 00074 IF (TRIM(HFILE).NE.CGRIB_FILE) CGRIB_FILE="" 00075 ! 00076 CALL PREP_GRIB_GRID(HFILE,KLUOUT,YINMODEL,CINGRID_TYPE,TZTIME_GRIB) 00077 ! 00078 CALL READ_GRIB_LAND_MASK(HFILE,KLUOUT,YINMODEL,ZMASK) 00079 ! 00080 ! 00081 !* 2. Reading of field 00082 ! ---------------- 00083 ! 00084 !* 3. Transformation into physical quantity to be interpolated 00085 ! -------------------------------------------------------- 00086 ! 00087 SELECT CASE(HSURF) 00088 ! 00089 !* 3.1 Profile of temperature in the soil 00090 ! 00091 CASE('TG ') 00092 !* reading of the profile and its depth definition 00093 SELECT CASE(YINMODEL) 00094 CASE('ECMWF ') 00095 CALL READ_GRIB_TG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00096 CASE('ARPEGE','ALADIN','MOCAGE') 00097 CALL READ_GRIB_TG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00098 CASE('HIRLAM') 00099 CALL READ_GRIB_TG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00100 END SELECT 00101 CALL SOIL_PROFILE_GRIB 00102 00103 CASE('WG ') 00104 !* reading of the profile and its depth definition 00105 SELECT CASE(YINMODEL) 00106 CASE('ECMWF ') 00107 CALL READ_GRIB_WG_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00108 CASE('ARPEGE','ALADIN','MOCAGE') 00109 CALL READ_GRIB_WG_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00110 CASE('HIRLAM') 00111 CALL READ_GRIB_WG_HIRLAM(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00112 END SELECT 00113 CALL SOIL_PROFILE_GRIB 00114 00115 !* 3.3 Profile of soil ice content 00116 00117 CASE('WGI ') 00118 !* reading of the profile and its depth definition 00119 SELECT CASE(YINMODEL) 00120 CASE('ECMWF ') 00121 CALL READ_GRIB_WGI_ECMWF(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00122 CASE('ARPEGE','ALADIN','MOCAGE') 00123 CALL READ_GRIB_WGI_METEO_FRANCE(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD,ZD) 00124 CASE('HIRLAM') 00125 CALL READ_GRIB_WGI_HIRLAM(HFILE,KLUOUT,ZFIELD,ZD) 00126 END SELECT 00127 CALL SOIL_PROFILE_GRIB 00128 ! 00129 !* 3.4 Water content intercepted on leaves, LAI 00130 ! 00131 CASE('WR ') 00132 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00133 PFIELD(:,:,:) = XWR_DEF 00134 ! 00135 CASE('LAI ') 00136 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00137 PFIELD(:,:,:) = XUNDEF 00138 ! 00139 ! 00140 !* 3.5 Other fields 00141 ! 00142 CASE('ZS ') 00143 CALL READ_GRIB_ZS_LAND(HFILE,KLUOUT,YINMODEL,ZMASK,ZFIELD1D) 00144 ALLOCATE(PFIELD(SIZE(ZFIELD1D,1),1,1)) 00145 PFIELD(:,1,1)=ZFIELD1D(:) 00146 DEALLOCATE(ZFIELD1D) 00147 00148 CASE DEFAULT 00149 CALL ABOR1_SFX('PREP_ISBA_GRIB: OPTION NOT SUPPORTED - '//HSURF) 00150 00151 END SELECT 00152 ! 00153 DEALLOCATE(ZMASK) 00154 ! 00155 !* 4. Interpolation method 00156 ! -------------------- 00157 ! 00158 CINTERP_TYPE='HORIBL' 00159 ! 00160 !------------------------------------------------------------------------------------- 00161 !------------------------------------------------------------------------------------- 00162 ! 00163 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_GRIB',1,ZHOOK_HANDLE) 00164 CONTAINS 00165 ! 00166 !------------------------------------------------------------------------------------- 00167 !------------------------------------------------------------------------------------- 00168 SUBROUTINE SOIL_PROFILE_GRIB 00169 !------------------------------------------------------------------------------------- 00170 ! 00171 REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT ! work array 00172 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00173 ! 00174 !------------------------------------------------------------------------------------- 00175 ! 00176 ! 00177 !* interpolation on fine vertical grid 00178 IF (LHOOK) CALL DR_HOOK('SOIL_PROFILE_GRIB',0,ZHOOK_HANDLE) 00179 ALLOCATE(ZOUT (SIZE(ZFIELD,1),SIZE(XGRID_SOIL))) 00180 CALL INTERP_GRID(ZD,ZFIELD,XGRID_SOIL,ZOUT) 00181 ! 00182 !* extends definition to all vegtypes. 00183 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),NVEGTYPE)) 00184 DO JVEGTYPE=1,NVEGTYPE 00185 PFIELD(:,:,JVEGTYPE)=ZOUT(:,:) 00186 END DO 00187 !* end 00188 DEALLOCATE(ZOUT) 00189 DEALLOCATE(ZFIELD) 00190 DEALLOCATE(ZD) 00191 IF (LHOOK) CALL DR_HOOK('SOIL_PROFILE_GRIB',1,ZHOOK_HANDLE) 00192 00193 END SUBROUTINE SOIL_PROFILE_GRIB 00194 ! 00195 !------------------------------------------------------------------------------------- 00196 END SUBROUTINE PREP_ISBA_GRIB
1.8.0
