start_lake_of.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #######
SUBROUTINE start_lake_of(KDAY, KMONTH, PLON, PLAT, PDEPTH, &   ! IN
                     PT_SNOW, PT_ICE, PT_MNW, PT_WML, PT_BOT, PT_B1, PCT, & ! Lake variables
                     PH_SNOW, PH_ICE, PH_ML, PH_B1, PT_SFC)                 ! OUT
!     ###############
!
! PURPOSE: Extract the climate lake variables from the climate lake dataset 
!          for the given date, the given grid box of the atmopheric model grid in lon-lat
!          and for the given lake depth;
!          this version is for netcdf3 (old-fashioned)
! AUTHOR: Ekaterina Kourzeneva, 
!         Meteo France, 2010
! INPUT:  KDAY - the day number 
!         KMONTH - the month number
!         PLON - longitude of the center of the atmospheric model grid box, deg. dec., -180.0 ... 180.0
!         PLAT - latitude of the center of the atmospheric model grid box, deg. dec., -90.0 ... 90.0
!         PDEPTH - the lake depth in the grid box, m 
! LIBRARIES: NetCDF. Install it and make sure you use right compilation and linkage lines!
!                    (see the example for details)
! READS FILES: data for the lake climatology (LAKE_LTA.nc)
! Be sure that all necessary files are present and not zipped!!!
! OUTPUT: PT_SNOW - the snow temperature, K (no snow at present, so equal to the ice temperature) 
!         PT_ICE - the ice temperature, K
!         PT_MNW - the mean water temperature, K
!         PT_WML - the mixed layer temperature, K
!         PT_BOT - the bottom temperature, K
!         PT_B1 - the temperature on the outer edge of the active layer of the bottom sediments, K
!                (at present the bottom sediments block is not used, 
!                 so eq. to the freshwater maximum density temperature)
!         PCT - the shape factor, dimensioneless
!         PH_SNOW - the snow depth, m (no snow at present, so equal to zero)
!         PH_ICE - the ice depth, m
!         PH_ML - the mixed layer depth, m
!         PH_B1 - the depth of the active layer if the bottom sediments, m
!                (at present the bottom sediments block is not used, 
!                 so eq. to the dummy value)  
!         PT_SFC - the surface temperature, K (the diagnostic value, so just for information)
! WRITES FILES: no
!
!------------------------------------------------------------------------------------------------------------
!         Modified   07/2012, P. Le Moigne : In case there's a lake but no climatic data
!                                    associated then fill with neighbour existing data
!                                    instead of aborting
!------------------------------------------------------------------------------------------------------------
!
USE modd_data_lake, ONLY : clakelta, nlong, nlatg, xfirstlat, &
                           xc_small, ngraddepth_lta, xcentrgraddepth_lta, &
                           xauxt_snow, xauxt_ice, xauxt_mnw, xauxt_wml, xauxt_bot, &
                           xauxt_b1, xauxct, xauxh_snow, xauxh_ice, xauxh_ml, &
                           xauxh_b1, xauxt_sfc
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
INTEGER, INTENT(IN) :: KDAY,   & ! The day number
                       KMONTH    ! The month number
REAL, INTENT(IN) :: PLON, PLAT   ! Longitude and latitude of the center of the atmospheric model grid box, 
                                 ! deg. dec. (-180.0 ... 180.0), (-90.0 ... 90.0)
REAL, INTENT(IN) :: PDEPTH       ! The depth of the lakes, m
REAL, INTENT(OUT) :: PT_SNOW, &  ! the snow temperature, K (no snow at present, so equal to the ice temperature) 
                     PT_ICE,  &  ! the ice temperature, K
                     PT_MNW,  &  ! the mean water temperature, K
                     PT_WML,  &  ! the mixed layer temperature, K
                     PT_BOT,  &  ! the bottom temperature, K
                     PT_B1,   &  ! the temperature on the outer edge of the active layer of the bottom sediments, K
                                 !  (at present the bottom sediments block is not used, 
                                 !  so eq. to the freshwater maximum density temperature)
                     pct,     &  ! the shape factor, dimensioneless
                     ph_snow, &  ! the snow depth, m (no snow at present, so equal to zero)
                     ph_ice,  &  ! the ice depth, m
                     ph_ml,   &  ! the mixed layer depth, m
                     ph_b1,   &  ! the depth of the active layer if the bottom sediments, m
                                 !  (at present the bottom sediments block is not used, 
                                 !   so eq. to the dummy value)  
                     pt_sfc      ! the surface temperature, K (the diagnostic value, so just for information) 
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(1,1) :: ZWT_SNOW, ZWT_ICE, ZWT_MNW, ZWT_WML, ZWT_BOT, ZWT_B1, ZWCT, & ! Lake values
                         ZWH_SNOW, ZWH_ICE, ZWH_ML, ZWH_B1, ZWT_SFC                  ! to read from NetCDF                 
REAL :: ZFT_SNOW, ZFT_ICE, ZFT_MNW, ZFT_WML, ZFT_BOT, ZFT_B1, ZFCT, &
        ZFH_SNOW, ZFH_ICE, ZFH_ML, ZFH_B1, ZFT_SFC
