|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ####### 00002 SUBROUTINE START_LAKE_OF(KDAY, KMONTH, PLON, PLAT, PDEPTH, & ! IN 00003 PT_SNOW, PT_ICE, PT_MNW, PT_WML, PT_BOT, PT_B1, PCT, & ! Lake variables 00004 PH_SNOW, PH_ICE, PH_ML, PH_B1, PT_SFC) ! OUT 00005 ! ############### 00006 ! 00007 ! PURPOSE: Extract the climate lake variables from the climate lake dataset 00008 ! for the given date, the given grid box of the atmopheric model grid in lon-lat 00009 ! and for the given lake depth; 00010 ! this version is for netcdf3 (old-fashioned) 00011 ! AUTHOR: Ekaterina Kourzeneva, 00012 ! Meteo France, 2010 00013 ! INPUT: KDAY - the day number 00014 ! KMONTH - the month number 00015 ! PLON - longitude of the center of the atmospheric model grid box, deg. dec., -180.0 ... 180.0 00016 ! PLAT - latitude of the center of the atmospheric model grid box, deg. dec., -90.0 ... 90.0 00017 ! PDEPTH - the lake depth in the grid box, m 00018 ! LIBRARIES: NetCDF. Install it and make sure you use right compilation and linkage lines! 00019 ! (see the example for details) 00020 ! READS FILES: data for the lake climatology (LAKE_LTA.nc) 00021 ! Be sure that all necessary files are present and not zipped!!! 00022 ! OUTPUT: PT_SNOW - the snow temperature, K (no snow at present, so equal to the ice temperature) 00023 ! PT_ICE - the ice temperature, K 00024 ! PT_MNW - the mean water temperature, K 00025 ! PT_WML - the mixed layer temperature, K 00026 ! PT_BOT - the bottom temperature, K 00027 ! PT_B1 - the temperature on the outer edge of the active layer of the bottom sediments, K 00028 ! (at present the bottom sediments block is not used, 00029 ! so eq. to the freshwater maximum density temperature) 00030 ! PCT - the shape factor, dimensioneless 00031 ! PH_SNOW - the snow depth, m (no snow at present, so equal to zero) 00032 ! PH_ICE - the ice depth, m 00033 ! PH_ML - the mixed layer depth, m 00034 ! PH_B1 - the depth of the active layer if the bottom sediments, m 00035 ! (at present the bottom sediments block is not used, 00036 ! so eq. to the dummy value) 00037 ! PT_SFC - the surface temperature, K (the diagnostic value, so just for information) 00038 ! WRITES FILES: no 00039 ! 00040 !------------------------------------------------------------------------------------------------------------ 00041 ! Modified 07/2012, P. Le Moigne : In case there's a lake but no climatic data 00042 ! associated then fill with neighbour existing data 00043 ! instead of aborting 00044 !------------------------------------------------------------------------------------------------------------ 00045 ! 00046 USE MODD_DATA_LAKE, ONLY : CLAKELTA, NLONG, NLATG, XFIRSTLAT, & 00047 XC_SMALL, NGRADDEPTH_LTA, XCENTRGRADDEPTH_LTA, & 00048 XAUXT_SNOW, XAUXT_ICE, XAUXT_MNW, XAUXT_WML, XAUXT_BOT, & 00049 XAUXT_B1, XAUXCT, XAUXH_SNOW, XAUXH_ICE, XAUXH_ML, & 00050 XAUXH_B1, XAUXT_SFC 00051 ! 00052 USE MODI_ABOR1_SFX 00053 ! 00054 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00055 USE PARKIND1 ,ONLY : JPRB 00056 ! 00057 IMPLICIT NONE 00058 include 'netcdf.inc' 00059 ! 00060 !* 0.1 declarations of arguments 00061 ! 00062 INTEGER, INTENT(IN) :: KDAY, ! The day number 00063 KMONTH ! The month number 00064 REAL, INTENT(IN) :: PLON, PLAT ! Longitude and latitude of the center of the atmospheric model grid box, 00065 ! deg. dec. (-180.0 ... 180.0), (-90.0 ... 90.0) 00066 REAL, INTENT(IN) :: PDEPTH ! The depth of the lakes, m 00067 REAL, INTENT(OUT) :: PT_SNOW, ! the snow temperature, K (no snow at present, so equal to the ice temperature) 00068 PT_ICE, ! the ice temperature, K 00069 PT_MNW, ! the mean water temperature, K 00070 PT_WML, ! the mixed layer temperature, K 00071 PT_BOT, ! the bottom temperature, K 00072 PT_B1, ! the temperature on the outer edge of the active layer of the bottom sediments, K 00073 ! (at present the bottom sediments block is not used, 00074 ! so eq. to the freshwater maximum density temperature) 00075 PCT, & ! the shape factor, dimensioneless 00076 PH_SNOW, & ! the snow depth, m (no snow at present, so equal to zero) 00077 PH_ICE, & ! the ice depth, m 00078 PH_ML, & ! the mixed layer depth, m 00079 PH_B1, & ! the depth of the active layer if the bottom sediments, m 00080 ! (at present the bottom sediments block is not used, 00081 ! so eq. to the dummy value) 00082 PT_SFC ! the surface temperature, K (the diagnostic value, so just for information) 00083 ! 00084 !* 0.2 declarations of local variables 00085 ! 00086 REAL, DIMENSION(1,1) :: ZWT_SNOW, ZWT_ICE, ZWT_MNW, ZWT_WML, ZWT_BOT, ZWT_B1, ZWCT, ! Lake values 00087 ZWH_SNOW, ZWH_ICE, ZWH_ML, ZWH_B1, ZWT_SFC ! to read from NetCDF 00088 REAL :: ZFT_SNOW, ZFT_ICE, ZFT_MNW, ZFT_WML, ZFT_BOT, ZFT_B1, ZFCT, 00089 ZFH_SNOW, ZFH_ICE, ZFH_ML, ZFH_B1, ZFT_SFC 00090 REAL, DIMENSION(NGRADDEPTH_LTA) :: ZDISTD 00091 REAL :: ZWLON, ZWLAT, ZWDEPTH 00092 ! 00093 LOGICAL :: LEXIST 00094 ! 00095 INTEGER :: ID_LAKELTA, ID_MONTH, ! IDs for NetCDF 00096 ID_DEC, ID_LON, ID_LAT, ID_DEPTH, 00097 ID_T_SNOW, ID_T_ICE, ID_T_MNW, ID_T_WML, ID_T_BOT, ID_T_B1, ID_CT, 00098 ID_H_SNOW, ID_H_ICE, ID_H_ML, ID_H_B1, ID_T_SFC 00099 INTEGER :: IDEC, IMONTH ! Number of the decade and the month 00100 INTEGER :: ILON, ILAT ! Numbers of the "lake" grid boxes in longitude and latitude 00101 INTEGER :: IDEPTH ! Number of the lake class in depth 00102 INTEGER, DIMENSION(1) :: ILOC_DEPTH 00103 INTEGER :: IRET 00104 INTEGER :: IMONTHN, IDECN, ILONN, ILATN, IDEPTHN 00105 INTEGER, DIMENSION(5) :: NINDEX 00106 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00107 ! ---------------------------------------------------------------------------------------------- 00108 ! 00109 IF (LHOOK) CALL DR_HOOK('START_LAKE_OF',0,ZHOOK_HANDLE) 00110 ! 00111 !* 0. Check 00112 ! 00113 IF(KDAY.LE.0 .OR. KDAY.GT.31) CALL ABOR1_SFX("START_LAKE_OF: WRONG DAY NUMBER (!!!!)") 00114 IF(KMONTH.LE.0 .OR. KMONTH.GT.12) CALL ABOR1_SFX("START_LAKE_OF: WRONG MONTH NUMBER (!!!!)") 00115 IF(PLON.LT.-180. .OR. PLON.GT.180.) CALL ABOR1_SFX("START_LAKE_OF: WRONG LONGITUDE (!!!!)") 00116 IF(PLAT.LT.-90. .OR. PLAT.GT.90.) CALL ABOR1_SFX("START_LAKE_OF: WRONG LATITUDE (!!!!)") 00117 ! 00118 !* 1. Calculate time indexes 00119 ! 00120 IMONTH = KMONTH 00121 ! 00122 SELECT CASE(KDAY) 00123 CASE(1:10) 00124 IDEC=1 00125 CASE(11:20) 00126 IDEC=2 00127 CASE(21:31) 00128 IDEC=3 00129 END SELECT 00130 ! 00131 !* 2. Calculate lon-lat indexes 00132 ! 00133 ZWLON = PLON 00134 ZWLAT = MAX(PLAT,XFIRSTLAT) 00135 ! 00136 ILON = NINT(ZWLON) + NLONG/2 + 1 00137 ILAT = NINT(ZWLAT) - XFIRSTLAT + 1 00138 ! 00139 !* 3. Check lake depth 00140 ! 00141 IF (PDEPTH.LT.XC_SMALL) & 00142 CALL ABOR1_SFX("START_LAKE_OF: YOUR LAKE DEPTH IS TOO SMALL TO ACTIVATE CLI_LAKE IN SOME POINTS") 00143 ! 00144 !* 4. Calculate the appropriate index 00145 ! 00146 ZWDEPTH = MIN(PDEPTH,50.) 00147 ZDISTD = ABS(XCENTRGRADDEPTH_LTA(:) - ZWDEPTH) 00148 ILOC_DEPTH = MINLOC(ZDISTD) 00149 IDEPTH = ILOC_DEPTH(1) 00150 ! 00151 !* 5. Open file for reading 00152 ! 00153 IRET = NF_OPEN(TRIM(ADJUSTL(CLAKELTA)),NF_NOWRITE,ID_LAKELTA) 00154 IF (IRET.NE.0) CALL ABOR1_SFX("START_LAKE_OF: WRONG OR NO LAKE DATA FILE") 00155 ! 00156 !* 6. Check data in the lake file 00157 ! 00158 IRET = NF_INQ_DIMID(ID_LAKELTA, "NMonth", ID_MONTH) 00159 IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_MONTH, IMONTHN) 00160 IF (IMONTHN.NE.12) CALL ABOR1_SFX("START_LAKE_OF: NUMBER OF MONTHS IN THE LAKE FILE IS NOT 12????") 00161 ! 00162 IRET = NF_INQ_DIMID(ID_LAKELTA, "NDec", ID_DEC) 00163 IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_DEC, IDECN) 00164 IF (IDECN.NE.3) CALL ABOR1_SFX("START_LAKE_OF: NUMBER OF DECADES IN MONTH IN THE LAKE FILE IS NOT 3????") 00165 ! 00166 IRET = NF_INQ_DIMID(ID_LAKELTA, "NLon", ID_LON) 00167 IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_LON, ILONN) 00168 IF (ILONN.NE.NLONG) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!") 00169 ! 00170 IRET = NF_INQ_DIMID(ID_LAKELTA, "NLat", ID_LAT) 00171 IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_LAT, ILATN) 00172 IF (ILATN.NE.NLATG) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!") 00173 ! 00174 IRET = NF_INQ_DIMID(ID_LAKELTA, "NDepth", ID_DEPTH) 00175 IRET = NF_INQ_DIMLEN(ID_LAKELTA, ID_DEPTH, IDEPTHN) 00176 IF (IDEPTHN.NE.NGRADDEPTH_LTA) CALL ABOR1_SFX("START_LAKE_OF: WRONG NUMBER OF GRADATIONS IN DEPTH IN THE LAKE FILE!") 00177 ! 00178 IRET = NF_INQ_VARID(ID_LAKELTA, "T_snow", ID_T_SNOW) 00179 IRET = NF_INQ_VARID(ID_LAKELTA, "T_ice", ID_T_ICE) 00180 IRET = NF_INQ_VARID(ID_LAKELTA, "T_mnw", ID_T_MNW) 00181 IRET = NF_INQ_VARID(ID_LAKELTA, "T_wML", ID_T_WML) 00182 IRET = NF_INQ_VARID(ID_LAKELTA, "T_bot", ID_T_BOT) 00183 IRET = NF_INQ_VARID(ID_LAKELTA, "T_B1", ID_T_B1) 00184 IRET = NF_INQ_VARID(ID_LAKELTA, "C_T", ID_CT) 00185 IRET = NF_INQ_VARID(ID_LAKELTA, "h_snow", ID_H_SNOW) 00186 IRET = NF_INQ_VARID(ID_LAKELTA, "h_ice", ID_H_ICE) 00187 IRET = NF_INQ_VARID(ID_LAKELTA, "h_ML", ID_H_ML) 00188 IRET = NF_INQ_VARID(ID_LAKELTA, "H_B1", ID_H_B1) 00189 IRET = NF_INQ_VARID(ID_LAKELTA, "T_sfc", ID_T_SFC) 00190 ! 00191 !* 7. Reading 00192 ! 00193 NINDEX(1) = IMONTH 00194 NINDEX(2) = IDEC 00195 NINDEX(3) = ILON 00196 NINDEX(4) = ILAT 00197 NINDEX(5) = IDEPTH 00198 ! 00199 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SNOW) 00200 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_ICE, '_FillValue',ZFT_ICE) 00201 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_MNW, '_FillValue',ZFT_MNW) 00202 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_WML, '_FillValue',ZFT_WML) 00203 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_BOT, '_FillValue',ZFT_BOT) 00204 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_B1, '_FillValue',ZFT_B1) 00205 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_CT, '_FillValue',ZFCT) 00206 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_SNOW, '_FillValue',ZFH_SNOW) 00207 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_ICE, '_FillValue',ZFH_ICE) 00208 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_ML, '_FillValue',ZFH_ML) 00209 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_H_B1, '_FillValue',ZFH_B1) 00210 IRET = NF_GET_ATT_DOUBLE(ID_LAKELTA, ID_T_SNOW, '_FillValue',ZFT_SFC) 00211 ! 00212 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_SNOW, NINDEX, ZWT_SNOW) 00213 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_ICE, NINDEX, ZWT_ICE) 00214 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_MNW, NINDEX, ZWT_MNW) 00215 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_WML, NINDEX, ZWT_WML) 00216 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_BOT, NINDEX, ZWT_BOT) 00217 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_B1, NINDEX, ZWT_B1) 00218 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_CT, NINDEX, ZWCT) 00219 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_SNOW, NINDEX, ZWH_SNOW) 00220 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_ICE, NINDEX, ZWH_ICE) 00221 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_ML, NINDEX, ZWH_ML) 00222 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_H_B1, NINDEX, ZWH_B1) 00223 IRET = NF_GET_VAR1_DOUBLE(ID_LAKELTA, ID_T_SFC, NINDEX, ZWT_SFC) 00224 ! 00225 !* 8. Close file 00226 ! 00227 IRET = NF_CLOSE(ID_LAKELTA) 00228 ! 00229 !* 9. Make output 00230 ! 00231 00232 LEXIST=(ZWT_SNOW(1,1).NE.ZFT_SNOW .AND. ZWT_ICE(1,1).NE.ZFT_ICE .AND. ZWT_MNW(1,1).NE.ZFT_MNW .AND. & 00233 ZWT_WML(1,1).NE.ZFT_WML .AND. ZWT_BOT(1,1).NE.ZFT_BOT .AND. ZWT_B1(1,1).NE.ZFT_B1 .AND. & 00234 ZWCT(1,1).NE.ZFCT .AND. ZWH_SNOW(1,1).NE.ZFH_SNOW .AND. ZWH_ICE(1,1).NE.ZFH_ICE .AND. & 00235 ZWH_ML(1,1).NE.ZFH_ML .AND. ZWH_B1(1,1).NE.ZFH_B1 .AND. ZWT_SFC(1,1).NE.ZFT_SFC) 00236 00237 IF (LEXIST) THEN 00238 ! 00239 XAUXT_SNOW = ZWT_SNOW(1,1) 00240 XAUXT_ICE = ZWT_ICE(1,1) 00241 XAUXT_MNW = ZWT_MNW(1,1) 00242 XAUXT_WML = ZWT_WML(1,1) 00243 XAUXT_BOT = ZWT_BOT(1,1) 00244 XAUXT_B1 = ZWT_B1(1,1) 00245 XAUXCT = ZWCT(1,1) 00246 XAUXH_SNOW = ZWH_SNOW(1,1) 00247 XAUXH_ICE = ZWH_ICE(1,1) 00248 XAUXH_ML = ZWH_ML(1,1) 00249 XAUXH_B1 = ZWH_B1(1,1) 00250 XAUXT_SFC = ZWT_SFC(1,1) 00251 ! 00252 ENDIF 00253 ! 00254 PT_SNOW = XAUXT_SNOW 00255 PT_ICE = XAUXT_ICE 00256 PT_MNW = XAUXT_MNW 00257 PT_WML = XAUXT_WML 00258 PT_BOT = XAUXT_BOT 00259 PT_B1 = XAUXT_B1 00260 PCT = XAUXCT 00261 PH_SNOW = XAUXH_SNOW 00262 PH_ICE = XAUXH_ICE 00263 PH_ML = XAUXH_ML 00264 PH_B1 = XAUXH_B1 00265 PT_SFC = XAUXT_SFC 00266 ! 00267 IF (LHOOK) CALL DR_HOOK('START_LAKE_OF',1,ZHOOK_HANDLE) 00268 ! 00269 END SUBROUTINE START_LAKE_OF
1.8.0
