prep_seaflux_extern.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 prep_seaflux_extern (&
                                hprogram,hsurf,hfile,hfiletype,hfilepgd,hfilepgdtype,kluout,pfield)
!     #################################################################################
!
!
!
!
USE modd_type_date_surf
!
USE modi_prep_grid_extern
USE modi_read_surf
USE modi_open_aux_io_surf
USE modi_close_aux_io_surf
!
USE modd_surf_par, ONLY : xundef
USE modd_prep,       ONLY : cingrid_type, cinterp_type
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
!
 CHARACTER(LEN=6),   INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=7),   INTENT(IN)  :: hsurf     ! type of field
 CHARACTER(LEN=28),  INTENT(IN)  :: hfile     ! name of file
 CHARACTER(LEN=6),   INTENT(IN)  :: hfiletype ! type of input file
 CHARACTER(LEN=28),  INTENT(IN)  :: hfilepgd     ! name of file
 CHARACTER(LEN=6),   INTENT(IN)  :: hfilepgdtype ! type of input file
INTEGER,            INTENT(IN)  :: kluout    ! logical unit of output listing
REAL,DIMENSION(:,:), POINTER    :: pfield    ! field to interpolate horizontally
!
!*      0.2    declarations of local variables
!
!
REAL, DIMENSION(:), ALLOCATABLE :: zmask
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
INTEGER           :: iresp          ! reading return code
!
INTEGER           :: ini            ! total 1D dimension
INTEGER           :: iversion       ! total 1D dimension
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------------
!
!*      1.     Preparation of IO for reading in the file
!              -----------------------------------------
!
!* Note that all points are read, even those without physical meaning.
!  These points will not be used during the horizontal interpolation step.
!  Their value must be defined as XUNDEF.
!
IF (lhook) CALL dr_hook('PREP_SEAFLUX_EXTERN',0,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
!*      2.     Reading of grid
!              ---------------
!
 CALL open_aux_io_surf(&
                       hfilepgd,hfilepgdtype,'FULL  ')
 CALL prep_grid_extern(&
                       hfilepgdtype,kluout,cingrid_type,cinterp_type,ini)
!
yrecfm='VERSION'
 CALL read_surf(hfilepgdtype,yrecfm,iversion,iresp)
!
ALLOCATE(zmask(ini))
IF (iversion>=7) THEN
  yrecfm='FRAC_SEA'
 CALL read_surf(hfilepgdtype,yrecfm,zmask,iresp,hdir='A')
ELSE
  zmask(:) = 1.
ENDIF
!
 CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
!
!---------------------------------------------------------------------------------------
SELECT CASE(hsurf)
!---------------------------------------------------------------------------------------
!
!*     3.      Orography
!              ---------
!
  CASE('ZS     ')
    ALLOCATE(pfield(ini,1))
    pfield(:,:) = 0.
!
!*      4.  Sea surface temperature
!           -----------------------
!
  CASE('SST    ')
    ALLOCATE(pfield(ini,1))
    yrecfm='SST'
    CALL open_aux_io_surf(&
                       hfile,hfiletype,'SEA   ')
    CALL read_surf(&
                   hfiletype,yrecfm,pfield(:,1),iresp,hdir='A')
    CALL close_aux_io_surf(hfile,hfiletype)
    WHERE (zmask(:)==0.) pfield(:,1) = xundef    
!
!*      5.  Sea surface salinity
!           --------------------
!
  CASE('SSS    ')
    ALLOCATE(pfield(ini,1))
    yrecfm='SSS'
    CALL open_aux_io_surf(&
                       hfile,hfiletype,'FULL  ')
    CALL read_surf(&
                   hfiletype,'VERSION',iversion,iresp)
    CALL close_aux_io_surf(hfile,hfiletype)
    IF(iversion>=8)THEN
      CALL open_aux_io_surf(&
                       hfile,hfiletype,'SEA   ')
      CALL read_surf(&
                   hfiletype,yrecfm,pfield(:,1),iresp,hdir='A')
      CALL close_aux_io_surf(hfile,hfiletype)
      WHERE (zmask(:)==0.) pfield(:,1) = xundef      
    ELSE
      pfield = 0.0
    ENDIF
!
!*      6.  Sea ice fraction
!           ----------------
!
  CASE('SIC    ')
    ALLOCATE(pfield(ini,1))
    pfield = 0.0
!
!---------------------------------------------------------------------------------------
END SELECT
!-------------------------------------------------------------------------------------
!
DEALLOCATE(zmask)
!
!*      6.     End of IO
!              ---------
!
IF (lhook) CALL dr_hook('PREP_SEAFLUX_EXTERN',1,zhook_handle)
!
!---------------------------------------------------------------------------------------
!
END SUBROUTINE prep_seaflux_extern