prism_def_grid.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_grid 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 based on previous
00020 !                          prism_def_grid (now psmile_def_grid)
00021 !
00022 !----------------------------------------------------------------------
00023 !
00024 !  $Id: prism_def_grid.F90 2705 2010-11-04 14:01:08Z hanke $
00025 !  $Author: hanke $
00026 !
00027 !----------------------------------------------------------------------
00028 subroutine prism_def_grid (grid_id, grid_name, comp_id, &
00029                            grid_valid_shape, grid_type, ierror)
00030 
00031    use psmile_smioc, only : smioc_comp, smioc_grid, &
00032                             sga_smioc_comp
00033    use prism_constants, only : prism_error_arg, prism_error_internal, prism_error_grid
00034    use psmile, only : ch_id, Number_of_Comps_allocated, Comps, psmile_status_free
00035    use psmile_user_data, only : psmile_store_data_grid
00036 
00037    implicit none
00038 
00039    character(len=*), intent(in) :: grid_name
00040    integer, intent (in)         :: comp_id
00041    integer, intent (in)         :: grid_valid_shape (1:2,*)
00042    integer, intent (in)         :: grid_type
00043    integer, intent (out)        :: grid_id
00044    integer, intent (out)        :: ierror
00045 
00046    type(smioc_comp), pointer    :: comp
00047    type(smioc_grid), pointer    :: grid
00048    integer                      :: i
00049 
00050 #ifdef VERBOSE
00051    print 9990, trim(ch_id)
00052    call psmile_flushstd
00053 #endif /* VERBOSE */
00054 
00055    ierror = 0
00056 
00057    ! check comp_id
00058    if (comp_id < 1 .or. comp_id > Number_of_Comps_allocated) then
00059 
00060       ierror = PRISM_Error_Arg
00061       call psmile_error (ierror, 'comp_id', (/comp_id, Number_of_Comps_allocated/), 2, &
00062                          __FILE__, __LINE__ )
00063       return
00064    !check whether this is valid component
00065    else if (Comps(comp_id)%status == psmile_status_free) then
00066 
00067       ierror = PRISM_Error_Arg
00068       call psmile_error (prism_error_arg, 'comp_id (not active)', (/comp_id/), 1, &
00069                          __FILE__, __LINE__)
00070       return
00071    endif
00072 
00073    ! check whether there is smioc data for this component
00074    if (comp_id > size(sga_smioc_comp)) then
00075 
00076       ierror = prism_error_internal
00077       call psmile_error (ierror, 'No SMIOC data available for component', &
00078                          (/grid_id, comp_id/), 2, &
00079                          __FILE__, __LINE__ )
00080       return
00081    endif
00082 
00083    ! get pointer to component smioc data
00084    comp => sga_smioc_comp(comp_id)
00085 
00086    ! check whether there is at least one grid defined for this compnent
00087    if (.not. associated (comp%sga_smioc_grids) ) then
00088 
00089       ierror = prism_error_grid
00090       call psmile_error (ierror, 'No grids specified in SMIOC', &
00091                          (/grid_id, comp_id, grid_type/), 3, &
00092                          __FILE__, __LINE__ )
00093       return
00094    endif
00095 
00096    ! check whether there is a grid defined with the name given by the user
00097    nullify (grid)
00098    do i = 1, size (comp%sga_smioc_grids)
00099       if (comp%sga_smioc_grids(i)%cg_grid_name == trim (grid_name)) then
00100          grid => comp%sga_smioc_grids(i)
00101          exit
00102       endif
00103    enddo
00104    if (.not. associated (grid)) then
00105 
00106       ! print info's about grid names
00107       print 9890, trim(ch_id), trim(grid_name), size (comp%sga_smioc_grids)
00108       do i = 1, size(comp%sga_smioc_grids)
00109          print  9880, trim(comp%sga_smioc_grids(i)%cg_grid_name)
00110       end do
00111 
00112       call psmile_abort()
00113    endif
00114 
00115    ! process data
00116    call psmile_store_data_grid (grid_id, grid_name, comp_id, &
00117                                 grid_valid_shape, grid_type, ierror)
00118 
00119 #ifdef VERBOSE
00120    print 9980, trim(ch_id), ierror
00121    call psmile_flushstd
00122 #endif /* VERBOSE */
00123 
00124 9990 format (1x, a, ': prism_def_grid: ')
00125 9980 format (1x, a, ': prism_def_grid: eof ierror =', i5)
00126 9890  format (1x, a, ': Error in psmile_def_grid: grid name "', a, &
00127                      '" in application' , &
00128              /1x, 'does not match any grid name in SMIOC file' &
00129              /1x, 'There are', i4, ' grids defined in SMIOC and names are:')
00130 9880  format (1x, a)
00131 
00132 end subroutine prism_def_grid