grid_modif.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_modif(KLUOUT,KLUNAM,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
!!    J.Escobar    09/02/05 bug init IGRID_PAR
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_grid_modif_cartesian
!
USE modi_grid_modif_conf_proj
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
INTEGER,           INTENT(IN)   :: kluout     ! output listing logical unit
INTEGER,           INTENT(IN)   :: klunam     ! namelist file logical unit
 CHARACTER(LEN=10), INTENT(IN)   :: hgrid      ! type of horizontal grid
INTEGER,           INTENT(INOUT):: kgrid_par  ! size of PGRID_PAR
REAL, DIMENSION(:), POINTER     :: pgrid_par  ! parameters defining this grid
INTEGER,           INTENT(INOUT):: kl         ! number of points
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                         :: igrid_par ! modified grid vector size
INTEGER                         :: il        ! number of points in modified grid
REAL, DIMENSION(:), ALLOCATABLE :: zgrid_par ! modified grid vector
REAL(KIND=JPRB) :: zhook_handle
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GRID_MODIF',0,zhook_handle)
!
IF (hgrid=="NONE      ".OR.hgrid=="LONLAT REG".OR.hgrid=="GAUSS     ".OR.&
        hgrid=="LONLATVAL ") THEN
  IF (lhook) CALL dr_hook('GRID_MODIF',1,zhook_handle)
  RETURN
END IF
!
igrid_par = 0
ALLOCATE(zgrid_par(0))
 CALL grid_modification(kluout,klunam,hgrid,kgrid_par,kl,pgrid_par,igrid_par,il,.false.,zgrid_par)
DEALLOCATE(zgrid_par)
!
ALLOCATE(zgrid_par(igrid_par))
 CALL grid_modification(kluout,klunam,hgrid,kgrid_par,kl,pgrid_par,igrid_par,il,.true.,zgrid_par)
!
DEALLOCATE(pgrid_par)
!
kgrid_par = igrid_par
kl        = il
ALLOCATE(pgrid_par(kgrid_par))
pgrid_par = zgrid_par
!
DEALLOCATE(zgrid_par)
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('GRID_MODIF',1,zhook_handle)
 CONTAINS
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!     ##########################################################
      SUBROUTINE grid_modification(KLUOUT,KLUNAM,HGRID,KGRID_PAR,KL,PGRID_PAR, &
                                     kgrid_par2,kl2,omodif,pgrid_par2            )  
!     ##########################################################
!!
!!    PURPOSE
!!    -------
!!   Modification of grid parameters
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson                   Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original     01/2004
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
IMPLICIT NONE
!
!*    0.1    Declaration of dummy arguments
!            ------------------------------
!
INTEGER,                      INTENT(IN)    :: kluout     ! output listing logical unit
INTEGER,                      INTENT(IN)    :: klunam     ! namelist file logical unit
 CHARACTER(LEN=10),            INTENT(IN)    :: hgrid      ! type of horizontal grid
INTEGER,                      INTENT(IN)    :: kl         ! number of points
INTEGER,                      INTENT(IN)    :: kgrid_par  ! size of PGRID_PAR
REAL, DIMENSION(:),           INTENT(IN)    :: pgrid_par  ! parameters defining the grid
INTEGER,                      INTENT(INOUT) :: kl2        ! number of points in modified grid
INTEGER,                      INTENT(INOUT) :: kgrid_par2 ! size of PGRID_PAR2
LOGICAL,                      INTENT(IN)    :: omodif     ! flag to modify the grid
REAL, DIMENSION(:), OPTIONAL, INTENT(OUT)   :: pgrid_par2 ! parameters defining the modified grid
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER                         :: igrid_par2
REAL, DIMENSION(:), ALLOCATABLE :: zgrid_par2
REAL(KIND=JPRB) :: zhook_handle
!
!------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('GRID_MODIFICATION',0,zhook_handle)
IF (omodif) THEN
  igrid_par2 = kgrid_par2
ELSE
  igrid_par2 = 0
END IF
!
ALLOCATE(zgrid_par2(igrid_par2))
!
SELECT CASE (hgrid)
  CASE ("CONF PROJ ")
    CALL grid_modif_conf_proj(kluout,klunam,kgrid_par,kl,pgrid_par, &
                                       kgrid_par2,kl2,omodif,zgrid_par2      )  

  CASE ("CARTESIAN ")
    CALL grid_modif_cartesian(kluout,klunam,kgrid_par,kl,pgrid_par, &
                                       kgrid_par2,kl2,omodif,zgrid_par2      )  

END SELECT
!
IF (omodif) pgrid_par2 = zgrid_par2
!
DEALLOCATE(zgrid_par2)
IF (lhook) CALL dr_hook('GRID_MODIFICATION',1,zhook_handle)
!
END SUBROUTINE grid_modification
!
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
END SUBROUTINE grid_modif