pgd_grid.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 pgd_grid (&
                            ug, u, &
                           hprogram,hfile,hfiletype,ogrid,hgrid,kgrid_par,pgrid_par)
!     ##########################################################
!!
!!    PURPOSE
!!    -------
!!   Reads in namelist the grid type and parameters.
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     01/2004
!!    E. Martin    10/2007 IGN grid
!!    P. Samuelsson  12/2012 Rotated lonlat
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
!
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surfex_mpi,     ONLY : nsize, nindex, npio, nrank
USE modd_surfex_omp,     ONLY : nindx2sfx, nwork, nwork2, xwork, xwork2, xwork3, &
                                nwork_full, nwork2_full, xwork_full, xwork2_full
!
USE modd_pgd_grid,       ONLY : nl, xgrid_par, ngrid_par, xmeshlength
USE modn_pgd_grid
USE modd_csts,           ONLY : xpi, xradius
!
USE modi_default_grid
USE modi_grid_from_file
USE modi_open_namelist
USE modi_test_nam_var_surf
USE modi_close_namelist
USE modi_get_luout
USE modi_read_nam_gridtype
USE modi_latlon_grid
!
USE mode_pos_surf
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
!
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)   :: hprogram   ! program calling the surface
 CHARACTER(LEN=28), INTENT(IN)   :: hfile      ! atmospheric file name
 CHARACTER(LEN=6),  INTENT(IN)   :: hfiletype  ! atmospheric file type
LOGICAL,           INTENT(IN)   :: ogrid      ! .true. if grid is imposed by atm. model
 CHARACTER(LEN=10), INTENT(OUT)  :: hgrid      ! grid type
INTEGER,           INTENT(OUT)  :: kgrid_par  ! size of PGRID_PAR
REAL, DIMENSION(:), POINTER     :: pgrid_par  ! parameters defining this grid
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER           :: iluout ! output listing logical unit
INTEGER           :: ilunam ! namelist file  logical unit
LOGICAL           :: gfound ! Flag true if namelist is present
REAL(KIND=JPRB) :: zhook_handle
!
!*    0.3    Declaration of namelists
!            ------------------------
!
!------------------------------------------------------------------------------
!
!*    1.      Defaults
!             --------
!
IF (lhook) CALL dr_hook('PGD_GRID',0,zhook_handle)
 CALL default_grid(hprogram,cgrid)
!
yinifile  = '                         '
yinifiletype = '      '
!
IF (ogrid) THEN
  yinifile  = hfile
  yinifiletype = hfiletype
END IF
!
 CALL get_luout(hprogram,iluout)
!------------------------------------------------------------------------------
!
!*    2.      Open namelist
!             -------------
!
IF (.NOT. ogrid) THEN
  CALL open_namelist(hprogram,ilunam)
!
!------------------------------------------------------------------------------
!
!*    3.      Read grid type
!             --------------
!
  CALL posnam(ilunam,'NAM_PGD_GRID',gfound,iluout)
  IF (gfound) READ(unit=ilunam,nml=nam_pgd_grid)
!
!------------------------------------------------------------------------------
!
!*    5.      Close namelist
!             --------------
!
  CALL close_namelist(hprogram,ilunam)
!
END IF
!-------------------------------------------------------------------------------
!
!*       4.    check of grid and input file types
!              ----------------------------------
! 
 CALL test_nam_var_surf(iluout,'CGRID',cgrid,'CONF PROJ ','NONE      ','LONLAT REG','CARTESIAN ','GAUSS     ',&
          'IGN       ','LONLATVAL ','LONLAT ROT')  
 CALL test_nam_var_surf(iluout,'YINIFILETYPE',yinifiletype,'      ','MESONH','LFI   ','ASCII ','NC    ')
!
!
!------------------------------------------------------------------------------
!
!*    5.      Initializes grid characteristics
!             --------------------------------
!
!*    5.1     From another file
!             -----------------
!
IF (len_trim(yinifiletype)>0 .AND. len_trim(yinifile)>0 ) THEN
  IF (yinifiletype=='MESONH' .OR. yinifiletype=='LFI   ' .OR. yinifiletype=='ASCII ' .OR. yinifiletype=='NC    ') THEN
    CALL grid_from_file(&
                        hprogram,yinifile,yinifiletype,ogrid,cgrid,ngrid_par,xgrid_par,nl)
  ELSE
    CALL abor1_sfx('PGD_GRID: FILE TYPE NOT SUPPORTED '//hfiletype//' FOR FILE '//hfile)
  END IF
!
ELSE
!
!*    5.2     Grid not initialized
!             --------------------
!
  IF (cgrid=='NONE      ' .OR. cgrid=='          ') THEN
    CALL abor1_sfx('PGD_GRID: GRID TYPE NOT INITIALIZED, CGRID='//cgrid)

!
!*    5.3     Grid initialized
!             ----------------
!
  ELSE
!
    CALL read_nam_gridtype(hprogram,cgrid,ngrid_par,xgrid_par,nl)
!
  END IF

END IF
!
hgrid     = cgrid
u%NDIM_FULL = nl
nsize     = u%NDIM_FULL
IF (.NOT.ALLOCATED(nindex)) THEN
  ALLOCATE(nindex(u%NDIM_FULL))
  nindex(:) = 0
ENDIF
nindx2sfx    = u%NDIM_FULL
ALLOCATE(nwork(u%NDIM_FULL))
ALLOCATE(xwork(u%NDIM_FULL))
ALLOCATE(nwork2(u%NDIM_FULL,10))
ALLOCATE(xwork2(u%NDIM_FULL,10))
ALLOCATE(xwork3(u%NDIM_FULL,10,10))
IF (nrank==npio) THEN
  ALLOCATE(nwork_full(u%NDIM_FULL))
  ALLOCATE(xwork_full(u%NDIM_FULL))
  ALLOCATE(nwork2_full(u%NDIM_FULL,10))
  ALLOCATE(xwork2_full(u%NDIM_FULL,10))
ELSE
  ALLOCATE(nwork_full(0))
  ALLOCATE(xwork_full(0))
  ALLOCATE(nwork2_full(0,0))
  ALLOCATE(xwork2_full(0,0))
ENDIF
!
kgrid_par = ngrid_par
ALLOCATE(pgrid_par(kgrid_par))
pgrid_par = xgrid_par
!
!------------------------------------------------------------------------------
!
!*    6.      Latitude and longitude
!             ----------------------
!
ALLOCATE(ug%XLAT       (nl))
ALLOCATE(ug%XLON       (nl))
ALLOCATE(ug%XMESH_SIZE (nl))
ALLOCATE(ug%XJPDIR     (nl))
 CALL latlon_grid(cgrid,ngrid_par,nl,iluout,xgrid_par,ug%XLAT,ug%XLON,ug%XMESH_SIZE,ug%XJPDIR)
!
!------------------------------------------------------------------------------
!
!*    7.      Average grid length (in degrees)
!             --------------------------------
!
!* in meters
xmeshlength = sum( sqrt(ug%XMESH_SIZE) ) / nl
!
!* in degrees (of latitude)
xmeshlength = xmeshlength *180. / xpi / xradius
IF (lhook) CALL dr_hook('PGD_GRID',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE pgd_grid