prism_def_var.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_def_var 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_def_var.F90 2803 2010-12-06 17:28:25Z hanke $
00024 !  $Author: hanke $
00025 !
00026 !----------------------------------------------------------------------
00027 subroutine prism_def_var (var_id, var_name, grid_id, point_id, mask_id, &
00028                           var_nodims, var_actual_shape, var_type, ierror)
00029 
00030    use prism_constants, only  : prism_error_invalid_arg, prism_undefined
00031    use psmile, only           : ch_id
00032    use psmile_smioc, only     : smioc_comp, sga_smioc_comp
00033    use psmile_user_data, only : psmile_store_data_var, &
00034                                 get_grid_id, get_comp_id, get_grid_type, &
00035                                 test_user_grid_id, test_user_mask_id, &
00036                                 test_user_point_id, get_grid_valid_shape
00037    use psmile_grid, only      : get_size_of_shape
00038 
00039    implicit none
00040 
00041    character (len=*), intent (in) :: var_name
00042    integer, intent (in)           :: mask_id
00043    integer, intent (in)           :: point_id
00044    integer, intent (in)           :: grid_id
00045    integer, intent (in)           :: var_nodims(2)
00046    integer, intent (in)           :: var_actual_shape(1:2,1:var_nodims(1))
00047    integer, intent (in)           :: var_type
00048    integer, intent (out)          :: var_id
00049    integer, intent (out)          :: ierror
00050 
00051    type(smioc_comp), pointer :: comp
00052    integer :: smioc_transi_id
00053    integer :: size_of_shape (2)
00054    integer :: i
00055    integer, allocatable :: grid_valid_shape(:,:)
00056 
00057 #ifdef VERBOSE
00058    print 9990, trim(ch_id)
00059    call psmile_flushstd
00060 #endif /* VERBOSE */
00061 
00062    ierror = 0
00063 
00064    ! check ids provided by the user
00065    call test_user_grid_id (grid_id, ierror)
00066    if (mask_id /= prism_undefined) call test_user_mask_id (mask_id, ierror)
00067    call test_user_point_id (point_id, ierror)
00068 
00069    ! I am using the point id in order to get grid_id instead of the grid_id
00070    ! provided by the user, because the grid_id is redundant in the prism_def_var
00071    ! interface and my be removed in the future.
00072    comp => sga_smioc_comp (get_comp_id (get_grid_id (point_id)))
00073 
00074    ! search for the field in smioc
00075    do smioc_transi_id = 1, size (comp%sga_smioc_transi)
00076       if (trim(comp%sga_smioc_transi(smioc_transi_id)%cg_local_name) == trim(var_name)) exit
00077    enddo
00078 
00079    ! if there is no transient with the given name in smioc
00080    if (smioc_transi_id > size (comp%sga_smioc_transi)) then
00081 
00082       var_id = prism_undefined
00083       print *, trim(ch_id), ': prism_def_var: no matching transient found for ', var_name, &
00084                             ' in SMIOC'
00085 #ifdef VERBOSE
00086       print 9980, trim(ch_id), ierror
00087       call psmile_flushstd
00088 #endif /* VERBOSE */
00089       return
00090    endif
00091 
00092    ! check whether the variable is neither a in- nor output field
00093    if (comp%sga_smioc_transi(smioc_transi_id)%ig_nb_transi_out == 0 .and. &
00094        comp%sga_smioc_transi(smioc_transi_id)%sg_transi_in%ig_nb_in_orig == 0) then
00095 
00096       var_id = prism_undefined
00097       print *, trim(ch_id), ': prism_def_var: transient ', var_name, &
00098                             ' is neither in- nor output field'
00099 #ifdef VERBOSE
00100       print 9980, trim(ch_id), ierror
00101       call psmile_flushstd
00102 #endif /* VERBOSE */
00103       return
00104    endif
00105 
00106    size_of_shape = get_size_of_shape(get_grid_type(grid_id))
00107 
00108    allocate (grid_valid_shape(2, size_of_shape(2)))
00109 
00110    grid_valid_shape = get_grid_valid_shape(get_grid_id (point_id), size_of_shape)
00111 
00112    ! check whether the grid_valid_shape fits into var_actual_shape
00113    do i = 1, size_of_shape(2)
00114       if (grid_valid_shape(1,i) /= prism_undefined .and. &
00115           (grid_valid_shape(1,i) < var_actual_shape(1,i) .or. &
00116            grid_valid_shape(2,i) > var_actual_shape(2,i))) then
00117 
00118          ierror = prism_error_invalid_arg
00119          call psmile_error (ierror, "var_actual_shape", (/0/), 1, &
00120                            __FILE__, __LINE__ )
00121       endif
00122    enddo
00123 
00124    deallocate (grid_valid_shape)
00125 
00126    call psmile_store_data_var (var_id, var_name, grid_id, point_id, mask_id, &
00127                                var_nodims, var_actual_shape, var_type, ierror)
00128 
00129 #ifdef VERBOSE
00130    print 9980, trim(ch_id), ierror
00131    call psmile_flushstd
00132 #endif /* VERBOSE */
00133 
00134 9990 format (1x, a, ': prism_def_var: ')
00135 9980 format (1x, a, ': prism_def_var: eof ierror =', i5)
00136 
00137 end subroutine prism_def_var