Class | stdio |
In: |
stdio.f90
|
標準入出力用モジュール 基本的に他モジュールのデバッグ用にのみ使用され, ユーザは本モジュールを意識する必要はない.
Subroutine : | |||
dl : | integer, intent(in)
| ||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
nx : | integer, intent(in)
| ||
ny : | integer, intent(in)
| ||
nz : | integer, intent(in)
| ||
aval(nx,ny,nz) : | real, intent(in)
|
実数配列変数を返す手続きについて, debug level ごとに処理.
subroutine debug_flag_a( dl, cmod, cpro, nx, ny, nz, aval ) ! 実数配列変数を返す手続きについて, debug level ごとに処理. implicit none integer, intent(in) :: dl ! debug level ! 0 = 何もしない, 1 = NaN 値が入っていると警告 character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 integer, intent(in) :: nx ! 第 1 要素の要素数 integer, intent(in) :: ny ! 第 2 要素の要素数 integer, intent(in) :: nz ! 第 3 要素の要素数 real, intent(in) :: aval(nx,ny,nz) ! 手続きが返した値 select case (dl) case (1) call nan_check_a( trim(cmod), trim(cpro), nx, ny, nz, aval ) ! case (2) ! if(present(unity))then ! call stdio_real( trim(cmod), trim(cpro), rval, trim(unity) ) ! else ! call stdio_real( trim(cmod), trim(cpro), rval ) ! end if end select end subroutine debug_flag_a
Subroutine : | |||
dl : | integer, intent(in)
| ||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
ival : | integer, intent(in)
| ||
unity : | character(*), intent(in), optional
|
整数スカラー変数を返す手続きについて, debug level ごとに処理.
subroutine debug_flag_i( dl, cmod, cpro, ival, unity ) ! 整数スカラー変数を返す手続きについて, debug level ごとに処理. implicit none integer, intent(in) :: dl ! debug level ! 0 = 何もしない, 1 = NaN 値が入っていると警告, 2 = 値を標準出力 character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 integer, intent(in) :: ival ! 手続きが返した値 character(*), intent(in), optional :: unity ! 単位 select case (dl) ! case (1) ! call nan_check_s( trim(cmod), trim(cpro), rval ) case (2) if(present(unity))then call stdio_integer( trim(cmod), trim(cpro), ival, trim(unity) ) else call stdio_integer( trim(cmod), trim(cpro), ival ) end if end select end subroutine debug_flag_i
Subroutine : | |||
dl : | integer, intent(in)
| ||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
rval : | real, intent(in)
| ||
unity : | character(*), intent(in), optional
|
実数スカラー変数を返す手続きについて, debug level ごとに処理.
subroutine debug_flag_r( dl, cmod, cpro, rval, unity ) ! 実数スカラー変数を返す手続きについて, debug level ごとに処理. implicit none integer, intent(in) :: dl ! debug level ! 0 = 何もしない, 1 = NaN 値が入っていると警告, 2 = 値を標準出力 character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 real, intent(in) :: rval ! 手続きが返した値 character(*), intent(in), optional :: unity ! 単位 select case (dl) case (1) call nan_check_s( trim(cmod), trim(cpro), rval ) case (2) if(present(unity))then call stdio_real( trim(cmod), trim(cpro), rval, trim(unity) ) else call stdio_real( trim(cmod), trim(cpro), rval ) end if end select end subroutine debug_flag_r
Subroutine : | |||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
nx : | integer, intent(in)
| ||
ny : | integer, intent(in)
| ||
nz : | integer, intent(in)
| ||
val(nx,ny,nz) : | real, intent(in)
|
実数配列 val の中に nan 値が存在するとエラーを出力する. 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで, 1, 2 次元の配列に対しても変換可能.
subroutine nan_check_a( cmod, cpro, nx, ny, nz, val ) ! 実数配列 val の中に nan 値が存在するとエラーを出力する. ! 引数の配列は 3 次元であるが, その前の要素数を 1 などに設定することで, ! 1, 2 次元の配列に対しても変換可能. implicit none character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 integer, intent(in) :: nx ! 第 1 要素の要素数 integer, intent(in) :: ny ! 第 2 要素の要素数 integer, intent(in) :: nz ! 第 3 要素の要素数 real, intent(in) :: val(nx,ny,nz) ! 変換する配列 integer :: i, j, k, counter ! 作業用配列 counter=0 do k=1,nz do j=1,ny do i=1,nx if(isnan(val(i,j,k)))then if(counter==0)then counter=1 call stdio_char( 'Detected NaN value.', 'E', cmod=trim(cmod), cpro=trim(cpro) ) call stdio_array( 'VAL', (/i, j, k/) ) else call stdio_array( 'VAL', (/i, j, k/) ) end if end if end do end do end do end subroutine nan_check_a
Subroutine : | |||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
rval : | real, intent(in)
|
実数を返す手続きについて, 値が nan であればその旨警告する.
subroutine nan_check_s( cmod, cpro, rval ) ! 実数を返す手続きについて, 値が nan であればその旨警告する. implicit none character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 real, intent(in) :: rval ! 手続きの返した値 if(isnan(rval))then call stdio_char( 'Detected NaN value.', 'E', cmod=trim(cmod), cpro=trim(cpro) ) end if end subroutine nan_check_s
Subroutine : | |||
cval : | character(*), intent(in)
| ||
array_num(:) : | integer, intent(in)
|
該当配列の要素番号を出力する.
subroutine stdio_array( cval, array_num ) ! 該当配列の要素番号を出力する. implicit none character(*), intent(in) :: cval ! 配列名 integer, intent(in) :: array_num(:) ! 各次元の要素番号 integer :: i, ni, nc character(20) :: formal character(1000) :: output_char character(6) :: i2c, tmpc ni=size(array_num) nc=len_trim(cval)+ni*7+2 write(i2c,*) nc formal='(a'//trim(adjustl(i2c))//')' output_char=trim(cval)//'(' do i=1,ni write(tmpc,'(I6)') array_num(i) output_char=trim(adjustl(output_char))//tmpc(1:6)//',' end do output_char(len_trim(output_char):len_trim(output_char))=')' write(*,trim(formal)) trim(adjustl(output_char)) end subroutine stdio_array
Subroutine : | |||
cval : | character(*), intent(in)
| ||
cflag : | character(1), intent(in)
| ||
cmod : | character(*), intent(in), optional
| ||
cpro : | character(*), intent(in), optional
|
手続き名とモジュール名情報を付記しながら, 文字出力を行う.
subroutine stdio_char( cval, cflag, cmod, cpro ) ! 手続き名とモジュール名情報を付記しながら, 文字出力を行う. implicit none character(*), intent(in) :: cval ! 出力させたいメッセージ character(1), intent(in) :: cflag ! メッセージの種類. ! 'E' = エラー, 'W' = 警告, 'M' = 単なるメッセージ. character(*), intent(in), optional :: cmod ! モジュール名 character(*), intent(in), optional :: cpro ! 手続き名 character(100) :: formal ! 出力フォーマット設定用 character(15) :: tmpc integer :: lengc(4) if(present(cmod))then lengc(1)=len_trim(adjustl(cmod)) lengc(4)=23 else lengc(1)=0 lengc(4)=16 end if if(present(cpro))then lengc(2)=len_trim(adjustl(cpro)) else lengc(2)=0 end if lengc(3)=len_trim(adjustl(cval)) select case (cflag(1:1)) case ('E') tmpc='**** ERROR **** ' case ('W') tmpc='*** WARNING *** ' case ('M') tmpc='*** MESSAGE *** ' end select write(formal,*) lengc(1)+lengc(2)+lengc(3)+lengc(4) formal='(a'//trim(adjustl(formal))//')' if(present(cmod))then write(*,formal) trim(adjustl(tmpc))//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', trim(adjustl(cval)) else write(*,formal) trim(adjustl(tmpc))//trim(adjustl(cval)) end if end subroutine stdio_char
Subroutine : | |||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
ival : | integer, intent(in)
| ||
unity : | character(*), intent(in), optional
|
整数を返す手続きについて, その値と手続き名を返す.
subroutine stdio_integer( cmod, cpro, ival, unity ) ! 整数を返す手続きについて, その値と手続き名を返す. implicit none character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 integer, intent(in) :: ival ! 手続きの返した値 character(*), intent(in), optional :: unity ! 単位 character(100) :: formal ! 出力フォーマット設定用 character(20) :: unitc integer :: lengc(3) lengc(1)=len_trim(adjustl(cmod)) lengc(2)=len_trim(adjustl(cpro)) if(present(unity))then lengc(3)=len_trim(adjustl(unity)) write(formal,*) lengc(1)+lengc(2)+lengc(3)+15 write(unitc,*) lengc(3)+3 formal='(a'//trim(adjustl(formal))//',I8.8,a'//trim(adjustl(unitc))//')' write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', ival, ' ['//trim(adjustl(unity))//']' else write(formal,*) lengc(1)+lengc(2)+15 formal='(a'//trim(adjustl(formal))//',I8.8)' write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', ival end if end subroutine stdio_integer
Subroutine : | |||
cmod : | character(*), intent(in)
| ||
cpro : | character(*), intent(in)
| ||
rval : | real, intent(in)
| ||
unity : | character(*), intent(in), optional
|
実数を返す手続きについて, その値と手続き名を返す.
subroutine stdio_real( cmod, cpro, rval, unity ) ! 実数を返す手続きについて, その値と手続き名を返す. implicit none character(*), intent(in) :: cmod ! モジュール名 character(*), intent(in) :: cpro ! 手続き名 real, intent(in) :: rval ! 手続きの返した値 character(*), intent(in), optional :: unity ! 単位 character(100) :: formal ! 出力フォーマット設定用 character(20) :: unitc integer :: lengc(3) lengc(1)=len_trim(adjustl(cmod)) lengc(2)=len_trim(adjustl(cpro)) if(present(unity))then lengc(3)=len_trim(adjustl(unity)) write(formal,*) lengc(1)+lengc(2)+15 write(unitc,*) lengc(3)+3 formal='(a'//trim(adjustl(formal))//',1P,E14.5,a'//trim(adjustl(unitc))//')' write(*,trim(adjustl(formal))) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', rval, ' ['//trim(adjustl(unity))//']' else write(formal,*) lengc(1)+lengc(2)+15 formal='(a'//trim(adjustl(formal))//',1P,E14.5)' write(*,trim(formal)) "DEBUG : "//trim(adjustl(cpro))//' in ' //trim(adjustl(cmod))//' : ', rval end if end subroutine stdio_real