psmile_store_data_var.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_var stores the data provided
00009 ! by the user through the interface prism_def_var.
00010 !
00011 !
00012 ! !REVISION HISTORY:
00013 !
00014 !   Date      Programmer   Description
00015 ! ----------  ----------   -----------
00016 ! 27.10.10    M. Hanke     created
00017 !
00018 !----------------------------------------------------------------------
00019 !
00020 !  $Id: psmile_store_data_var.F90 2754 2010-11-19 14:31:55Z hanke $
00021 !  $Author: hanke $
00022 !
00023 !----------------------------------------------------------------------
00024 
00025 subroutine psmile_store_data_var (var_id, var_name, grid_id, point_id, mask_id, &
00026                         var_nodims, var_actual_shape, var_type, ierror )
00027 
00028    use psmile_user_data, only : var_data
00029    use prism_constants, only : prism_undefined
00030    use psmile_common, only : ch_id
00031    use psmile_reallocate, only : psmile_realloc
00032 
00033    implicit none
00034 
00035    integer, intent(out)          :: var_id
00036    character (len=*), intent(in) :: var_name
00037    integer, intent(in)           :: grid_id
00038    integer, intent(in)           :: point_id
00039    integer, intent(in)           :: mask_id
00040    integer, intent(in)           :: var_nodims(2)
00041    integer, intent(in)           :: var_actual_shape(1:2, 1:var_nodims(1)+var_nodims(2))
00042    integer, intent(in)           :: var_type
00043    integer, intent(out)          :: ierror
00044 
00045 #ifdef VERBOSE
00046    print 9990, trim(ch_id)
00047    call psmile_flushstd
00048 #endif /* VERBOSE */
00049 
00050    ierror = 0
00051 
00052    if (.not. associated (var_data)) then
00053       var_id = 1
00054    else
00055       var_id = size(var_data) + 1
00056    endif
00057 
00058    var_data => psmile_realloc (var_data, var_id)
00059 
00060    var_data(var_id)%var_name = trim (var_name)
00061    var_data(var_id)%point_id = point_id
00062    var_data(var_id)%mask_id = mask_id
00063    allocate (var_data(var_id)%var_actual_shape(1:2, 1:var_nodims(1)+var_nodims(2)))
00064    var_data(var_id)%var_actual_shape = var_actual_shape
00065    var_data(var_id)%var_type = var_type
00066 
00067 #ifdef VERBOSE
00068    print 9980, trim(ch_id), ierror
00069    call psmile_flushstd
00070 #endif /* VERBOSE */
00071 
00072 9990 format (1x, a, ': psmile_store_data_var: ')
00073 9980 format (1x, a, ': psmile_store_data_var: eof ierror =', i5)
00074 
00075 end subroutine psmile_store_data_var