psmile_control_grids.F90

Go to the documentation of this file.
00001 !-----------------------------------------------------------------------
00002 ! Copyright 2006-2010, NEC Europe Ltd., London, UK.
00003 ! All rights reserved. Use is subject to OASIS4 license terms.
00004 !-----------------------------------------------------------------------
00005 !BOP
00006 !
00007 ! !ROUTINE: PSMILe_Control_grids
00008 !
00009 ! !INTERFACE:
00010       subroutine psmile_control_grids (ierror)
00011 
00012 !
00013 ! !USES:
00014 !
00015       use PRISM_constants
00016 !
00017       use PSMILe, dummy_interface => PSMILe_Control_grids
00018 
00019       implicit none
00020 !
00021 ! !OUTPUT PARAMETERS:
00022 !
00023       integer, Intent (Out)               :: ierror
00024 
00025 !     Returns the error code of PSMILe_Control_grids;
00026 !             ierror = 0 : No error
00027 !             ierror > 0 : Severe error
00028 !
00029 ! !LOCAL VARIABLES
00030 !
00031       integer                      :: grid_id
00032       integer                      :: method_id
00033 
00034       integer, parameter           :: nerrp = 3
00035       integer                      :: ierrp (nerrp)
00036 !
00037 !
00038 ! !DESCRIPTION:
00039 !
00040 ! Subroutine "PSMILe_Control_grids" controls the values in the
00041 ! Grid definitions.
00042 !
00043 !
00044 ! !REVISION HISTORY:
00045 !
00046 !   Date      Programmer   Description
00047 ! ----------  ----------   -----------
00048 ! 01.12.03    H. Ritzdorf  created
00049 !
00050 !EOP
00051 !----------------------------------------------------------------------
00052 !
00053 ! $Id: psmile_control_grids.F90 2325 2010-04-21 15:00:07Z valcke $
00054 ! $Author: valcke $
00055 !
00056    Character(len=len_cvs_string), save :: mycvs = 
00057        '$Id: psmile_control_grids.F90 2325 2010-04-21 15:00:07Z valcke $'
00058 !
00059 !----------------------------------------------------------------------
00060 
00061 #ifdef VERBOSE
00062       print *, trim(ch_id), ': PSMILe_Control_grids: start'
00063 
00064       call psmile_flushstd
00065 #endif /* VERBOSE */
00066 !
00067 !  Initialization
00068 !
00069       ierror = 0
00070 !
00071 !   For all grids
00072 !
00073 !  bessser
00074 !     do grid_id = 1, Number_of_grids
00075 
00076       do grid_id = 1, Number_of_Grids_allocated
00077       if (Grids(grid_id)%status /= PSMILe_status_free) then
00078 
00079          if (Grids(grid_id)%corner_pointer%corner_datatype == MPI_DATATYPE_NULL &
00080              .and.  &
00081              Grids(grid_id)%grid_type /= PRISM_Gridless) then
00082             ierror = PRISM_Error_Grid
00083             ierrp (1) = grid_id
00084             ierrp (2) = Grids(grid_id)%comp_id
00085             ierrp (3) = Grids(grid_id)%grid_type
00086 
00087             call psmile_error (ierror, &
00088                'Corners were not specified by routine PRISM_Set_Corners', &
00089                ierrp, nerrp, __FILE__, __LINE__)
00090 
00091          endif
00092 
00093       endif
00094       enddo
00095 
00096       do method_id = 1, Number_of_Methods_allocated
00097          if ( Methods(method_id)%grid_id == PRISM_Gaussreduced_regvrt ) then
00098             Methods(method_id)%coords_pointer%coords_shape(1:2,3) = &
00099             Methods(method_id)%coords_pointer%coords_shape(1:2,2)
00100             Methods(method_id)%coords_pointer%coords_shape(1:2,2) = 1
00101          endif
00102       enddo
00103 
00104 !
00105 !===> All done
00106 !
00107 #ifdef VERBOSE
00108       print *, trim(ch_id), ': PSMILe_Control_grids: eof ierror =', ierror
00109 
00110       call psmile_flushstd
00111 #endif /* VERBOSE */
00112 !
00113       end subroutine PSMILe_Control_grids