REAL, DIMENSION(NGRADDEPTH_LTA) :: ZDISTD
REAL :: ZWLON, ZWLAT, ZWDEPTH
!
LOGICAL :: LEXIST
!
 INTEGER :: ID_LAKELTA, ID_MONTH, &  ! IDs for NetCDF 
            ID_DEC, ID_LON, ID_LAT, ID_DEPTH, &
            ID_T_SNOW, ID_T_ICE, ID_T_MNW, ID_T_WML, ID_T_BOT, ID_T_B1, ID_CT, &
            ID_H_SNOW, ID_H_ICE, ID_H_ML, ID_H_B1, ID_T_SFC
 INTEGER :: IDEC, IMONTH ! Number of the decade and the month
 INTEGER :: ILON, ILAT ! Numbers of the "lake" grid boxes in longitude and latitude
 INTEGER :: IDEPTH ! Number of the lake class in depth
 INTEGER, DIMENSION(1) :: ILOC_DEPTH
 INTEGER :: IRET
 INTEGER :: IMONTHN, IDECN, ILONN, ILATN, IDEPTHN
 INTEGER, DIMENSION(5) :: NINDEX
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ----------------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('START_LAKE_OF',0,zhook_handle)
!
!*      0.     Check
!
IF(kday.LE.0 .OR. kday.GT.31) CALL abor1_sfx("START_LAKE_OF: WRONG DAY NUMBER (!!!!)")
IF(kmonth.LE.0 .OR. kmonth.GT.12) CALL abor1_sfx("START_LAKE_OF: WRONG MONTH NUMBER (!!!!)")
IF(plon.LT.-180. .OR. plon.GT.180.) CALL abor1_sfx("START_LAKE_OF: WRONG LONGITUDE (!!!!)")
IF(plat.LT.-90. .OR. plat.GT.90.) CALL abor1_sfx("START_LAKE_OF: WRONG LATITUDE (!!!!)")
!
!*      1.     Calculate time indexes 
!
imonth = kmonth
!
SELECT CASE(kday)
  CASE(1:10)
    idec=1
  CASE(11:20)
    idec=2
  CASE(21:31)
    idec=3
END SELECT
!
!*      2.     Calculate lon-lat indexes
!
zwlon = plon
zwlat = max(plat,xfirstlat)
!
ilon = nint(zwlon) + nlong/2 + 1
ilat = nint(zwlat) - xfirstlat + 1
!
!*      3.     Check lake depth
!
IF (pdepth.LT.xc_small) &
  CALL abor1_sfx("START_LAKE_OF: YOUR LAKE DEPTH IS TOO SMALL TO ACTIVATE CLI_LAKE IN SOME POINTS")
