psmile_transform_cell_cyclic_dble.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2010, DKRZ, Hamburg, Germany.
! All rights reserved. Use is subject to OASIS4 license terms.
!------------------------------------------------------------------------
!
! !DESCRIPTION:
!
! Subroutine "psmile_transform_cell_cyclic" turns cells that cross
! cyclic coordinate ranges into valid cells that other routines
! can easily deal with.
! example:
! cyclic_grid_extent = 360
!  input cell: ([359,80],[  1,80],[  1,81],[359,81])
! output cell: ([359,80],[361,80],[361,81],[359,81])
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 07.09.10    M. Hanke     created
!
!----------------------------------------------------------------------
!
!  $Id: psmile_transform_cell_cyclic_dble.F90 2601 2010-09-27 11:48:58Z hanke $
!  $Author: hanke $
!
!----------------------------------------------------------------------
#undef VERBOSE
subroutine psmile_transform_cell_cyclic_dble (cell, cyclic_grid_extent, ierror)
!
! !USES:
!
   use psmile_common, only : ch_id
   use psmile_grid
!
! !INPUT PARAMETERS:
!
   double precision, intent(in) :: cyclic_grid_extent
!
! !INOUT PARAMETERS:
!
   double precision, intent(inout) :: cell (4)
!
! !OUTPUT PARAMETERS:
!
!     Returns the error code of psmile_Transform_extent_back;
!             ierror = 0 : No error
!             ierror > 0 : Severe error (currently not used)
   integer, intent (out) :: ierror
!
! !LOCAL VARIABLES
!
!  true if transformation of a cell corner is required
   logical :: trans_req
!  contains half of cyclic_grid_extent
   double precision :: half_cyclic_grid_extent
!  contains the distance between two adjacent corners of the cell
   double precision :: edge_length
!  loop variable
   integer :: i
!  indices for accessing a single edge
   integer :: index1, index2

#ifdef VERBOSE
   print 9990, trim(ch_id), cell
   call psmile_flushstd
#endif /* VERBOSE */

   ierror = 0

   trans_req = .false.
   half_cyclic_grid_extent = cyclic_grid_extent / 2._psmile_float_kind

   index2 = 4

   do i = 1, 8
      ! computes the indices for the current edge
      ! (some bit twiddeling is used to generate the following index sequence:
      !  1-2, 3-4, 3-2, 1-4, 1-2, 3-4, 1-2, 3-4
      index1 = iand(ior(i, 1), 3)
      index2 = ieor(index2, 6)
      ! compute the distance between the corners of the current edge
      edge_length = cell(index1) - cell(index2)

#if defined(DEBUG) && defined(VERBOSE)
      if (abs(edge_length) > half_cyclic_grid_extent) &
         print 9970, trim(ch_id), cell(index1), cell(index2)
#endif

      ! if corner i is too small
      do while (edge_length < - half_cyclic_grid_extent)
         ! shift up corner i by cyclic_grid_extent
         cell(index1) = cell(index1) + cyclic_grid_extent
         ! compute the new distance between the corners of the current edge
         edge_length = cell(index1) - cell(index2)
      enddo

      ! if corner i+1 is too small
      do while (edge_length > half_cyclic_grid_extent)

         ! shift up corner i+1 by cyclic_grid_extent
         cell(index2) = cell(index2) + cyclic_grid_extent

         ! compute the new distance between the corners of the current edge
         edge_length = cell(index1) - cell(index2)
      enddo

   enddo

#ifdef VERBOSE
   print 9991, trim(ch_id), cell
   print 9980, trim(ch_id), ierror
   call psmile_flushstd

9990 format (1x, a, ': psmile_transform_cell_cyclic_dble: cell in ', 4f8.2)
9991 format (1x, a, ': psmile_transform_cell_cyclic_dble: cell out', 4f8.2)
9980 format (1x, a, ': psmile_transform_cell_cyclic_dble: eof ierror =', i3)
9970 format (1x, a, ': psmile_transform_cell_cyclic_dble: transforming edge: ', 4f8.2)

#endif /* VERBOSE */

end subroutine psmile_transform_cell_cyclic_dble