お知らせ+活動記録+たわごと

HP と Twitter を補完するとともに、互いの密接な連携を図るため、本ブログを開設した。三位一体を目指す。情報提供、広報活動、教育・啓蒙活動の一環として、肩の力を抜き、冗長性を廃し、簡にして要を得た文章を書くよう心がける。
<< October 2017 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 >>
 
MOBILE
qrcode
PROFILE
無料ブログ作成サービス JUGEM
 
RIETAN-FP の Fortran 90/95 化の推進
少し前から RIETAN-FP のソースコードを少しずつ Fortran 90/95 の文法で書き改めつつある。具体的には
  1. モジュール
  2. 種別値関数 KIND
  3. CONTAINS 文
  4. 内部副プログラム
  5. Fortran 90 流の宣言文
  6. 構造体
  7. FORALL 構文
  8. DO 構造名
  9. 部分配列間の代入と演算
  10. 配列と文字列の動的割り付け
  11. ポインタ
などをできるだけ使うよう心がけている。上記の機能をすべて活用している例として、v2.33へのバージョンアップ時に新たに書き起こしたコードを公開しよう。PANalytical XML フォーマットの粉末X線回折強度データファイル(UTF-8コード)の入力部分だ。

SUBROUTINE PANALYTICAL_XML(NUNIT, DEG, XINT, NTOTAL, STEP)
! Read angles and intensities from hoge.int with the PANalytical XML format
! NUNIT: Unit number of intensity data file, hoge.int.
! DEG: 2-theta/degree.
! XINT: Diffraction intensities.
! MAXP: Maximum number of intensity data.
! NTOTAL: Total number of diffraction intensities.
! STEP: Step width/degree.
USE CONSTANTS, ONLY: S_P, D_P
USE INT_PARAMETERS, ONLY: NP ! Maximum number of intensity data
IMPLICIT NONE
TYPE RANGE
    REAL(D_P) :: MIN, MAX, STEP
END TYPE
INTEGER, INTENT(IN) :: NUNIT
INTEGER, INTENT(INOUT) :: NTOTAL
REAL(S_P), DIMENSION(NP), TARGET, INTENT(INOUT) :: DEG
! A temporary array to store intensities in a block
REAL(S_P), DIMENSION(:), POINTER :: XINT_BLOCK
REAL(S_P), DIMENSION(NP), INTENT(INOUT) :: XINT
REAL(S_P), INTENT(INOUT) :: STEP
INTEGER :: IS, IE, IBLOCK, IOS, J
TYPE(RANGE) :: DEGREES
CHARACTER(:), ALLOCATABLE :: LINE ! A temporary character-type variable

ALLOCATE (CHARACTER(100000) :: LINE)
DO
    READ(NUNIT, '(A)') LINE
    IF (INDEX(LINE(1:80), '<positions axis="2Theta" unit="deg">') > 0) EXIT
END DO
DEGREES%MIN = TWO_THETA(1)
DEGREES%MAX = TWO_THETA(2)
XINT_BLOCK => DEG ! A pointer is associated with a target
ALLOCATE (XINT_BLOCK(NP))
XINT_BLOCK = 0.0 ! Initialize array XINT_BLOCK
XINT = 0.0 ! Initialize array XINT

BLOCK_NO: DO IBLOCK = 1, 1000
    DO
        READ(NUNIT, '(A)', IOSTAT = IOS) LINE
        IF (IOS < 0) EXIT BLOCK_NO
        IS = INDEX(LINE(1:80),'<intensities unit="counts">')
        IF (IS > 0) EXIT
    END DO
    IS = IS + 27
    IE = INDEX(LINE,'</intensities>')
    IF (IE == 0) THEN
        WRITE(6,'(//11X,A)') 'The length of a string, LINE, to '// &
        'store diffraction intensities is too short'
        STOP
    END IF
    LINE(IE:) = '/' ! Only a slash is put after the last intensity
    ! Read intensities in between '<intensities unit="counts">' and '/'
    SELECT CASE (IBLOCK)
    CASE (1)
        READ(LINE(IS:IE), *) (XINT_BLOCK(J), J = 1, NP)
        DO J = NP, 1, -1
            IF (XINT_BLOCK(J) /= 0.0) EXIT
        END DO
        NTOTAL = J
    CASE DEFAULT
        READ(LINE(IS:IE), *) (XINT_BLOCK(J), J = 1, NTOTAL)
    END SELECT
    XINT(1:NTOTAL) = XINT(1:NTOTAL) + XINT_BLOCK(1:NTOTAL)
END DO BLOCK_NO

DEALLOCATE(LINE)
DEALLOCATE(XINT_BLOCK)
WRITE(6,'(/11X, A, I3)') 'Number of data blocks =', IBLOCK - 1
DEGREES%STEP = (DEGREES%MAX - DEGREES%MIN)/DBLE(NTOTAL - 1)
FORALL (J=1:NTOTAL) DEG(J) = SNGL(DEGREES%MIN + DBLE(J - 1)*DEGREES%STEP)
STEP = SNGL(STEP_DP)

CONTAINS
FUNCTION TWO_THETA(IPOS)
INTEGER, INTENT(IN) :: IPOS
REAL(D_P) :: TWO_THETA
READ(NUNIT, '(A)') LINE
IF (IPOS == 1) THEN
    IS = INDEX(LINE, '<startPosition>') + 15
    IE = INDEX(LINE, '</startPosition>') - 1
ELSE IF (IPOS == 2) THEN
    IS = INDEX(LINE, '<endPosition>') + 13
    IE = INDEX(LINE, '</endPosition>') - 1
END IF
READ(LINE(IS:IE), *) TWO_THETA
END FUNCTION TWO_THETA
END SUBROUTINE PANALYTICAL_XML

PANALYTICAL_XML は拡張可能なマーク付け言語 XML 形式のタグ付きデータから2θ、カウント、データ点数をそれぞれ DEG, XINT, NTOTAL に収めるサブルーチンである。マルチブロックのファイルに対応しており、複数のファイルに分かれている強度データは単一ファイルにマージすれば、処理できる。

頻用する定数はモジュールで定義しておき、使用する定数を USE ..... ONLY で指定する。サブルーチンや関数副プログラムの引数をすべて記述し、しかも入力 (IN)、出力 (OUT)、入出力 (INOUT) を明記する。IMPLICIT NONE を選択し、変数はすべて明示的に宣言しているが、その部分はさすがに冗長に見える。

一ブロックのカウントが一行に記録されているため、LINEという長さ100000の文字変数を動的に割り付け、使い終わった時点で割り付けを解除するようにした。また、ポインタを使って未使用の配列 DEG の領域を配列 XINT_BLOCK に流用している。

単一のプログラム単位内でしか使わない内部副プログラムは、FUNCTION TWO_THETA のように CONTAINS 文以下に置く。平屋を二階建てに増築するだけでも、主従の関係が理解しやすくなる。CONTAINS に続く内部副プログラム中の引数と宣言文が激減し、ソースコードがコンパクトになるという利点もある。メインプログラムから呼び出しているサブルーチンの大半は、内部サブルーチンとして書き直した。

今後新たに追加するルーチンでは、上記10個の文を存分に活用していくつもりだ。
コメント
コメントする









 

(C) 2017 ブログ JUGEM Some Rights Reserved.