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
つづく