source: NEMO/branches/UKMO/NEMO_4.0.4_generic_obs/src/OCE/OBS/obs_readsnowdepth.F90 @ 15497

MODULE obs_readsnowdepth
   !!======================================================================
   !!                       ***  MODULE obs_readsnowdepth  ***
   !! Observation diagnostics: Get the snow depth for freeboard conversion to thickness
   !!======================================================================
   !! History :      ! 2018-10 (E. Fiedler) Initial version
   !!----------------------------------------------------------------------

   !!----------------------------------------------------------------------
   !!   obs_rea_snowdepth    : Driver for reading MDT
   !!----------------------------------------------------------------------
   USE par_kind         ! Precision variables
   USE par_oce          ! Domain parameters
   USE in_out_manager   ! I/O manager
   USE obs_surf_def     ! Surface observation definitions
   USE obs_inter_sup    ! Interpolation support routines
   USE obs_inter_h2d    ! 2D interpolation
   USE obs_utils        ! Various observation tools
   USE iom_nf90         ! IOM NetCDF
   USE netcdf           ! NetCDF library
   USE lib_mpp          ! MPP library
   USE dom_oce, ONLY : &                  ! Domain variables
      &                    tmask, tmask_i, e1t, e2t, gphit, glamt
   USE obs_const, ONLY :   obfillflt      ! Fillvalue

   IMPLICIT NONE
   PRIVATE
   
   PUBLIC   obs_rea_snowdepth     ! called by dia_obs

   !!----------------------------------------------------------------------
   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
   !! $Id$
   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE obs_rea_snowdepth( fbddata, k2dint, ksnow, thick_s )
      !!---------------------------------------------------------------------
      !!
      !!                   *** ROUTINE obs_rea_snowdepth ***
      !!
      !! ** Purpose : Get snowdepth at observation points
      !!
      !! ** Method  : 
      !!
      !! ** Action  : 
      !!----------------------------------------------------------------------
      USE iom
      !
      TYPE(obs_surf), INTENT(inout)  ::   fbddata   ! Sea ice freeboard data
      INTEGER       , INTENT(in)     ::   k2dint    ! ?
      INTEGER       , INTENT(in)    ::    ksnow     ! Index of snow thickness extra var
      REAL(wp), INTENT(IN), DIMENSION(jpi,jpj) :: thick_s ! Model snow depth
     
      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_snowdepth'

      INTEGER ::   jobs                ! Obs loop variable
      INTEGER ::   jpi_thick_s, jpj_thick_s      ! Number of grid point in lat/lon for the snow depth
      INTEGER ::   iico, ijco          ! Grid point indices

      !
      REAL(wp), DIMENSION(1)     ::   zext, zobsmask
      REAL(wp), DIMENSION(2,2,1) ::   zweig
      !
      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   zmask, z_thick_s_l, zglam, zgphi
      INTEGER , DIMENSION(:,:,:), ALLOCATABLE ::   igrdi, igrdj
      !
      REAL(wp), DIMENSION(jpi,jpj) ::  z_thick_s, thick_s_mask
         
      REAL(wp) :: zlam, zphi, zfill, zinfill    ! local scalar
      !!----------------------------------------------------------------------

      IF(lwp)WRITE(numout,*) 
      IF(lwp)WRITE(numout,*) ' obs_rea_snowdepth : Get model snow depth for freeboard conversion to sea ice thickness'
      IF(lwp)WRITE(numout,*) ' ------------- '
      CALL FLUSH(numout)

      ! Get ice thickness information
      z_thick_s = thick_s

      ! Setup mask based on tmask
      thick_s_mask(:,:) = tmask(:,:,1)

      ! Interpolate the snow depth already on the model grid at the observation point
  
      ALLOCATE( &
         & igrdi(2,2,fbddata%nsurf), &
         & igrdj(2,2,fbddata%nsurf), &
         & zglam(2,2,fbddata%nsurf), &
         & zgphi(2,2,fbddata%nsurf), &
         & zmask(2,2,fbddata%nsurf), &
         & z_thick_s_l(2,2,fbddata%nsurf)  &
         & )
         
      DO jobs = 1, fbddata%nsurf

         igrdi(1,1,jobs) = fbddata%mi(jobs)-1
         igrdj(1,1,jobs) = fbddata%mj(jobs)-1
         igrdi(1,2,jobs) = fbddata%mi(jobs)-1
         igrdj(1,2,jobs) = fbddata%mj(jobs)
         igrdi(2,1,jobs) = fbddata%mi(jobs)
         igrdj(2,1,jobs) = fbddata%mj(jobs)-1
         igrdi(2,2,jobs) = fbddata%mi(jobs)
         igrdj(2,2,jobs) = fbddata%mj(jobs)

      END DO

      CALL obs_int_comm_2d( 2, 2, fbddata%nsurf, jpi, jpj, igrdi, igrdj, glamt  , zglam )
      CALL obs_int_comm_2d( 2, 2, fbddata%nsurf, jpi, jpj, igrdi, igrdj, gphit  , zgphi )
      CALL obs_int_comm_2d( 2, 2, fbddata%nsurf, jpi, jpj, igrdi, igrdj, thick_s_mask, zmask )
      CALL obs_int_comm_2d( 2, 2, fbddata%nsurf, jpi, jpj, igrdi, igrdj, z_thick_s  , z_thick_s_l )

      DO jobs = 1, fbddata%nsurf
            
         zlam = fbddata%rlam(jobs)
         zphi = fbddata%rphi(jobs)

         CALL obs_int_h2d_init( 1, 1, k2dint, zlam, zphi,         &
            &                   zglam(:,:,jobs), zgphi(:,:,jobs), &
            &                   zmask(:,:,jobs), zweig, zobsmask )
            
         CALL obs_int_h2d( 1, 1, zweig, z_thick_s_l(:,:,jobs),  zext )
 
         fbddata%rext(jobs,ksnow) = zext(1)

! mark any masked data with a QC flag
         IF( zobsmask(1) == 0 )   fbddata%nqc(jobs) = IBSET(fbddata%nqc(jobs),15)

         END DO
         
      DEALLOCATE( &
         & igrdi, &
         & igrdj, &
         & zglam, &
         & zgphi, &
         & zmask, &
         & z_thick_s_l  &
         & )

      IF(lwp)WRITE(numout,*) ' ------------- '
      !
   END SUBROUTINE obs_rea_snowdepth
   
   !!======================================================================
END MODULE obs_readsnowdepth