src/SURFEX/prep_watflux_extern.F90

   1 !SURFEX_LIC Copyright 1994-2014 Meteo-France
   2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
   3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
   4 !SURFEX_LIC for details. version 1.
   5 !     #########
   6 SUBROUTINE PREP_WATFLUX_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
   7 !     #################################################################################
   8 !
   9 USE MODD_TYPE_DATE_SURF
  10 !
  11 USE MODI_PREP_GRID_EXTERN
  12 USE MODI_READ_SURF
  13 USE MODI_OPEN_AUX_IO_SURF
  14 USE MODI_CLOSE_AUX_IO_SURF
  15 USE MODI_ABOR1_SFX
  16 USE MODI_GET_LUOUT
  17 !
  18 USE MODD_PREP,       ONLY : CINGRID_TYPE, CINTERP_TYPE
  19 !
  20 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
  21 USE PARKIND1  ,ONLY : JPRB
  22 !
  23 IMPLICIT NONE
  24 !
  25 !*      0.1    declarations of arguments
  26 !
  27  CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
  28  CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field
  29  CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file
  30  CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file
  31  CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file
  32  CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file
  33 INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing
  34 REAL,DIMENSION(:,:), POINTER    :: PFIELD    ! field to interpolate horizontally
  35 !
  36 !*      0.2    declarations of local variables
  37 !
  38 !
  39  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
  40 INTEGER           :: IRESP          ! reading return code
  41 INTEGER           :: ILUOUT
  42 INTEGER           :: IDIM_WATER
  43 !
  44 INTEGER           :: INI            ! total 1D dimension
  45 REAL(KIND=JPRB) :: ZHOOK_HANDLE
  46 !
  47 !-------------------------------------------------------------------------------------
  48 !
  49 !*      1.     Preparation of IO for reading in the file
  50 !              -----------------------------------------
  51 !
  52 !* Note that all points are read, even those without physical meaning.
  53 !  These points will not be used during the horizontal interpolation step.
  54 !  Their value must be defined as XUNDEF.
  55 !
  56 IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_EXTERN',0,ZHOOK_HANDLE)
  57 !
  58 !-------------------------------------------------------------------------------------
  59 !
  60 !*      2.     Reading of grid
  61 !              ---------------
  62 !
  63  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'WATER ')
  64  CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
  65 !
  66  CALL READ_SURF(HFILEPGDTYPE,'DIM_WATER',IDIM_WATER,IRESP)
  67 !
  68 IF (IDIM_WATER==0) THEN
  69   CALL GET_LUOUT(HPROGRAM,ILUOUT)
  70   WRITE(ILUOUT,*) ' '
  71   WRITE(ILUOUT,*) 'No inland water data available in input file ',HFILE
  72   WRITE(ILUOUT,*) 'Please change your input file '
  73   WRITE(ILUOUT,*) '             or '
  74   WRITE(ILUOUT,*) 'specify inland water temperature XTS_WATER_UNIF'
  75   CALL ABOR1_SFX('PREP_WATFLUX_EXTERN: No inland water data available in input file')
  76 END IF
  77 !---------------------------------------------------------------------------------------
  78 SELECT CASE(HSURF)
  79 !---------------------------------------------------------------------------------------
  80 !
  81 !*     3.      Orography
  82 !              ---------
  83 !
  84   CASE('ZS     ')
  85     ALLOCATE(PFIELD(INI,1))
  86     YRECFM='ZS'
  87     CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
  88     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
  89 !
  90 !*      4.  Sea surface temperature
  91 !           -----------------------
  92 !
  93   CASE('TSWATER')
  94     ALLOCATE(PFIELD(INI,1))
  95     YRECFM='TS_WATER'
  96     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
  97     CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'WATER ')
  98     CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
  99     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
 100 !
 101 !---------------------------------------------------------------------------------------
 102 END SELECT
 103 !-------------------------------------------------------------------------------------
 104 !
 105 !*      6.     End of IO
 106 !              ---------
 107 !
 108 IF (LHOOK) CALL DR_HOOK('PREP_WATFLUX_EXTERN',1,ZHOOK_HANDLE)
 109 !
 110 !---------------------------------------------------------------------------------------
 111 !
 112 END SUBROUTINE PREP_WATFLUX_EXTERN