|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_TEB_GARDEN_EXTERN* - 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 !!------------------------------------------------------------------ 00025 ! 00026 00027 ! 00028 USE MODE_READ_EXTERN 00029 ! 00030 USE MODD_TYPE_DATE_SURF 00031 ! 00032 USE MODI_PREP_GRID_EXTERN 00033 USE MODI_READ_SURF 00034 USE MODI_INTERP_GRID 00035 USE MODI_OPEN_AUX_IO_SURF 00036 USE MODI_CLOSE_AUX_IO_SURF 00037 USE MODI_READ_TEB_PATCH 00038 USE MODI_GET_CURRENT_TEB_PATCH 00039 USE MODI_TOWN_PRESENCE 00040 ! 00041 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE 00042 USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF 00043 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00044 USE MODD_SURF_PAR, ONLY : XUNDEF 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 USE MODI_PUT_ON_ALL_VEGTYPES 00050 ! 00051 IMPLICIT NONE 00052 ! 00053 !* 0.1 declarations of arguments 00054 ! 00055 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00056 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00057 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file 00058 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file 00059 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file 00060 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file 00061 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00062 REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid) 00063 ! 00064 !* 0.2 declarations of local variables 00065 ! 00066 CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read 00067 INTEGER :: IRESP ! reading return code 00068 INTEGER :: INI ! total 1D dimension 00069 INTEGER :: IPATCH ! number of patch 00070 ! 00071 REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches 00072 REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch 00073 REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil 00074 REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch 00075 REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT ! 00076 INTEGER :: JPATCH ! loop counter for patch 00077 INTEGER :: ITEB_PATCH ! number of TEB patches in file 00078 INTEGER :: ICURRENT_PATCH ! current TEB patch to be initialized 00079 INTEGER :: IVERSION ! SURFEX version 00080 INTEGER :: IBUGFIX ! SURFEX bug version 00081 LOGICAL :: GOLD_NAME ! old name flag for temperatures 00082 CHARACTER(LEN=12) :: YSURF ! type of field 00083 CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch 00084 LOGICAL :: GTEB ! flag if TEB fields are present 00085 LOGICAL :: GGARDEN ! T if gardens are present in the file 00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00087 ! 00088 !------------------------------------------------------------------------------ 00089 ! 00090 !* 1. Preparation of IO for reading in the file 00091 ! ----------------------------------------- 00092 ! 00093 !* Note that all points are read, even those without physical meaning. 00094 ! These points will not be used during the horizontal interpolation step. 00095 ! Their value must be defined as XUNDEF. 00096 ! 00097 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',0,ZHOOK_HANDLE) 00098 ! 00099 !------------------------------------------------------------------------------ 00100 ! 00101 !* 2. Reading of grid 00102 ! --------------- 00103 ! 00104 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ') 00105 ! 00106 !* reading of version of the file being read 00107 CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP) 00108 CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP) 00109 GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3)) 00110 ! 00111 CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI) 00112 ! 00113 !* reads if TEB fields exist in the input file 00114 CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB) 00115 ! 00116 IF (GTEB) THEN 00117 CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH) 00118 CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH) 00119 YPATCH=' ' 00120 IF (ITEB_PATCH>1) THEN 00121 WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_' 00122 END IF 00123 END IF 00124 ! 00125 !--------------------------------------------------------------------------------------- 00126 ! 00127 !* 3. Transformation into physical quantity to be interpolated 00128 ! -------------------------------------------------------- 00129 ! 00130 SELECT CASE(HSURF) 00131 ! 00132 !* 3. Orography 00133 ! --------- 00134 ! 00135 CASE('ZS ') 00136 ALLOCATE(PFIELD(INI,1,1)) 00137 YRECFM='ZS' 00138 CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A') 00139 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00140 ! 00141 !-------------------------------------------------------------------------- 00142 ! 00143 ! 00144 !* 3.1 Profile of temperature, water or ice in the soil 00145 ! 00146 CASE('TG ','WG ','WGI ') 00147 !* choice if one reads garden fields (if present) or ISBA fields 00148 GGARDEN = .FALSE. 00149 IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP) 00150 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00151 IF (GGARDEN) THEN 00152 YSURF = 'GD_'//HSURF(1:3) 00153 IF (GOLD_NAME) YSURF = 'TWN_'//HSURF(1:3) 00154 YSURF = YPATCH//YSURF 00155 ELSE 00156 YSURF = HSURF 00157 END IF 00158 YSURF=ADJUSTL(YSURF) 00159 !* reading of the profile and its depth definition 00160 CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,& 00161 HSURF,YSURF,ZFIELD,ZD) 00162 ! 00163 ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2))) 00164 ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2))) 00165 ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL))) 00166 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3))) 00167 ! 00168 DO JPATCH=1,SIZE(ZFIELD,3) 00169 ZFIELD1(:,:)=ZFIELD(:,:,JPATCH) 00170 ZD1(:,:)=ZD(:,:,JPATCH) 00171 CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT) 00172 PFIELD(:,:,JPATCH)=ZOUT(:,:) 00173 END DO 00174 ! 00175 DEALLOCATE(ZFIELD) 00176 DEALLOCATE(ZOUT) 00177 DEALLOCATE(ZFIELD1) 00178 DEALLOCATE(ZD) 00179 ! 00180 !-------------------------------------------------------------------------- 00181 ! 00182 !* 3.4 Water content intercepted on leaves, LAI 00183 ! 00184 CASE('WR ') 00185 ALLOCATE(PFIELD(INI,1,NVEGTYPE)) 00186 !* choice if one reads garden fields (if present) or ISBA fields 00187 GGARDEN = .FALSE. 00188 IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP) 00189 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00190 IF (GGARDEN) THEN 00191 IPATCH = 1 00192 YRECFM = 'GD_WR' 00193 IF (GOLD_NAME) YRECFM = 'TWN_WR' 00194 YRECFM = YPATCH//YRECFM 00195 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ') 00196 ELSE 00197 YRECFM = 'PATCH_NUMBER' 00198 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE') 00199 CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP) 00200 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00201 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE') 00202 YRECFM = 'WR' 00203 END IF 00204 YRECFM=ADJUSTL(YRECFM) 00205 00206 ALLOCATE(ZFIELD(INI,1,IPATCH)) 00207 CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A') 00208 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00209 CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD) 00210 DEALLOCATE(ZFIELD) 00211 ! 00212 CASE('LAI ') 00213 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00214 ALLOCATE(PFIELD(INI,1,NVEGTYPE)) 00215 PFIELD(:,:,:) = XUNDEF 00216 ! 00217 END SELECT 00218 ! 00219 ! 00220 !--------------------------------------------------------------------------- 00221 ! 00222 !* 6. End of IO 00223 ! --------- 00224 ! 00225 IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',1,ZHOOK_HANDLE) 00226 ! 00227 !--------------------------------------------------------------------------- 00228 !--------------------------------------------------------------------------- 00229 END SUBROUTINE PREP_TEB_GARDEN_EXTERN
1.8.0
