PP#13~Fortran Tips#8
科学技術計算の計算結果はグリッドデータを出力表示することが多いので出力形式のコーディングに挑戦します。今後二回に亘って連載し、初回は整数データを扱います。
例えば、こんな三次元データの入出力イメージ(4、3、2)を想定してください。
メインのサブルーチンです。
subroutine printIntArray(Output, IntValue, NX, NY, NZ, NMAX)
!********************************************************************************
!* *
!* Produce the neat formatted output for an integer array *
!* *
!********************************************************************************
implicit none
integer,intent(in):: Output, NX, NY, NZ, NMAX
integer,intent(in):: IntValue( NMAX )
integer:: NXY, x, y, z, yz, &
x1m, x2m, ipr, npr, ig, ib, value
integer,parameter:: NxPrintDefault = 15
real(8):: time
logical:: qremark
!================================================================================
! Output : Output stream
! IntValue : Array to be printed (stored in natural order)
! QNULL : true if grid is null
!================================================================================
!--------------------------------------------------------------------------------
! Write heading
!--------------------------------------------------------------------------------
write(Output, '(" **********************************************************************")')
write(Output, '(" * Print out Integer Array *")')
write(Output, '(" **********************************************************************")')
!--------------------------------------------------------------------------------
!NxPrintDefault grids with X axis
npr = NX / NxPrintDefault + 1
NXY = NX * NY
!--------------------------------------------------------------------------------
do ipr=0,npr-1
x1m = NxPrintDefault * ipr + 1
x2m = min( NX, x1m + NxPrintDefault - 1)
!Z axis
do z=1,NZ
qremark = (z == 1) .or. (NY > 10)
if (qremark) then
write(Output, '(\"(i, j, k) = ",i3,\)') x1m
do x=x1m+1,x2m
write(Output, '(i8,\)') x
enddo
write(Output, *)
endif
if (qremark .or. NY > 0) write(Output, '()')
!Y axis
do y=1,NY
yz = (z-1) * NXY + (y-1) * NX
write(Output, '("(*,",i3,",",i3,") ",\)') y,z
do x=x1m,x2m
ig = yz + x
value = IntValue(ig)
! if (QNULL(ig)) then
! write(Output, '(" ***** ",\)')
! else
if (abs(value) >= 1e+8) then
write(Output, '(" ----- ",\)')
else
write(Output, '(i8,\)') value
endif
! endif
enddo
write(Output, '()')
enddo
enddo
enddo
!================================================================================
end subroutine
一方、呼び込むDriver Programの一例です。
program call_PrintIntArray
!********************************************************************************
!* call_printIntArray *
!********************************************************************************
implicit none
integer,parameter:: output = 6
integer,parameter:: NMAX = 100
integer:: NX, NY, NZ, NXY, x, y, z, ig
integer:: IntValue(NMAX)
character(1):: key
!================================================================================
do
print '(" Input NX, NY, NZ = "\)' ; read (*,*) NX, NY, NZ
if (NX*NY*NZ > NMAX) then
print '(" NX*NY*NZ is greater than NMAX. Input again!")'
else
exit
endif
enddo
100 continue
NXY = NX * NY
do z=1,NZ
do y=1,NY
do x=1,NX
ig = NXY * (z-1) + NX * (y-1) + x
write(*, '(" Input integer value at (",i4,",",i4,",",i4,") = "\)') x,y,z ; read(*,*) IntValue(ig)
enddo
enddo
enddo
call printIntArray(Output, IntValue, NX, NY, NZ, NMAX)
do
print '()'
print '(" Re-input integer value? (y/n) = "\)' ; read (*,*) key
if (key == "y" .or. key == "Y") then
goto 100
else
print '("Reached end of program")'
exit
endif
enddo
!================================================================================
stop
end program
つづく