Advertisement
Guest User

int2char_module

a guest
Dec 16th, 2015
43
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. !-----------------------------------------------------------------------
  2. !Module int2char_module
  3. !-----------------------------------------------------------------------
  4. module int2char_module
  5. !use
  6. implicit none
  7.  private ! all by default
  8.  public :: int2char, isp,rsp,idp,rdp,iqp,rqp
  9.  
  10.       integer, parameter :: isp  = selected_int_kind(9)
  11.       integer, parameter :: idp  = selected_int_kind(18)
  12.       integer, parameter :: iqp  = selected_int_kind(36)
  13.  
  14.       integer, parameter :: rsp = kind(1.0)
  15.       integer, parameter :: rdp = selected_real_kind(2*precision(1.0_rsp))
  16.       integer, parameter :: rqp = selected_real_kind(2*precision(1.0_rdp))
  17.  
  18.  
  19.  interface int2char
  20.  module procedure int2char4, int2char8, int2char16
  21.  end interface int2char
  22.  
  23.  contains
  24.    pure function csize4(i) result (sz)
  25.       implicit none
  26.       integer(isp), intent (in) :: i
  27.       integer(isp) :: sz
  28.  
  29.       if(i==0) then
  30.          sz=1
  31.       else if(i<0) then
  32.          sz = floor(log10(real(abs(i),kind=rsp))) + 1 + 1 ! additional  1 for minus sign
  33.       else
  34.          sz = floor(log10(real(i,kind=rsp))) + 1
  35.       endif
  36.  
  37.    end function csize4
  38.  
  39.    pure function csize8(i) result (sz)
  40.       implicit none
  41.       integer(idp), intent (in) :: i
  42.       integer(idp) :: sz
  43.  
  44.       if(i==0_idp) then
  45.          sz=1_idp
  46.       else if(i<0_idp) then
  47.          sz = floor(log10(real(abs(i),kind=rdp))) + 1_idp + 1_idp ! additional  1 for minus sign
  48.       else
  49.          sz = floor(log10(real(i,kind=rdp))) + 1_idp
  50.       endif
  51.  
  52.    end function csize8
  53.  
  54.    pure function csize16(i) result (sz)
  55.       implicit none
  56.       integer(iqp), intent (in) :: i
  57.       integer(iqp) :: sz
  58.  
  59.       if(i==0_iqp) then
  60.          sz=1_iqp
  61.       else if(i<0_iqp) then
  62.          sz = floor(log10(real(abs(i),kind=rqp))) + 1 + 1 ! additional  1 for minus sign
  63.       else
  64.          sz = floor(log10(real(i,kind=rqp))) + 1
  65.       endif
  66.  
  67.    end function csize16
  68.  
  69.    !-----------------------------------------------------------------------
  70.    !Function integer to character
  71.    !-----------------------------------------------------------------------
  72.    function int2char4(i) result (c)
  73.       implicit none
  74.       integer(isp), intent (in) :: i
  75.       character (len=csize4(i)) :: c
  76.       if(i<0) then
  77.          write (c,'(A,i0)') "-",abs(i)
  78.       else
  79.          write (c,'(i0)') i
  80.       end if
  81.  
  82.    end function int2char4
  83.  
  84.    !-----------------------------------------------------------------------
  85.    !Function integer to character
  86.    !-----------------------------------------------------------------------
  87.    function int2char8(i) result (c)
  88.       implicit none
  89.       integer(idp), intent (in) :: i
  90.       character (len=csize8(i)) :: c
  91.       if(i<0) then
  92.          write (c,'(A,i0)') "-",abs(i)
  93.       else
  94.          write (c,'(i0)') i
  95.       end if
  96.  
  97.    end function int2char8
  98.  
  99.    !-----------------------------------------------------------------------
  100.    !Function integer to character
  101.    !-----------------------------------------------------------------------
  102.    function int2char16(i) result (c)
  103.       implicit none
  104.       integer(iqp), intent (in) :: i
  105.       character (len=csize16(i)) :: c
  106.       if(i<0) then
  107.          write (c,'(A,i0)') "-",abs(i)
  108.       else
  109.          write (c,'(i0)') i
  110.       end if
  111.  
  112.    end function int2char16
  113.  
  114. end module int2char_module
Advertisement
RAW Paste Data Copied
Advertisement