prep_watflux_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_watflux_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 modi_abor1_sfx
USE modi_get_luout
!
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           :: iluout
INTEGER           :: idim_water
!
INTEGER           :: iversion       ! total 1D dimension
INTEGER           :: ini            ! 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_WATFLUX_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)
!
 CALL read_surf(&
               hfilepgdtype,'DIM_WATER',idim_water,iresp)
!
yrecfm='VERSION'
 CALL read_surf(hfilepgdtype,yrecfm,iversion,iresp)
!
ALLOCATE(zmask(ini))
IF (iversion>=7) THEN
  yrecfm='FRAC_WATER'
  CALL read_surf(hfilepgdtype,yrecfm,zmask,iresp,hdir='A')       
ELSE
  zmask(:) = 1.
ENDIF  
!
IF (idim_water==0) THEN
  CALL get_luout(hprogram,iluout)
  WRITE(iluout,*) ' '
  WRITE(iluout,*) 'No inland water data available in input file ',hfile
  WRITE(iluout,*) 'Please change your input file '
  WRITE(iluout,*) '             or '
  WRITE(iluout,*) 'specify inland water temperature XTS_WATER_UNIF'
  CALL abor1_sfx('PREP_WATFLUX_EXTERN: No inland water data available in input file')
END IF
!---------------------------------------------------------------------------------------
SELECT CASE(hsurf)
!---------------------------------------------------------------------------------------
!
!*     3.      Orography
!              ---------
!
  CASE('ZS     ')
    ALLOCATE(pfield(ini,1))
    yrecfm='ZS'
    CALL read_surf(&
               hfilepgdtype,yrecfm,pfield(:,1),iresp,hdir='A')
    CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
!
!*      4.  Sea surface temperature
!           -----------------------
!
  CASE('TSWATER')
    ALLOCATE(pfield(ini,1))
    yrecfm='TS_WATER'
    CALL close_aux_io_surf(hfilepgd,hfilepgdtype)
    CALL open_aux_io_surf(&
                      hfile,hfiletype,'WATER ')
    CALL read_surf(&
               hfiletype,yrecfm,pfield(:,1),iresp,hdir='A')
    CALL close_aux_io_surf(hfile,hfiletype)
    WHERE (zmask(:)==0.) pfield(:,1) = xundef    
!
!---------------------------------------------------------------------------------------
END SELECT
!-------------------------------------------------------------------------------------
!
DEALLOCATE(zmask)
!
!*      6.     End of IO
!              ---------
!
IF (lhook) CALL dr_hook('PREP_WATFLUX_EXTERN',1,zhook_handle)
!
!---------------------------------------------------------------------------------------
!
END SUBROUTINE prep_watflux_extern