DOUG 0.2

Points2D.F90

Go to the documentation of this file.
00001 ! DOUG - Domain decomposition On Unstructured Grids
00002 ! Copyright (C) 1998-2006 Faculty of Computer Science, University of Tartu and
00003 ! Department of Mathematics, University of Bath
00004 !
00005 ! This library is free software; you can redistribute it and/or
00006 ! modify it under the terms of the GNU Lesser General Public
00007 ! License as published by the Free Software Foundation; either
00008 ! version 2.1 of the License, or (at your option) any later version.
00009 !
00010 ! This library is distributed in the hope that it will be useful,
00011 ! but WITHOUT ANY WARRANTY; without even the implied warranty of
00012 ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
00013 ! Lesser General Public License for more details.
00014 !
00015 ! You should have received a copy of the GNU Lesser General Public
00016 ! License along with this library; if not, write to the Free Software
00017 ! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
00018 ! or contact the authors (University of Tartu, Faculty of Computer Science, Chair
00019 ! of Distributed Systems, Liivi 2, 50409 Tartu, Estonia, http://dougdevel.org,
00020 ! mailto:info(at)dougdevel.org)
00021 
00022 module  Points2D_class
00023 
00024   use DOUG_utils
00025   use globals
00026 
00027   implicit none
00028 
00029 #include<doug_config.h>
00030 
00031 !!$  include 'DOUG_utils.f90'
00032 !!$  include 'globals.f90'
00033 
00034   type Points2D
00035      real(kind=xyzk), dimension(:), pointer :: x    ! X coordinates
00036      real(kind=xyzk), dimension(:), pointer :: y    ! Y coordinates
00037      integer                              :: np=0 ! Number of points
00038   end type Points2D
00039   
00040   public :: &
00041        Points2D_New,     & 
00042        Points2D_Destroy, & 
00043        Points2D_Init,    &
00044        Points2D_newFill, &
00045        Points2D_copy,    &
00046        Points2D_resizePreserve
00047 
00048   interface assignment (=)
00049      module procedure Points2D_copy
00050   end interface
00051   
00052   ! private :: 
00053 
00054 contains
00055 
00056 
00057   !------------------------------------
00058   ! Class constructor
00059   !------------------------------------
00060   function Points2D_New(np) result(p2d)
00061 
00062     integer        :: np
00063     type(Points2D) :: p2d
00064 
00065     allocate(p2d%x(np), p2d%y(np))
00066 
00067     p2d%np = np
00068 
00069   end function Points2D_New
00070 
00071 
00072   !-------------------------------
00073   ! Class destructor
00074   !-------------------------------
00075   subroutine Points2D_Destroy(p2d)
00076 
00077     type(Points2D) :: p2d
00078 
00079     if (associated(p2d%x)) deallocate(p2d%x)
00080     if (associated(p2d%y)) deallocate(p2d%y)
00081 
00082     p2d%np = 0
00083 
00084   end subroutine Points2D_Destroy
00085 
00086   
00087   !------------------------------------
00088   ! Initializer
00089   !------------------------------------
00090   subroutine Points2D_Init(p2d, xc, yc)
00091 
00092     type(Points2D)             , intent(in out) :: p2d
00093     real(kind=xyzk), dimension(:), intent(in)     :: xc, yc
00094 
00095     p2d%x = xc
00096     p2d%y = yc
00097 
00098   end subroutine Points2D_Init
00099 
00100 
00101   !-------------------------------------------
00102   ! Fill arrays in and return Points2D object
00103   !-------------------------------------------
00104   function Points2D_newFill(xc, yc) result(p2d)
00105     
00106     real(kind=xyzk), dimension(:), intent(in) :: xc, yc
00107     type(Points2D)                          :: p2d
00108 
00109     integer                                 :: np ! Number of points
00110 
00111     np = size(xc)
00112 
00113     if (np /= size(yc)) then
00114        call DOUG_abort('[Points2D_newFill] : sizes of input arrays must match.')
00115     end if
00116 
00117     p2d = Points2D_New(np)
00118     call Points2D_Init(p2d, xc, yc)
00119     
00120   end function Points2D_newFill
00121 
00122 
00123   !------------------------------------------
00124   ! Copy itself (mimic "=" (equal) operation)
00125   ! Overload "=".
00126   !------------------------------------------
00127   subroutine Points2D_copy(p2, p1)
00128     type(Points2D), intent(out) :: p2 ! left side of operator
00129     type(Points2D), intent(in)  :: p1 ! right side of operator
00130     
00131     allocate(p2%x(p1%np), p2%y(p1%np))
00132     
00133     p2%np = p1%np
00134 
00135     p2%x = p1%x
00136     p2%y = p1%y
00137 
00138   end subroutine Points2D_copy
00139 
00140 
00141   !---------------------------------------------------
00142   ! Resize set of points by truncating/increasing the 
00143   ! size of coordinate arrays and keeping values 
00144   ! in resized arrays intact.
00145   !---------------------------------------------------
00146   subroutine Points2D_resizePreserve(p2d, new_np)
00147 
00148     type(Points2D), intent(in out) :: p2d
00149     integer,        intent(in)     :: new_np ! New number of points
00150 
00151     type(Points2D)                 :: tmp_p2d
00152     integer                        :: n, i
00153 
00154     if (p2d%np == new_np) return
00155 
00156     ! Save data to temporary object
00157     tmp_p2d = p2d ! via Points2D_copy
00158 
00159     call Points2D_Destroy(p2d)
00160     p2d = Points2D_New(new_np)
00161 
00162     ! Copy data back
00163     if (p2d%np >= tmp_p2d%np) then 
00164        n = tmp_p2d%np
00165     else
00166        n = p2d%np
00167     end if    
00168     do i = 1,n
00169        p2d%x(i) = tmp_p2d%x(i)
00170        p2d%y(i) = tmp_p2d%y(i)
00171     end do
00172 
00173     call Points2D_Destroy(tmp_p2d)
00174     
00175   end subroutine Points2D_resizePreserve
00176   !=============================================
00177   !
00178   ! Plotting routines
00179   !
00180   !---------------------------------------------
00181   ! Plot set of points
00182   !---------------------------------------------
00183   subroutine Points2D_pl2D_Plot(p2d, INIT_CONT_END)
00184 
00185     use globals, only : stream, D_MSGLVL
00186 
00187     implicit none
00188 
00189     type(Points2D)                       :: p2d
00190     integer,      intent(in), optional   :: INIT_CONT_END
00191 
00192     real(kind=xyzk), dimension(:), pointer :: xc, yc
00193     real(kind=xyzk)                        :: xmin, xmax, ymin, ymax
00194     integer                              :: n 
00195     character*5                          :: buf5
00196 
00197 #ifdef D_WANT_PLPLOT_YES
00198 
00199     if (D_MSGLVL > 5) then
00200        write(stream, *)
00201        write(stream, *) '[Points2D_pl2D_Plot] : Plotting points.'
00202     end if
00203 
00204     n = p2d%np ! Length of coordinate arrays
00205 
00206     xc => p2d%x
00207     yc => p2d%y
00208 
00209     if (.not.present(INIT_CONT_END).or.&
00210          (present(INIT_CONT_END).and.(INIT_CONT_END == D_PLPLOT_INIT))) then
00211        xmin = minval(xc)
00212        xmax = maxval(xc)
00213        ymin = minval(yc)
00214        ymax = maxval(yc)
00215 
00216        xmin = xmin - abs(xmax)/10.0
00217        xmax = xmax + abs(xmax)/10.0
00218        ymin = ymin - abs(ymax)/10.0
00219        ymax = ymax + abs(ymax)/10.0
00220        
00221        call plsdev("tk")
00222        call plinit()
00223 
00224        call plenv (xmin, xmax, ymin, ymax, 0, 0);
00225 
00226        call plcol0(1) ! red
00227        write(buf5, '(i3)') n ! Because we plot closed polygons
00228        call pllab( '(x)', '(y)', 'Points : '//buf5//' points' )
00229     end if
00230 
00231     ! Plot vertices
00232     call plcol0(15) ! white
00233     call plssym(0.0d0, 5.0d0)
00234     call plpoin(n, xc, yc, 1)
00235 
00236     if (.not.present(INIT_CONT_END).or.&
00237          (present(INIT_CONT_END).and.(INIT_CONT_END == D_PLPLOT_END))) then
00238        call plend()
00239     end if
00240 
00241     nullify(xc, yc)
00242 
00243 #else
00244     write(stream, '(/a)') ' [Points2D_pl2D_Plot] : Compiled w/o plotting support!'
00245 #endif
00246 
00247 
00248   end subroutine Points2D_pl2D_Plot
00249 
00250 end module Points2D_class