module kind_type !--------------------------------------------------------------------! ! PROGRAM DESCRIPTION: ! Author: Werner W. Schulz ! Department of Chemistry ! University of Cambridge ! COPYRIGHT (c) 1998 WERNER W. SCHULZ ! Please read the Description further down in the program Section. !--------------------------------------------------------------------! implicit none public :: NumericModel private :: NumericInquiry ! A Type Definition for collecting KIND,PRECISION,RANGE Data ! for Integer & FloatingPoint Models type, public :: type_kind integer :: k, p, r character(len=8) :: Text end type type_kind ! Single, DoublePrecision and Integer Default Values integer, parameter, public :: & SP = kind(1.0) & ,DP = selected_real_kind( p=precision(1.0_SP)+1 ) integer, parameter, public :: ID = kind(SP) ! Parameters needed for writing NumericModel Programme character(len=*), parameter, public :: & FileName = "NumericModel" & ,ModuleName = "Fortran_Kind_Module" & ,FileExt = ".f90" integer, parameter, private :: uf=8 character(len=*), parameter, private :: emptyLine = " " contains subroutine NumericModel( f, i ) ! ARGUMENTS: type(type_kind), dimension(:), intent(in out) :: f, i ! LOCAL VARIABLES: integer :: ic & ,Nr_Int & ,Nr_Flt ! EXECUTION: Nr_Int = count( i%k>0 ) Nr_Flt = count( f%k>0 ) open( unit=uf, file=ModuleName//FileExt & ,status="replace", action="write" ) ! Write a Module with KIND Parameters for all Integer/FloatingPoint write(unit=uf,fmt="(A)") & "module " // ModuleName & ,emptyLine & ," implicit none " & ,emptyLine & ," ! This Programme was generated by a copyrighted Code." & ," ! Author: Werner W Schulz (C) 1998." & ,emptyLine & ," ! The following Parameters present all available KIND Values" & ," ! under the Compiler that generated this Module." & ,emptyLine & ," ! Integer KIND Parameters:" do ic=1,Nr_Int write(unit=uf,fmt="(A,I2)") & " integer, parameter, public :: " & // trim(i(ic)%Text) // " = ", i(ic)%k end do write(unit=uf,fmt="(A)") & emptyLine & ," ! Real/Complex KIND Parameters:" do ic=1,Nr_Flt write(unit=uf,fmt="(A,I2)") & " integer, parameter, public :: " & // trim(f(ic)%Text) // " = ", f(ic)%k end do write(unit=uf,fmt="(A)") & emptyLine & ,"end module " // ModuleName ! End of Module close(unit=uf) ! Part Two: The Main Numeric Code open( unit=uf, file=FileName//FileExt & ,status="replace", action="write" ) ! Write a Program to print out relevant NumericModel Information write(unit=uf,fmt="(A)") & emptyLine & ,"program " // FileName & ,emptyLine & ," use " // ModuleName & ," implicit none " & ,emptyLine & ,"! LOCAL VARIABLES:" do ic=1,Nr_Int write(unit=uf,fmt="(A)") & " integer(kind=" // trim(i(ic)%Text) // "), parameter :: " & // trim(i(ic)%Text) // "_var = 1_" // adjustl(trim(i(ic)%text)) end do write(unit=uf,fmt="(A)") emptyLine do ic=1,Nr_Flt write(unit=uf,fmt="(A)") & " real(kind=" // trim(f(ic)%Text) // "), parameter :: " & // trim(f(ic)%Text) // "_var = 1.0_" // adjustl(trim(f(ic)%text)) end do write(unit=uf,fmt="(A)") emptyLine write(unit=uf,fmt="(A)") & "! EXECUION:" & ,emptyLine & ," write(unit=*,fmt=""(TR1,A)"") &" & ," "" "" &" & ," ,"" The Numerical Models of"" &" & ," ,"" Integer & Real/Complex Types"" &" & ," ,"" "" &" & ," ,"" available with this Computer/Compiler"" &" & ," ,"" "" &" & ," ,"" "" &" & ," ,"" Author: Werner W Schulz, (C) 1998"" &" & ," ,"" "" &" & ," ,"" This Programme was generated automatically by KindFinder,"" &" & ," ,"" Author: Werner W Schulz, (C) 1998"" &" & ," ,"" The Names used below are those used in KindFinder"" &" & ," ,"" """ & ,emptyLine & ,emptyLine & ," ! IntegerModel:" & ," write(unit=*,fmt=""(//TR1,A)"") &" & ," ""INTEGER MODEL:""" & ,emptyLine call NumericInquiry( "Name", "", "A20", i ) call NumericInquiry( "KIND", "kind", "I20", i ) call NumericInquiry( "DIGITS", "digits", "I20", i ) call NumericInquiry( "RADIX", "radix", "I20", i ) call NumericInquiry( "RANGE", "range", "I20", i ) call NumericInquiry( "HUGE", "huge", "I20", i ) ! Code for FloatingPoint Statements: write(unit=uf,fmt="(A)") & " ! FloatingPointModel:" & ," write(unit=*,fmt=""(//TR1,A)"") &" & ," ""FLOATINGPOINT MODEL (Real/Complex):""" & ,emptyLine call NumericInquiry( "Name", "", "A20", f ) call NumericInquiry( "KIND", "kind", "I20", f ) call NumericInquiry( "DIGITS", "digits", "I20", f ) call NumericInquiry( "RADIX", "radix", "I20", f ) call NumericInquiry( "MINEXPONENT", "minexponent", "I20", f ) call NumericInquiry( "MAXEXPONENT", "maxexponent", "I20", f ) call NumericInquiry( "PRECISION", "precision", "I20", f ) call NumericInquiry( "RANGE", "range", "I20", f ) call NumericInquiry( "EPSILON", "epsilon", "ES20.3", f ) call NumericInquiry( "HUGE", "huge", "ES20.3", f ) call NumericInquiry( "TINY", "tiny", "ES20.3", f ) write(unit=uf,fmt="(A)") & emptyLine & ," write(unit=*,fmt=""(//)"") " & ,emptyLine ! Finishing off with STOP and END PROGRAM write(unit=uf,fmt="(A)") & emptyLine & ," stop" & ,emptyLine & ,"end program " // FileName ! Done close(unit=uf) ! EXIT: return end subroutine NumericModel subroutine NumericInquiry( NI_Text, NI_Func, NI_Format, NI_Array ) ! ARGUMENTS: character(len=*), intent(in) :: NI_Text, NI_Func, NI_Format type(type_kind), dimension(:), intent(in) :: NI_Array ! LOCAL VARIABLES: logical :: isFunc integer :: NrA, ic character(len=13) :: Text character(len= 4) :: Tail NrA = count( NI_Array%k>0 ) isFunc = len_trim(NI_Func)>0 Text = "" Text = " " // trim(adjustl(NI_Text)) // ":" write(unit=uf,fmt="(A,I1,A/A/A)",advance="no") & " write(unit=*,fmt=""(TR1,A,",NrA, trim(NI_Format) //")"") &" & ," """ // Text // """ &" & ,"" do ic=1,NrA if( ic==NrA ) then Tail = " " else Tail = " &" end if if( isFunc ) then write(unit=uf,fmt="(A/)", advance="No") & " ," // trim(adjustl(NI_Func)) & // "(" // trim(NI_Array(ic)%Text) // "_var)" // Tail else write(unit=uf,fmt="(A/)", advance="No") & " ,""" // trim(NI_Array(ic)%Text) // """" // Tail end if end do write(unit=uf,fmt="(A)") " ", emptyLine return end subroutine NumericInquiry end module kind_type program KindFinder !--------------------------------------------------------------------! ! ! PROGRAM DESCRIPTION: ! ! This Programme checks for the available KIND Parameters ! available for a given Fortran compiler (Fortran 90/95/etc) ! ! The Programme prints into a file a new Fortran programme ! that can be compiled to write into a Unit the various ! Parameters that describe each Integer/Real Represenatation. ! ! The found KIND values are given Names according to this Scheme: ! Integer: Int_ with two digits, e.g. Int_04 ! if the KIND-Value is that of the default Integer-Type ! it is called Int_Def. ! ! Typically one can find Integer Implementations of these Sizes: ! (the KIND-Values are machine-specific) ! ! Kind Range my Name Size in Byte/Bits ! 1 2 Int_01 1/8 ! 2 4 Int_02 2/16 ! 4 9 Int_Def 4/32 ! ! and on 64-bit machines (modern workstations): ! 8 18 Int_08 8/64 ! ! ! ! FloatingPoint: ! Single if KIND-Value is that of the default REAL/COMPLEX ! Double if KIND-Value is that of the default DOUBLE PRECISION ! Extnd for any other found KIND-Value with i=1,2,.. ! (Typically only one or two are found.) ! ! On IEEE machines one will find these typical Values: ! (the KIND-Values are machine-specific) ! ! Kind Precision Range my Name ! 4 6 37 Single ! 8 15 307 Double ! ! plus these common but optional ones: ! 16 31 307 Extnd1 ! or 16 33 4931 Extnd1 ! ! ! KINDFINDER generates a new Fortran (F) code that will display ! all the numeric Model-Parameters as defined by the Fortran ! Standard and its intrinsic InquiryFunctions such as PRECISION. ! It also produces a Module, see ModuleName above, that can be ! copied and re-used elsewhere. ! ! CHANGES & COMMENTS ! ! I thank Otto Stolz for pointing out a short-coming of the ! original version of the Code that was published on ! comp-fortran-90@mailbase.co.uk in June 1998. ! This Version can handle KIND-Parameters which have the ! same PRECISION but different RANGEs (see Example above). ! ! Alan Miller kindly agreed to put the code onto his website at ! http://www.ozemail.com.au/~milleraj/ ! ! A few changes to allow for Lahey's LF compiler treatment of ! the first character on terminals. ! ! Version: 1.1 ! ! History: grew out of a discussion on comp-fortran-90@mailbase.co.uk ! in the Summer of 1998 ! O. Stolz pointed out an Error. !--------------------------------------------------------------------! ! ! Author: Werner W. Schulz ! Department of Chemistry ! University of Cambridge ! Date: ! ! COPYRIGHT (c) 1998 WERNER W. SCHULZ ! ! IMPORTANT NOTICE: ! Permission granted to compile and run this code for personal use ! or research purposes. Any commercial use of this code is prohibited ! without the explicit permission by the Author who retains all rights ! to this code. ! ! This code is provided on a as-is basis and NO WARRANTIES OF ANY KIND ! ARE GIVEN OR CAN BE IMPLIED. Anybody using this code does so on their ! own risk. ! The Author has made every effort to remove as many bugs as possible. ! ! The generated Module, Fortran_Kind_Module, can be used freely in ! Codes (unlike the generating SourceCode). ! ! Improvements, corrections, etc. should be sent to the Author for ! later releases. Any person doing so will be acknowledged. ! ! The code can be freely copied and distributed under above conditions ! and as long as this CopyRight notice is kept without modification. !--------------------------------------------------------------------! use kind_type implicit none integer, parameter :: nkm=10 !Number_of_Kind_Models type(type_kind), dimension(nkm) :: ir, fpr integer :: & f_prec_val & ,f_rnge_val & ,f_ctr & ,int_range & ,int_ctr & ,kv1,kv2,kv3 & ,i ! FLoatingPoint Part-------------------------------------- ! Initialize Array fpr fpr = type_kind(0,0,0, "" ) ! Iterate through various PRECISION values (finite Number) f_prec_val = 1 f_ctr = 0 Prec_Loop: do kv1 = selected_real_kind( p=f_prec_val ) kv2 = selected_real_kind( p=f_prec_val+1 ) if( kv1 < 1 ) then ! Current Precision f_prec_val is not available ! anymore. End of Search for f_prec_val exit Prec_Loop else if( kv1/=kv2 ) then ! Found a new KIND value ! Now find RANGE value f_rnge_val = 1 Range_Loop: do kv1 = selected_real_kind( p=f_prec_val, r=f_rnge_val ) kv2 = selected_real_kind( p=f_prec_val, r=f_rnge_val+1 ) kv3 = selected_real_kind( p=f_prec_val+1, r=f_rnge_val ) if( kv1 < 1 ) then ! Current Precision f_rnge_val is not available ! anymore. End of Search for f_rnge_val exit Range_Loop ! a KIND value, but could be one found earlier else if( kv1/=kv2 .and. kv1/=kv3 ) then f_ctr = f_ctr +1 fpr(f_ctr)%k = kv1 fpr(f_ctr)%p = f_prec_val fpr(f_ctr)%r = f_rnge_val if( fpr(f_ctr)%k==SP ) then fpr(f_ctr)%Text = " Single" else if( fpr(f_ctr)%k==DP ) then fpr(f_ctr)%Text = " Double" else write(unit=fpr(f_ctr)%Text,fmt="("" Extnd"",I1)") & count( fpr(1:f_ctr-1)%Text(1:3)==" E" )+1 end if end if f_rnge_val = f_rnge_val +1 end do Range_Loop end if f_prec_val = f_prec_val +1 end do Prec_Loop ! Integer KIND Values: easier Search---------------------- ! Initialize Array fpr ir = type_kind(0,0,0, "" ) ! Iterate through various RANGE values (finite Number) int_range = 1 int_ctr = 0 Int_Loop: do kv1 = selected_int_kind( int_range ) kv2 = selected_int_kind( int_range +1 ) if( kv1 < 1 ) then ! Current Precision f_prec_val is not available ! anymore. End of Search for f_prec_val exit Int_Loop else if( kv1/=kv2 ) then ! Found a new KIND value int_ctr = int_ctr +1 ir(int_ctr)%r = int_range ir(int_ctr)%k = kv1 if( ir(int_ctr)%k==ID ) then ir(int_ctr)%Text = " Int_Def" else write(unit=ir(int_ctr)%Text,fmt="("" Int_"",I2.2)") ir(int_ctr)%k end if end if int_range = int_range +1 end do Int_Loop write(unit=*,fmt="(//)") write(unit=*,fmt="(TR1,A)") & "!---------------------------------------------------------!" & ,"! !" & ,"! KINDFINDER !" & ,"! !" & ,"! KIND Search & Evaluation for !" & ,"! FloatingPoint and Integer Types !" & ,"! of the local Fortran Compiler !" & ,"! !" & ,"! Author: Werner W Schulz (C) 1998 !" & ,"! (email: wws20@cam.ac.uk) !" & ,"! !" & ,"! !" ! Output Info on FloatingPoint KINDs write(unit=*,fmt="(TR1,A)") & "! FloatingPoint Model Parameters: !" & ,"! Kind Precision Range Name !" do i=1,count( fpr%k>0 ) write(unit=*,fmt="(TR1,""!"",I5,2I12,TR8,A,TR12,""!"")") & fpr(i)%k, fpr(i)%p, fpr(i)%r, fpr(i)%Text end do ! Output Info on Integer KINDs write(unit=*,fmt="(TR1,A)") & "! !" & ,"! !" & ,"! Integer Model Parameters: !" & ,"! Kind Range Name !" do i=1,count( ir%r>0 ) write(unit=*,fmt="(TR1,""!"",I5,I8,TR24,A,TR12,""!"")") & ir(i)%k, ir(i)%r, ir(i)%Text end do write(unit=*,fmt="(TR1,A)") & "! !" & ,"! !" & ,"! !" & ,"! NOTE: !" & ,"! KindFinder has generated a Programme and a Module in !" & ,"! !" & ,"! " // FileName // FileExt // repeat(" ",48-len(FileName)) // "!" & ,"! " // ModuleName // FileExt // repeat(" ",48-len(ModuleName)) // "!" & ,"! !" & ,"! that will compute and display the Numerical Parameters !" & ,"! of the various INTEGER & FLOATING POINT Types !" & ,"! as specified by Fortran and the local Compiler. !" & ,"! The ModuleFile is can be used elsewhere. !" & ,"! !" & ,"! All Code is compatible with the Fortran Subsets and !" & ,"! should be able to run on any Fortran90-conforming !" & ,"! Compiler including F and Elf90. !" & ,"! !" & ,"! NOTE: !" & ,"! Possible KIND Values for LOGICAL or CHARACTER Types !" & ,"! must be obtained in the local Fortran Reference Manual !" & ,"! !" & ,"!---------------------------------------------------------!" write(unit=*,fmt="(//)") call NumericModel( fpr, ir ) stop end program KindFinder