writesurf_seaicen.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_seaice_n (DGU, U, &
                                      s, &
                                     hprogram)
!     #########################################
!
!!****  *WRITESURF_SEAICE_n* - write seaice scheme variables
!!
!!
!!    PURPOSE : writes state variable and 'domain' structure
!!    -------
!!
!!**  METHOD : 
!!    ------
!!      For now, only Gelato scheme is handled
!!
!!      quite standard in Surfex : use WRITE_SURF with 
!!         relevant field names (same names as in genuine gelato restarts)
!!
!!    EXTERNALS : WRITE_SURF, GLT_ALLOC, GET_TYPE_DIM
!!    --------
!!
!!    IMPLICIT ARGUMENTS : Gelato state variable, and some namelist parameters
!!    ------------------
!!
!!    REFERENCE : 
!!    ---------
!!
!!    AUTHOR : S. Sénési   *Meteo France*
!!    ------
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2014
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
!
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_seaflux_n, ONLY : seaflux_t
!
USE modd_glt_param, ONLY : nl, nt
USE modd_types_glt,   ONLY : t_glt
!
USE modi_write_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_type_dim_n
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
!
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
TYPE(seaflux_t), INTENT(INOUT) :: s
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! calling program
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: iresp           ! Error code after reading
!
INTEGER           :: jmth, inmth
 CHARACTER(LEN=2 ) :: ymth
 CHARACTER(LEN=5)  :: ylvl
!
 CHARACTER(LEN=6)  :: yicecat
 CHARACTER(LEN=20) :: yform
 CHARACTER(LEN=12) :: yrecfm           ! Name of the article to be read
 CHARACTER(LEN=12) :: ycateg           ! Category to write
 CHARACTER(LEN=12) :: ylevel           ! Level to write
 CHARACTER(LEN=100):: ycomment         ! Error Message
!
INTEGER :: jk,jl                   ! loop counter on ice categories and layes 
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('WRITESURF_SEAICE_n',0,zhook_handle)
!
!
ycomment='(-)'
 CALL write_surf(dgu, u, &
                hprogram,'SEAICE_SCHEM',s%CSEAICE_SCHEME,iresp,ycomment)
