psmile_def_grid.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, CERFACS, Toulouse, France.
00003 ! Copyright 2006-2010, SGI Germany, Munich, Germany.
00004 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00005 ! All rights reserved. Use is subject to OASIS4 license terms.
00006 !-----------------------------------------------------------------------
00007 !BOP
00008 !
00009 ! !ROUTINE: psmile_def_grid
00010 !
00011 ! !INTERFACE:
00012 
00013       subroutine psmile_def_grid ( grid_id, grid_name, comp_id, &
00014                  grid_valid_shape, grid_type, ierror )
00015 !
00016 ! !USES:
00017 !
00018       use prism
00019       use PSMILe, dummy => psmile_def_grid
00020       use PSMILe_SMIOC, only : sga_smioc_comp, smioc_grid
00021 
00022       implicit none
00023 !
00024 ! !INPUT PARAMETERS:
00025 !
00026       Character(len=*), Intent(In)        :: grid_name
00027 
00028 !     Name of the grid to check with SMIOC entry
00029 
00030       integer, Intent (In)                :: comp_id
00031 
00032 !     Specifies the handle to the component information.
00033 !     comp_id was created by routine PRISM_InitComp ().
00034 
00035       integer, Intent (In)                :: grid_valid_shape (1:2,*)
00036 
00037 !     Specifies the valid block shape for the "ndim_3d"-dimensional block
00038 !     (without halo/overlap regions) with
00039 
00040 !     grid_valid_shape (1,    1) = Lowest  first   index of block
00041 !     grid_valid_shape (2,    1) = Highest first   index of block
00042 !     grid_valid_shape (1,    2) = Lowest  second  index of block
00043 !     grid_valid_shape (2,    2) = Highest second  index of block
00044 !        ...
00045 !     grid_valid_shape (1,    i) = Lowest  i-th    index of block
00046 !     grid_valid_shape (2,    i) = Highest i-th    index of block
00047 !     grid_valid_shape (1, ndim) = Lowest  ndim-th index of block
00048 !     grid_valid_shape (2, ndim) = Highest ndim-th index of block
00049 
00050       integer, Intent (In)                :: grid_type
00051 
00052 !     Code for the type of grid generation
00053 
00054 !     PRISM_Reglonlatvrt            = Regular grid in all directions
00055 !     PRISM_Irrlonlat_regvrt        = Horizontal irregular, regular in the vertical
00056 !     PRISM_Irrlonlatvrt            = Irregular grid in all directions
00057 !     PRISM_Irrlonlat_sigmavrt      = Horizontal irregular grid with sigma coordinates
00058 !     PRISM_Reglonlat_sigmavrt      = Horizontal regular grid with sigma coordinates
00059 !     PRISM_Unstructlonlat_regvrt   = Horizontal unstructured grid, regular in the vertical
00060 !     PRISM_Unstructlonlat_sigmavrt = Horizontal unstructured grid with sigma coordinates
00061 !     PRISM_Unstructlonlatvrt       = Unstructured grid in all directions
00062 !     PRISM_Gridless                = No geographical inforamtion available
00063 !     PRISM_Gaussreduced_regvrt     = Gaussian reduced grid with regular vertical
00064 !     PRISM_Gaussreduced_sigmavrt   = Gaussian reduced grid with sigma coordinates
00065 !
00066 ! !OUTPUT PARAMETERS:
00067 !
00068       integer, Intent (Out)               :: grid_id
00069 
00070 !     Returns the handle to the grid information created.
00071 
00072       integer, Intent (Out)               :: ierror
00073 !
00074 !     Returns the error code of psmile_def_grid;
00075 !             ierror = 0 : No error
00076 !             ierror > 0 : Severe error
00077 !
00078 !
00079 ! !LOCAL VARIABLES
00080 !
00081       Type(smioc_grid), pointer :: sga_smioc_grids(:)
00082 
00083       integer             :: i
00084       integer             :: n_dim
00085       integer(kind=int64) :: len
00086 
00087       integer, parameter  :: nerrp = 3
00088       integer             :: ierrp (nerrp)
00089 !
00090 ! !DESCRIPTION:
00091 !
00092 !  Subroutine "psmile_def_grid" announces a grid and describes its structure.
00093 !  The localisation of the grid points and other characteristics will be
00094 !  described by other routines. The link will be made through the grid
00095 !  identifier. The interface supports only 3-d grids. A 2-d surface in a
00096 !  3-d space thus necessarily requires information about the
00097 !  vertical. The grid for sea surface temperature would have a vertical
00098 !  coordinate array on length 1 containing the location of this surface
00099 !  in the vertical (e.g. z=0) and vertical bounds. These bounds allow the
00100 !  software to determine the sign convention for fluxes.
00101 !
00102 !
00103 ! !REVISION HISTORY:
00104 !   Date      Programmer   Description
00105 ! ----------  ----------   -----------
00106 ! 01.12.03    H. Ritzdorf  created
00107 !
00108 !EOP
00109 !----------------------------------------------------------------------
00110 !
00111 ! $Id: psmile_def_grid.F90 3010 2011-03-10 13:26:49Z hanke $
00112 ! $Author: hanke $
00113 !
00114   Character(len=len_cvs_string), save :: mycvs = 
00115       '$Id: psmile_def_grid.F90 3010 2011-03-10 13:26:49Z hanke $'
00116 !
00117 !----------------------------------------------------------------------
00118 
00119 #ifdef VERBOSE
00120       print 9990, trim(ch_id), comp_id
00121 
00122       call psmile_flushstd
00123 #endif /* VERBOSE */
00124 
00125 !------------------------------------------------------------------------
00126 !  1st Initialization
00127 !------------------------------------------------------------------------
00128 
00129       ierror = 0
00130       grid_id = PRISM_UNDEFINED
00131 
00132 !------------------------------------------------------------------------
00133 !  2nd Get handle Id
00134 !------------------------------------------------------------------------
00135 
00136       call psmile_get_grid_handle (grid_id, ierror)
00137       if (ierror > 0) return
00138 
00139 !------------------------------------------------------------------------
00140 !  3rd Now control grid_type and store shape and dimension information
00141 !------------------------------------------------------------------------
00142 
00143       Grids(grid_id)%grid_shape = 1
00144 
00145       select case ( grid_type )
00146 
00147       case ( PRISM_Gridless )
00148 
00149 ! WARNING: WORKAROUND: Currently for gridless grids all three dimensions
00150 !   have to be specified for the shape. We probably have no chance to
00151 !   check for consistent input at this stage. This may lead to conflicts
00152 !   when gridless grids have to match unstructured grids.
00153 !   !!! Gridless grids matches only with gridless grids !
00154 
00155          Grids(grid_id)%grid_shape (1:2, 1:3) = &
00156                   grid_valid_shape (1:2, 1:3)
00157 
00158          do i = 1, 3
00159            if ( Grids(grid_id)%grid_shape (1,i) == PRISM_UNDEFINED ) &
00160                 Grids(grid_id)%grid_shape (1:2,i) = 1
00161          enddo
00162 
00163          Grids(grid_id)%n_dim = 3
00164 
00165          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00166 
00167       case ( PRISM_Unstructlonlatvrt )
00168 
00169          Grids(grid_id)%grid_shape (1:2, 1:1) = grid_valid_shape (1:2, 1:1)
00170          Grids(grid_id)%n_dim = 1
00171 
00172          Grids(grid_id)%grid_structure = PSMILe_Grid_Unstruct
00173 
00174       case ( PRISM_Unstructlonlat_regvrt )
00175 
00176          Grids(grid_id)%grid_shape (1:2, 1:2) = grid_valid_shape (1:2, 1:2)
00177          Grids(grid_id)%n_dim = 2
00178 
00179          Grids(grid_id)%grid_structure = PSMILe_Grid_Unstruct
00180 
00181       case ( PRISM_Unstructlonlat_sigmavrt )
00182 
00183          Grids(grid_id)%grid_shape (1:2, 1:2) = grid_valid_shape (1:2, 1:2)
00184          Grids(grid_id)%n_dim = 2
00185 
00186          Grids(grid_id)%grid_structure = PSMILe_Grid_Unstruct
00187 
00188       case ( PRISM_Irrlonlatvrt )
00189 
00190          Grids(grid_id)%grid_shape (1:2, 1:3) = grid_valid_shape (1:2, 1:3)
00191          Grids(grid_id)%n_dim = 3
00192 
00193          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00194 
00195       case ( PRISM_Irrlonlat_sigmavrt )
00196 
00197          Grids(grid_id)%grid_shape (1:2, 1:3) = grid_valid_shape (1:2, 1:3)
00198          Grids(grid_id)%n_dim = 3
00199 
00200          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00201 
00202       case ( PRISM_Irrlonlat_regvrt )
00203 
00204          Grids(grid_id)%grid_shape (1:2, 1:3) = grid_valid_shape (1:2, 1:3)
00205          Grids(grid_id)%n_dim = 3
00206 
00207          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00208 
00209       case ( PRISM_Reglonlatvrt )
00210 
00211          Grids(grid_id)%grid_shape (1:2, 1:3) = grid_valid_shape (1:2, 1:3)
00212          Grids(grid_id)%n_dim = 3
00213 
00214          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00215 
00216       case ( PRISM_Gaussreduced_regvrt )
00217 
00218          Grids(grid_id)%grid_shape (1:2, 1) = grid_valid_shape (1:2, 1)
00219          Grids(grid_id)%grid_shape (1:2, 2) = 1
00220          Grids(grid_id)%grid_shape (1:2, 3) = grid_valid_shape (1:2, 2)
00221          Grids(grid_id)%n_dim = 3
00222 
00223          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00224 
00225       case ( PRISM_Gaussreduced_sigmavrt )
00226 
00227          Grids(grid_id)%grid_shape (1:2, 1) = grid_valid_shape (1:2, 1)
00228          Grids(grid_id)%grid_shape (1:2, 2) = 1
00229          Grids(grid_id)%grid_shape (1:2, 3) = grid_valid_shape (1:2, 2)
00230          Grids(grid_id)%n_dim = 3
00231 
00232          Grids(grid_id)%grid_structure = PSMILe_Grid_Block
00233 
00234       case  DEFAULT
00235 
00236          ierror = PRISM_Error_Grid
00237 
00238          ierrp (1) = grid_id
00239          ierrp (2) = comp_id
00240          ierrp (3) = grid_type
00241 
00242          call psmile_error ( ierror, 'unsupported grid generation type', &
00243                              ierrp, 3, __FILE__, __LINE__ )
00244          return
00245 
00246       end select
00247 
00248       if ( Grids(grid_id)%grid_structure == PSMILe_Grid_Unstruct ) then
00249 
00250          ierrp (1) = grid_id
00251 
00252          ierror = PRISM_Error_Arg
00253 
00254          call psmile_error ( PRISM_Error_Arg, &
00255                              'unstructured grids are not yet supported', &
00256                              ierrp, 1, __FILE__, __LINE__ )
00257          return
00258 
00259       endif
00260 
00261 !------------------------------------------------------------------------
00262 !  4th and control of grid_valid_shape
00263 !------------------------------------------------------------------------
00264 
00265       if ( grid_type == PRISM_Gaussreduced_regvrt .or. &
00266            grid_type == PRISM_Gaussreduced_sigmavrt ) then
00267          n_dim = 2
00268       else
00269          n_dim = Grids(grid_id)%n_dim
00270       endif
00271 
00272       do i = 1, n_dim
00273          if ( grid_valid_shape(1,i) > grid_valid_shape(2,i) ) exit
00274       enddo
00275 
00276       if (i <= n_dim ) then
00277          ierror = PRISM_Error_Arglist
00278 
00279          call psmile_error ( ierror, 'grid_valid_shape ', &
00280                              grid_valid_shape , n_dim*2, &
00281                              __FILE__, __LINE__ )
00282       endif
00283 
00284 !------------------------------------------------------------------------
00285 !  5th Allocate specific types
00286 !------------------------------------------------------------------------
00287 
00288       Allocate (Grids(grid_id)%corner_pointer, stat = ierror)
00289       if (ierror > 0) then
00290          ierrp (1) = ierror
00291          ierrp (2) = 1
00292 
00293          ierror = PRISM_Error_Alloc
00294 
00295          call psmile_error ( ierror, 'Grids(grid_Id)%corner_pointer', &
00296                              ierrp, 2, __FILE__, __LINE__ )
00297          return
00298 
00299       endif
00300 
00301 !------------------------------------------------------------------------
00302 !  6th Store Grid data
00303 !------------------------------------------------------------------------
00304 
00305       Grids(grid_id)%comp_id        = comp_id
00306       Grids(grid_id)%status         = PSMILe_Status_defined
00307       Grids(grid_id)%grid_type      = grid_type
00308       Grids(grid_id)%grid_name      = trim(grid_name)
00309       Grids(grid_id)%smioc_index    = PRISM_UNDEFINED
00310 !
00311       len = 1
00312 !
00313       do i = 1, n_dim
00314          len = len * (grid_valid_shape(2,i) - grid_valid_shape(1,i)+1)
00315       enddo
00316 !
00317       Grids(grid_id)%size = len
00318       Grids(grid_id)%nbr_halo_segments = 0
00319 
00320 !     Initialise global size, actual values are calculated
00321 !     and assigned in psmile_enddef_comp_periodic.F90
00322 
00323       Grids(grid_id)%global_size = 1
00324 
00325 !------------------------------------------------------------------------
00326 !     Grids(grid_id)%used_for_coupling will be set to .true. in def_var
00327 !      whenever a variable is defined that is subject to coupling. 
00328 !------------------------------------------------------------------------
00329 
00330       Grids(grid_id)%used_for_coupling = .false.
00331 
00332 !------------------------------------------------------------------------
00333 !     Grids(grid_id)%used_for_io will be set to .true. in def_var
00334 !     if some data are read or sent to a file 
00335 !------------------------------------------------------------------------
00336 
00337       Grids(grid_id)%used_for_io = .false.
00338 
00339 !------------------------------------------------------------------------
00340 !  7th Initialize further data
00341 !------------------------------------------------------------------------
00342 
00343       Grids(grid_id)%corner_pointer%corner_shape    = 0
00344       Grids(grid_id)%corner_pointer%corner_datatype = MPI_DATATYPE_NULL
00345       Nullify ( Grids(grid_id)%corner_pointer%pole_array )
00346       Nullify ( Grids(grid_id)%nbr_points_per_lat )
00347       Nullify ( Grids(grid_id)%halo )
00348 
00349       Nullify ( Grids(grid_id)%reduced_gauss_data%nbr_points_per_lat)
00350       Nullify ( Grids(grid_id)%reduced_gauss_data%aux_3d_to_local_1d_map)
00351       Nullify ( Grids(grid_id)%reduced_gauss_data%local_1d_stencil_lookup)
00352       Nullify ( Grids(grid_id)%reduced_gauss_data%local_block_info)
00353       Nullify ( Grids(grid_id)%reduced_gauss_data%global_lat_offsets)
00354 
00355       do i = 1, ndim_3d
00356          Nullify ( Grids(grid_id)%corner_pointer%corners_real(i)%vector)
00357          Nullify ( Grids(grid_id)%corner_pointer%corners_dble(i)%vector)
00358 
00359 #if defined ( PRISM_QUAD_TYPE )
00360          Nullify ( Grids(grid_id)%corner_pointer%corners_quad(i)%vector )
00361 #endif
00362       end do
00363 
00364 !------------------------------------------------------------------------
00365 !  8th Update Info of Component comp_id
00366 !------------------------------------------------------------------------
00367 
00368       Comps(comp_id)%n_grids = Comps(comp_id)%n_grids + 1
00369 
00370 !------------------------------------------------------------------------
00371 !  9th Update with Information from the SMIOC and Coherence checks
00372 !------------------------------------------------------------------------
00373 
00374       if (Appl%stand_alone) then
00375         Grids(grid_id)%global_grid_id = grid_id
00376       else
00377         Grids(grid_id)%global_grid_id = PRISM_UNDEFINED
00378       endif
00379 
00380       Grids(grid_id)%smioc_index    = PRISM_UNDEFINED
00381 
00382       sga_smioc_grids => sga_smioc_comp(comp_id)%sga_smioc_grids
00383 
00384       do i = 1, size(sga_smioc_grids)
00385         if ( trim(sga_smioc_grids(i)%cg_grid_name) == trim(adjustl(grid_name)) ) &
00386         then
00387            Grids(grid_id)%global_grid_id = sga_smioc_grids(i)%ig_grid_id
00388 #ifdef DEBUG
00389            print *, trim(ch_id), ': psmile_def_grid compared name   ', &
00390                 trim(adjustl(grid_name))
00391            print *, trim(ch_id), ': psmile_def_grid with smioc name ', &
00392                 trim(sga_smioc_grids(i)%cg_grid_name)
00393 #endif
00394            Grids(grid_id)%smioc_index    = i
00395            Grids(grid_id)%global_grid_id = sga_smioc_grids(i)%ig_grid_id
00396            Grids(grid_id)%periodic       = sga_smioc_grids(i)%iga_periodic
00397 !rr pole_covered is initialised with false.
00398 !rr See prism_set_corners_3d_double/real for more details.
00399            Grids(grid_id)%pole_covered   = .false.
00400 !rr        Grids(grid_id)%pole_covered   = sga_smioc_grids(i)%ig_pole_covered == PSMILe_true
00401            exit
00402         endif
00403       enddo
00404 
00405 !------------------------------------------------------------------------
00406 !  10th Epilogue
00407 !------------------------------------------------------------------------
00408 
00409 #ifdef VERBOSE
00410       print 9980, trim(ch_id), ierror, comp_id, grid_id
00411 
00412       call psmile_flushstd
00413 #endif /* VERBOSE */
00414 !
00415 !  Formats:
00416 !
00417 #ifdef VERBOSE
00418 
00419 9990 format (1x, a, ': psmile_def_grid: comp_id', i4)
00420 9980 format (1x, a, ': psmile_def_grid: eof ierror =', i4, &
00421              '; comp_id =', i4, ', grid_id', i4)
00422 
00423 #endif /* VERBOSE */ 
00424 
00425 9870  format (1x, a, ': Error in psmile_def_grid: inconistent grid type', &
00426                   i5, ' with smioc grid type', i8)
00427                 
00428       end subroutine psmile_def_grid