writesurf_seafluxn.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 writesurf_seaflux_n (HSELECT, O, OR, S, HPROGRAM)
!     ########################################
!
!!****  *WRITE_SEAFLUX_n* - writes SEAFLUX fields
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*      
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003 
!!      Modified    01/2014 : S. Senesi : handle seaice scheme
!!      S. Belamari 03/2014   Include sea surface salinity XSSS
!!      R. Séférian 01/2015 : introduce interactive ocean surface albedo
!!      S. Senesi   08/2015 : fix units in some HCOMMENTs
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_ocean_n, ONLY : ocean_t
USE modd_ocean_rel_n, ONLY : ocean_rel_t
USE modd_seaflux_n, ONLY : seaflux_t
!
USE modi_write_surf
USE modi_writesurf_ocean_n
USE modi_writesurf_seaice_n
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT 
!
TYPE(ocean_t), INTENT(INOUT) :: O
TYPE(ocean_rel_t), INTENT(INOUT) :: OR
TYPE(seaflux_t), INTENT(INOUT) :: S
!
 CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling

!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: JMTH, INMTH
 CHARACTER(LEN=2 ) :: YMTH
!
INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears
 CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
 CHARACTER(LEN=100):: YCOMMENT       ! Comment string
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
!
IF (lhook) CALL dr_hook('WRITESURF_SEAFLUX_N',0,zhook_handle)
!
 CALL writesurf_ocean_n(hselect, o, or, hprogram)
!
!*       2.     Sea-ice prognostic fields:
!               --------------------------
!
!* flag to tell if Sea Ice model is used
!
ycomment='flag to handle sea ice cover'
 CALL write_surf(hselect, hprogram,'HANDLE_SIC',s%LHANDLE_SIC,iresp,ycomment)
!
IF (s%LHANDLE_SIC) CALL writesurf_seaice_n(hselect, s, hprogram)
!
!
!*       3.     Prognostic fields:
!               -----------------
!
!* water temperature
!
IF(s%LINTERPOL_SST)THEN
!
  inmth=SIZE(s%XSST_MTH,2)
!
  DO jmth=1,inmth
     WRITE(ymth,'(I2)') (jmth-1)
     yrecfm='SST_MTH'//adjustl(ymth(:len_trim(ymth)))
     ycomment='SST at month t'//adjustl(ymth(:len_trim(ymth)))//' (K)'
     CALL write_surf(hselect, hprogram,yrecfm,s%XSST_MTH(:,jmth),iresp,hcomment=ycomment)
  ENDDO
!
ENDIF
!
yrecfm='SST'
ycomment='SST (K)'
 CALL write_surf(hselect, hprogram,yrecfm,s%XSST(:),iresp,hcomment=ycomment)  
!
!-------------------------------------------------------------------------------
!
!*       4.     Semi-prognostic fields:
!               ----------------------
!
!* roughness length
!
yrecfm='Z0SEA'
ycomment='Z0SEA (m)'
 CALL write_surf(hselect, hprogram,yrecfm,s%XZ0(:),iresp,hcomment=ycomment)
!
!
!* sea surface salinity
!
IF(s%LINTERPOL_SSS)THEN
   !
   inmth=SIZE(s%XSSS_MTH,2)
   !
   DO jmth=1,inmth
      WRITE(ymth,'(I2)') (jmth-1)
      yrecfm='SSS_MTH'//adjustl(ymth(:len_trim(ymth)))
      ycomment='Sea Surface Salinity at month t'//adjustl(ymth(:len_trim(ymth)))//' (psu)'
      CALL write_surf(hselect, hprogram,yrecfm,s%XSSS_MTH(:,jmth),iresp,hcomment=ycomment)
   ENDDO
!
ENDIF
!
yrecfm='SSS'
ycomment='Sea Surface Salinity (psu)'
 CALL write_surf(hselect, hprogram,yrecfm,s%XSSS(:),iresp,hcomment=ycomment)  
!
!
!* ocean surface albedo (direct and diffuse fraction)
!
IF(s%CSEA_ALB=='RS14')THEN
!
  yrecfm='OSA_DIR'
  ycomment='direct ocean surface albedo (-)'
  CALL write_surf(hselect, hprogram,yrecfm,s%XDIR_ALB(:),iresp,hcomment=ycomment)
!
  yrecfm='OSA_SCA'
  ycomment='diffuse ocean surface albedo (-)'
  CALL write_surf(hselect, hprogram,yrecfm,s%XSCA_ALB(:),iresp,hcomment=ycomment)
!
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       5.  Time
!            ----
!
yrecfm='DTCUR'
ycomment='s'
 CALL write_surf(hselect, hprogram,yrecfm,s%TTIME,iresp,hcomment=ycomment)
!
IF (lhook) CALL dr_hook('WRITESURF_SEAFLUX_N',1,zhook_handle)
!
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE writesurf_seaflux_n