PP#13~Fortran Tips#8

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

つづく

Comments are closed.