psmile_store_data_points_grless.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2010, DKRZ, Hamburg, Germany.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !
00006 ! !DESCRIPTION:
00007 !
00008 ! The routine psmile_store_data_points_grless stores the data provided
00009 ! by the user through the interface prism_set_points
00010 ! (psmile_set_points_gridless).
00011 !
00012 !
00013 ! !REVISION HISTORY:
00014 !
00015 !   Date      Programmer   Description
00016 ! ----------  ----------   -----------
00017 ! 27.10.10    M. Hanke     created
00018 !
00019 !----------------------------------------------------------------------
00020 !
00021 !  $Id: psmile_store_data_points_grless.F90 2754 2010-11-19 14:31:55Z hanke $
00022 !  $Author: hanke $
00023 !
00024 !----------------------------------------------------------------------
00025 
00026 subroutine psmile_store_data_points_grless(point_id, point_name, grid_id, &
00027                                            new_points, ierror)
00028    use psmile_user_data, only : point_data, &
00029                                 free_user_coordinate_data, &
00030                                 init_user_coordinate_data
00031    use psmile_common, only : ch_id
00032    use psmile_reallocate, only : psmile_realloc
00033 
00034    implicit none
00035 
00036    character (len=*), intent(in)    :: point_name
00037    integer,           intent(in)    :: grid_id
00038    integer,           intent(inout) :: point_id
00039    logical,           intent(in)    :: new_points
00040    integer,           intent(out)   :: ierror
00041 
00042 #ifdef VERBOSE
00043    print 9990, trim(ch_id)
00044    call psmile_flushstd
00045 #endif /* VERBOSE */
00046 
00047    ierror = 0
00048 
00049    if (new_points) then
00050 
00051       if (.not. associated (point_data)) then
00052          point_id = 1
00053       else
00054          point_id = size (point_data) + 1
00055       endif
00056 
00057       point_data => psmile_realloc (point_data, point_id)
00058    else
00059 
00060       call free_user_coordinate_data (point_data(point_id)%points, ierror)
00061    endif
00062 
00063    call init_user_coordinate_data(point_data(point_id)%points)
00064 
00065    point_data(point_id)%grid_id = grid_id
00066    point_data(point_id)%name = trim (point_name)
00067 
00068 #ifdef VERBOSE
00069    print 9980, trim(ch_id), ierror
00070    call psmile_flushstd
00071 #endif /* VERBOSE */
00072 
00073 9990 format (1x, a, ': psmile_store_data_points_grless: ')
00074 9980 format (1x, a, ': psmile_store_data_points_grless: eof ierror =', i5)
00075 end subroutine psmile_store_data_points_grless