psmile_store_data_intern.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 ! This file contains two routines which were introduced in order to be
00009 ! able to make data structures, internally created for user defined
00010 ! interpolation, known to psmile_user_data. This was necessary because
00011 ! in the block merge process (psmile_merge_fields) all unknown structures
00012 ! were ignored.
00013 !
00014 !
00015 ! !REVISION HISTORY:
00016 !
00017 !   Date      Programmer   Description
00018 ! ----------  ----------   -----------
00019 ! 18.11.10    M. Hanke     created
00020 !
00021 !----------------------------------------------------------------------
00022 !
00023 !  $Id: psmile_store_data_intern.F90 2752 2010-11-19 13:57:45Z hanke $
00024 !  $Author: hanke $
00025 !
00026 !----------------------------------------------------------------------
00027 
00028    subroutine psmile_store_data_intern_field(psmile_var_id)
00029       use psmile_reallocate
00030       use psmile_user_data, only : var_data, var_id_map
00031       use psmile_multimap, only : add_pair
00032       use psmile_common, only : ch_id
00033 
00034       implicit none
00035 
00036       integer, intent (in) :: psmile_var_id
00037 
00038       integer :: var_id
00039 
00040 #ifdef VERBOSE
00041    print 9990, trim(ch_id)
00042    call psmile_flushstd
00043 #endif /* VERBOSE */
00044 
00045       if (.not. associated (var_data)) then
00046          var_id = 1
00047       else
00048          var_id = size (var_data) + 1
00049       endif
00050 
00051       var_data => psmile_realloc (var_data, var_id)
00052 
00053       call add_pair (var_id_map, var_id, psmile_var_id)
00054 
00055 #ifdef VERBOSE
00056    print 9980, trim(ch_id)
00057    call psmile_flushstd
00058 #endif /* VERBOSE */
00059 
00060 9990 format (1x, a, ': psmile_store_data_intern_field: ')
00061 9980 format (1x, a, ': psmile_store_data_intern_field: eof')
00062 
00063    end subroutine psmile_store_data_intern_field
00064 
00065    subroutine psmile_store_data_intern_points(psmile_point_id)
00066       use psmile_reallocate
00067       use psmile_user_data, only : point_data, point_id_map
00068       use psmile_multimap, only : add_pair
00069       use psmile_common, only : ch_id
00070 
00071       implicit none
00072 
00073       integer, intent (in) :: psmile_point_id
00074 
00075       integer :: point_id
00076 
00077 #ifdef VERBOSE
00078    print 9990, trim(ch_id)
00079    call psmile_flushstd
00080 #endif /* VERBOSE */
00081 
00082       if (.not. associated (point_data)) then
00083          point_id = 1
00084       else
00085          point_id = size (point_data) + 1
00086       endif
00087 
00088       point_data => psmile_realloc (point_data, point_id)
00089 
00090       call add_pair (point_id_map, point_id, psmile_point_id)
00091 
00092 #ifdef VERBOSE
00093    print 9980, trim(ch_id)
00094    call psmile_flushstd
00095 #endif /* VERBOSE */
00096 
00097 9990 format (1x, a, ': psmile_store_data_intern_points: ')
00098 9980 format (1x, a, ': psmile_store_data_intern_points: eof')
00099 
00100    end subroutine psmile_store_data_intern_points