read_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 read_seaflux_n (DTCO, SG, S, U, &
                                 hprogram,kluout)
!     #########################################
!
!!****  *READ_SEAFLUX_n* - read SEAFLUX varaibles
!!
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*      
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2003 
!!      Modified    02/2008 Add oceanic variables initialisation
!!      S. Belamari 04/2014 Suppress LMERCATOR
!!      R. Séférian 01/2015 introduce new ocean surface albedo 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_seaflux_grid_n, ONLY : seaflux_grid_t
USE modd_seaflux_n, ONLY : seaflux_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_par,       ONLY : xundef
!
USE modi_read_surf
USE modi_interpol_sst_mth
!
USE modi_get_type_dim_n
USE modi_abor1_sfx
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(seaflux_grid_t), INTENT(INOUT) :: sg
TYPE(seaflux_t), INTENT(INOUT) :: s
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)  :: hprogram ! calling program
INTEGER,           INTENT(IN)  :: kluout
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER           :: jmth, inmth
 CHARACTER(LEN=2 ) :: ymth
!
INTEGER           :: ilu          ! 1D physical dimension
!
INTEGER           :: iresp          ! Error code after redding
!
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
!
INTEGER           :: iversion       ! surface version
!
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!* 1D physical dimension
!
IF (lhook) CALL dr_hook('READ_SEAFLUX_N',0,zhook_handle)
!
yrecfm='SIZE_SEA'
 CALL get_type_dim_n(dtco, u, &
                    'SEA   ',ilu)
!
!*       2.     Prognostic fields:
!               -----------------
!
!* water temperature
!
ALLOCATE(s%XSST(ilu))
!
IF(s%LINTERPOL_SST)THEN
!
! Precedent, Current, Next, and Second-next Monthly SST
  inmth=4
!
  ALLOCATE(s%XSST_MTH(SIZE(s%XSST),inmth))
  DO jmth=1,inmth
     WRITE(ymth,'(I2)') (jmth-1)
     yrecfm='SST_MTH'//adjustl(ymth(:len_trim(ymth)))
     CALL read_surf(&
                    hprogram,yrecfm,s%XSST_MTH(:,jmth),iresp)
  ENDDO
!
  CALL interpol_sst_mth(s, &
                        s%TTIME%TDATE%YEAR,s%TTIME%TDATE%MONTH,s%TTIME%TDATE%DAY,'T',s%XSST)
!
ELSE
! 
  ALLOCATE(s%XSST_MTH(0,0))
!
  yrecfm='SST'
  CALL read_surf(&
                    hprogram,yrecfm,s%XSST(:),iresp)
!
ENDIF
!
!* stochastic flux perturbation pattern
!
ALLOCATE(s%XPERTFLUX(ilu))
IF( s%LPERTFLUX ) THEN
   CALL read_surf(&
                    hprogram,'PERTSEAFLUX',s%XPERTFLUX(:),iresp)
ELSE
  s%XPERTFLUX(:) = 0.
ENDIF
!
!-------------------------------------------------------------------------------
!
!*       3.     Semi-prognostic fields:
!               ----------------------
!
!* roughness length
!
ALLOCATE(s%XZ0(ilu))
yrecfm='Z0SEA'
s%XZ0(:) = 0.001
 CALL read_surf(&
                    hprogram,yrecfm,s%XZ0(:),iresp)
!
!* flag to use or not the SeaIce model 
!
 CALL read_surf(&
                    hprogram,'VERSION',iversion,iresp)
IF (iversion <8) THEN
   s%LHANDLE_SIC=.false.
ELSE
   CALL read_surf(&
                    hprogram,'HANDLE_SIC',s%LHANDLE_SIC,iresp)
ENDIF
!
!
! * sea surface salinity
!
ALLOCATE(s%XSSS(ilu))
s%XSSS(:)=0.0
!
!* Sea surface salinity nudging data
!
IF(s%LINTERPOL_SSS)THEN
   !
   ! Precedent, Current, Next, and Second-next Monthly SSS
   inmth=4
   !
   ALLOCATE(s%XSSS_MTH(ilu,inmth))
   DO jmth=1,inmth
      WRITE(ymth,'(I2)') (jmth-1)
      yrecfm='SSS_MTH'//adjustl(ymth(:len_trim(ymth)))
      CALL read_surf(&
                    hprogram,yrecfm,s%XSSS_MTH(:,jmth),iresp)
      CALL check_sea(yrecfm,s%XSSS_MTH(:,jmth))
   ENDDO
   !
   CALL interpol_sst_mth(s, &
                        s%TTIME%TDATE%YEAR,s%TTIME%TDATE%MONTH,s%TTIME%TDATE%DAY,'S',s%XSSS)
   !
ELSEIF (iversion>=8) THEN
   ! 
   ALLOCATE(s%XSSS_MTH(0,0))
   !
   yrecfm='SSS'
   CALL read_surf(&
                    hprogram,yrecfm,s%XSSS,iresp)
   IF(s%LHANDLE_SIC)THEN
     CALL check_sea(yrecfm,s%XSSS(:))
   ENDIF
   !
ENDIF
!
!* ocean surface albedo (direct and diffuse fraction)
!
ALLOCATE(s%XDIR_ALB (ilu))
ALLOCATE(s%XSCA_ALB (ilu))
!
IF(s%CSEA_ALB=='RS14')THEN
!
  yrecfm='OSA_DIR'
  CALL read_surf(&
                    hprogram,yrecfm,s%XDIR_ALB(:),iresp)
!
  yrecfm='OSA_SCA'
  CALL read_surf(&
                    hprogram,yrecfm,s%XSCA_ALB(:),iresp)
!
ELSE
!
  s%XDIR_ALB(:)=0.065
  s%XSCA_ALB(:)=0.065
!
ENDIF
!
IF (lhook) CALL dr_hook('READ_SEAFLUX_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
 CONTAINS
!-------------------------------------------------------------------------------
!
SUBROUTINE check_sea(HFIELD,PFIELD)
!
!
IMPLICIT NONE
!
 CHARACTER(LEN=12),  INTENT(IN) :: hfield
REAL, DIMENSION(:), INTENT(IN) :: pfield
!
REAL            :: zmax,zmin
INTEGER         :: ji, ierrc
!
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('READ_SEAFLUX_N:CHECK_SEA',0,zhook_handle)
!
zmin=-1.0e10
zmax=1.0e10
!
ierrc=0
!
DO ji=1,ilu
   IF(pfield(ji)>zmax.OR.pfield(ji)<zmin)THEN
      ierrc=ierrc+1
      WRITE(kluout,*)'PROBLEM FIELD '//trim(hfield)//' =',pfield(ji),&
                     'NOT REALISTIC AT LOCATION (LAT/LON)',sg%XLAT(ji),sg%XLON(ji)
   ENDIF
ENDDO
!         
IF(ierrc>0) CALL abor1_sfx('READ_SEAFLUX_N: FIELD '//trim(hfield)//' NOT REALISTIC')
!
IF (lhook) CALL dr_hook('READ_SEAFLUX_N:CHECK_SEA',1,zhook_handle)

END SUBROUTINE check_sea
!
!------------------------------------------------------------------------------
END SUBROUTINE read_seaflux_n