!
!
IF (s%CSEAICE_SCHEME == 'GELATO') THEN 
   ycomment='Number of sea-ice layers'
   CALL write_surf(dgu, u, &
                hprogram,'ICENL',nl,iresp,ycomment)
   ycomment='Number of ice categories'
   CALL write_surf(dgu, u, &
                hprogram,'ICENT',nt,iresp,ycomment)
   !
   !*       1.     Prognostic fields with only space dimension(s) :
   !
   ycomment='ICEUSTAR ()'
   CALL write_surf(dgu, u, &
                hprogram,'ICEUSTAR',s%TGLT%ust(:,1),iresp,ycomment)
   !
   !*       2.     Prognostic fields with space and ice-category dimension(s) :
   !
   DO jk=1,nt
      WRITE(yicecat,'(I2)') jk
      ycateg='_'//adjustl(yicecat)
      ! .. Write sea ice age for type JK
      ycomment='X_Y_ICEAGE'//ycateg//' (s)'
      CALL write_surf(dgu, u, &
                hprogram,'ICEAGE'//ycateg,s%TGLT%sit(jk,:,1)%age,iresp,ycomment)
      ! .. Write melt pond volume for type JK
      ycomment='X_Y_ICEVMP'//ycateg//' (m3)'
      CALL write_surf(dgu, u, &
                hprogram,'ICEVMP'//ycateg,s%TGLT%sit(jk,:,1)%vmp,iresp,ycomment)
      ! .. Write sea ice surface albedo for type JK
      ycomment='X_Y_ICEASN'//ycateg//' ([0-1])'
      CALL write_surf(dgu, u, &
                hprogram,'ICEASN'//ycateg,s%TGLT%sit(jk,:,1)%asn,iresp,ycomment)
      ! .. Write sea ice fraction for type JK
      ycomment='X_Y_ICEFSI'//ycateg//' ([0-1])'
      CALL write_surf(dgu, u, &
                hprogram,'ICEFSI'//ycateg, s%TGLT%sit(jk,:,1)%fsi,iresp,ycomment)
      ! .. Write sea ice thickness for type JK
      ycomment='X_Y_ICEHSI'//ycateg//' (m)'
      CALL write_surf(dgu, u, &
                hprogram,'ICEHSI'//ycateg, s%TGLT%sit(jk,:,1)%hsi,iresp,ycomment)
      ! .. Write sea ice salinity for type JK
      ycomment='X_Y_ICESSI'//ycateg//' (psu)'
      CALL write_surf(dgu, u, &
                hprogram,'ICESSI'//ycateg, s%TGLT%sit(jk,:,1)%ssi,iresp,ycomment)
      ! .. Write sea ice surface temperature for type JK
      ycomment='X_Y_ICETSF'//ycateg//' (K)'
      CALL write_surf(dgu, u, &
                hprogram,'ICETSF'//ycateg, s%TGLT%sit(jk,:,1)%tsf,iresp,ycomment)
      ! .. Write snow thickness for type JK
      ycomment='X_Y_ICEHSN'//ycateg//' (m)'
      CALL write_surf(dgu, u, &
                hprogram,'ICEHSN'//ycateg, s%TGLT%sit(jk,:,1)%hsn,iresp,ycomment)
      ! .. Write snow density for type JK
      ycomment='X_Y_ICERSN'//ycateg//' (kg m-3)'
      CALL write_surf(dgu, u, &
                hprogram,'ICERSN'//ycateg, s%TGLT%sit(jk,:,1)%rsn,iresp,ycomment)
      !
      !*       3.     Prognostic fields with space and ice-category and layer dimension(s) :
      !
      DO jl=1,nl
         WRITE(ylvl,'(I2)') jl
         ylevel=ycateg(1:len_trim(ycateg))//'_'//adjustl(ylvl)
         yform='(A6,I1.1,A4)'
         IF (jl >= 10)  yform='(A6,I2.2,A4)'
         WRITE(ycomment,fmt=yform) 'X_Y_ICEH',jl,' (J/kg)'
         ! .. Write sea ice vertical gltools_enthalpy profile for type JK and level JL  
         CALL write_surf(dgu, u, &
                hprogram,'ICEH'//ylevel, s%TGLT%sil(jl,jk,:,1)%ent,iresp,ycomment)
      END DO
   END DO
ELSE
   ! This is a placeholder for writing state variables for another seaice scheme
ENDIF
!
!
!-------------------------------------------------------------------------------
!
!* sea ice cover
!
IF(s%LINTERPOL_SIC)THEN
!
   inmth=SIZE(s%XSIC_MTH,2)
!
   DO jmth=1,inmth
      WRITE(ymth,'(I2)') (jmth-1)
      yrecfm='SIC_MTH'//adjustl(ymth(:len_trim(ymth)))
      ycomment='Sea ice coverage at month t'//adjustl(ymth(:len_trim(ymth)))
      CALL write_surf(dgu, u, &
                hprogram,yrecfm,s%XSIC_MTH(:,jmth),iresp,hcomment=ycomment)
   ENDDO
!
ENDIF
!
yrecfm='SIC'
ycomment='Sea ice coverage'
 CALL write_surf(dgu, u, &
                hprogram,yrecfm,s%XSIC(:),iresp,hcomment=ycomment)  
!
!
!* sea ice thickness constraint
!
IF(s%LINTERPOL_SIT)THEN
!
   inmth=SIZE(s%XSIT_MTH,2)
!
   DO jmth=1,inmth
      WRITE(ymth,'(I2)') (jmth-1)
      yrecfm='SIT_MTH'//adjustl(ymth(:len_trim(ymth)))
      ycomment='Sea ice thickness constraint at month t'//adjustl(ymth(:len_trim(ymth)))
      CALL write_surf(dgu, u, &
                hprogram,yrecfm,s%XSIT_MTH(:,jmth),iresp,hcomment=ycomment)
   ENDDO
!
ENDIF
!
IF (lhook) CALL dr_hook('WRITESURF_SEAICE_n',1,zhook_handle)
!
!------------------------------------------------------------------------------
END SUBROUTINE writesurf_seaice_n