SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_HOR_FLAKE_FIELD(HPROGRAM,HSURF,HATMFILE,HATMFILETYPE,& 00003 HPGDFILE,HPGDFILETYPE,ONOVALUE) 00004 ! ################################################################################# 00005 ! 00006 !!**** *PREP_HOR_FLAKE_FIELD* - Reads, interpolates and prepares a water field 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 ! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! REFERENCE 00015 !! --------- 00016 !! 00017 !! 00018 !! AUTHOR 00019 !! ------ 00020 !! S. Malardel 00021 !! 00022 !! MODIFICATIONS 00023 !! ------------- 00024 !! Original 01/2004 00025 !! P. Le Moigne 10/2005, Phasage Arome 00026 !! E. Kourzeneva 09/2010, Make possible to interpolate 00027 !! only lake surface temperature, 00028 !! but not profiles 00029 !!------------------------------------------------------------------ 00030 ! 00031 ! 00032 ! 00033 USE MODD_SURF_PAR, ONLY : XUNDEF 00034 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE, XZS_LS, XLAT_OUT, XLON_OUT, & 00035 XX_OUT, XY_OUT, CMASK 00036 USE MODD_FLAKE_n, ONLY : XZS, XTS, XT_SNOW, XT_ICE, XT_MNW, XT_WML, & 00037 XT_BOT, XT_B1, & 00038 XCT, XH_SNOW, XH_ICE, XH_ML, XH_B1, & 00039 ! Water depth is needed in order to compute XCT. 00040 !salgado - check if XWATER_DEPTH is initialized during prep! 00041 XWATER_DEPTH 00042 ! 00043 USE MODD_FLAKE_GRID_n, ONLY : XLAT, XLON 00044 ! 00045 USE MODD_CSTS, ONLY : XTT 00046 USE MODD_PREP_FLAKE, ONLY : LCLIM_LAKE 00047 ! 00048 USE MODI_READ_PREP_FLAKE_CONF 00049 USE MODI_PREP_FLAKE_GRIB 00050 USE MODI_PREP_FLAKE_ASCLLV 00051 USE MODI_PREP_FLAKE_UNIF 00052 USE MODI_PREP_FLAKE_BUFFER 00053 USE MODI_HOR_INTERPOL 00054 USE MODI_GET_LUOUT 00055 USE MODI_PREP_FLAKE_EXTERN 00056 ! 00057 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00058 USE PARKIND1 ,ONLY : JPRB 00059 ! 00060 USE MODI_ABOR1_SFX 00061 IMPLICIT NONE 00062 ! 00063 !* 0.1 declarations of arguments 00064 ! 00065 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00066 CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field 00067 CHARACTER(LEN=28), INTENT(IN) :: HATMFILE ! name of the Atmospheric file 00068 CHARACTER(LEN=6), INTENT(IN) :: HATMFILETYPE! type of the Atmospheric file 00069 CHARACTER(LEN=28), INTENT(IN) :: HPGDFILE ! name of the Atmospheric file 00070 CHARACTER(LEN=6), INTENT(IN) :: HPGDFILETYPE! type of the Atmospheric file 00071 LOGICAL, OPTIONAL, INTENT(OUT) :: ONOVALUE ! flag for the not given value 00072 ! 00073 ! 00074 !* 0.2 declarations of local variables 00075 ! 00076 CHARACTER(LEN=6) :: YFILETYPE ! type of input file 00077 CHARACTER(LEN=28) :: YFILE ! name of file 00078 CHARACTER(LEN=6) :: YFILEPGDTYPE ! type of input file 00079 CHARACTER(LEN=28) :: YFILEPGD ! name of file 00080 REAL, POINTER, DIMENSION(:,:) :: ZFIELDIN ! field to interpolate horizontally 00081 REAL, ALLOCATABLE, DIMENSION(:,:) :: ZFIELDOUT ! field interpolated horizontally 00082 INTEGER :: ILUOUT ! output listing logical unit 00083 ! 00084 LOGICAL :: GUNIF ! flag for prescribed uniform field 00085 LOGICAL :: GDEFAULT ! flag for prescribed default field 00086 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00087 !------------------------------------------------------------------------------------- 00088 ! 00089 ! 00090 !* 1. Reading of input file name and type 00091 ! 00092 IF (LHOOK) CALL DR_HOOK('PREP_HOR_FLAKE_FIELD',0,ZHOOK_HANDLE) 00093 CALL GET_LUOUT(HPROGRAM,ILUOUT) 00094 ! 00095 CALL READ_PREP_FLAKE_CONF(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,& 00096 HATMFILE,HATMFILETYPE,HPGDFILE,HPGDFILETYPE,ILUOUT,GUNIF) 00097 ! 00098 CMASK = 'WATER' 00099 ! 00100 GDEFAULT = (YFILETYPE==' ' .OR. (HSURF(1:2)/='ZS' .AND. HSURF(1:2)/='TS' & 00101 .AND. SIZE(XLAT).NE.1)) .AND. .NOT.GUNIF 00102 IF (PRESENT(ONOVALUE)) ONOVALUE = GDEFAULT 00103 ! 00104 IF (.NOT. GDEFAULT) THEN 00105 ! 00106 !------------------------------------------------------------------------------------- 00107 ! 00108 !* 2. Reading of input configuration (Grid and interpolation type) 00109 ! 00110 IF (GUNIF) THEN 00111 CALL PREP_FLAKE_UNIF(ILUOUT,HSURF,ZFIELDIN) 00112 ELSE IF (YFILETYPE=='ASCLLV') THEN 00113 CALL PREP_FLAKE_ASCLLV(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00114 ELSE IF (YFILETYPE=='GRIB ') THEN 00115 CALL PREP_FLAKE_GRIB(HPROGRAM,HSURF,YFILE,ILUOUT,ZFIELDIN) 00116 ELSE IF (YFILETYPE=='MESONH' .OR. YFILETYPE=='ASCII ' .OR. YFILETYPE=='LFI ') THEN 00117 CALL PREP_FLAKE_EXTERN(HPROGRAM,HSURF,YFILE,YFILETYPE,YFILEPGD,YFILEPGDTYPE,ILUOUT,ZFIELDIN) 00118 ELSE IF (YFILETYPE=='BUFFER') THEN 00119 CALL PREP_FLAKE_BUFFER(HPROGRAM,HSURF,ILUOUT,ZFIELDIN) 00120 ELSE 00121 CALL ABOR1_SFX('PREP_HOR_FLAKE_FIELD: data file type not supported : '//YFILETYPE) 00122 END IF 00123 ! 00124 ! 00125 !* 4. Horizontal interpolation 00126 ! 00127 !ALLOCATE(ZFIELDOUT(SIZE(XLAT),SIZE(ZFIELDIN,2))) 00128 ALLOCATE(ZFIELDOUT(SIZE(XLAT),1)) 00129 ! 00130 !Impossible to interpolate lake profiles, only the lake surface temperature! 00131 !But in uniform case and 1 point case 00132 IF(GUNIF .OR. SIZE(XLAT).EQ.1) THEN 00133 CALL HOR_INTERPOL(ILUOUT,ZFIELDIN,ZFIELDOUT) 00134 ELSE IF(HSURF(1:2)=='ZS' .OR. HSURF(1:2)=='TS') THEN 00135 WRITE(ILUOUT,*) "WARNING! Impossible to interpolate lake profiles in horisontal!" 00136 WRITE(ILUOUT,*) "So, interoplate only surface temperature and start from lakes mixed down to the bottom" 00137 CALL HOR_INTERPOL(ILUOUT,ZFIELDIN,ZFIELDOUT) 00138 END IF 00139 ! 00140 !* 5. Return to historical variable 00141 ! 00142 SELECT CASE (HSURF) 00143 CASE('ZS ') 00144 ALLOCATE(XZS_LS(SIZE(ZFIELDOUT,1))) 00145 XZS_LS(:) = ZFIELDOUT(:,1) 00146 CASE('TS ') 00147 ALLOCATE(XTS(SIZE(ZFIELDOUT,1))) 00148 XTS(:) = ZFIELDOUT(:,1) 00149 CASE('T_SNOW ') 00150 ALLOCATE(XT_SNOW(SIZE(ZFIELDOUT,1))) 00151 XT_SNOW(:) = ZFIELDOUT(:,1) 00152 CASE('T_ICE ') 00153 ALLOCATE(XT_ICE(SIZE(ZFIELDOUT,1))) 00154 XT_ICE(:) = ZFIELDOUT(:,1) 00155 CASE('T_WML ') 00156 ALLOCATE(XT_WML(SIZE(ZFIELDOUT,1))) 00157 XT_WML(:) = ZFIELDOUT(:,1) 00158 CASE('T_BOT ') 00159 ALLOCATE(XT_BOT(SIZE(ZFIELDOUT,1))) 00160 XT_BOT(:) = ZFIELDOUT(:,1) 00161 CASE('T_B1 ') 00162 ALLOCATE(XT_B1(SIZE(ZFIELDOUT,1))) 00163 XT_B1(:) = ZFIELDOUT(:,1) 00164 CASE('CT ') 00165 ALLOCATE(XCT(SIZE(ZFIELDOUT,1))) 00166 XCT(:) = ZFIELDOUT(:,1) 00167 CASE('H_SNOW ') 00168 ALLOCATE(XH_SNOW(SIZE(ZFIELDOUT,1))) 00169 XH_SNOW(:) = ZFIELDOUT(:,1) 00170 CASE('H_ICE ') 00171 ALLOCATE(XH_ICE(SIZE(ZFIELDOUT,1))) 00172 XH_ICE(:) = ZFIELDOUT(:,1) 00173 CASE('H_ML ') 00174 ALLOCATE(XH_ML(SIZE(ZFIELDOUT,1))) 00175 XH_ML(:) = ZFIELDOUT(:,1) 00176 CASE('H_B1 ') 00177 ALLOCATE(XH_B1(SIZE(ZFIELDOUT,1))) 00178 XH_B1(:) = ZFIELDOUT(:,1) 00179 END SELECT 00180 !* 6. Deallocations 00181 ! 00182 IF (ALL(ZFIELDOUT==XUNDEF)) GDEFAULT = .TRUE. 00183 ! 00184 DEALLOCATE(ZFIELDIN ) 00185 DEALLOCATE(ZFIELDOUT) 00186 ! 00187 END IF 00188 00189 ! 00190 IF (GDEFAULT) THEN 00191 ! 00192 !* 7. Initial values of FLAKE variables are computed from TS 00193 ! when uniform values are not prescribed 00194 IF (HSURF(1:2)/='ZS') WRITE(ILUOUT,*) 'NO FILE FOR FIELD ',HSURF, & 00195 ': UNIFORM DEFAULT FIELD IS PRESCRIBED' 00196 00197 END IF 00198 ! 00199 IF (LHOOK) CALL DR_HOOK('PREP_HOR_FLAKE_FIELD',1,ZHOOK_HANDLE) 00200 ! 00201 !------------------------------------------------------------------------------------- 00202 ! 00203 END SUBROUTINE PREP_HOR_FLAKE_FIELD