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