psmile_grid.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2010, DKRZ, Hamburg, Germany.
! All rights reserved. Use is subject to OASIS4 license terms.
!------------------------------------------------------------------------

module psmile_grid

!
! available grid types
!
   use prism_constants, only : PRISM_Reglonlatvrt, &
                               PRISM_Irrlonlat_regvrt, &
                               PRISM_Irrlonlatvrt, &
                               PRISM_Irrlonlat_sigmavrt, &
                               PRISM_Reglonlat_sigmavrt, &
                               PRISM_Unstructlonlat_regvrt, &
                               PRISM_Unstructlonlat_sigmavrt, &
                               PRISM_Unstructlonlatvrt, &
                               PRISM_Gridless, &
                               PRISM_Gaussreduced_regvrt, &
                               PRISM_Gaussreduced_sigmavrt
   use psmile_common, only : psmile_float_kind, ndim_1d, ndim_2d, &
                             ndim_3d, psmile_undef

   implicit none

!
! maximum number of parts a given extention can be
! splitted into by psmile_transform_extent_cyclic
!
   integer, parameter :: max_num_trans_parts = 3*3 ! be carefull: if this value is changed, you will
                                                   ! have to adjust the interface for
                                                   ! "psmile_transform_extent_cyclic" accordingly
                                                   ! (NEC does not like import statement)
!
! code return by psmile_transform_extent_cyclic which indicates,
! that no transformation was performed
!
   integer, parameter :: code_no_trans = 0
!
! all grids are transformed automatically into the common grid range
! in order to be able to compare them
!
   real (psmile_float_kind), parameter :: common_grid_range(2,ndim_3d) = 
      reshape( (/-180, 180, -90, 90, 0, 0/), (/2, 3/) )
!
! lists of grids which arr allowed to be cyclic in a certain dimension
!
   integer, parameter :: grids_cyclic_in_first_dim(9) = 
                  (/PRISM_Reglonlatvrt, PRISM_Irrlonlat_regvrt,         
                    PRISM_Irrlonlatvrt,                                 
                    PRISM_Irrlonlat_sigmavrt, PRISM_Reglonlat_sigmavrt, 
                    PRISM_Unstructlonlat_regvrt,                        
                    PRISM_Unstructlonlat_sigmavrt,                      
                    PRISM_Unstructlonlatvrt,                            
                    PRISM_Gaussreduced_regvrt/)

   integer, parameter :: grids_cyclic_in_second_dim(9) = 
                  (/PRISM_Reglonlatvrt, PRISM_Irrlonlat_regvrt,         
                    PRISM_Irrlonlatvrt,                                 
                    PRISM_Irrlonlat_sigmavrt, PRISM_Reglonlat_sigmavrt, 
                    PRISM_Unstructlonlat_regvrt,                        
                    PRISM_Unstructlonlat_sigmavrt,                      
                    PRISM_Unstructlonlatvrt,                            
                    PRISM_Gaussreduced_regvrt/)
   integer, parameter :: grids_cyclic_in_third_dimension(1) = (/psmile_undef/)

!
! defines a threshold which triggers a special handling for cell near the pole
!
   double precision, parameter :: pole_threshold = 86.0d0 ! transformer uses a north_threshold
                                                          ! maybe these parameters can be unified

   interface

!
! routines for transforming the user given coords range into
! the common -180 to 180 range and back
!

      subroutine psmile_transform_extent_cyclic (grid_type, extent, &
                                                transformed, tr_codes, n_trans, &
                                                ierror)
         use psmile_common, only : psmile_float_kind, ndim_3d

         integer,                  intent (in)  :: grid_type
         real (psmile_float_kind), intent (in)  :: extent (2, ndim_3d)
         real (psmile_float_kind), intent (out) :: transformed (2, ndim_3d, 3*3)
         integer,                  intent (out) :: tr_codes(3*3)
         integer,                  intent (out) :: ierror, n_trans
      end subroutine

      subroutine psmile_transform_extent_back (tr_codes, extents, &
                                               transformed, n_trans,  &
                                               ierror)
         use psmile_common, only : psmile_float_kind, ndim_3d, nd_extent_infos

         integer,                  intent (in)  :: n_trans
         integer,                  intent (in)  :: tr_codes (n_trans)
         real (psmile_float_kind), intent (in)  :: extents (2, ndim_3d, 
                                                            n_trans)
         real (psmile_float_kind), intent (out) :: transformed (2, ndim_3d, 
                                                                n_trans)
         integer,                  intent (out) :: ierror
      end subroutine

      subroutine psmile_transform_coords (comp_info, search, ierror)
         use psmile_common, only : enddef_comp, enddef_search

         type (enddef_comp),   intent (in)    :: comp_info
         type (enddef_search), intent (inout) :: search
         integer,              intent (out)   :: ierror
      end subroutine

      subroutine psmile_transform_coords_db_re (tr_code_to, tr_code_from, &
                          coords_data_dble, coords_data_real, &
                          coords_size, datatype, ierror)
         use psmile_common, only : dble_vector, real_vector, ndim_3d

         integer, intent (in)                        :: tr_code_to
         integer, intent (in)                        :: tr_code_from
         integer, intent (in)                        :: coords_size (ndim_3d)
         integer, intent (in)                        :: datatype
         type (dble_vector), intent(inout), optional :: coords_data_dble (ndim_3d)
         type (real_vector), intent(inout), optional :: coords_data_real (ndim_3d)
         integer, intent (out)                       :: ierror
      end subroutine

   end interface

   interface psmile_transform_cell_cyclic
