ol_define_dim.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 ol_define_dim (UG, U, &
                          hprogram, kluout, kni, kdim1, hunit1, hunit2, &
                         px, py, kdims, kddim, hname_dim, knpatch)
!     #######################################################
!!****  *OL_DEFINE_DIM* - 
!!
!!    PURPOSE
!!    -------
!!
      !!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      S. Faroux   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/2010 
!!      07/2011     add specific computation for IGN grid (B. Decharme)
!-------------------------------------------------------------------------------                         
!
!
!
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_io_surf_ol, ONLY: nmask_ign
!
USE modn_io_offline, ONLY : lwrite_coord
!
USE modi_get_grid_dim
USE modi_get_grid_coord
!
USE mode_gridtype_ign
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
include 'netcdf.inc'
!
!
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
!
 CHARACTER(LEN=6),  INTENT(IN)    :: hprogram
INTEGER, INTENT(IN)              :: kluout
INTEGER, INTENT(IN)              :: kni
INTEGER, INTENT(OUT)             :: kdim1
 CHARACTER(LEN=13) , DIMENSION(:), INTENT(OUT) :: hunit1, hunit2
REAL,DIMENSION(:), POINTER                :: px, py
INTEGER, DIMENSION(:), POINTER            :: kdims, kddim
 CHARACTER(LEN=100), DIMENSION(:), POINTER :: hname_dim
INTEGER, OPTIONAL, INTENT(IN)    :: knpatch
!
REAL, DIMENSION(KNI)             :: zxx, zyy
 CHARACTER(LEN=3)                 :: ytype
INTEGER                          :: indims, idim2
INTEGER                          :: i, j, k, l
LOGICAL                          :: grect     ! T if rectangular grid
REAL(KIND=JPRB) :: zhook_handle
!
IF (lhook) CALL dr_hook('OL_DEFINE_DIM',0,zhook_handle)
!
kdim1=0
idim2=0
!
IF (.NOT.lwrite_coord) THEN
  !
  IF ( ug%CGRID.EQ.'CONF PROJ ' .OR. ug%CGRID.EQ.'CARTESIAN '&
  .OR. ug%CGRID.EQ.'LONLAT REG' .OR. ug%CGRID.EQ.'IGN' ) THEN
    ytype='XY '
    IF (ug%CGRID.EQ.'LONLAT REG') ytype='LON'
    IF (ASSOCIATED(ug%XGRID_FULL_PAR)) THEN
      CALL get_grid_dim(ug%CGRID,ug%NGRID_PAR,ug%XGRID_FULL_PAR,grect,kdim1,idim2)
    ELSEIF (ASSOCIATED(ug%XGRID_PAR)) THEN
      CALL get_grid_dim(ug%CGRID,ug%NGRID_PAR,ug%XGRID_PAR,grect,kdim1,idim2)
    ENDIF
  ENDIF
  !
ENDIF
!
indims = 2
IF ( kdim1.NE.0       ) indims = 3
IF ( present(knpatch) ) indims = indims + 1
!
ALLOCATE(kdims(indims))
ALLOCATE(kddim(indims))
ALLOCATE(hname_dim(indims))
!
IF ( kdim1.NE.0 ) THEN
  kdims(1) = kdim1
  kdims(2) = idim2
  IF (ytype.EQ.'LON') THEN
    hname_dim(1) = 'lon'
    hname_dim(2) = 'lat'
    hunit1(1)    = 'degrees_east'
    hunit2(1)    = 'degrees_north'
  ELSE
    hname_dim(1) = 'xx'
    hname_dim(2) = 'yy'
    hunit1(1)    = 'meters'
    hunit2(1)    = 'meters'
  ENDIF
  ALLOCATE(px(kdim1))
  ALLOCATE(py(idim2))
ELSE
  kdims(1) = kni
  hname_dim(1) = 'Number_of_points' 
  IF (lwrite_coord) THEN
    ALLOCATE(px(kni))
    ALLOCATE(py(kni))
  ENDIF
ENDIF
!
IF (lwrite_coord) THEN
  !
  IF (ASSOCIATED(ug%XGRID_FULL_PAR)) THEN
    CALL get_grid_coord(ug, u, &
                        kluout,px=px,py=py,kl=kni,hgrid=ug%CGRID,pgrid_par=ug%XGRID_FULL_PAR)
  ELSEIF (ASSOCIATED(ug%XGRID_PAR)) THEN
    CALL get_grid_coord(ug, u, &
                        kluout,px=px,py=py,kl=kni,hgrid=ug%CGRID,pgrid_par=ug%XGRID_PAR)
  ENDIF
  !
ELSEIF ( ug%CGRID.EQ.'CONF PROJ '.OR. ug%CGRID.EQ.'CARTESIAN '.OR. &
         ug%CGRID.EQ.'LONLAT REG' ) THEN
  !
  IF (ASSOCIATED(ug%XGRID_FULL_PAR)) THEN
    CALL get_grid_coord(ug, u, &
                        kluout,px=zxx,py=zyy,kl=kni,hgrid=ug%CGRID,pgrid_par=ug%XGRID_FULL_PAR)
  ELSEIF (ASSOCIATED(ug%XGRID_PAR)) THEN
    CALL get_grid_coord(ug, u, &
                        kluout,px=zxx,py=zyy,kl=kni,hgrid=ug%CGRID,pgrid_par=ug%XGRID_PAR)
  ENDIF
  !
  IF (ASSOCIATED(px)) THEN
    DO j=1,SIZE(px)
      px(j)=zxx(j)
    ENDDO
  ENDIF
  IF (ASSOCIATED(py)) THEN
    DO j=1,SIZE(py)
      py(j)=zyy((j-1)*(kni/SIZE(py))+1)
    ENDDO
  ENDIF
!
ELSEIF(ug%CGRID.EQ.'IGN       ')THEN
  !
  IF (ASSOCIATED(ug%XGRID_FULL_PAR)) THEN
    CALL get_gridtype_ign(ug%XGRID_FULL_PAR,px=zxx,py=zyy,pxall=px,pyall=py)
  ELSEIF (ASSOCIATED(ug%XGRID_PAR)) THEN
    CALL get_gridtype_ign(ug%XGRID_PAR,px=zxx,py=zyy,pxall=px,pyall=py)
  ENDIF
  !
  IF (.NOT.ALLOCATED(nmask_ign))THEN
    ALLOCATE(nmask_ign(kni))
    l=0
    DO j=1,SIZE(py)    
      DO i=1,SIZE(px)
        l=l+1
        DO k=1,kni
          IF((zxx(k)==px(i)).AND.(zyy(k)==py(j)))THEN
            nmask_ign(k)=l
          ENDIF
        ENDDO
      ENDDO
    ENDDO
  ENDIF
  !
ENDIF
!
!
IF (present(knpatch)) THEN
  kdims(indims-1) = knpatch
  hname_dim(indims-1) = 'Number_of_Tile'
ENDIF
!
IF (hprogram/='NOTIME ') THEN
  kdims(indims) = nf_unlimited
  hname_dim(indims) = 'time'
ELSE
  kdims(indims) = 40
  hname_dim(indims) = 'char_len'
ENDIF
!
IF (lhook) CALL dr_hook('OL_DEFINE_DIM',1,zhook_handle)
!
END SUBROUTINE ol_define_dim