grid_from_file.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 grid_from_file (&
                                 hprogram,hfile,hfiletype,ogrid,hgrid,kgrid_par,pgrid_par,kl)
!     ##########################################################
!!
!!    PURPOSE
!!    -------
!!   Reads in namelist the grid type and parameters.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     01/2004
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
!
USE modi_open_aux_io_surf
USE modi_read_gridtype
USE modi_close_aux_io_surf
USE modi_read_surf
USE modi_open_namelist
USE modi_close_namelist
USE modi_grid_modif
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_get_luout
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
!
!
 CHARACTER(LEN=6),  INTENT(IN)   :: hprogram   ! program calling the surface
 CHARACTER(LEN=28), INTENT(IN)   :: hfile      ! file name
 CHARACTER(LEN=6),  INTENT(IN)   :: hfiletype  ! file type
LOGICAL,           INTENT(IN)   :: ogrid      ! .true. if grid is imposed by atm. model
 CHARACTER(LEN=10), INTENT(OUT)  :: hgrid      ! type of horizontal grid
INTEGER,           INTENT(OUT)  :: kgrid_par  ! size of PGRID_PAR
REAL, DIMENSION(:), POINTER     :: pgrid_par  ! parameters defining this grid
INTEGER,           INTENT(OUT)  :: kl         ! number of points on processor
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER           :: iluout ! listing  file  logical unit
INTEGER           :: ilunam ! namelist file  logical unit
INTEGER           :: iresp  ! return code
REAL(KIND=JPRB) :: zhook_handle
!
!*    0.3    Declaration of namelists
!            ------------------------
!
!------------------------------------------------------------------------------
!
!*       1.    Defaults
!              --------
!
IF (lhook) CALL dr_hook('GRID_FROM_FILE',0,zhook_handle)
 CALL get_luout(hprogram,iluout)
!
!---------------------------------------------------------------------------
!
!*       2.    Opening of the file
!              -------------------
!
 CALL open_aux_io_surf(&
                       hfile,hfiletype,'FULL  ')
!
!---------------------------------------------------------------------------
!
!*       3.    Number of points in this file
!              -----------------------------
!
 CALL read_surf(&
                hfiletype,'DIM_FULL  ',kl,iresp)
!
!---------------------------------------------------------------------------
!
!*       4.    Grid type
!              ---------
!
 CALL read_surf(&
                hfiletype,'GRID_TYPE',hgrid,iresp)
!
!---------------------------------------------------------------------------
!
!*       5.    Reading parameters of the grid
!              ------------------------------
!
 CALL read_gridtype(&
                    hfiletype,hgrid,kgrid_par,kl,.false.,hdir='A')
!
ALLOCATE(pgrid_par(kgrid_par))
 CALL read_gridtype(&
                    hfiletype,hgrid,kgrid_par,kl,.true.,pgrid_par,iresp,hdir='A')
!
!---------------------------------------------------------------------------
!
!*       6.    Closes the file
!              ---------------
!
 CALL close_aux_io_surf(hfile,hfiletype)
!
!------------------------------------------------------------------------------
!
!*       7.    Open namelist
!              -------------
!
 CALL open_namelist(hprogram,ilunam)
!
!------------------------------------------------------------------------------
!
!*       8.    Grid modification
!              -----------------
!
IF (.NOT. ogrid) CALL grid_modif(iluout,ilunam,hgrid,kgrid_par,pgrid_par,kl)
!
!------------------------------------------------------------------------------
!
!*       9.    Close namelist
!              --------------
!
 CALL close_namelist(hprogram,ilunam)
IF (lhook) CALL dr_hook('GRID_FROM_FILE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE grid_from_file