psmile_mg_clean.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_MG_clean
00008 !
00009 ! !INTERFACE:
00010 
00011       subroutine psmile_mg_clean (ierror)
00012 !
00013 ! !USES:
00014 !
00015       use PRISM_constants
00016 !
00017       use PSMILe, dummy_interface => PSMILe_MG_clean
00018 
00019       Implicit none
00020 !
00021 ! !INPUT PARAMETERS:
00022 !
00023 !
00024 ! !OUTPUT PARAMETERS:
00025 !
00026       Integer, Intent (Out)        :: ierror
00027 !
00028 !     Returns the error code of PSMILe_MG_clean;
00029 !             ierror = 0 : No error
00030 !             ierror > 0 : Severe error
00031 !
00032 ! !LOCAL VARIABLES
00033 !
00034 !  ... for grids
00035 
00036       Integer                      :: i, j
00037 
00038 !  ... for multigrid data generated
00039 
00040       Integer                      :: levbeg, n
00041       Type (Enddef_mg), Pointer    :: mg_info
00042 !
00043 ! !DESCRIPTION:
00044 !
00045 ! Subroutine "PSMILe_MG_clean" frees the data structured allocated
00046 ! for the multigrid search of neighourhood information which was setup
00047 ! in routine "PSMILe_MG_setup".
00048 !
00049 ! !REVISION HISTORY:
00050 !
00051 !   Date      Programmer   Description
00052 ! ----------  ----------   -----------
00053 ! 09.06.08    H. Ritzdorf  created
00054 !
00055 !EOP
00056 !----------------------------------------------------------------------
00057 !
00058 !  $Id: psmile_mg_clean.F90,v 1.1.2.1 2008/06/20 10:43:48 ritzdorf Exp $
00059 !  $Autor$
00060 !
00061    Character(len=len_cvs_string), save :: mycvs = 
00062        '$Id: psmile_mg_clean.F90,v 1.1.2.1 2008/06/20 10:43:48 ritzdorf Exp $'
00063 !
00064 !----------------------------------------------------------------------
00065 
00066 #ifdef VERBOSE
00067       print 9990, trim(ch_id)
00068 
00069       call psmile_flushstd
00070 #endif /* VERBOSE */
00071 !
00072 !  Initialization
00073 !
00074       ierror = 0
00075 !
00076 !===> For all grids
00077 !
00078          do i = 1, Number_of_Grids_allocated
00079          if (Grids(i)%nlev > 0) then
00080 !
00081             if (Grids(i)%grid_type == PRISM_Gaussreduced_regvrt) then
00082                levbeg = 0
00083             else
00084                levbeg = 1
00085             endif
00086 
00087                do n = levbeg, Grids(i)%nlev
00088                mg_info => Grids(i)%mg_infos(n)
00089                if (Associated(mg_info%real_arrays)) then
00090 !
00091                      do j = 1, ndim_3d
00092                      Deallocate (mg_info%real_arrays%chmin(j)%vector)
00093                      Deallocate (mg_info%real_arrays%chmax(j)%vector)
00094                      Deallocate (mg_info%real_arrays%midp (j)%vector)
00095                      end do
00096  
00097                   Deallocate (mg_info%real_arrays)
00098 !
00099                else if (Associated(mg_info%double_arrays)) then
00100                   
00101                      do j = 1, ndim_3d
00102                      Deallocate (mg_info%double_arrays%chmin(j)%vector)
00103                      Deallocate (mg_info%double_arrays%chmax(j)%vector)
00104                      Deallocate (mg_info%double_arrays%midp (j)%vector)
00105                      end do
00106 
00107                   Deallocate (mg_info%double_arrays)
00108 #if defined ( PRISM_QUAD_TYPE )
00109 !
00110                else if (Associated(mg_info%quad_arrays)) then
00111                   
00112                      do j = 1, ndim_3d
00113                      Deallocate (mg_info%quad_arrays%chmin(j)%vector)
00114                      Deallocate (mg_info%quad_arrays%chmax(j)%vector)
00115                      Deallocate (mg_info%quad_arrays%midp (j)%vector)
00116                      end do
00117 
00118                   Deallocate (mg_info%quad_arrays)
00119 #endif
00120                endif
00121                end do
00122 
00123             Deallocate (Grids(i)%mg_infos)
00124          endif
00125          enddo !  i = 1, Number_of_Grids_allocated
00126 !
00127 !===> All done
00128 !
00129 #ifdef VERBOSE
00130       print 9980, trim(ch_id), ierror
00131       call psmile_flushstd
00132 #endif /* VERBOSE */
00133 !
00134 #ifdef VERBOSE
00135 
00136 9990 format (1x, a, ': psmile_mg_clean:')
00137 9980 format (1x, a, ': psmile_mg_clean: eof ierror =', i3)
00138 
00139 #endif /* VERBOSE */
00140 
00141       end subroutine PSMILe_MG_clean