!----------------------------------------------------------------------
! NEMO system team, System and Interface for oceanic RElocable Nesting
!----------------------------------------------------------------------
!
! MODULE: dom
!
! DESCRIPTION:
!> @brief
!> This module manage domain computation.
!>
!> @details
!> define type TDOM:
!> @code
!> TYPE(TDOM) :: tl_dom
!> @endcode
!>
!> to initialize domain structure:
!> @code
!> tl_dom=dom_init(td_mpp, [id_imin,] [id_imax,] [id_jmin,] [id_jmax],[cd_card])
!> @endcode
!> - td_mpp is mpp structure of an opened file.
!> - id_imin is i-direction sub-domain lower left point indice
!> - id_imax is i-direction sub-domain upper right point indice
!> - id_jmin is j-direction sub-domain lower left point indice
!> - id_jmax is j-direction sub-domain upper right point indice
!> - cd_card is the cardinal name (for boundary case)
!>
!> to get global domain dimension:
!> - tl_dom\%t_dim0
!>
!> to get NEMO periodicity index of global domain:
!> - tl_dom\%i_perio0
!>
!> to get NEMO pivot point index F(0),T(1):
!> - tl_dom\%i_pivot
!>
!> to get East-West overlap of global domain:
!> - tl_dom\%i_ew0
!>
!> to get selected sub domain dimension:
!> - tl_dom\%t_dim
!>
!> to get NEMO periodicity index of sub domain:
!> - tl_dom\%i_perio
!>
!> to get East-West overlap of sub domain:
!> - tl_dom\%i_ew
!>
!> to get i-direction sub-domain lower left point indice:
!> - tl_dom\%i_imin
!>
!> to get i-direction sub-domain upper right point indice:
!> - tl_dom\%i_imax
!>
!> to get j-direction sub-domain lower left point indice:
!> - tl_dom\%i_jmin
!>
!> to get j-direction sub-domain upper right point indice:
!> - tl_dom\%i_jmax
!>
!> to get size of i-direction extra band:
!> - tl_dom\%i_iextra
!>
!> to get size of j-direction extra band:
!> - tl_dom\%i_jextra
!>
!> to get i-direction ghost cell number:
!> - tl_dom\%i_ighost
!>
!> to get j-direction ghost cell number:
!> - tl_dom\%i_jghost
!>
!> to get boundary index:
!> - tl_dom\%i_bdy
!> - 0 = no boundary
!> - 1 = north
!> - 2 = south
!> - 3 = east
!> - 4 = west
!>
!> to clean domain structure:
!> @code
!> CALL dom_clean(td_dom)
!> @endcode
!> - td_dom is domain structure
!>
!> to print information about domain structure:
!> @code
!> CALL dom_print(td_dom)
!> @endcode
!>
!> to get East-West overlap (if any):
!> @code
!> il_ew=dom_get_ew_overlap(td_lon)
!> @endcode
!> - td_lon : longitude variable structure
!>
!> to add extra bands to coarse grid domain (for interpolation):
!> @code
!> CALL dom_add_extra( td_dom, id_iext, id_jext )
!> @endcode
!> - td_dom is domain structure
!> - id_iext is i-direction size of extra bands
!> - id_jext is j-direction size of extra bands
!>
!> to remove extra bands from fine grid (after interpolation):
!> @code
!> CALL dom_del_extra( td_var, td_dom, id_rho )
!> @endcode
!> - td_var is variable structure to be changed
!> - td_dom is domain structure
!> - id_rho is a array of refinement factor following i- and j-direction
!>
!> to reset coarse grid domain witouht extra bands:
!> @code
!> CALL dom_clean_extra( td_dom )
!> @endcode
!>
!> @author
!> J.Paul
! REVISION HISTORY:
!> @date November, 2013 - Initial Version
!> @date September, 2014
!> - add header
!> - use zero indice to defined cyclic or global domain
!> @date October, 2014
!> - use mpp file structure instead of file
!>
!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!----------------------------------------------------------------------
MODULE dom
USE kind ! F90 kind parameter
USE global ! global parameter
USE fct ! basic useful function
USE logger ! log file manager
USE dim ! dimension manager
USE var ! variable manager
USE mpp ! mpp file manager
IMPLICIT NONE
! NOTE_avoid_public_variables_if_possible
! type and variable
PUBLIC :: TDOM !< domain structure
PRIVATE :: im_minext !< default minumum number of extraband
! function and subroutine
PUBLIC :: dom_copy !< copy domain structure
PUBLIc :: dom_clean !< clean domain structure
PUBLIC :: dom_init !< initialise domain structure
PUBLIC :: dom_print !< print information about domain
PUBLIC :: dom_add_extra !< add useful extra bands to coarse grid for interpolation
PUBLIC :: dom_clean_extra !< reset domain without extra bands
PUBLIC :: dom_del_extra !< remove extra point from fine grid after interpolation
PRIVATE :: dom__init_mpp ! initialise domain structure, given mpp file structure
PRIVATE :: dom__define ! define sub domain indices
! define sub domain indices for input domain with
PRIVATE :: dom__define_cyclic_north_fold ! - cyclic east-west boundary and north fold boundary condition.
PRIVATE :: dom__define_north_fold ! - north fold boundary condition.
PRIVATE :: dom__define_symmetric ! - symmetric boundary condition across the equator.
PRIVATE :: dom__define_cyclic ! - cyclic east-west boundary.
PRIVATE :: dom__define_closed ! - cyclic east-west boundary.
! compute size of sub domain
PRIVATE :: dom__size_no_pole ! - without north fold condition
PRIVATE :: dom__size_no_pole_overlap ! - without north fold condition, and which overlap east-west boundary
PRIVATE :: dom__size_no_pole_no_overlap ! - without north fold condition, and which do not overlap east-west boundary
PRIVATE :: dom__size_pole ! - with north fold condition
PRIVATE :: dom__size_pole_overlap ! - with north fold condition, and which overlap east-west boundary
PRIVATE :: dom__size_pole_no_overlap ! - with north fold condition, and which do not overlap east-west boundary
! compute size of
PRIVATE :: dom__size_global ! - global domain
PRIVATE :: dom__size_semi_global ! - semi global domain
PRIVATE :: dom__copy_unit ! copy attribute structure
TYPE TDOM !< domain structure
TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim0 !< global domain dimension
TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< sub domain dimension
INTEGER(i4) :: i_perio0 !< NEMO periodicity index of global domain
INTEGER(i4) :: i_ew0 !< East-West overlap of global domain
INTEGER(i4) :: i_perio !< NEMO periodicity index of sub domain
INTEGER(i4) :: i_pivot !< NEMO pivot point index F(0),T(1)
INTEGER(i4) :: i_imin = 0 !< i-direction sub-domain lower left point indice
INTEGER(i4) :: i_imax = 0 !< i-direction sub-domain upper right point indice
INTEGER(i4) :: i_jmin = 0 !< j-direction sub-domain lower left point indice
INTEGER(i4) :: i_jmax = 0 !< j-direction sub-domain upper right point indice
INTEGER(i4) :: i_bdy = 0 !< boundary index : 0 = no boundary
!< 1 = north
!< 2 = south
!< 3 = east
!< 4 = west
INTEGER(i4), DIMENSION(2,2) :: i_ghost0 = 0 !< array of ghost cell factor of global domain
INTEGER(i4), DIMENSION(2,2) :: i_ghost = 0 !< array of ghost cell factor of sub domain
INTEGER(i4), DIMENSION(2) :: i_iextra = 0 !< i-direction extra point
INTEGER(i4), DIMENSION(2) :: i_jextra = 0 !< j-direction extra point
END TYPE TDOM
INTEGER(i4), PARAMETER :: im_minext = 2 !< default minumum number of extraband
INTERFACE dom_init
MODULE PROCEDURE dom__init_file
MODULE PROCEDURE dom__init_mpp
END INTERFACE dom_init
INTERFACE dom_copy
MODULE PROCEDURE dom__copy_unit ! copy attribute structure
END INTERFACE
CONTAINS
!-------------------------------------------------------------------
!> @brief
!> This subroutine copy an domain structure in another one
!> @details
!> dummy function to get the same use for all structure
!>
!> @warning do not use on the output of a function who create or read an
!> structure (ex: tl_dom=dom_copy(dom_init()) is forbidden).
!> This will create memory leaks.
!> @warning to avoid infinite loop, do not use any function inside
!> this subroutine
!>
!> @author J.Paul
!> @date November, 2014 - Initial Version
!>
!> @param[in] td_dom domain structure
!> @return copy of input domain structure
!-------------------------------------------------------------------
FUNCTION dom__copy_unit( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(IN) :: td_dom
! function
TYPE(TDOM) :: dom__copy_unit
! local variable
!----------------------------------------------------------------
dom__copy_unit=td_dom
END FUNCTION dom__copy_unit
!-------------------------------------------------------------------
!> @brief This subroutine print some information about domain strucutre.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_dom dom structure
!-------------------------------------------------------------------
SUBROUTINE dom_print(td_dom)
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(IN) :: td_dom
! local argument
CHARACTER(LEN=lc) :: cl_pivot
!----------------------------------------------------------------
SELECT CASE(td_dom%i_pivot)
CASE(0)
cl_pivot='F-point'
CASE(1)
cl_pivot='T-point'
CASE DEFAULT
cl_pivot='unknown'
END SELECT
WRITE(*,'((a,4(i0,1x)),(/a,i2,a,a),2(/a,2(i0,1x)),(/a,4(i0,1x)),(/a,i2/),&
& 4(/a,i0),4(/a,2(i0,1x)))') &
& " global domain size ",td_dom%t_dim0(:)%i_len, &
& " domain periodicity ",td_dom%i_perio0,", pivot: ",TRIM(cl_pivot), &
& " i-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_I,:), &
& " j-direction ghost cell factor of global domain ",td_dom%i_ghost0(jp_J,:), &
& " sub-domain size : ",td_dom%t_dim(:)%i_len, &
& " sub domain periodicity ",td_dom%i_perio, &
& " i-direction sub-domain lower left point indice ",td_dom%i_imin, &
& " i-direction sub-domain upper right point indice ",td_dom%i_imax, &
& " j-direction sub-domain lower left point indice ",td_dom%i_jmin, &
& " j-direction sub-domain upper right point indice ",td_dom%i_jmax, &
& " i-direction ghost cell factor ",td_dom%i_ghost(jp_I,:), &
& " j-direction ghost cell factor ",td_dom%i_ghost(jp_J,:), &
& " i-direction extra point for interpolation ",td_dom%i_iextra(:), &
& " j-direction extra point for interpolation ",td_dom%i_jextra(:)
END SUBROUTINE dom_print
!-------------------------------------------------------------------
!> @brief
!> This function intialise domain structure, given open file structure,
!> and sub domain indices.
!> @details
!> sub domain indices are computed, taking into account coarse grid
!> periodicity, pivot point, and East-West overlap.
!
!> @author J.Paul
!> - June, 2013- Initial Version
!> @date September, 2014
!> - add boundary index
!> - add ghost cell factor
!> @date October, 2014
!> - work on mpp file structure instead of file structure
!>
!> @param[in] td_mpp mpp structure
!> @param[in] id_perio grid periodicity
!> @param[in] id_imin i-direction sub-domain lower left point indice
!> @param[in] id_imax i-direction sub-domain upper right point indice
!> @param[in] id_jmin j-direction sub-domain lower left point indice
!> @param[in] id_jmax j-direction sub-domain upper right point indice
!> @param[in] cd_card name of cardinal (for boundary)
!> @return domain structure
!-------------------------------------------------------------------
TYPE(TDOM) FUNCTION dom__init_mpp( td_mpp, &
& id_imin, id_imax, id_jmin, id_jmax, &
& cd_card )
IMPLICIT NONE
! Argument
TYPE(TMPP) , INTENT(IN) :: td_mpp
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
!local variable
!----------------------------------------------------------------
! clean domain structure
CALL dom_clean(dom__init_mpp)
IF( .NOT. ASSOCIATED(td_mpp%t_proc) )THEN
CALL logger_error( &
& " DOM INIT: no processor file associated to mpp "//&
& TRIM(td_mpp%c_name))
ELSE
! global domain define by file
! look for boundary index
IF( PRESENT(cd_card) )THEN
SELECT CASE(TRIM(cd_card))
CASE('north')
dom__init_mpp%i_bdy=jp_north
CASE('south')
dom__init_mpp%i_bdy=jp_south
CASE('east')
dom__init_mpp%i_bdy=jp_east
CASE('west')
dom__init_mpp%i_bdy=jp_west
CASE DEFAULT
! no boundary
dom__init_mpp%i_bdy=0
END SELECT
ELSE
! no boundary
dom__init_mpp%i_bdy=0
ENDIF
! use global dimension define by mpp file
dom__init_mpp%t_dim0(:) = dim_copy(td_mpp%t_dim(:))
IF( td_mpp%i_perio < 0 .OR. td_mpp%i_perio > 6 )THEN
CALL logger_error("DOM INIT: invalid grid periodicity. "//&
& "you should use grid_get_perio to compute it")
ELSE
dom__init_mpp%i_perio0=td_mpp%i_perio
ENDIF
! global domain pivot point
SELECT CASE(dom__init_mpp%i_perio0)
CASE(3,4)
dom__init_mpp%i_pivot = 0
CASE(5,6)
dom__init_mpp%i_pivot = 1
CASE DEFAULT
dom__init_mpp%i_pivot = 0
END SELECT
! add ghost cell factor of global domain
dom__init_mpp%i_ghost0(:,:)=0
SELECT CASE(dom__init_mpp%i_perio0)
CASE(0)
dom__init_mpp%i_ghost0(:,:)=1
CASE(1)
dom__init_mpp%i_ghost0(jp_J,:)=1
CASE(2)
dom__init_mpp%i_ghost0(jp_I,:)=1
dom__init_mpp%i_ghost0(jp_J,2)=1
CASE(3,5)
dom__init_mpp%i_ghost0(jp_I,:)=1
dom__init_mpp%i_ghost0(jp_J,1)=1
CASE(4,6)
dom__init_mpp%i_ghost0(jp_J,1)=1
END SELECT
! look for EW overlap
dom__init_mpp%i_ew0=td_mpp%i_ew
! initialise domain as global
dom__init_mpp%i_imin = 1
dom__init_mpp%i_imax = dom__init_mpp%t_dim0(1)%i_len
dom__init_mpp%i_jmin = 1
dom__init_mpp%i_jmax = dom__init_mpp%t_dim0(2)%i_len
! sub domain dimension
dom__init_mpp%t_dim(:) = dim_copy(td_mpp%t_dim(:))
! define sub domain indices
CALL dom__define( dom__init_mpp, &
& id_imin, id_imax, id_jmin, id_jmax )
ENDIF
END FUNCTION dom__init_mpp
!-------------------------------------------------------------------
!> @brief
!> This function intialise domain structure, given open file structure,
!> and sub domain indices.
!> @details
!> sub domain indices are computed, taking into account coarse grid
!> periodicity, pivot point, and East-West overlap.
!
!> @author J.Paul
!> - June, 2013- Initial Version
!> @date September, 2014
!> - add boundary index
!> - add ghost cell factor
!>
!> @param[in] td_file file structure
!> @param[in] id_perio grid periodicity
!> @param[in] id_imin i-direction sub-domain lower left point indice
!> @param[in] id_imax i-direction sub-domain upper right point indice
!> @param[in] id_jmin j-direction sub-domain lower left point indice
!> @param[in] id_jmax j-direction sub-domain upper right point indice
!> @param[in] cd_card name of cardinal (for boundary)
!> @return domain structure
!-------------------------------------------------------------------
TYPE(TDOM) FUNCTION dom__init_file( td_file, &
& id_imin, id_imax, id_jmin, id_jmax, &
& cd_card )
IMPLICIT NONE
! Argument
TYPE(TFILE) , INTENT(IN) :: td_file
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imin
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_imax
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmin
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_jmax
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_card
!local variable
!----------------------------------------------------------------
! clean domain structure
CALL dom_clean(dom__init_file)
IF( td_file%i_id == 0 )THEN
CALL logger_error( &
& " DOM INIT: no id associated to file "//TRIM(td_file%c_name))
ELSE
! global domain define by file
! look for boundary index
IF( PRESENT(cd_card) )THEN
SELECT CASE(TRIM(cd_card))
CASE('north')
dom__init_file%i_bdy=jp_north
CASE('south')
dom__init_file%i_bdy=jp_south
CASE('east')
dom__init_file%i_bdy=jp_east
CASE('west')
dom__init_file%i_bdy=jp_west
CASE DEFAULT
! no boundary
dom__init_file%i_bdy=0
END SELECT
ELSE
! no boundary
dom__init_file%i_bdy=0
ENDIF
! use global dimension define by file
dom__init_file%t_dim0(:) = dim_copy(td_file%t_dim(:))
IF( td_file%i_perio < 0 .OR. td_file%i_perio > 6 )THEN
CALL logger_error("DOM INIT: invalid grid periodicity. "//&
& "you should use grid_get_perio to compute it")
ELSE
dom__init_file%i_perio0=td_file%i_perio
ENDIF
! global domain pivot point
SELECT CASE(dom__init_file%i_perio0)
CASE(3,4)
dom__init_file%i_pivot = 0
CASE(5,6)
dom__init_file%i_pivot = 1
CASE DEFAULT
dom__init_file%i_pivot = 0
END SELECT
! add ghost cell factor of global domain
dom__init_file%i_ghost0(:,:)=0
SELECT CASE(dom__init_file%i_perio0)
CASE(0)
dom__init_file%i_ghost0(:,:)=1
CASE(1)
dom__init_file%i_ghost0(jp_J,:)=1
CASE(2)
dom__init_file%i_ghost0(jp_I,:)=1
dom__init_file%i_ghost0(jp_J,2)=1
CASE(3,5)
dom__init_file%i_ghost0(jp_I,:)=1
dom__init_file%i_ghost0(jp_J,1)=1
CASE(4,6)
dom__init_file%i_ghost0(jp_J,1)=1
END SELECT
! look for EW overlap
dom__init_file%i_ew0=td_file%i_ew
! initialise domain as global
dom__init_file%i_imin = 1
dom__init_file%i_imax = dom__init_file%t_dim0(1)%i_len
dom__init_file%i_jmin = 1
dom__init_file%i_jmax = dom__init_file%t_dim0(2)%i_len
! sub domain dimension
dom__init_file%t_dim(:) = dim_copy(td_file%t_dim(:))
! define sub domain indices
CALL dom__define( dom__init_file, &
& id_imin, id_imax, id_jmin, id_jmax )
ENDIF
END FUNCTION dom__init_file
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices, and compute the size
!> of the sub domain.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain structure
!> @param[in] id_imin i-direction sub-domain lower left point indice
!> @param[in] id_imax i-direction sub-domain upper right point indice
!> @param[in] id_jmin j-direction sub-domain lower left point indice
!> @param[in] id_jmax j-direction sub-domain upper right point indice
!-------------------------------------------------------------------
SUBROUTINE dom__define(td_dom, &
& id_imin, id_imax, id_jmin, id_jmax )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
INTEGER(i4), INTENT(IN), OPTIONAL :: id_imin
INTEGER(i4), INTENT(IN), OPTIONAL :: id_imax
INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmin
INTEGER(i4), INTENT(IN), OPTIONAL :: id_jmax
!----------------------------------------------------------------
IF( PRESENT(id_imin) ) td_dom%i_imin = id_imin
IF( PRESENT(id_imax) ) td_dom%i_imax = id_imax
IF( PRESENT(id_jmin) ) td_dom%i_jmin = id_jmin
IF( PRESENT(id_jmax) ) td_dom%i_jmax = id_jmax
! check indices
IF(( td_dom%i_imin < -1 .OR. td_dom%i_imin > td_dom%t_dim0(1)%i_len ).OR. &
& ( td_dom%i_imax < -1 .OR. td_dom%i_imax > td_dom%t_dim0(1)%i_len ).OR. &
& ( td_dom%i_jmin < -1 .OR. td_dom%i_jmin > td_dom%t_dim0(2)%i_len ).OR. &
& ( td_dom%i_jmax < -1 .OR. td_dom%i_jmax > td_dom%t_dim0(2)%i_len ))THEN
CALL logger_debug("0 <= imin ("//TRIM(fct_str(id_imin))//") < "//&
& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
CALL logger_debug("0 <= imax ("//TRIM(fct_str(id_imax))//") < "//&
& TRIM(fct_str(td_dom%t_dim0(1)%i_len)))
CALL logger_debug("0 <= jmin ("//TRIM(fct_str(id_jmin))//") < "//&
& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
CALL logger_debug("0 <= jmax ("//TRIM(fct_str(id_jmax))//") < "//&
& TRIM(fct_str(td_dom%t_dim0(2)%i_len)))
CALL logger_fatal( "DOM INIT DEFINE: invalid grid definition."// &
& " check min and max indices")
ELSE
! force to select north fold
IF( td_dom%i_perio0 > 2 .AND. &
& ( td_dom%i_jmax >= td_dom%t_dim0(2)%i_len-1 .OR. &
& td_dom%i_jmax < td_dom%i_jmin .OR. &
& td_dom%i_jmin == 0 ) )THEN
td_dom%i_jmax=0
ENDIF
! force to use cyclic boundary
IF( ( td_dom%i_perio0 == 1 .OR. &
& td_dom%i_perio0 == 4 .OR. &
& td_dom%i_perio0 == 6 ) .AND. &
& ( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
& ABS(td_dom%i_imax-td_dom%i_imin)+1 == td_dom%t_dim0(1)%i_len ) &
& )THEN
td_dom%i_imin = 0
td_dom%i_imax = 0
ENDIF
SELECT CASE(td_dom%i_perio0)
CASE(0) ! closed boundary
CALL logger_trace("DOM INIT DEFINE: closed boundary")
CALL dom__define_closed( td_dom )
CASE(1) ! cyclic east-west boundary
CALL logger_trace("DOM INIT DEFINE: cyclic east-west boundary")
CALL dom__define_cyclic( td_dom )
CASE(2) ! symmetric boundary condition across the equator
CALL logger_trace("DOM INIT DEFINE: symmetric boundary condition "//&
& " across the equator")
CALL dom__define_symmetric( td_dom )
CASE(3) ! North fold boundary (with a F-point pivot)
CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
& "(with a F-point pivot)")
CALL dom__define_north_fold( td_dom )
CASE(5) ! North fold boundary (with a T-point pivot)
CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
& "(with a T-point pivot)")
CALL dom__define_north_fold( td_dom )
CASE(4) ! North fold boundary (with a F-point pivot)
! and cyclic east-west boundary
CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
& "(with a F-point pivot) and cyclic "//&
& "east-west boundary")
CALL dom__define_cyclic_north_fold( td_dom )
CASE(6) ! North fold boundary (with a T-point pivot)
! and cyclic east-west boundary
CALL logger_trace("DOM INIT DEFINE: North fold boundary "//&
& "(with a T-point pivot) and cyclic "//&
& "east-west boundary")
CALL dom__define_cyclic_north_fold( td_dom )
CASE DEFAULT
CALL logger_error("DOM INIT DEFINE: invalid grid periodicity index")
END SELECT
ENDIF
END SUBROUTINE dom__define
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices from global domain with
!> cyclic east-west boundary and north fold boundary condition.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!> @date September, 2014
!> - use zero indice to defined cyclic or global domain
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__define_cyclic_north_fold( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
!CALL dom__check_EW_index( td_dom )
IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
& td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "domain to extract is global" )
! coarse domain is global domain
CALL dom__size_global( td_dom )
ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
& td_dom%i_jmax == 0 )THEN
CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "domain to extract is semi-global" )
CALL dom__size_semi_global( td_dom )
ELSEIF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .AND. &
& td_dom%i_jmax /= 0 )THEN
CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "domain to extract is band of latidue" )
CALL dom__size_no_pole( td_dom )
ELSEIF( td_dom%i_jmax == 0 )THEN
CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "domain to extract use north fold" )
CALL dom__size_pole( td_dom )
ELSEIF( td_dom%i_jmax /= 0 )THEN
CALL logger_trace("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "domain to extract do not use north fold" )
! no North Pole
CALL dom__size_no_pole( td_dom )
ELSE
CALL logger_error("DOM DEFINE CYCLIC NORTH FOLD: "//&
& "should have been an impossible case" )
ENDIF
END SUBROUTINE dom__define_cyclic_north_fold
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices from global domain
!> with north fold boundary condition.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__define_north_fold( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_jmax /= 0 )THEN
CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
& "domain to extract has no north boundary" )
! no North Pole
CALL dom__size_no_pole_no_overlap( td_dom )
ELSE
CALL logger_trace("DOM DEFINE NORTH FOLD: "//&
& "sub domain has north boundary" )
CALL dom__size_pole_no_overlap( td_dom )
ENDIF
END SUBROUTINE dom__define_north_fold
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices from global domain
!> with symmetric boundary condition across the equator.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__define_symmetric( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
CALL dom__size_no_pole_no_overlap( td_dom )
END SUBROUTINE dom__define_symmetric
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices from global domain
!> with cyclic east-west boundary.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__define_cyclic( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_imin >= td_dom%i_imax )THEN
CALL logger_trace("DOM DEFINE CYCLIC: "//&
& "domain to extract overlap east-west boundary")
CALL dom__size_no_pole_overlap( td_dom )
ELSE
! id_imin < id_imax
CALL logger_trace("DOM DEFINE CYCLIC: "//&
& "domain to extract do not overlap east-west boundary")
CALL dom__size_no_pole_no_overlap( td_dom )
ENDIF
END SUBROUTINE dom__define_cyclic
!-------------------------------------------------------------------
!> @brief
!> This subroutine define sub domain indices from global domain
!> with closed boundaries.
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__define_closed( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
CALL dom__size_no_pole_no_overlap( td_dom )
END SUBROUTINE dom__define_closed
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of global domain
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__size_global( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
td_dom%i_imin = 1
td_dom%i_imax = td_dom%t_dim0(1)%i_len
td_dom%i_jmin = 1
td_dom%i_jmax = td_dom%t_dim0(2)%i_len
! domain size
td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
td_dom%t_dim(2)%i_len = td_dom%t_dim0(2)%i_len
! no ghost cell to add
td_dom%i_ghost(:,:)=0
! periodicity
IF( td_dom%i_pivot == 0 )THEN ! 0-F
td_dom%i_perio=4
td_dom%i_pivot=0
ELSE ! 1-T
td_dom%i_perio=6
td_dom%i_pivot=1
ENDIF
END SUBROUTINE dom__size_global
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of a semi global domain
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!> @note never tested
!-------------------------------------------------------------------
SUBROUTINE dom__size_semi_global( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
! local variable
INTEGER(i4) :: il_imid ! canadian bipole index (middle of global domain)
!----------------------------------------------------------------
il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
td_dom%i_imin = 2
td_dom%i_imax = il_imid !td_dom%t_dim0(1)%i_len
IF( td_dom%i_jmin == 0 ) td_dom%i_jmin=1
td_dom%i_jmax = td_dom%t_dim0(2)%i_len
! domain size
td_dom%t_dim(1)%i_len = td_dom%i_imax - &
& td_dom%i_imin + 1
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
! ghost cell to add
td_dom%i_ghost(:,:)=1
! periodicity
IF( td_dom%i_pivot == 0 )THEN !0-F
td_dom%i_perio=3
td_dom%i_pivot=0
ELSE !1-T
td_dom%i_perio=5
td_dom%i_pivot=1
ENDIF
END SUBROUTINE dom__size_semi_global
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain without north fold
!> condition
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__size_no_pole( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_jmax == 0 )THEN
CALL logger_fatal("DOM SIZE NO POLE: invalid domain. "//&
& "can not get north pole from this coarse grid. "//&
& "check namelist and coarse grid periodicity." )
ENDIF
IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 .OR. &
& td_dom%i_imin > td_dom%i_imax )THEN
CALL logger_trace("DOM SIZE NO POLE: "// &
& "domain to extract overlap east-west boundary")
CALL dom__size_no_pole_overlap( td_dom )
ELSE
! id_imin < id_imax
CALL logger_trace("DOM SIZE NO POLE: "// &
& "domain to extract do not overlap east-west boundary")
CALL dom__size_no_pole_no_overlap( td_dom )
ENDIF
END SUBROUTINE dom__size_no_pole
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain with north fold
!> condition.
!>
!> @author J.Paul
!> - April, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!> @note never tested
!-------------------------------------------------------------------
SUBROUTINE dom__size_pole( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_imin >= td_dom%i_imax )THEN
CALL logger_trace("DOM SIZE POLE: "//&
& "domain to extract overlap east-west boundary")
CALL dom__size_pole_overlap( td_dom )
ELSEIF( td_dom%i_imin < td_dom%i_imax )THEN
CALL logger_trace("DOM SIZE POLE: "//&
& "domain to extract do not overlap east-west boundary")
CALL dom__size_pole_no_overlap( td_dom )
ENDIF
END SUBROUTINE dom__size_pole
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain without north fold
!> condition, and which overlap east-west boundary
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__size_no_pole_overlap( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_jmax == 0 )THEN
CALL logger_fatal("DOM SIZE NO POLE OVERLAP: invalid domain. "//&
& "can not get north pole from this coarse grid. "//&
& "check namelist and coarse grid periodicity." )
ENDIF
IF( td_dom%i_imin == 0 .AND. td_dom%i_imax == 0 )THEN
! domain to extract with east west cyclic boundary
CALL logger_trace("DOM SIZE NO POLE OVERLAP: "//&
& "domain to extract has cyclic east-west boundary")
td_dom%i_imin = 1
td_dom%i_imax = td_dom%t_dim0(1)%i_len
td_dom%t_dim(1)%i_len = td_dom%t_dim0(1)%i_len
! no ghost cell
td_dom%i_ghost(jp_I,:)=0
! periodicity
td_dom%i_perio=1
ELSE
! id_imin > id_imax
! extract domain overlap east-west boundary
td_dom%t_dim(1)%i_len = td_dom%i_imax + &
& td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
& td_dom%i_ew0 ! remove cyclic boundary
! add ghost cell
td_dom%i_ghost(jp_I,:)=1
! periodicity
td_dom%i_perio=0
ENDIF
td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
& td_dom%i_jmin + 1
! add ghost cell
td_dom%i_ghost(jp_J,:)=1
END SUBROUTINE dom__size_no_pole_overlap
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain without north fold
!> condition, and which do not overlap east-west boundary
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom__size_no_pole_no_overlap( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
!----------------------------------------------------------------
IF( td_dom%i_jmax == 0 )THEN
CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
& "can not get north pole from this coarse grid. "//&
& "check domain indices and grid periodicity." )
ENDIF
IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 )THEN
CALL logger_fatal("DOM SIZE NO POLE NO OVERLAP: invalid domain. "//&
& "can not overlap East-West boundary with this coarse grid. "//&
& "check domain indices and grid periodicity." )
ENDIF
td_dom%t_dim(1)%i_len = td_dom%i_imax - &
& td_dom%i_imin + 1
td_dom%t_dim(2)%i_len = td_dom%i_jmax - &
& td_dom%i_jmin + 1
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
END SUBROUTINE dom__size_no_pole_no_overlap
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain with north fold
!> condition, and which overlap east-west boundary
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!> @note never tested
!-------------------------------------------------------------------
SUBROUTINE dom__size_pole_overlap( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
! local variable
INTEGER(i4) :: il_idom1 ! extract domain size, east part
INTEGER(i4) :: il_idom2 ! extract domain size, west part
INTEGER(i4) :: il_imid ! cananadian bipole index (middle of global domain)
!----------------------------------------------------------------
CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
& "asian bipole inside domain to extract")
il_imid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
il_idom1 = td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1
il_idom2 = td_dom%i_imax
IF( il_idom1 > il_imid .OR. il_idom2 > il_imid )THEN
CALL logger_trace("DOM SIZE POLE OVERLAP: "//&
& "canadian bipole inside domain to extract")
td_dom%i_imin = 0
td_dom%i_imax = 0
IF( td_dom%i_jmin == 0 .AND. td_dom%i_jmax == 0 )THEN
CALL dom__size_global( td_dom )
ELSE
CALL dom__size_semi_global( td_dom )
ENDIF
! periodicity
td_dom%i_perio=0
ELSEIF( il_idom1 > il_idom2 )THEN
! east part bigger than west part
CALL logger_trace("DOM SIZE POLE OVERLAP: east part bigger than west part ")
! to respect symmetry around asian bipole
td_dom%i_imax = il_idom1
IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
! north pole
td_dom%i_jmax = td_dom%t_dim0(2)%i_len
! compute size
td_dom%t_dim(1)%i_len = il_idom1 !! no ghost cell ??
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
ELSE ! il_idom2 >= il_idom1
! west part bigger than east part
CALL logger_trace("DOM SIZE POLE OVERLAP: west part bigger than east part ")
! to respect symmetry around asian bipole
td_dom%i_imin = td_dom%t_dim0(1)%i_len - il_idom2 + 1
IF( td_dom%i_jmin == 0 ) td_dom%i_jmin = 1
! north pole
td_dom%i_jmax=td_dom%t_dim0(2)%i_len
! compute size
td_dom%t_dim(1)%i_len = il_idom2
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) - 2
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
ENDIF
END SUBROUTINE dom__size_pole_overlap
!-------------------------------------------------------------------
!> @brief
!> This subroutine compute size of sub domain with north fold
!> condition, and which do not overlap east-west boundary
!>
!> @author J.Paul
!> - November, 2013- Subroutine written
!
!> @param[inout] td_dom domain strcuture
!> @note never tested
!-------------------------------------------------------------------
SUBROUTINE dom__size_pole_no_overlap( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
! local variable
INTEGER(i4) :: il_idom1 ! extract domain size, east part
INTEGER(i4) :: il_idom2 ! extract domain size, west part
INTEGER(i4) :: il_mid ! canadian biple index ?
!----------------------------------------------------------------
IF( td_dom%i_imin == 0 .OR. td_dom%i_imax == 0 .OR. &
& td_dom%i_imin > td_dom%i_imax )THEN
CALL logger_fatal("DOM SIZE POLE NO OVERLAP: invalid domain. "//&
& "can not overlap East-West boundary with this coarse grid. "//&
& "check namelist and coarse grid periodicity." )
ENDIF
CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
& "no asian bipole inside domain to extract")
IF( td_dom%i_jmin==0 ) td_dom%i_jmin = 1
IF( td_dom%i_jmax==0 ) td_dom%i_jmax = td_dom%t_dim0(2)%i_len
!
il_mid = td_dom%t_dim0(1)%i_len/2 + td_dom%i_pivot
IF( (td_dom%i_imin < il_mid .AND. td_dom%i_imax < il_mid) .OR. &
& (td_dom%i_imin > il_mid .AND. td_dom%i_imax > il_mid) )THEN
CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
& "no canadian bipole inside domain to extract")
td_dom%t_dim(1)%i_len = td_dom%i_imax - &
& td_dom%i_imin + 1
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) - 2 ! remove north fold condition ?
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
ELSE ! id_imin < il_mid .AND. id_imax > il_mid
CALL logger_trace("DOM SIZE POLE NO OVERLAP: "//&
& "canadian bipole inside domain to extract")
il_idom1 = td_dom%i_imax - (il_mid - 1)
il_idom2 = il_mid - td_dom%i_imin
IF( il_idom1 > il_idom2 )THEN
! east part bigger than west part
CALL logger_trace("DOM SIZE POLE NO OVERLAP: east part bigger than west part ")
! to respect symmetry around canadian bipole
td_dom%i_imin = il_mid - il_idom1
td_dom%t_dim(1)%i_len = il_idom1 + 1
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) &
& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
ELSE ! il_idom2 >= il_idom1
! west part bigger than east part
CALL logger_trace("DOM SIZE POLE NO OVERLAP: west part bigger than east part ")
! to respect symmetry around canadian bipole
td_dom%i_imax = il_mid + il_idom2
td_dom%t_dim(1)%i_len = il_idom2 + 1
td_dom%t_dim(2)%i_len = ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmin + 1 ) + &
& ( td_dom%t_dim0(2)%i_len - &
& td_dom%i_jmax + 1 ) &
& - 2 - 2 * td_dom%i_pivot ! remove north fold condition ?
! add ghost cell
td_dom%i_ghost(:,:)=1
! periodicity
td_dom%i_perio=0
ENDIF
ENDIF
END SUBROUTINE dom__size_pole_no_overlap
!-------------------------------------------------------------------
!> @brief
!> This subroutine add extra bands to coarse domain to get enough point for
!> interpolation...
!>
!> @details
!> - domain periodicity is take into account.
!> - domain indices are changed, and size of extra bands are saved.
!> - optionaly, i- and j- direction size of extra bands could be specify
!> (default=im_minext)
!>
!> @author J.Paul
!> @date November, 2013
!> @date September, 2014
!> - take into account number of ghost cell
!
!> @param[inout] td_dom domain strcuture
!> @param [in] id_iext i-direction size of extra bands (default=im_minext)
!> @param [in] id_jext j-direction size of extra bands (default=im_minext)
!-------------------------------------------------------------------
SUBROUTINE dom_add_extra( td_dom, id_iext, id_jext )
IMPLICIT NONE
! Argument
TYPE(TDOM) , INTENT(INOUT) :: td_dom
INTEGER(i4), INTENT(IN ), OPTIONAL :: id_iext
INTEGER(i4), INTENT(IN ), OPTIONAL :: id_jext
! local variable
INTEGER(i4) :: il_iext
INTEGER(i4) :: il_jext
! loop indices
!----------------------------------------------------------------
! init
il_iext=im_minext
IF( PRESENT(id_iext) ) il_iext=id_iext
il_jext=im_minext
IF( PRESENT(id_jext) ) il_jext=id_jext
td_dom%i_iextra(:)=0
td_dom%i_jextra(:)=0
IF( td_dom%i_imin == 1 .AND. &
& td_dom%i_imax == td_dom%t_dim0(1)%i_len .AND. &
& td_dom%i_jmin == 1 .AND. &
& td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
! global
! nothing to be done
ELSE
IF( td_dom%i_imin == 1 .AND. &
& td_dom%i_imax == td_dom%t_dim0(1)%i_len )THEN
! EW cyclic
! nothing to be done
ELSE
IF( td_dom%i_ew0 < 0 )THEN
! EW not cyclic
IF( td_dom%i_imin - il_iext > td_dom%i_ghost0(jp_I,1)*ip_ghost )THEN
td_dom%i_iextra(1) = il_iext
td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
ELSE ! td_dom%i_imin - il_iext <= td_dom%i_ghost0(jp_I,1)*ip_ghost
td_dom%i_iextra(1) = MIN(0, &
& td_dom%i_imin - &
& td_dom%i_ghost0(jp_I,1)*ip_ghost -1)
td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
ENDIF
IF( td_dom%i_imax + il_iext < &
& td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost )THEN
td_dom%i_iextra(2) = il_iext
td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
ELSE ! td_dom%i_imax + il_iext >= &
! td_dom%t_dim0(1)%i_len - td_dom%i_ghost0(jp_I,2)*ip_ghost
td_dom%i_iextra(2) = MIN(0, &
& td_dom%t_dim0(1)%i_len - &
& td_dom%i_ghost0(jp_I,2)*ip_ghost - &
& td_dom%i_imax )
td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
ENDIF
ELSE ! td_dom%i_ew0 >= 0
! EW cyclic
IF( td_dom%i_imin - il_iext > 0 )THEN
td_dom%i_iextra(1) = il_iext
td_dom%i_imin = td_dom%i_imin - td_dom%i_iextra(1)
ELSE ! td_dom%i_imin - il_iext <= 0
td_dom%i_iextra(1) = il_iext
td_dom%i_imin = td_dom%t_dim0(1)%i_len + &
& td_dom%i_imin - td_dom%i_iextra(1) -&
& td_dom%i_ew0
ENDIF
IF( td_dom%i_imax + il_iext <= td_dom%t_dim0(1)%i_len )THEN
td_dom%i_iextra(2) = il_iext
td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2)
ELSE ! td_dom%i_imax + il_iext > td_dom%t_dim0(1)%i_len
td_dom%i_iextra(2) = il_iext
td_dom%i_imax = td_dom%i_imax + td_dom%i_iextra(2) - &
& (td_dom%t_dim0(1)%i_len-td_dom%i_ew0)
ENDIF
ENDIF
ENDIF
IF( td_dom%i_jmin == 1 .AND. &
& td_dom%i_jmax == td_dom%t_dim0(2)%i_len )THEN
! nothing to be done
ELSE
IF( td_dom%i_jmin - il_jext > td_dom%i_ghost0(jp_J,1)*ip_ghost )THEN
td_dom%i_jextra(1) = il_jext
td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1)
ELSE ! td_dom%i_jmin - il_jext <= td_dom%i_ghost0(jp_J,1)*ip_ghost
td_dom%i_jextra(1) = MIN(0, &
& td_dom%i_jmin - &
& td_dom%i_ghost0(jp_J,1)*ip_ghost - 1)
td_dom%i_jmin = td_dom%i_jmin - td_dom%i_jextra(1)
ENDIF
IF( td_dom%i_jmax + il_jext < &
& td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost )THEN
td_dom%i_jextra(2) = il_jext
td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2)
ELSE ! td_dom%i_jmax + il_jext >= &
! td_dom%t_dim0(2)%i_len - td_dom%i_ghost0(jp_J,2)*ip_ghost
td_dom%i_jextra(2) = MIN(0, &
& td_dom%t_dim0(2)%i_len - &
& td_dom%i_ghost0(jp_J,2)*ip_ghost - &
& td_dom%i_jmax )
td_dom%i_jmax = td_dom%i_jmax + td_dom%i_jextra(2)
ENDIF
ENDIF
ENDIF
IF( td_dom%i_imin <= td_dom%i_imax )THEN
td_dom%t_dim(1)%i_len = td_dom%i_imax - td_dom%i_imin +1
ELSE ! td_dom%i_imin > td_dom%i_imax
td_dom%t_dim(1)%i_len = td_dom%i_imax + &
& td_dom%t_dim0(1)%i_len - td_dom%i_imin + 1 - &
& td_dom%i_ew0 ! remove overlap
ENDIF
td_dom%t_dim(2)%i_len = td_dom%i_jmax-td_dom%i_jmin+1
END SUBROUTINE dom_add_extra
!-------------------------------------------------------------------
!> @brief
!> This subroutine clean coarse grid domain structure.
!> it remove extra point added.
!
!> @author J.Paul
!> @date November, 2013
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom_clean_extra( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM) , INTENT(INOUT) :: td_dom
! local variable
! loop indices
!----------------------------------------------------------------
! change domain
td_dom%i_imin = td_dom%i_imin + td_dom%i_iextra(1)
td_dom%i_jmin = td_dom%i_jmin + td_dom%i_jextra(1)
td_dom%i_imax = td_dom%i_imax - td_dom%i_iextra(2)
td_dom%i_jmax = td_dom%i_jmax - td_dom%i_jextra(2)
td_dom%t_dim(1)%i_len = td_dom%t_dim(1)%i_len - &
& td_dom%i_iextra(1) - &
& td_dom%i_iextra(2)
td_dom%t_dim(2)%i_len = td_dom%t_dim(2)%i_len - &
& td_dom%i_jextra(1) - &
& td_dom%i_jextra(2)
td_dom%i_iextra(:)=0
td_dom%i_jextra(:)=0
END SUBROUTINE dom_clean_extra
!-------------------------------------------------------------------
!> @brief
!> This subroutine delete extra band, from fine grid variable value,
!> and dimension, taking into account refinement factor.
!>
!> @details
!> @note This subroutine should be used before clean domain structure.
!>
!> @warning if work on coordinates grid, do not remove all extra point.
!> save value on ghost cell.
!>
!> @author J.Paul
!> @date November, 2013
!> @date September, 2014
!> - take into account boundary for one point size domain
!> @date December, 2014
!> - add special case for coordinates file.
!
!> @param[inout] td_var variable strcuture
!> @param[in] td_dom domain strcuture
!> @param[in] id_rho array of refinement factor
!> @param[in] ld_coord work on coordinates file or not
!-------------------------------------------------------------------
SUBROUTINE dom_del_extra( td_var, td_dom, id_rho, ld_coord )
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
TYPE(TDOM) , INTENT(IN ) :: td_dom
INTEGER(i4), DIMENSION(:), INTENT(IN ), OPTIONAL :: id_rho
LOGICAL , INTENT(IN ), OPTIONAL :: ld_coord
! local variable
INTEGER(i4) :: il_iextra
INTEGER(i4) :: il_jextra
INTEGER(i4) :: il_imin
INTEGER(i4) :: il_imax
INTEGER(i4) :: il_jmin
INTEGER(i4) :: il_jmax
INTEGER(i4), DIMENSION(2) :: il_rho
INTEGER(i4), DIMENSION(2,2) :: il_ghost
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
LOGICAL :: ll_coord
! loop indices
!----------------------------------------------------------------
IF( PRESENT(id_rho) )THEN
! work on coarse grid
il_rho(:)=id_rho(jp_I:jp_J)
ELSE
! work on fine grid
il_rho(:)=1
ENDIF
ll_coord=.false.
IF( PRESENT(ld_coord) ) ll_coord=ld_coord
IF( .NOT. ASSOCIATED(td_var%d_value) )THEN
CALL logger_error("DOM DEL EXTRA: no value associated to "//&
& "variable "//TRIM(td_var%c_name) )
ELSE
! get variable right domain
IF( ALL(td_var%t_dim(1:2)%l_use) )THEN
ALLOCATE(dl_value(td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len, &
& td_var%t_dim(3)%i_len, &
& td_var%t_dim(4)%i_len) )
dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
il_iextra=SUM(td_dom%i_iextra(:))*il_rho(jp_I)
il_jextra=SUM(td_dom%i_jextra(:))*il_rho(jp_J)
il_ghost(:,:)=0
IF( ll_coord )THEN
il_ghost(:,:)=td_dom%i_ghost(:,:)
ENDIF
IF( il_iextra >= td_var%t_dim(1)%i_len )THEN
! case one point size dimension
SELECT CASE(td_dom%i_bdy)
CASE(jp_north,jp_east)
CALL logger_info("DOM DEL EXTRA: special case for north"//&
& " or east boundary.")
IF( td_dom%i_iextra(1) <= 0 )THEN
il_imin= 1
il_ghost(jp_I,1) = 0
ELSE
il_imin= 1 + (td_dom%i_iextra(1)-1)*il_rho(jp_I) + 1 &
& - il_ghost(jp_I,1)
ENDIF
IF( td_dom%i_iextra(2) <= 0 )THEN;
il_imax= td_var%t_dim(1)%i_len
il_ghost(jp_I,2) = 0
ELSE
il_imax= td_var%t_dim(1)%i_len - &
& td_dom%i_iextra(2)*il_rho(jp_I) &
& + il_ghost(jp_I,2)
ENDIF
CASE(jp_south,jp_west)
CALL logger_info("DOM DEL EXTRA: special case for south"//&
& " or west boundary.")
IF( td_dom%i_iextra(1) <= 0 )THEN
il_imin= 1
il_ghost(jp_I,1) = 0
ELSE
il_imin= 1 + td_dom%i_iextra(1)*il_rho(jp_I) &
& - il_ghost(jp_I,1)
ENDIF
IF( td_dom%i_iextra(2) <= 0 )THEN
il_imax= td_var%t_dim(1)%i_len
il_ghost(jp_I,2) = 0
ELSE
il_imax= td_var%t_dim(1)%i_len - &
& (td_dom%i_iextra(2)-1)*il_rho(jp_I) - 1 &
& + il_ghost(jp_I,2)
ENDIF
CASE DEFAULT
IF( MOD(il_iextra-td_var%t_dim(1)%i_len,2)==0 )THEN
! case one point size dimension with even refinment
CALL logger_fatal("DOM DEL EXTRA: should have been"//&
& "an impossible case: domain of "//&
& " one point size and even refinment.")
ELSE
il_imin= 1 + &
& (td_dom%i_iextra(1)-1)*il_rho(jp_I) + &
& (il_rho(jp_I)-1)/2 + 1 &
& - il_ghost(jp_I,1)
il_imax= td_var%t_dim(1)%i_len - &
& (td_dom%i_iextra(2)-1)*il_rho(jp_I) - &
& (il_rho(jp_I)-1)/2 - 1 &
& + il_ghost(jp_I,2)
ENDIF
END SELECT
td_var%t_dim(1)%i_len = 1 + SUM(il_ghost(jp_I,:))
ELSE
! general case
il_imin=1 + td_dom%i_iextra(1)*il_rho(jp_I) &
& - il_ghost(jp_I,1)
il_imax=td_var%t_dim(1)%i_len - td_dom%i_iextra(2)*il_rho(jp_I) &
& + il_ghost(jp_I,2)
td_var%t_dim(1)%i_len=td_var%t_dim(1)%i_len - il_iextra &
& + SUM(il_ghost(jp_I,:))
ENDIF
IF( il_jextra >= td_var%t_dim(2)%i_len )THEN
! case one point size dimension
SELECT CASE(td_dom%i_bdy)
CASE(jp_north,jp_east)
IF( td_dom%i_jextra(1) <= 0 )THEN
il_jmin= 1
il_ghost(jp_J,1) = 0
ELSE
il_jmin= 1 + (td_dom%i_jextra(1)-1)*il_rho(jp_J) + 1 &
& - il_ghost(jp_J,1)
ENDIF
IF( td_dom%i_jextra(2) <= 0 )THEN
il_jmax= td_var%t_dim(2)%i_len
il_ghost(jp_J,2) = 0
ELSE
il_jmax= td_var%t_dim(2)%i_len - &
& td_dom%i_jextra(2)*il_rho(jp_J) &
& + il_ghost(jp_J,2)
ENDIF
CASE(jp_south,jp_west)
IF( td_dom%i_iextra(2) <= 0 )THEN
il_jmin= 1
il_ghost(jp_J,1) = 0
ELSE
il_jmin= 1 + td_dom%i_jextra(1)*il_rho(jp_J) &
& - il_ghost(jp_J,1)
ENDIF
IF( td_dom%i_jextra(2) <= 0 )THEN
il_jmax= td_var%t_dim(2)%i_len
il_ghost(jp_J,2) = 0
ELSE
il_jmax= td_var%t_dim(2)%i_len - &
& (td_dom%i_jextra(2)-1)*il_rho(jp_J) - 1 &
& + il_ghost(jp_J,2)
ENDIF
CASE DEFAULT
IF( MOD(il_jextra-td_var%t_dim(2)%i_len,2)==0 )THEN
! case one point size dimension with even refinment
CALL logger_fatal("DOM DEL EXTRA: should have been"//&
& "an impossible case: domain of "//&
& " one point size and even refinment.")
ELSE
il_jmin= 1 + &
& (td_dom%i_jextra(1)-1)*il_rho(jp_J) + &
& (il_rho(jp_J)-1)/2 + 1 &
& - il_ghost(jp_J,1)
il_jmax= td_var%t_dim(2)%i_len - &
& (td_dom%i_jextra(2)-1)*il_rho(jp_J) - &
& (il_rho(jp_J)-1)/2 - 1 &
& + il_ghost(jp_J,2)
ENDIF
END SELECT
td_var%t_dim(2)%i_len = 1 + SUM(il_ghost(jp_J,:))
ELSE
! general case
il_jmin=1 + td_dom%i_jextra(1)*il_rho(jp_J) &
& - il_ghost(jp_J,1)
il_jmax=td_var%t_dim(2)%i_len - td_dom%i_jextra(2)*il_rho(jp_J) &
& + il_ghost(jp_J,2)
td_var%t_dim(2)%i_len= td_var%t_dim(2)%i_len - il_jextra &
& + SUM(il_ghost(jp_J,:))
ENDIF
DEALLOCATE(td_var%d_value)
ALLOCATE(td_var%d_value(td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len, &
& td_var%t_dim(3)%i_len, &
& td_var%t_dim(4)%i_len) )
td_var%d_value(:,:,:,:)=dl_value(il_imin:il_imax, &
& il_jmin:il_jmax, &
& :, :)
DEALLOCATE(dl_value)
ENDIF
ENDIF
END SUBROUTINE dom_del_extra
!-------------------------------------------------------------------
!> @brief
!> This subroutine clean domain structure.
!
!> @author J.Paul
!> @date November, 2013
!
!> @param[inout] td_dom domain strcuture
!-------------------------------------------------------------------
SUBROUTINE dom_clean( td_dom )
IMPLICIT NONE
! Argument
TYPE(TDOM), INTENT(INOUT) :: td_dom
! local variable
TYPE(TDOM) :: tl_dom ! empty dom structure
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
CALL logger_info( "DOM CLEAN: reset domain " )
! del dimension
DO ji=ip_maxdim,1,-1
CALL dim_clean( td_dom%t_dim0(ji) )
ENDDO
! replace by empty structure
td_dom=tl_dom
END SUBROUTINE dom_clean
END MODULE dom