FORTRANででかい配列のアサーション

FORTRANプログラムのリファクタリングをしている。そんなことをするからにはデータフローもなんだかよくわからない悲惨なプログラムである。
で、ロジックを推測して論理的に書きなおすのであるが、プログラムを壊してしまっていないことを確認しながらバージョン管理をすすめていかないと険呑このうえない。 そこでアサーション（想定していない動作をしたら落ちるような確認）をほうぼうに入れていくのだが、なにせFORTRANだからその対象はきまって巨大な配列である。1行で確認するためには、定数データをプログラムに埋め込むわけにいかないから、外部にファイルで持つべきである。

で、こんなサブルーチンを書いてみた。


まず、プログラムの要所要所で、壊れては困るデータを第3引数VALにしてASSERTを呼ぶ。文字型でなければ何でもよい。第２引数SIZは要素数（INTEGER, REAL, LOGICALの場合）あるいはその2倍（DOUBLE PRECISION, COMPLEXの場合）である。配列でなくても1要素配列とみなせばよい。第1引数には16文字以下で行番号なり適当な名前を入れて置く。

で、まずいじっていないプログラムを実行すると ASSERTDAT というファイルが生じるので、これを大事に保存して、次にプログラムをいじって実行すると、動作が変化したときには落ちるというわけである。

アサーションの場所を増減したいこともあるかもしれない。減らすのは簡単で、CALL ASSERT を削除すれば、名前がマッチしない場合は ASSERTDAT 内のレコードを読み飛ばす。増やすのは、しかたがないので、最初からやりなおしである。

      SUBROUTINE ASSERT(NAM, SIZ, VAL)
      IMPLICIT NONE
      CHARACTER(*), INTENT(IN):: NAM
      INTEGER, INTENT(IN):: SIZ
      INTEGER, INTENT(IN):: VAL(*)
      CHARACTER(16):: INAM, FNAM
      INTEGER, SAVE:: UNI = -1
      LOGICAL, SAVE:: RMODE = .TRUE.
      LOGICAL:: OP
      INTEGER:: FSIZ, IOS, I
      INTEGER, ALLOCATABLE:: FVAL(:)
      CHARACTER(*), PARAMETER:: DFN = 'ASSERTDAT'
      LOGICAL, SAVE:: DBG = .FALSE.
      IF (UNI < 0) THEN
        DO, UNI = 40, 100
          INQUIRE(UNIT=UNI, OPENED=OP)
          IF (.NOT. OP) EXIT
        ENDDO
        OPEN(UNI, FILE=DFN, STATUS='OLD', ACTION='READ',
     $    POSITION='REWIND',
     $    FORM='UNFORMATTED', ACCESS='SEQUENTIAL', IOSTAT=IOS)
        IF (IOS == 0) THEN
          CONTINUE
          IF (DBG) WRITE(0, '(A,I3)') '!OPEN-READ', UNI
        ELSE
          IF (DBG) WRITE(0, '(A,I3)') '!OPEN-WRITE', UNI
          RMODE = .FALSE.
          OPEN(UNI, FILE=DFN, STATUS='NEW', ACTION='WRITE',
     $    POSITION='REWIND',
     $    FORM='UNFORMATTED', ACCESS='SEQUENTIAL')
        ENDIF
      ENDIF
      INAM = NAM
      IF (DBG) WRITE(0, '(A,I)') '!TRY '// INAM, SIZ
      IF (RMODE) THEN
        DO
          READ(UNI) FNAM, FSIZ
          IF (FNAM == INAM) THEN
            IF (FSIZ /= SIZ) THEN
              WRITE(0, *) 'ASSERT: SIZE MISMATCH', INAM, SIZ, FSIZ
              STOP 16
            ENDIF
            ALLOCATE(FVAL(SIZ))
            READ(UNI) FVAL(1:SIZ)
            IF (.NOT.ALL(FVAL(1:SIZ)==VAL(1:SIZ))) THEN
              DO, I = 1, SIZ
                IF (FVAL(I) /= VAL(I)) THEN
                  WRITE(0, '(A,A,":",3Z9.8)')
     $              '!ASSERT:', INAM, I, FVAL(I), VAL(I)
                ENDIF
              ENDDO
              STOP 16
            ENDIF
            DEALLOCATE(FVAL)
            EXIT
          ELSE
            IF (DBG) WRITE(0, '(A,A)') '!PASS', FNAM
            READ(UNI)
          ENDIF
        ENDDO
      ELSE
        WRITE(UNI) INAM, SIZ
        WRITE(UNI) VAL(1:SIZ)
      ENDIF
      END SUBROUTINE