!
! routine for transforming cells that cross cyclic boundaries (360->0 or 180->-180)
!

      subroutine psmile_transform_cell_cyclic_dble (cell, cyclic_grid_extent, ierror)

         double precision, intent(in)    :: cyclic_grid_extent
         double precision, intent(inout) :: cell (4)
         integer, intent (out)           :: ierror
      end subroutine psmile_transform_cell_cyclic_dble

      subroutine psmile_transform_cell_cyclic_real (cell, cyclic_grid_extent, ierror)

         real, intent(in)      :: cyclic_grid_extent
         real, intent(inout)   :: cell (4)
         integer, intent (out) :: ierror
      end subroutine psmile_transform_cell_cyclic_real

   end interface psmile_transform_cell_cyclic

   private :: psmile_transform_cell_cyclic_dble
   private :: psmile_transform_cell_cyclic_real

   contains

      function get_size_of_shape(grid_type)

         use prism_constants, only : PRISM_Error_Grid

         integer, intent(in) :: grid_type
         integer :: get_size_of_shape(2)

         get_size_of_shape(1) = 2

         select case ( grid_type )

         case ( PRISM_Unstructlonlatvrt )

            get_size_of_shape(2) = 1

         case ( PRISM_Unstructlonlat_regvrt,   &
                PRISM_Unstructlonlat_sigmavrt, &
                PRISM_Gaussreduced_regvrt,     &
                PRISM_Gaussreduced_sigmavrt)

            get_size_of_shape(2) = 2

         case ( PRISM_Gridless,           &
                PRISM_Irrlonlatvrt,       &
                PRISM_Irrlonlat_sigmavrt, &
                PRISM_Irrlonlat_regvrt,   &
                PRISM_Reglonlatvrt,       &
                PRISM_Reglonlat_sigmavrt)

            get_size_of_shape(2) = 3

         case  DEFAULT

            call psmile_error ( PRISM_Error_Grid, 'unsupported grid type', &
               (/0, 0, grid_type/), 3, __FILE__, __LINE__ )

         end select ! grid_type

      end function get_size_of_shape

      function get_num_independent_dims(grid_type)

         use prism_constants, only : PRISM_Error_Grid

         integer, intent(in) :: grid_type
         integer :: get_num_independent_dims

         select case ( grid_type )

                               
         case ( PRISM_Reglonlatvrt, &
                PRISM_Reglonlat_sigmavrt)

            get_num_independent_dims = ndim_3d

         case ( PRISM_Irrlonlat_regvrt,        &
                PRISM_Irrlonlat_sigmavrt,      &
                PRISM_Unstructlonlat_regvrt,   &
                PRISM_Unstructlonlat_sigmavrt, &
                PRISM_Gaussreduced_regvrt,     &
                PRISM_Gaussreduced_sigmavrt)

            get_num_independent_dims = ndim_2d

         case ( PRISM_Irrlonlatvrt,      &
                PRISM_Unstructlonlatvrt, &
                PRISM_Gridless )

            get_num_independent_dims = ndim_1d

         case  DEFAULT

            get_num_independent_dims = psmile_undef

            call psmile_error ( PRISM_Error_Grid, 'unsupported grid type', &
               (/0, 0, grid_type/), 3, __FILE__, __LINE__ )

         end select ! grid_type

      end function get_num_independent_dims

end module psmile_grid