| Class | Basis |
| In: |
basis.f90
|
基本的な計算関数を実行するモジュール
| Function : | |||
| c2i_convert : | integer | ||
| cval : | character(*), intent(in)
|
文字型を実数型に変換する
integer function c2i_convert( cval ) ! 文字型を実数型に変換する implicit none character(*), intent(in) :: cval ! 変換する文字 read(cval,*) c2i_convert return end function
| Function : | |||
| c2r_convert : | real | ||
| cval : | character(*), intent(in)
|
文字型を実数型に変換する
real function c2r_convert( cval ) ! 文字型を実数型に変換する implicit none character(*), intent(in) :: cval ! 変換する文字 read(cval,*) c2r_convert return end function
| Function : | |||
| counter_day : | integer | ||
| stime : | type(dtime), intent(in)
| ||
| etime : | type(dtime), intent(in)
|
開始日から終了日までの日数をカウントする.
integer function counter_day( stime, etime )
! 開始日から終了日までの日数をカウントする.
implicit none
type(dtime), intent(in) :: stime ! 開始日
type(dtime), intent(in) :: etime ! 終了日
integer, parameter, dimension(13) :: month=(/31,28,31,30,31,30, 31,31,30,31,30,31,29/)
integer :: nt, nm, days, i, year_tmp, year_fact
integer :: nsy, nsm, nsd, ney, nem, ned
nt=etime%year_d-stime%year_d+1
nm=etime%month_d-stime%month_d+1
days=0
nsy=stime%year_d
nsm=stime%month_d
nsd=stime%day_d
ney=etime%year_d
nem=etime%month_d
ned=etime%day_d
!-- 一年分ある場合, 閏年で場合分けする.
if(nt>2)then
do i=2,nt-1
year_tmp=nsy+i-1
if(mod(year_tmp,4)==0)then
year_fact=366
else
year_fact=365
end if
days=days+year_fact
end do
end if
!-- 上の処理を行っているので, あと足し合わせるのは開始年と終了年の日数のみ.
!-- まず, 1 ケ月まるまる存在する月を足し合わせる.
!-- ただし, 開始日が 12 月, 終了日が 1 月の場合は, 日を足す過程で足されるので,
!-- ここではカウントしない.
if(nt>1)then ! 年がまたがる場合
if(nsm<12)then ! 開始日が 12 月ではない場合.
do i=nsm+1,12
if(i==2.and.mod(nsy,4)==0)then
days=days+month(13)
else
days=days+month(i)
end if
end do
end if
if(nem>1)then ! 終了日が 1 月ではない場合.
do i=1,nem-1
if(i==2.and.mod(ney,4)==0)then
days=days+month(13)
else
days=days+month(i)
end if
end do
end if
else
if(nm>2)then ! 年がまたがらず, 月がまたがり, かつ間に 1 ヶ月分
! まるまる入っている場合.
do i=nsm+1,nem-1
if(i==2.and.mod(ney,4)==0)then
days=days+month(13)
else
days=days+month(i)
end if
end do
end if
end if
!-- 後は, 開始月と終了月の日数を足し合わせる.
if(nt/=1.or.nm/=1)then ! 年も月もかぶっていない場合
if(mod(nsy,4)==0.and.nsm==2)then
days=days+month(13)-nsd
else
days=days+month(nsm)-nsd
end if
if(mod(ney,4)==0.and.nem==2)then
days=days+ned
else
days=days+ned
end if
else
days=days+ned-nsd
end if
days=days+1
counter_day=days
return
end function
| Function : | |||
| i2c_convert : | character(100) | ||
| ival : | integer, intent(in)
| ||
| forma : | character(*), intent(in), optional
|
実数型を文字型に変換する
character(100) function i2c_convert( ival, forma )
! 実数型を文字型に変換する
implicit none
integer, intent(in) :: ival ! 変換する整数
character(*), intent(in), optional :: forma ! 指定するフォーマット
character(100) :: tmp
if(present(forma))then
write(tmp,trim(forma)) ival
else
write(tmp,*) ival
end if
i2c_convert=tmp
return
end function
| Function : | |||
| r2c_convert : | character(100) | ||
| rval : | real, intent(in)
| ||
| forma : | character(*), intent(in), optional
|
実数型を文字型に変換する
character(100) function r2c_convert( rval, forma )
! 実数型を文字型に変換する
implicit none
real, intent(in) :: rval ! 変換する実数
character(*), intent(in), optional :: forma ! 指定するフォーマット
character(100) :: tmp
if(present(forma))then
write(tmp,trim(forma)) rval
else
write(tmp,*) rval
end if
r2c_convert=tmp
return
end function
| Subroutine : | |||
| L : | integer, intent(in)
| ||
| output : | integer, intent(inout)
|
任意の桁数で擬似乱数を生成するサブルーチン 混合合同法という乱数生成アルゴリズムを用いて擬似乱数を生成 $x_{n+1}=a\times x_{n}+b (mod \; L)$
subroutine rand_make(L,output)
! 任意の桁数で擬似乱数を生成するサブルーチン
! 混合合同法という乱数生成アルゴリズムを用いて擬似乱数を生成
! $x_{n+1}=a\times x_{n}+b (mod \; L)$
implicit none
integer, intent(in) :: L ! 出力する最大桁数 + 1 の数値
integer, intent(inout) :: output ! 出力される乱数
integer :: a, b, x0, i, input
integer, external :: time
input=time()
input=mod(input,L)
write(*,*) input
a=11
b=12
x0=input
do i=1,10
x0=a*x0+b
x0=mod(x0,L)
end do
output=x0
end subroutine
| Function : | |||
| split_num : | integer | ||
| cval : | character(*), intent(in)
| ||
| split_str : | character(1), intent(in), optional
|
split_str で指定された文字列を区分け記号として, 文字列 cval を分割したときの 分割個数を返す. split_str が指定されない場合, 空白文字を分割記号として処理. 現在, 分割記号は 1 文字のみ対応.
integer function split_num( cval, split_str )
! split_str で指定された文字列を区分け記号として, 文字列 cval を分割したときの
! 分割個数を返す. split_str が指定されない場合, 空白文字を分割記号として処理.
! 現在, 分割記号は 1 文字のみ対応.
implicit none
character(*), intent(in) :: cval ! 分割したい文字列
character(1), intent(in), optional :: split_str ! 分割記号
character(1) :: split
integer :: nc, counter, i
logical :: double_flag
if(present(split_str))then
split=trim(adjustl(split_str))
else
split=' '
end if
nc=len_trim(adjustl(cval))
counter=0
double_flag=.false.
do i=2,nc-1 ! 文字列の最初と最後に分割文字が入っていてもそれは無視できるため.
if(cval(i:i)==split)then
if(double_flag.eqv..false.)then
counter=counter+1
double_flag=.true.
end if
else
double_flag=.false.
end if
end do
split_num=counter+1
return
end function
| Subroutine : | |||
| cval : | character(*), intent(in)
| ||
| num : | integer, intent(in)
| ||
| cval_ar : | character(*), dimension(num), intent(inout)
| ||
| split_str : | character(1), intent(in), optional |
cval を split_str を区分け文字として cval_ar という配列に分割する. 現在, split_str は 1 文字にのみ対応している. デフォルトでは半角スペースが 対応している.
subroutine splitting( cval, num, cval_ar, split_str )
! cval を split_str を区分け文字として cval_ar という配列に分割する.
! 現在, split_str は 1 文字にのみ対応している. デフォルトでは半角スペースが
! 対応している.
implicit none
character(*), intent(in) :: cval ! 分割したい文字列
integer, intent(in) :: num ! num 個に分割.
! この値は先に split_num 関数で調べておく.
character(*), dimension(num), intent(inout) :: cval_ar
! 分割された文字列が格納される.
character(1), intent(in), optional :: split_str
character(1) :: split
integer :: nc, counter, counter_counter, i
integer, dimension(num) :: isnum, ienum
logical :: double_flag
if(present(split_str))then
split=split_str
else
split=' '
end if
nc=len_trim(adjustl(cval))
counter=0
counter_counter=0
double_flag=.false.
isnum(1)=1
do i=2,nc-1 ! 文字列の最初と最後に分割文字が入っていてもそれは無視できるため.
if(cval(i:i)==split)then
if(double_flag.eqv..false.)then
counter_counter=counter_counter+1
counter=0
ienum(counter_counter)=i-1
double_flag=.true.
else
counter=counter+1
end if
else
if(double_flag.eqv..true.)then
isnum(counter_counter)=i
end if
double_flag=.false.
end if
end do
do i=1,num
cval_ar(i)=cval(isnum(i):ienum(i))
end do
end subroutine splitting