!
!*      4.     Calculate the appropriate index
!
zwdepth = min(pdepth,50.)
zdistd = abs(xcentrgraddepth_lta(:) - zwdepth)
iloc_depth = minloc(zdistd)
idepth = iloc_depth(1)
!
!*      5.     Open file for reading
!
iret = nf90_open(trim(adjustl(clakelta)),nf90_nowrite,id_lakelta)
IF (iret.NE.0) CALL abor1_sfx("START_LAKE_OF: WRONG OR NO LAKE DATA FILE")
!
!*      6.     Check data in the lake file
!
iret = nf90_inq_dimid(id_lakelta, "NMonth", id_month)
iret = nf90_inquire_dimension(id_lakelta, id_month, len=imonthn)
IF (imonthn.NE.12) CALL abor1_sfx("START_LAKE_OF: NUMBER OF MONTHS IN THE LAKE FILE IS NOT 12????") 
!
iret = nf90_inq_dimid(id_lakelta, "NDec", id_dec)
iret = nf90_inquire_dimension(id_lakelta, id_dec, len=idecn)
IF (idecn.NE.3) CALL abor1_sfx("START_LAKE_OF: NUMBER OF DECADES IN MONTH IN THE LAKE FILE IS NOT 3????")
!
iret = nf90_inq_dimid(id_lakelta, "NLon", id_lon)  
iret = nf90_inquire_dimension(id_lakelta, id_lon, len=ilonn)
IF (ilonn.NE.nlong) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
iret = nf90_inq_dimid(id_lakelta, "NLat", id_lat)    
iret = nf90_inquire_dimension(id_lakelta, id_lat, len=ilatn)
IF (ilatn.NE.nlatg) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
iret = nf90_inq_dimid(id_lakelta, "NDepth", id_depth)
iret = nf90_inquire_dimension(id_lakelta, id_depth, len=idepthn)
IF (idepthn.NE.ngraddepth_lta) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF GRADATIONS IN DEPTH IN THE LAKE FILE!")
!
iret = nf90_inq_varid(id_lakelta, "T_snow", id_t_snow)
iret = nf90_inq_varid(id_lakelta, "T_ice", id_t_ice)
iret = nf90_inq_varid(id_lakelta, "T_mnw", id_t_mnw) 
iret = nf90_inq_varid(id_lakelta, "T_wML", id_t_wml)
iret = nf90_inq_varid(id_lakelta, "T_bot", id_t_bot)
iret = nf90_inq_varid(id_lakelta, "T_B1", id_t_b1)
iret = nf90_inq_varid(id_lakelta, "C_T", id_ct)
iret = nf90_inq_varid(id_lakelta, "h_snow", id_h_snow)
iret = nf90_inq_varid(id_lakelta, "h_ice", id_h_ice)
iret = nf90_inq_varid(id_lakelta, "h_ML", id_h_ml)  
iret = nf90_inq_varid(id_lakelta, "H_B1", id_h_b1)
iret = nf90_inq_varid(id_lakelta, "T_sfc", id_t_sfc)
!
!*      7.     Reading
!
nindex(1) = imonth
nindex(2) = idec
nindex(3) = ilon
nindex(4) = ilat
nindex(5) = idepth
!
iret = nf90_get_att(id_lakelta, id_t_snow, '_FillValue',zft_snow)
iret = nf90_get_att(id_lakelta, id_t_ice, '_FillValue',zft_ice)
iret = nf90_get_att(id_lakelta, id_t_mnw, '_FillValue',zft_mnw)
iret = nf90_get_att(id_lakelta, id_t_wml, '_FillValue',zft_wml)
iret = nf90_get_att(id_lakelta, id_t_bot, '_FillValue',zft_bot)
iret = nf90_get_att(id_lakelta, id_t_b1, '_FillValue',zft_b1)
iret = nf90_get_att(id_lakelta, id_ct, '_FillValue',zfct)
iret = nf90_get_att(id_lakelta, id_h_snow, '_FillValue',zfh_snow)
iret = nf90_get_att(id_lakelta, id_h_ice, '_FillValue',zfh_ice)
iret = nf90_get_att(id_lakelta, id_h_ml, '_FillValue',zfh_ml)
iret = nf90_get_att(id_lakelta, id_h_b1, '_FillValue',zfh_b1)
iret = nf90_get_att(id_lakelta, id_t_snow, '_FillValue',zft_sfc)
!
iret = nf90_get_var(id_lakelta, id_t_snow, zwt_snow, nindex)
iret = nf90_get_var(id_lakelta, id_t_ice, zwt_ice, nindex)
iret = nf90_get_var(id_lakelta, id_t_mnw, zwt_mnw, nindex)
iret = nf90_get_var(id_lakelta, id_t_wml, zwt_wml, nindex)
iret = nf90_get_var(id_lakelta, id_t_bot, zwt_bot, nindex)
iret = nf90_get_var(id_lakelta, id_t_b1, zwt_b1, nindex)
iret = nf90_get_var(id_lakelta, id_ct, zwct, nindex)
iret = nf90_get_var(id_lakelta, id_h_snow, zwh_snow, nindex)
iret = nf90_get_var(id_lakelta, id_h_ice, zwh_ice, nindex)
iret = nf90_get_var(id_lakelta, id_h_ml, zwh_ml, nindex)
iret = nf90_get_var(id_lakelta, id_h_b1, zwh_b1, nindex)
iret = nf90_get_var(id_lakelta, id_t_sfc, zwt_sfc, nindex)
!
!*      8.     Close file
!
iret = nf90_close(id_lakelta)   
!
!*      9.     Make output
!

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. &
        zwt_wml(1,1).NE.zft_wml .AND. zwt_bot(1,1).NE.zft_bot .AND. zwt_b1(1,1).NE.zft_b1 .AND. &
        zwct(1,1).NE.zfct .AND. zwh_snow(1,1).NE.zfh_snow .AND. zwh_ice(1,1).NE.zfh_ice .AND. &
         zwh_ml(1,1).NE.zfh_ml .AND. zwh_b1(1,1).NE.zfh_b1 .AND. zwt_sfc(1,1).NE.zft_sfc)

IF (lexist) THEN
  !
  xauxt_snow = zwt_snow(1,1)
  xauxt_ice = zwt_ice(1,1) 
  xauxt_mnw = zwt_mnw(1,1) 
  xauxt_wml = zwt_wml(1,1)
  xauxt_bot = zwt_bot(1,1)
  xauxt_b1 = zwt_b1(1,1)
  xauxct = zwct(1,1) 
  xauxh_snow = zwh_snow(1,1)
  xauxh_ice = zwh_ice(1,1)
  xauxh_ml = zwh_ml(1,1)
  xauxh_b1 = zwh_b1(1,1)
  xauxt_sfc = zwt_sfc(1,1)
  !
ENDIF
!
pt_snow = xauxt_snow 
pt_ice  = xauxt_ice 
pt_mnw  = xauxt_mnw 
pt_wml  = xauxt_wml 
pt_bot  = xauxt_bot 
pt_b1   = xauxt_b1  
pct     = xauxct 
ph_snow = xauxh_snow 
ph_ice  = xauxh_ice 
ph_ml   = xauxh_ml 
ph_b1   = xauxh_b1 
pt_sfc  = xauxt_sfc
!
IF (lhook) CALL dr_hook('START_LAKE_OF',1,zhook_handle)
!
END SUBROUTINE start_lake_of