|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_ISBA_BUFFER(HPROGRAM,HSURF,KLUOUT,PFIELD) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_ISBA_BUFFER* - initializes ISBA fields from operational BUFFER 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! S. Malardel 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 03/2005 00024 !!------------------------------------------------------------------ 00025 ! 00026 00027 ! 00028 USE MODE_READ_BUFFER 00029 ! 00030 USE MODD_TYPE_DATE_SURF 00031 ! 00032 USE MODI_PREP_BUFFER_GRID 00033 USE MODI_INTERP_GRID 00034 ! 00035 USE MODD_PREP, ONLY : CINTERP_TYPE 00036 USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF 00037 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00038 USE MODD_SURF_PAR, ONLY : XUNDEF 00039 USE MODD_GRID_BUFFER, ONLY : NNI 00040 ! 00041 ! 00042 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00043 USE PARKIND1 ,ONLY : JPRB 00044 ! 00045 IMPLICIT NONE 00046 ! 00047 !* 0.1 declarations of arguments 00048 ! 00049 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00050 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00051 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00052 REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally 00053 ! 00054 !* 0.2 declarations of local variables 00055 ! 00056 TYPE (DATE_TIME) :: TZTIME_BUF ! current date and time 00057 CHARACTER(LEN=6) :: YINMODEL ! model from which buffer originates 00058 REAL, DIMENSION(:,:), POINTER :: ZFIELD ! field read 00059 REAL, DIMENSION(:), POINTER :: ZFIELD1D ! field read 00060 REAL, DIMENSION(:,:), POINTER :: ZD ! depth of field in the soil 00061 INTEGER :: JVEGTYPE ! loop counter on vegtypes 00062 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00063 ! 00064 !------------------------------------------------------------------------------------- 00065 ! 00066 !* 1. Reading of grid 00067 ! --------------- 00068 ! 00069 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_BUFFER',0,ZHOOK_HANDLE) 00070 CALL PREP_BUFFER_GRID(KLUOUT,YINMODEL,TZTIME_BUF) 00071 00072 ! 00073 !* 2. Reading of field 00074 ! ---------------- 00075 ! 00076 !* 3. Transformation into physical quantity to be interpolated 00077 ! -------------------------------------------------------- 00078 ! 00079 SELECT CASE(HSURF) 00080 ! 00081 !* 3.1 Profile of temperature in the soil 00082 ! 00083 CASE('TG ') 00084 !* reading of the profile and its depth definition 00085 SELECT CASE(YINMODEL) 00086 CASE('ALADIN') 00087 CALL READ_BUFFER_TG(KLUOUT,YINMODEL,ZFIELD,ZD) 00088 END SELECT 00089 00090 CALL SOIL_PROFILE_BUFFER 00091 00092 CASE('WG ') 00093 !* reading of the profile and its depth definition 00094 SELECT CASE(YINMODEL) 00095 CASE('ARPEGE','ALADIN','MOCAGE') 00096 CALL READ_BUFFER_WG(KLUOUT,YINMODEL,ZFIELD,ZD) 00097 END SELECT 00098 CALL SOIL_PROFILE_BUFFER 00099 00100 00101 !* 3.3 Profile of soil ice content 00102 00103 CASE('WGI ') 00104 !* reading of the profile and its depth definition 00105 SELECT CASE(YINMODEL) 00106 CASE('ALADIN') 00107 CALL READ_BUFFER_WGI(KLUOUT,YINMODEL,ZFIELD,ZD) 00108 END SELECT 00109 CALL SOIL_PROFILE_BUFFER 00110 ! 00111 !* 3.4 Water content intercepted on leaves, LAI 00112 ! 00113 CASE('WR ') 00114 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00115 PFIELD(:,:,:) = XWR_DEF 00116 ! 00117 CASE('LAI ') 00118 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00119 PFIELD(:,:,:) = XUNDEF 00120 ! 00121 ! 00122 !* 3.5 Other fields 00123 ! 00124 CASE('ZS ') 00125 !GH 00126 ! CALL READ_BUFFER_ZS_LAND(KLUOUT,YINMODEL,ZFIELD1D) 00127 CALL READ_BUFFER_ZS(KLUOUT,YINMODEL,ZFIELD1D) 00128 !END GH 00129 ALLOCATE(PFIELD(SIZE(ZFIELD1D,1),1,1)) 00130 PFIELD(:,1,1)=ZFIELD1D(:) 00131 DEALLOCATE(ZFIELD1D) 00132 END SELECT 00133 ! 00134 !* 4. Interpolation method 00135 ! -------------------- 00136 ! 00137 CINTERP_TYPE='BUFFER' 00138 ! 00139 ! 00140 !------------------------------------------------------------------------------------- 00141 !------------------------------------------------------------------------------------- 00142 ! 00143 IF (LHOOK) CALL DR_HOOK('PREP_ISBA_BUFFER',1,ZHOOK_HANDLE) 00144 CONTAINS 00145 ! 00146 !------------------------------------------------------------------------------------- 00147 !------------------------------------------------------------------------------------- 00148 SUBROUTINE SOIL_PROFILE_BUFFER 00149 !------------------------------------------------------------------------------------- 00150 ! 00151 REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT ! work array 00152 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00153 ! 00154 !------------------------------------------------------------------------------------- 00155 ! 00156 ! 00157 !* interpolation on fine vertical grid 00158 IF (LHOOK) CALL DR_HOOK('SOIL_PROFILE_BUFFER',0,ZHOOK_HANDLE) 00159 ALLOCATE(ZOUT (SIZE(ZFIELD,1),SIZE(XGRID_SOIL))) 00160 CALL INTERP_GRID(ZD,ZFIELD,XGRID_SOIL,ZOUT) 00161 ! 00162 !* extends definition to all vegtypes. 00163 ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),NVEGTYPE)) 00164 DO JVEGTYPE=1,NVEGTYPE 00165 PFIELD(:,:,JVEGTYPE)=ZOUT(:,:) 00166 END DO 00167 !* end 00168 DEALLOCATE(ZOUT) 00169 DEALLOCATE(ZFIELD) 00170 DEALLOCATE(ZD) 00171 IF (LHOOK) CALL DR_HOOK('SOIL_PROFILE_BUFFER',1,ZHOOK_HANDLE) 00172 00173 END SUBROUTINE SOIL_PROFILE_BUFFER 00174 ! 00175 !------------------------------------------------------------------------------------- 00176 END SUBROUTINE PREP_ISBA_BUFFER
1.8.0
