interpol_sst_mth.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 interpol_sst_mth (S, &
                                   kyear,kmonth,kday,hflag,pout)
!     #######################################################
!
!!****  *INTERPOL_SST_MTH* - Interpolation of monthly SST, SSS, SIT or SIC
!!
!!    PURPOSE
!!    -------
!!
!!
!!**  METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      
!     B.Decharme  Meteo-France
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    28/01/10
!!      Modified    02/2014   S. Senesi : allow to work on SSS, SIT and SIC fields
!!      Modified    07/2015   B. Decharme : new linear interpolation
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modd_seaflux_n, ONLY : seaflux_t
!
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declaration of arguments
!------------------------
! 
!
TYPE(seaflux_t), INTENT(INOUT) :: s
!
INTEGER,          INTENT(IN) :: kyear  ! year of date
INTEGER,          INTENT(IN) :: kmonth ! month of date
INTEGER,          INTENT(IN) :: kday   ! day of date
 CHARACTER(LEN=1), INTENT(IN) :: hflag  ! 'T' for SST, 'S' for SSS, 'H' for SIT, 'C' for SIC
!
REAL, DIMENSION(:), INTENT(OUT) :: pout   ! Sea surface temperature or salinity, or SIC or SIT at time t 
!
!*       0.2   Declaration of local variables
!              ------------------------------
!
REAL            :: zdat   ! current day in the current month
REAL            :: zndat  ! number of days in the current month
INTEGER         :: imth0  ! previous month
INTEGER         :: imth1  ! current month 
INTEGER         :: imth2  ! next month
INTEGER         :: indays ! number of days in KMONTH
!
INTEGER         :: idelta
!
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!*       1.    Number of days in a month
!              -------------------------
!
IF (lhook) CALL dr_hook('INTERPOL_SST_MTH',0,zhook_handle)
IF ( (hflag/='S') .AND. (hflag/='T') .AND. (hflag/='H') .AND. (hflag/='C') )THEN
   CALL abor1_sfx('FATAL ERROR in INTERPOL_SST_MTH : HFLAG not S nor T nor C nor H. !')
ENDIF
SELECT CASE (kmonth)
    CASE(4,6,9,11)
      indays=30
    CASE(1,3,5,7:8,10,12)
      indays=31
    CASE(2)
      IF( ((mod(kyear,4)==0).AND.(mod(kyear,100)/=0)) .OR. (mod(kyear,400)==0))THEN
        indays=29
      ELSE
        indays=28
      ENDIF
END SELECT
!
!
!-------------------------------------------------------------------------------
!
!*       2.    SST or SSS  Interpolation using previous, current and next month
!              --------------------------------------------------------
!
zdat = REAL(kday)
zndat= REAL(indays)
!
! The current month correspond to the indice 2 (or 3 if next month)
!
IF (kmonth==s%TZTIME%TDATE%MONTH) THEN 
   idelta=0
ELSE
   idelta=1
END IF
!
imth0=1+idelta
imth1=2+idelta
imth2=3+idelta
!
IF (hflag =='T') THEN 
   CALL interpol_local(s%CINTERPOL_SST,s%XSST_MTH(:,imth0),s%XSST_MTH(:,imth1),s%XSST_MTH(:,imth2))
ELSEIF (hflag =='S') THEN 
   CALL interpol_local(s%CINTERPOL_SSS,s%XSSS_MTH(:,imth0),s%XSSS_MTH(:,imth1),s%XSSS_MTH(:,imth2))
   pout(:) = max(0.0,pout(:))
ELSEIF (hflag =='H') THEN 
   CALL interpol_local(s%CINTERPOL_SIT,s%XSIT_MTH(:,imth0),s%XSIT_MTH(:,imth1),s%XSIT_MTH(:,imth2))
   pout(:) = max(0.0,pout(:))
ELSEIF (hflag =='C') THEN
   CALL interpol_local(s%CINTERPOL_SIC,s%XSIC_MTH(:,imth0),s%XSIC_MTH(:,imth1),s%XSIC_MTH(:,imth2))
   pout(:) = max(0.0,min(1.0,pout(:)))
ENDIF
!
IF (lhook) CALL dr_hook('INTERPOL_SST_MTH',1,zhook_handle)
!
!=======================================================================================
!
 CONTAINS
!
!=======================================================================================
!
SUBROUTINE interpol_local(HMETHOD,PMTH0,PMTH1,PMTH2)
!
USE modi_interpol_quadra
USE modi_interpol_linear
!
IMPLICIT NONE
!
 CHARACTER(LEN=6),    INTENT(IN) :: hmethod
REAL, DIMENSION(:) , INTENT(IN) :: pmth0
REAL, DIMENSION(:) , INTENT(IN) :: pmth1
REAL, DIMENSION(:) , INTENT(IN) :: pmth2
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('INTERPOL_SST_MTH:INTERPOL_LOCAL',0,zhook_handle)
!
IF(hmethod=='QUADRA')THEN
  CALL interpol_quadra(zdat,zndat,pmth0,pmth1,pmth2,pout)
ELSEIF(hmethod=='LINEAR')THEN
  CALL interpol_linear(zdat,zndat,pmth0,pmth1,pmth2,pout)
ELSEIF(hmethod=='UNIF')THEN
  pout(:) = pmth1(:)
ELSE
  CALL abor1_sfx('INTERPOL_SST_MTH:INTERPOL_LOCAL: interpolation method not supported')
ENDIF
!
IF (lhook) CALL dr_hook('INTERPOL_SST_MTH:INTERPOL_LOCAL',1,zhook_handle)
!
END SUBROUTINE interpol_local
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE interpol_sst_mth