!----------------------------------------------------------------------
SUBROUTINE UPDSST ( KPROMA, KSTART, KPROF, KFNUDG, KCSS, KBLK,&
 !----------------------------------------------------------------------
 ! - INPUT 1D
 & PXNUDG,&
 ! - IN/OUT 1D
 & PTS,  PTP,  PWS,  PWP,  PSNS,&
 & PLSM, PALB, PEMI, PZ0F, PZ0H, PD2,  PIVEG)  
!****
!     ------------------------------------------------------------------

!     UPDATING SST AND MISCELLANEOUS IN CASE OF NUDGING

!     INDEED, UPDCLI DEFINES ONCE A DAY THE OPEN SEA/SEA ICE PROPERTIES
!     FROM THE CONTENT OF BCOND FILES. HERE WE USE AT EACH TIME STEP
!     THE CONTENT OF THE NUDGING FILES, WHICH MAY BE QUITE DIFFERENT

!     WHEN ISBA IS DESACTIVATED (LSOLV=.FALSE.), 
!     ONE SHOULD USE LMCC02=.FALSE.,
!     SO THAT LSM=0 OVER SEA ICE, SINCE THERE IS NO WAY TO
!     DISCRIMINATE SEA AND SEA ICE (EXCEPT THE OLD TEST ON
!     TPCLIM=TMERGL WE DO NOT RECOMMEND)

!     SORRY WILLIAM, THE OTHER COMMENTS USE MOLIERE LANGUAGE

!     ------------------------------------------------------------------

!     ARGUMENTS D ENTREE
!     ------------------
!       KPROMA : DIMENSION HORIZONTALE
!       KSTART : BORNE INITIALE HORIZONTALE DES CALCULS
!       KPROF : BORNE FINALE HORIZONTALE DES CALCULS
!       KFNUDG  : NBRE DE PAS DE TEMPS D'ANALYSE A INTERPOLER
!       KCSS    : NBRE DE NIVEAUX DANS LE SOL PROFOND
!       KBLK  : OFFSET (KBLK=(KSTGLO-1)/NPROMA+1)       

!     ENTREES
!     -------
!       PXNUDG(KFNUDG) : COEFFICIENTS TEMPORELS

!     ARGUMENTS IMPLICITES
!     --------------------
!       INDICATEURS LOGIQUES    = COMMON /YOMPHY /: LSOLV
!       COEFF DE RAPPEL = COMMON /YOMNUD /

!     SORTIES
!     -------
!       PTS   : TEMPERATURE DE SURFACE
!       PTP   : TEMPERATURE PROFONDE
!       PWS   : RESERVOIR DE SURFACE
!       PWP   : RESERVOIR PROFOND   
!       PSNS  : RESERVOIR DE NEIGE  
!       PLSM  : MASQUE TERRE-MER
!       PALB  : ALBEDO
!       PEMIS : EMISSIVITE
!       PZ0F  : LONGUEUR DE RUGOSITE
!       PZ0H  : LONGUEUR DE RUGOSITE THERMIQUE
!       PD2   : PROFONDEUR RACINAIRE
!       PIVEG : TYPE DE VEGETATION

!     IMPROVISE PAR
!     ------------- 
!       MICHEL DEQUE

!     AVEC LES MODIFS DE
!     ------------------
!       1999-02-25: Michel Deque: nudging with correction
!       2000-01-10: Michel Deque: fix of bug with NTVGLA and with Z0
!       2001-07-04: Michel Deque: no update when coupled
!       2006-08-30: A. Alias    : RZHMER replaced by RZHZ0M*RZ0MER
!       2006-09-05: A. Alias    : RZHGLA replaced by RZHZ0G*RZ0GLA
!       2006-10-26: A. Alias    : Change in arguments list following
!                   introduction of new surface fields (CY31R2)
!       2007-10-31: A. Alias    : Test modified to proceed with nudging
!                                 Test removed (field PZ0H exists when LSOLV)
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMNUD   , ONLY : XNUDST, XVUST
USE YOMPHY   , ONLY : LSOLV
USE YOMCST   , ONLY : RG
USE YOMPHY1  , ONLY : ALBGLA, ALBMER, EMMGLA, EMMMER, NTVGLA, NTVMER,&
 & RD1, RD2GLA, RD2MER, RZ0GLA,&
 & RZHZ0G, RZ0MER, RZHZ0M, TMERGL  
