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
!
IMPLICIT NONE
include 'netcdf.inc'
!
!*      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 = nf_open(trim(adjustl(clakelta)),nf_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 = nf_inq_dimid(id_lakelta, "NMonth", id_month)
iret = nf_inq_dimlen(id_lakelta, id_month, imonthn)
IF (imonthn.NE.12) CALL abor1_sfx("START_LAKE_OF: NUMBER OF MONTHS IN THE LAKE FILE IS NOT 12????") 
!
iret = nf_inq_dimid(id_lakelta, "NDec", id_dec)
iret = nf_inq_dimlen(id_lakelta, id_dec, idecn)
IF (idecn.NE.3) CALL abor1_sfx("START_LAKE_OF: NUMBER OF DECADES IN MONTH IN THE LAKE FILE IS NOT 3????")
!
iret = nf_inq_dimid(id_lakelta, "NLon", id_lon)  
iret = nf_inq_dimlen(id_lakelta, id_lon, ilonn)
IF (ilonn.NE.nlong) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
iret = nf_inq_dimid(id_lakelta, "NLat", id_lat)    
iret = nf_inq_dimlen(id_lakelta, id_lat, ilatn)
IF (ilatn.NE.nlatg) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF POINTS IN LONGITUDE IN THE LAKE FILE!")
!
iret = nf_inq_dimid(id_lakelta, "NDepth", id_depth)
iret = nf_inq_dimlen(id_lakelta, id_depth, idepthn)
IF (idepthn.NE.ngraddepth_lta) CALL abor1_sfx("START_LAKE_OF: WRONG NUMBER OF GRADATIONS IN DEPTH IN THE LAKE FILE!")
!
iret = nf_inq_varid(id_lakelta, "T_snow", id_t_snow)
iret = nf_inq_varid(id_lakelta, "T_ice", id_t_ice)
iret = nf_inq_varid(id_lakelta, "T_mnw", id_t_mnw) 
iret = nf_inq_varid(id_lakelta, "T_wML", id_t_wml)
iret = nf_inq_varid(id_lakelta, "T_bot", id_t_bot)
iret = nf_inq_varid(id_lakelta, "T_B1", id_t_b1)
iret = nf_inq_varid(id_lakelta, "C_T", id_ct)
iret = nf_inq_varid(id_lakelta, "h_snow", id_h_snow)
iret = nf_inq_varid(id_lakelta, "h_ice", id_h_ice)
iret = nf_inq_varid(id_lakelta, "h_ML", id_h_ml)  
iret = nf_inq_varid(id_lakelta, "H_B1", id_h_b1)
iret = nf_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 = nf_get_att_double(id_lakelta, id_t_snow, '_FillValue',zft_snow)
iret = nf_get_att_double(id_lakelta, id_t_ice, '_FillValue',zft_ice)
iret = nf_get_att_double(id_lakelta, id_t_mnw, '_FillValue',zft_mnw)
iret = nf_get_att_double(id_lakelta, id_t_wml, '_FillValue',zft_wml)
iret = nf_get_att_double(id_lakelta, id_t_bot, '_FillValue',zft_bot)
iret = nf_get_att_double(id_lakelta, id_t_b1, '_FillValue',zft_b1)
iret = nf_get_att_double(id_lakelta, id_ct, '_FillValue',zfct)
iret = nf_get_att_double(id_lakelta, id_h_snow, '_FillValue',zfh_snow)
iret = nf_get_att_double(id_lakelta, id_h_ice, '_FillValue',zfh_ice)
iret = nf_get_att_double(id_lakelta, id_h_ml, '_FillValue',zfh_ml)
iret = nf_get_att_double(id_lakelta, id_h_b1, '_FillValue',zfh_b1)
iret = nf_get_att_double(id_lakelta, id_t_snow, '_FillValue',zft_sfc)
!
iret = nf_get_var1_double(id_lakelta, id_t_snow, nindex, zwt_snow)
iret = nf_get_var1_double(id_lakelta, id_t_ice, nindex, zwt_ice)
iret = nf_get_var1_double(id_lakelta, id_t_mnw, nindex, zwt_mnw)
iret = nf_get_var1_double(id_lakelta, id_t_wml, nindex, zwt_wml)
iret = nf_get_var1_double(id_lakelta, id_t_bot, nindex, zwt_bot)
iret = nf_get_var1_double(id_lakelta, id_t_b1, nindex, zwt_b1)
iret = nf_get_var1_double(id_lakelta, id_ct, nindex, zwct)
iret = nf_get_var1_double(id_lakelta, id_h_snow, nindex, zwh_snow)
iret = nf_get_var1_double(id_lakelta, id_h_ice, nindex, zwh_ice)
iret = nf_get_var1_double(id_lakelta, id_h_ml, nindex, zwh_ml)
iret = nf_get_var1_double(id_lakelta, id_h_b1, nindex, zwh_b1)
iret = nf_get_var1_double(id_lakelta, id_t_sfc, nindex, zwt_sfc)
!
!*      8.     Close file
!
iret = nf_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