DOUG 0.2

RealKind.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 ! Moodul topeltt�psuse m��ratlemiseks
00023 Module RealKind
00024   implicit none
00025   !integer, parameter :: rk = selected_real_kind(18,4932)
00026   integer, parameter :: rk = selected_real_kind(15,307)
00027   !integer, parameter :: rk = selected_real_kind(6,37)
00028   integer, parameter :: xyzk = selected_real_kind(15,307)
00029 
00030 #ifndef HAS_ISNAN
00031   interface isnan
00032      module procedure isnan_4, isnan_8
00033   end interface
00034 #endif
00035 #ifndef HAS_ISINF
00036   interface isinf
00037      module procedure isinf_4, isinf_8
00038   end interface
00039 #endif
00040 
00041 contains
00042 
00043 #ifndef HAS_ISNAN
00044   function isnan_4(x) result(r)
00045     real(4), intent(in) :: x
00046     logical :: r
00047     real(4) :: ZERO=0._4
00048     r = (x==ZERO/ZERO)
00049   end function isnan_4
00050   function isnan_8(x) result(r)
00051     real(8), intent(in) :: x
00052     logical :: r
00053     real(8) :: ZERO=0._8
00054     r = (x==ZERO/ZERO)
00055   end function isnan_8
00056 #endif
00057 
00058 #ifndef HAS_ISINF
00059   function isinf_4(x) result(r)
00060     real(4), intent(in) :: x
00061     integer :: r
00062     real(4) :: ZERO=0._4
00063     if(x == 1._4/ZERO) then; r = 1
00064     else if (x == -1._4/ZERO) then; r = -1
00065     else; r = 0;
00066     end if
00067   end function isinf_4
00068   function isinf_8(x) result(r)
00069     real(8), intent(in) :: x
00070     integer :: r
00071     real(8) :: ZERO=0._8
00072     if(x == 1._8/ZERO) then; r = 1
00073     else if (x == -1._8/ZERO) then; r = -1
00074     else; r = 0
00075     end if
00076   end function isinf_8
00077 #endif
00078 
00079 end module RealKind
00080 
00081 !----------------------------------------------------------------------
00082 !$Log: RealKind.f90,v $
00083 !Revision 1.1.1.1  2003/10/25 06:41:34  eero
00084 !Created doug95 repository, added files created by Elmo (with some minor
00085 !changes), created Makefile, Make.sources and added file RealKind.f90
00086 !
00087 !----------------------------------------------------------------------