USE YOMMCC   , ONLY : LMCC02, LMCC03

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KPROMA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFNUDG 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBLK
INTEGER(KIND=JPIM),INTENT(IN)    :: KCSS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSTART 
INTEGER(KIND=JPIM),INTENT(IN)    :: KPROF 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXNUDG(KFNUDG) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTP(KPROMA,KCSS) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWP(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSNS(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLSM(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PALB(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMI(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ0F(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZ0H(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PD2(KPROMA) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PIVEG(KPROMA) 
INTEGER(KIND=JPIM), PARAMETER :: JPKZ = KIND(PIVEG)

REAL(KIND=JPRB) :: ZREF(KPROMA)

INTEGER(KIND=JPIM) :: JCSS, JROF, JSTEP

LOGICAL :: LLMEGL

REAL(KIND=JPRB) :: ZWXGLA, ZWXMER, ZWXSUR
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!*
!     ------------------------------------------------------------------
!     1.- MISE A JOUR SUR MER/BANQUISE

IF (LHOOK) CALL DR_HOOK('UPDSST',0,ZHOOK_HANDLE)

!       PAS DE MISE A JOUR DANS LE CAS DU NUDGING AVEC CORRECTION
!       PAS DE MISE A JOUR DANS LE CAS DU COUPLAGE
IF(XNUDST > 0.0_JPRB.AND.(.NOT.LMCC03)) THEN
  ZWXMER=1000._JPRB*RD2MER
  ZWXGLA=1000._JPRB*RD2GLA
  ZWXSUR=1000._JPRB*RD1
  !      ZREF :  TEMPERATURE DE SURFACE DE RAPPEL
  DO JROF = KSTART,KPROF
    ZREF(JROF)=0.0_JPRB
  ENDDO
  DO JSTEP=1,KFNUDG
    DO JROF = KSTART,KPROF
      ZREF(JROF)=ZREF(JROF)+XVUST(JROF,JSTEP,KBLK)*PXNUDG(JSTEP)
    ENDDO
  ENDDO
  !      BOUCLE SUR LES POINTS DE MER OU BANQUISE      
  DO JROF = KSTART,KPROF
    IF(LSOLV) THEN
      LLMEGL=(NINT(PIVEG(JROF)) == NTVMER.OR.&
       & (NINT(10*PIVEG(JROF))) == (10*NTVGLA+1))  
    ELSE
      LLMEGL=(PLSM(JROF) < 0.5_JPRB)
    ENDIF
    IF(LLMEGL)THEN
      IF(ZREF(JROF) > TMERGL) THEN
  !         Mer libre
        PLSM(JROF)=0.0_JPRB
        PIVEG(JROF)=REAL(NTVMER,JPKZ)
  ! don't reset Z0 because of Charnock formula
  !           PZ0F(JROF)=RZ0MER*RG
        PALB(JROF)=ALBMER
        PEMI(JROF)=EMMMER
        PTS(JROF)=ZREF(JROF)
        DO JCSS=1,KCSS
          PTP(JROF,JCSS)=ZREF(JROF)
        ENDDO
        PWS(JROF)=ZWXSUR
        PWP(JROF)=ZWXMER
        PSNS(JROF)=0.0_JPRB
        IF(LSOLV)THEN
          PD2(JROF)=RD2MER
          PZ0H(JROF)=RZHZ0M*RZ0MER*RG
        ENDIF
      ELSE
  !         Glace de mer
        IF(LMCC02)THEN
          PLSM(JROF)=1.0_JPRB
        ELSE
          PLSM(JROF)=0.0_JPRB
        ENDIF
        PIVEG(JROF)=REAL(NTVGLA,JPKZ)+.1_JPRB
        PZ0F(JROF)=RZ0GLA*RG
        PALB(JROF)=ALBGLA
        PEMI(JROF)=EMMGLA
        PTS(JROF)=ZREF(JROF)
        DO JCSS=1,KCSS
          PTP(JROF,JCSS)=ZREF(JROF)
        ENDDO
        PWS(JROF)=ZWXSUR
        PWP(JROF)=ZWXGLA
        IF(LSOLV)THEN
          PD2(JROF)=RD2GLA
          PZ0H(JROF)=RZHZ0G*RZ0GLA*RG
        ENDIF
      ENDIF
    ENDIF
  ENDDO

ENDIF

IF (LHOOK) CALL DR_HOOK('UPDSST',1,ZHOOK_HANDLE)
END SUBROUTINE UPDSST
