psmile_store_data_mask.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_mask stores the data provided
00009 ! by the user through the interface prism_set_mask.
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_mask.F90 2769 2010-11-23 14:49:21Z hanke $
00021 !  $Author: hanke $
00022 !
00023 !----------------------------------------------------------------------
00024 
00025 subroutine psmile_store_data_mask (mask_id, grid_id, mask_actual_shape, &
00026                                    mask_array, new_mask, ierror)
00027 
00028    use psmile_user_data, only  : mask_data, grid_data
00029    use psmile_grid, only       : get_size_of_shape
00030    use psmile_common, only     : ch_id
00031    use psmile_reallocate, only : psmile_realloc
00032 
00033    implicit none
00034 
00035    integer, intent(inout)       :: mask_id
00036    integer, intent(in)          :: grid_id
00037    integer, intent(in)          :: mask_actual_shape(2, *)
00038    logical, intent(in)          :: mask_array (*)
00039    logical, intent(in)          :: new_mask
00040    integer, intent(out)         :: ierror
00041 
00042    integer :: size_of_shape (2)
00043 
00044 #ifdef VERBOSE
00045    print 9990, trim(ch_id)
00046    call psmile_flushstd
00047 #endif /* VERBOSE */
00048 
00049    ierror = 0
00050 
00051    size_of_shape = get_size_of_shape(grid_data(grid_id)%grid_type)
00052 
00053    if (new_mask) then
00054 
00055       if (.not. associated (mask_data)) then
00056          mask_id = 1
00057       else
00058          mask_id = size(mask_data) + 1
00059       endif
00060 
00061       mask_data => psmile_realloc (mask_data, mask_id)
00062 
00063    else
00064 
00065       deallocate (mask_data(mask_id)%mask_actual_shape, &
00066                   mask_data(mask_id)%mask)
00067    endif
00068 
00069    mask_data(mask_id)%grid_id = grid_id
00070    allocate (mask_data(mask_id)%mask_actual_shape(2, size_of_shape(2)))
00071    mask_data(mask_id)%mask_actual_shape = mask_actual_shape(:,1:size_of_shape(2))
00072    allocate (mask_data(mask_id)%mask( &
00073       product (mask_data(mask_id)%mask_actual_shape(2,:) - &
00074                mask_data(mask_id)%mask_actual_shape(1,:) + 1)))
00075    mask_data(mask_id)%mask(:) = mask_array(1: size(mask_data(mask_id)%mask))
00076 
00077 #ifdef VERBOSE
00078    print 9980, trim(ch_id), ierror
00079    call psmile_flushstd
00080 #endif /* VERBOSE */
00081 
00082 9990 format (1x, a, ': psmile_store_data_mask: ')
00083 9980 format (1x, a, ': psmile_store_data_mask: eof ierror =', i5)
00084 
00085 end subroutine psmile_store_data_mask