prism_set_points_gridless.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 ! Copyright 2010, DKRZ, Hamburg, Germany.
00006 ! All rights reserved. Use is subject to OASIS4 license terms.
00007 !-----------------------------------------------------------------------
00008 !
00009 ! !DESCRIPTION:
00010 !
00011 ! The routine prism_set_points_gridless checks the consistency of the data
00012 ! provided by the user before it is further processed.
00013 !
00014 !
00015 ! !REVISION HISTORY:
00016 !
00017 !   Date      Programmer   Description
00018 ! ----------  ----------   -----------
00019 ! 04.11.10    M. Hanke     created
00020 !
00021 !----------------------------------------------------------------------
00022 !
00023 !  $Id: prism_set_points_gridless.F90 2708 2010-11-05 15:11:47Z hanke $
00024 !  $Author: hanke $
00025 !
00026 !----------------------------------------------------------------------
00027 subroutine prism_set_points_gridless (point_id, point_name, grid_id, &
00028                                       new_points, ierror)
00029 
00030    use prism_constants, only : PRISM_Gaussreduced_regvrt, &
00031                                PRISM_Gaussreduced_sigmavrt, &
00032                                prism_error_invalid_arg
00033    use psmile, only : ch_id
00034    use psmile_user_data, only : psmile_store_data_points_grless, &
00035                                 test_user_grid_id, test_user_point_id
00036 
00037    implicit none
00038 
00039    character (len=*), intent(in)    :: point_name
00040    integer,           intent(in)    :: grid_id
00041    integer,           intent(inout) :: point_id
00042    logical,           intent(in)    :: new_points
00043    integer,           intent(out)   :: ierror
00044 
00045    integer :: grid_type
00046 
00047 #ifdef VERBOSE
00048    print 9990, trim(ch_id)
00049    call psmile_flushstd
00050 #endif /* VERBOSE */
00051 
00052    ierror = 0
00053 
00054    call test_user_grid_id(grid_id, ierror)
00055 
00056    if (.not. new_points) call test_user_point_id (point_id, ierror)
00057 
00058    call psmile_store_data_points_grless (point_id, point_name, grid_id, &
00059                                          new_points, ierror)
00060 
00061 #ifdef VERBOSE
00062    print 9980, trim(ch_id), ierror
00063    call psmile_flushstd
00064 #endif /* VERBOSE */
00065 
00066 9990 format (1x, a, ': prism_set_points_gridless: ')
00067 9980 format (1x, a, ': prism_set_points_gridless: eof ierror =', i5)
00068 
00069 end subroutine prism_set_points_gridless