Class Basis
In: basis.f90

基本的な計算関数を実行するモジュール

Methods

Public Instance methods

Function :
c2i_convert :integer
cval :character(*), intent(in)
: 変換する文字

文字型を実数型に変換する

[Source]

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)
: 変換する文字

文字型を実数型に変換する

[Source]

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)
: 終了日

開始日から終了日までの日数をカウントする.

[Source]

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
  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

!-- 複数年にまたがる場合, 閏年で場合分けする.
!-- 開始年も 1 年の日数分カウントする(あとで引く).
  if(nt>1)then
     do i=1,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(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

     if(nsm>1)then  ! 開始日が 1 月ではない場合.
        do i=1,nsm-1
           if(i==2.and.mod(nsy,4)==0)then
              days=days-month(13)
           else
              days=days-month(i)
           end if
        end do
     end if

  else

     if(nm/=0)then  ! 年がまたがらず, 月がまたがる場合.
        do i=nsm,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
!  end if

  days=days+ned-nsd

  days=days+1
  counter_day=days

  return
end function
Function :
counter_sec :integer
stime :type(dtime), intent(in)
: 開始日時
etime :type(dtime), intent(in)
: 終了日時

開始日から終了日までの秒数をカウントする.

[Source]

integer function counter_sec( stime, etime )
! 開始日から終了日までの秒数をカウントする.
  implicit none
  type(dtime), intent(in) :: stime  ! 開始日時
  type(dtime), intent(in) :: etime  ! 終了日時
  integer :: nday, tmp_sec
  integer :: nsh, nsm, nss, neh, nem, nes

  tmp_sec=0

!-- まず, 日数をカウントする.

  nday=counter_day( stime, etime )

!-- 日数を元に, 日分の秒をカウント.
! counter_day は 1 日から計算されているから
! 同一日では counter_day = 1, 24 時間以内で日をまたぐ場合は counter_day = 2.

  if(nday>2)then
     tmp_sec=(nday-2)*86400
  end if

!-- stime から etime までの hour, minite, sec を計算して, トータルの秒を返す.

  nsh=stime%hour_d
  nsm=stime%min_d
  nss=stime%sec_d
  neh=etime%hour_d
  nem=etime%min_d
  nes=etime%sec_d

  if(nday==1)then  ! 日数が 1 日以内に存在する場合, hour からのみ計算.
     tmp_sec=tmp_sec+(neh-nsh)*3600+(nem-nsm)*60+(nes-nss)
  else  ! 日数がまたがっている場合は, stime の日を 86400 s でカウントしてから
        ! nsh, nsm, nss を引けばその日の秒が計算できる.
     tmp_sec=tmp_sec+86400  ! stime の 1 日分
     tmp_sec=tmp_sec+neh*3600+nem*60+nem  ! etime の日の秒を足す
     tmp_sec=tmp_sec-nsh*3600-nsm*60-nsm  ! stime の日の秒を引く
  end if

  counter_sec=tmp_sec

  return
end function
dtime
Derived Type :
year_d :integer
: 西暦
month_d :integer
:
day_d :integer
:
hour_d :integer
:
min_d :integer
:
sec_d :integer
:

開始日の日付

Function :
i2c_convert :character(100)
ival :integer, intent(in)
: 変換する整数
forma :character(*), intent(in), optional
: 指定するフォーマット

実数型を文字型に変換する

[Source]

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
: 指定するフォーマット

実数型を文字型に変換する

[Source]

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)
: 出力する最大桁数 + 1 の数値
output :integer, intent(inout)
: 出力される乱数

任意の桁数で擬似乱数を生成するサブルーチン 混合合同法という乱数生成アルゴリズムを用いて擬似乱数を生成 $x_{n+1}=a\times x_{n}+b (mod \; L)$

[Source]

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 文字のみ対応.

[Source]

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)
: num 個に分割. この値は先に split_num 関数で調べておく.
cval_ar :character(*), dimension(num), intent(inout)
: 分割された文字列が格納される.
split_str :character(1), intent(in), optional

cval を split_str を区分け文字として cval_ar という配列に分割する. 現在, split_str は 1 文字にのみ対応している. デフォルトでは半角スペースが 対応している.

[Source]

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
Subroutine :
factor :integer, intent(in)
: 何時間変化するか.
itime :type(dtime), intent(in)
: 変換前の時刻
ctime :type(dtime), intent(inout)
: 変換後の時刻

タイムゾーンの変換を行うルーチン 例えば, JST を UTC に変換する場合, factor = -9 とすればよい.

[Source]

subroutine time_zone_convert( factor, itime, ctime )
! タイムゾーンの変換を行うルーチン
! 例えば, JST を UTC に変換する場合, factor = -9 とすればよい.
  implicit none
  integer, intent(in) :: factor        ! 何時間変化するか.
  type(dtime), intent(in) :: itime     ! 変換前の時刻
  type(dtime), intent(inout) :: ctime  ! 変換後の時刻
  integer :: iyear, imonth, iday, ihour
  integer, parameter, dimension(13) :: month=(/31,28,31,30,31,30, 31,31,30,31,30,31,29/)

  iyear=itime%year_d
  imonth=itime%month_d
  iday=itime%day_d
  ihour=itime%hour_d

  ihour=ihour+factor

  if(ihour<1)then
     do while(ihour<1)
        iday=iday-1
        ihour=ihour+24
     end do
  else if(ihour>=24)then
     do while(ihour>=24)
        iday=iday+1
        ihour=ihour-24
     end do
  end if

  if(iday<1)then
     do while(iday<1)
        if(mod(iyear,4)==0.and.imonth==2)then
           iday=iday+month(13)
        else
           iday=iday+month(imonth)
        end if

        imonth=imonth-1

        if(imonth<=0)then
           iyear=iyear-1
           imonth=12
        end if
     end do
  else if(iday>month(imonth))then
     do while(iday>month(imonth))
        if(mod(iyear,4)==0.and.imonth==2)then
           iday=iday-month(13)
        else
           iday=iday-month(imonth)
        end if
        imonth=imonth+1
        if(imonth>12)then
           iyear=iyear+1
           imonth=1
        end if
     end do
  end if

  ctime%year_d=iyear
  ctime%month_d=imonth
  ctime%day_d=iday
  ctime%hour_d=ihour

end subroutine