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,HFLAG)
!     #######################################################
!
!!****  *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
!
 CHARACTER(LEN=1), INTENT(IN) :: HFLAG  ! 'T' for SST, 'S' for SSS, 'H' for SIT, 'C' for SIC

!
!*       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 (s%TTIME%TDATE%MONTH)
    CASE(4,6,9,11)
      indays=30
    CASE(1,3,5,7:8,10,12)
      indays=31
    CASE(2)
      IF( ((mod(s%TTIME%TDATE%YEAR,4)==0).AND.(mod(s%TTIME%TDATE%YEAR,100)/=0)) &
          .OR. (mod(s%TTIME%TDATE%YEAR,400)==0))THEN
        indays=29
      ELSE
        indays=28
      ENDIF
END SELECT
!
!
!-------------------------------------------------------------------------------
!
!*       2.    SST or SSS  Interpolation using previous, current and next month
!              --------------------------------------------------------
!
zdat = REAL(s%ttime%tdate%day)
zndat= REAL(indays)
!
! The current month correspond to the indice 2 (or 3 if next month)
!
IF (s%TTIME%TDATE%MONTH==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),s%XSST)
ELSEIF (hflag =='S') THEN 
   CALL interpol_local(s%CINTERPOL_SSS,s%XSSS_MTH(:,imth0),s%XSSS_MTH(:,imth1),s%XSSS_MTH(:,imth2),s%XSSS)
   s%XSSS(:) = max(0.0,s%XSSS(:))
ELSEIF (hflag =='H') THEN 
   CALL interpol_local(s%CINTERPOL_SIT,s%XSIT_MTH(:,imth0),s%XSIT_MTH(:,imth1),s%XSIT_MTH(:,imth2),s%XFSIT)
   s%XFSIT(:) = max(0.0,s%XFSIT(:))
ELSEIF (hflag =='C') THEN
   CALL interpol_local(s%CINTERPOL_SIC,s%XSIC_MTH(:,imth0),s%XSIC_MTH(:,imth1),s%XSIC_MTH(:,imth2),s%XFSIC)
   s%XFSIC(:) = max(0.0,min(1.0,s%XFSIC(:)))
ENDIF
!
IF (lhook) CALL dr_hook('INTERPOL_SST_MTH',1,zhook_handle)
!
!=======================================================================================
!
CONTAINS
!
!=======================================================================================
!
SUBROUTINE interpol_local(HMETHOD,PMTH0,PMTH1,PMTH2,POUT)
!
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, DIMENSION(:), INTENT(OUT) :: POUT
!
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