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 (HSELECT, 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_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
!              -------------------------
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
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(hselect,  hprogram,'SEAICE_SCHEM',s%CSEAICE_SCHEME,iresp,ycomment)
!
!
IF (s%CSEAICE_SCHEME == 'GELATO') THEN 
   ycomment='Number of sea-ice layers'
   CALL write_surf(hselect,hprogram,'ICENL',nl,iresp,ycomment)
   ycomment='Number of ice categories'
   CALL write_surf(hselect,hprogram,'ICENT',nt,iresp,ycomment)
   !
   !*       1.     Prognostic fields with only space dimension(s) :
   !
   ycomment='ICEUSTAR ()'
   CALL write_surf(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect,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(hselect, &
                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(hselect,hprogram,yrecfm,s%XSIC_MTH(:,jmth),iresp,hcomment=ycomment)
   ENDDO
!
ENDIF
!
yrecfm='SIC'
ycomment='Sea ice coverage'
 CALL write_surf(hselect,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(hselect,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