C
C Version 1.1 vjp 5/04/99
C
SUBROUTINE DIFFMERGE63(DIR1,DIR2,SCALEFAC)
C
C---------------------------------------------------------------------------C
C ( Serial Version 3/15/99 ) C
C Create a Difference File for elevation data at all nodes from two C
C different directories. C
C This version is compatible with ADCIRC version 33.04 C
C C
C Input Parameters: C
C C
C DIR1 = pathname of first directory C
C DIR2 = pathname of second directory C
C SCALEFAC = user supplied scale factor for difference C
C C
C---------------------------------------------------------------------------C
C
USE POST_GLOBAL
INTEGER I,J,K,L,IPROC,IDUM
INTEGER NDSETGE1,NDSETGE2
INTEGER NP1,NP2
INTEGER NSTEMP1,NSTEMP2
INTEGER ITEMPE1,ITEMPE2
INTEGER ITE1,ITE2
INTEGER IREC1,IREC2
INTEGER LEN1,LEN2
REAL(SZ) DTE1,DTE2,SCALEFAC
REAL(8) TIMEOUTE1,TIMEOUTE2
CHARACTER*80 DIR1,DIR2,FNAME1,FNAME2,FNAME3
CHARACTER*85 INLINE
CHARACTER*4 RDES4(8),RID4(6),AID4(6)
CHARACTER*8 RDES8(8),RID8(6),AID8(6)
LOGICAL FOUND1,FOUND2
REAL(8),ALLOCATABLE :: ETA1(:),ETA2(:)
ALLOCATE( ETA1(MNP),ETA2(MNP))
C
C--Construct File Names
C
DO I=1, LEN(DIR1)
IF (DIR1(I:I).EQ.' ') THEN
LEN1 = I-1
GO TO 100
ENDIF
ENDDO
100 CONTINUE
DO I=1, LEN(DIR2)
IF (DIR2(I:I).EQ.' ') THEN
LEN2 = I-1
GO TO 200
ENDIF
ENDDO
200 CONTINUE
C
FNAME1 = DIR1(1:LEN1)//'/fort.63'
FNAME2 = DIR2(1:LEN2)//'/fort.63'
FNAME3 = 'diffmerge.63'
C
C--Determine whether Unit 63 is Sequential Formatted or Direct Access Binary
C
IF (ABS(NOUTGE).EQ.1) THEN
GO TO 1000
ELSE
GO TO 2000
ENDIF
C
1000 CONTINUE
C
C--Open Both Global Sequential Formatted fort.63 files
C
INQUIRE(FILE=FNAME1,EXIST=FOUND1)
INQUIRE(FILE=FNAME2,EXIST=FOUND2)
IF (FOUND1.AND.FOUND2) THEN
OPEN(UNIT=53,FILE=FNAME1)
OPEN(UNIT=63,FILE=FNAME2)
OPEN(UNIT=73,FILE=FNAME3)
ELSE
print *, "No fort.63 files found"
RETURN
ENDIF
C
READ (53,'(A85)') INLINE
READ (63,'(A85)') INLINE
WRITE(73,'(A85)') INLINE
C
READ (53,3645) NDSETGE1,NP1,DTE1,NSTEMP1,ITEMPE1
READ (63,3645) NDSETGE2,NP2,DTE2,NSTEMP2,ITEMPE2
C
IF (NDSETGE1.NE.NDSETGE2) THEN
print *, "NDSETGE1 not equal to NDSETGE2"
RETURN
ENDIF
C
IF (NP1.NE.NP2) THEN
print *, "NP1 not equal to NP2"
RETURN
ENDIF
C
IF (ABS(DTE1-DTE2).GT.1.0E-5) THEN
print *, "DTE1 not equal to DTE2"
RETURN
ENDIF
C
IF (NSTEMP1.NE.NSTEMP2) THEN
print *, "NSTEMP1 not equal to NSTEMP2"
RETURN
ENDIF
IF (ITEMPE1.NE.ITEMPE2) THEN
print *, "ITEMPE1 not equal to ITEMPE2"
RETURN
ENDIF
C
WRITE(73,3645) NDSETGE1,NP1,DTE1,NSTEMP1,ITEMPE1
C
DO J=1,NDSETGE1
C
READ(53,2120) TIMEOUTE1,ITE1
READ(63,2120) TIMEOUTE2,ITE2
C
IF (ABS(TIMEOUTE1-TIMEOUTE2).GT.1.0E-5) THEN
print *, "TIMEOUTE1 not equal to TIMEOUTE2"
RETURN
ENDIF
C
IF (ITE1.NE.ITE2) THEN
print *, "ITE1 not equal to ITE2"
RETURN
ENDIF
C
WRITE(73,2120) TIMEOUTE1,ITE1
C
DO I=1, NNODG
READ(53,*) IDUM,ETA1(I)
READ(63,*) IDUM,ETA2(I)
WRITE(73,2453) I,SCALEFAC*(ETA1(I)-ETA2(I))
ENDDO
C
ENDDO
GO TO 9999
C
2000 CONTINUE
C
C--Open Both Global Direct Access Binary fort.63 files
C
INQUIRE(FILE=FNAME1,EXIST=FOUND1)
INQUIRE(FILE=FNAME2,EXIST=FOUND2)
IF (FOUND1.AND.FOUND2) THEN
OPEN(53,FILE=FNAME1,ACCESS='DIRECT',RECL=NBYTE)
OPEN(63,FILE=FNAME2,ACCESS='DIRECT',RECL=NBYTE)
OPEN(73,FILE=FNAME3,ACCESS='DIRECT',RECL=NBYTE)
ELSE
print *, "No fort.63 files found"
RETURN
ENDIF
C
C--Read RUNDES RUNID and AGRID from 1st Global File
C
IREC1 = 0
IF (NBYTE.EQ.4) THEN
DO I=1,8
READ(53,REC=IREC1+I) RDES4(I)
WRITE(73,REC=IREC1+I) RDES4(I)
ENDDO
IREC1=IREC1+8
DO I=1,6
READ(53,REC=IREC1+I) RID4(I)
WRITE(73,REC=IREC1+I) RID4(I)
ENDDO
IREC1=IREC1+6
DO I=1,6
READ(53,REC=IREC1+I) AID4(I)
WRITE(73,REC=IREC1+I) AID4(I)
ENDDO
IREC1=IREC1+6
ENDIF
IF (NBYTE.EQ.8) THEN
DO I=1,4
READ(53,REC=IREC1+I) RDES8(I)
WRITE(73,REC=IREC1+I) RDES8(I)
ENDDO
IREC1=IREC1+4
DO I=1,3
READ(53,REC=IREC1+I) RID8(I)
WRITE(73,REC=IREC1+I) RID8(I)
ENDDO
IREC1=IREC1+3
DO I=1,3
READ(53,REC=IREC1+I) AID8(I)
WRITE(73,REC=IREC1+I) AID8(I)
ENDDO
IREC1=IREC1+3
ENDIF
C
C--Read RUNDES RUNID and AGRID from 2nd Global File
C
IREC2 = 0
IF (NBYTE.EQ.4) THEN
DO I=1,8
READ(63,REC=IREC2+I) RDES4(I)
ENDDO
IREC2=IREC2+8
DO I=1,6
READ(63,REC=IREC2+I) RID4(I)
ENDDO
IREC2=IREC2+6
DO I=1,6
READ(63,REC=IREC2+I) AID4(I)
ENDDO
IREC2=IREC2+6
ENDIF
IF (NBYTE.EQ.8) THEN
DO I=1,4
READ(63,REC=IREC2+I) RDES8(I)
ENDDO
IREC2=IREC2+4
DO I=1,3
READ(63,REC=IREC2+I) RID8(I)
ENDDO
IREC2=IREC2+3
DO I=1,3
READ(63,REC=IREC2+I) AID8(I)
ENDDO
IREC2=IREC2+3
C
ENDIF
C
C
C--Read NTRSPE, NSTAE, DT*NSPOOLE from both files
C and then close both files to flush file buffers
C
READ(53,REC=IREC1+1) NDSETGE1
WRITE(73,REC=IREC1+1) NDSETGE1
READ(53,REC=IREC1+2) NP1
WRITE(73,REC=IREC1+2) NP1
READ(53,REC=IREC1+3) DTE1
WRITE(73,REC=IREC1+3) DTE1
READ(53,REC=IREC1+4) NSTEMP1
WRITE(73,REC=IREC1+4) NSTEMP1
READ(53,REC=IREC1+5) ITEMPE1
WRITE(73,REC=IREC1+5) ITEMPE1
IREC1 = IREC1+5
C
READ(63,REC=IREC2+1) NDSETGE2
READ(63,REC=IREC2+2) NP2
READ(63,REC=IREC2+3) DTE2
READ(63,REC=IREC2+4) NSTEMP2
READ(63,REC=IREC2+5) ITEMPE2
IREC2 = IREC2+5
C
CLOSE(53) ! Flush File Buffer for file 1
CLOSE(63) ! Flush File buffer for file 2
CLOSE(73) ! Flush File buffer for file 3
OPEN(53,FILE=FNAME1,ACCESS='DIRECT',RECL=NBYTE)
OPEN(63,FILE=FNAME2,ACCESS='DIRECT',RECL=NBYTE)
OPEN(73,FILE=FNAME2,ACCESS='DIRECT',RECL=NBYTE)
C
DO J=1,NDSETGE1
C
READ(53,REC=IREC1+1) TIMEOUTE1
WRITE(73,REC=IREC1+1) TIMEOUTE1
READ(53,REC=IREC1+2) ITE1
WRITE(73,REC=IREC1+2) ITE1
IREC1 = IREC1+2
C
READ(63,REC=IREC2+1) TIMEOUTE2
READ(63,REC=IREC2+2) ITE2
IREC2 = IREC2+2
C
DO I=1, NNODG
READ(53,REC=IREC1+I) ETA1(I)
READ(63,REC=IREC2+I) ETA2(I)
WRITE(73,REC=IREC1+I) I,SCALEFAC*(ETA1(I)-ETA2(I))
ENDDO
IREC1 = IREC1 + NNODG
IREC2 = IREC2 + NNODG
C
ENDDO
C
C--Close both Global fort.63 Files
C
9999 CONTINUE
CLOSE(53)
CLOSE(63)
CLOSE(73)
C
80 FORMAT(A40)
2120 FORMAT(2X,E20.10,5X,I10)
2453 FORMAT(2X,I8,2X,E15.8)
3645 FORMAT(1X,I10,1X,I10,1X,E15.7,1X,I5,1X,I5)
C
RETURN
END SUBROUTINE DIFFMERGE63
SUBROUTINE DIFFMERGE64(DIR1,DIR2,SCALEFAC)
C
C---------------------------------------------------------------------------C
C ( Serial Version 3/15/99 ) C
C Create a Difference file from velocity data at all nodes from two C
C different directories. C
C This version is compatible with ADCIRC version 33.04 C
C C
C Input Parameters: C
C C
C DIR1 = pathname of first directory C
C DIR2 = pathname of second directory C
C SCALEFAC = user supplied scale factor for difference C
C C
C---------------------------------------------------------------------------C
C
USE POST_GLOBAL
INTEGER I,J,K,L,IPROC,IDUM
INTEGER NDSETGV1,NDSETGV2
INTEGER NSTEMP1,NSTEMP2
INTEGER ITV1,ITV2
INTEGER ITEMPV1,ITEMPV2
INTEGER NP1,NP2
INTEGER IREC1,IREC2
INTEGER LEN1,LEN2
REAL(SZ) DTV1,DTV2,SCALEFAC
REAL(8) TIMEOUTV1,TIMEOUTV2
CHARACTER*80 DIR1,DIR2,FNAME1,FNAME2,FNAME3
CHARACTER*85 INLINE
CHARACTER*4 RDES4(8),RID4(6),AID4(6)
CHARACTER*8 RDES8(8),RID8(6),AID8(6)
LOGICAL FOUND1,FOUND2
REAL(8),ALLOCATABLE :: UU1(:),VV1(:)
REAL(8),ALLOCATABLE :: UU2(:),VV2(:)
ALLOCATE ( UU1(MNP),VV1(MNP))
ALLOCATE ( UU2(MNP),VV2(MNP))
C
C--Construct File Names
C
DO I=1, LEN(DIR1)
IF (DIR1(I:I).EQ.' ') THEN
LEN1 = I-1
GO TO 100
ENDIF
ENDDO
100 CONTINUE
DO I=1, LEN(DIR2)
IF (DIR2(I:I).EQ.' ') THEN
LEN2 = I-1
GO TO 200
ENDIF
ENDDO
200 CONTINUE
C
FNAME1 = DIR1(1:LEN1)//'/fort.64'
FNAME2 = DIR2(1:LEN2)//'/fort.64'
FNAME3 = 'diffmerge.64'
C
C--Determine whether Unit 64 is Sequential Formatted or Direct Access Binary
C
IF (ABS(NOUTGV).EQ.1) THEN
GO TO 1000
ELSE
GO TO 2000
ENDIF
C
1000 CONTINUE
C
C--Open Both Global Sequential Formatted fort.64 files
C
INQUIRE(FILE=FNAME1,EXIST=FOUND1)
INQUIRE(FILE=FNAME2,EXIST=FOUND2)
IF (FOUND1.AND.FOUND2) THEN
OPEN(UNIT=54,FILE=FNAME1)
OPEN(UNIT=64,FILE=FNAME2)
OPEN(UNIT=74,FILE=FNAME3)
ELSE
print *, "No fort.64 files found"
RETURN
ENDIF
C
READ (54,'(A85)') INLINE
READ (64,'(A85)') INLINE
WRITE(74,'(A85)') INLINE
C
READ (54,3645) NDSETGV1,NP1,DTV1,NSTEMP1,ITEMPV1
READ (64,3645) NDSETGV2,NP2,DTV2,NSTEMP2,ITEMPV2
C
IF (NDSETGV1.NE.NDSETGV2) THEN
print *, "NDSETGV1 not equal to NDSETGV2"
RETURN
ENDIF
C
IF (NP1.NE.NP2) THEN
print *, "NP1 not equal to NP2"
RETURN
ENDIF
C
IF (ABS(DTV1-DTV2).GT.1.0E-5) THEN
print *, "DTV1 not equal to DTV2"
RETURN
ENDIF
C
IF (NSTEMP1.NE.NSTEMP2) THEN
print *, "NSTEMP1 not equal to NSTEMP2"
RETURN
ENDIF
IF (ITEMPV1.NE.ITEMPV2) THEN
print *, "ITEMPV1 not equal to ITEMPV2"
RETURN
ENDIF
C
WRITE(74,3645) NDSETGV1,NP1,DTV1,NSTEMP1,ITEMPV1
C
DO J=1,NDSETGV1
C
READ(54,2120) TIMEOUTV1,ITV1
READ(64,2120) TIMEOUTV2,ITV2
C
IF (ABS(TIMEOUTV1-TIMEOUTV2).GT.1.0E-5) THEN
print *, "TIMEOUTV1 not equal to TIMEOUTV2"
RETURN
ENDIF
C
IF (ITV1.NE.ITV2) THEN
print *, "ITV1 not equal to ITV2"
RETURN
ENDIF
C
WRITE(74,2120) TIMEOUTV1,ITV1
C
DO I=1, NNODG
READ(54,*) IDUM,UU1(I),VV1(I)
READ(64,*) IDUM,UU2(I),VV2(I)
WRITE(74,2454) I,SCALEFAC*(UU1(I)-UU2(I)),
& SCALEFAC*(VV1(I)-VV2(I))
ENDDO
C
ENDDO
GO TO 9999
C
2000 CONTINUE
C
C--Open Both Global Direct Access Binary fort.64 files
C
INQUIRE(FILE=FNAME1,EXIST=FOUND1)
INQUIRE(FILE=FNAME2,EXIST=FOUND2)
IF (FOUND1.AND.FOUND2) THEN
OPEN(54,FILE=FNAME1,ACCESS='DIRECT',RECL=NBYTE)
OPEN(64,FILE=FNAME2,ACCESS='DIRECT',RECL=NBYTE)
OPEN(74,FILE=FNAME3,ACCESS='DIRECT',RECL=NBYTE)
ELSE
print *, "No fort.64 files found"
RETURN
ENDIF
C
C--Read RUNDES RUNID and AGRID from 1st Global File
C
IREC1 = 0
IF (NBYTE.EQ.4) THEN
DO I=1,8
READ(54,REC=IREC1+I) RDES4(I)
WRITE(74,REC=IREC1+I) RDES4(I)
ENDDO
IREC1=IREC1+8
DO I=1,6
READ(54,REC=IREC1+I) RID4(I)
WRITE(74,REC=IREC1+I) RID4(I)
ENDDO
IREC1=IREC1+6
DO I=1,6
READ(54,REC=IREC1+I) AID4(I)
WRITE(74,REC=IREC1+I) AID4(I)
ENDDO
IREC1=IREC1+6
ENDIF
IF (NBYTE.EQ.8) THEN
DO I=1,4
READ(54,REC=IREC1+I) RDES8(I)
WRITE(74,REC=IREC1+I) RDES8(I)
ENDDO
IREC1=IREC1+4
DO I=1,3
READ(54,REC=IREC1+I) RID8(I)
WRITE(74,REC=IREC1+I) RID8(I)
ENDDO
IREC1=IREC1+3
DO I=1,3
READ(54,REC=IREC1+I) AID8(I)
WRITE(74,REC=IREC1+I) AID8(I)
ENDDO
IREC1=IREC1+3
ENDIF
C
C--Read RUNDES RUNID and AGRID from 2nd Global File
C
IREC2 = 0
IF (NBYTE.EQ.4) THEN
DO I=1,8
READ(64,REC=IREC2+I) RDES4(I)
ENDDO
IREC2=IREC2+8
DO I=1,6
READ(64,REC=IREC2+I) RID4(I)
ENDDO
IREC2=IREC2+6
DO I=1,6
READ(64,REC=IREC2+I) AID4(I)
ENDDO
IREC2=IREC2+6
ENDIF
IF (NBYTE.EQ.8) THEN
DO I=1,4
READ(64,REC=IREC2+I) RDES8(I)
ENDDO
IREC2=IREC2+4
DO I=1,3
READ(64,REC=IREC2+I) RID8(I)
ENDDO
IREC2=IREC2+3
DO I=1,3
READ(64,REC=IREC2+I) AID8(I)
ENDDO
IREC2=IREC2+3
ENDIF
C
C--Read NTRSPE, NSTAE, DT*NSPOOLE from both files
C and then close both files to flush file buffers
C
READ(54,REC=IREC1+1) NDSETGV1
WRITE(74,REC=IREC1+1) NDSETGV1
READ(54,REC=IREC1+2) NP1
WRITE(74,REC=IREC1+2) NP1
READ(54,REC=IREC1+3) DTV1
WRITE(74,REC=IREC1+3) DTV1
READ(54,REC=IREC1+4) NSTEMP1
WRITE(74,REC=IREC1+4) NSTEMP1
READ(54,REC=IREC1+5) ITEMPV1
WRITE(74,REC=IREC1+5) ITEMPV1
IREC1 = IREC1+5
C
READ(64,REC=IREC2+1) NDSETGV2
READ(64,REC=IREC2+2) NP2
READ(64,REC=IREC2+3) DTV2
READ(64,REC=IREC2+4) NSTEMP2
READ(64,REC=IREC2+5) ITEMPV2
IREC2 = IREC2+5
C
CLOSE(54) ! Flush File Buffer for file 1
CLOSE(64) ! Flush File buffer for file 2
CLOSE(74) ! Flush File buffer for file 3
OPEN(54,FILE=FNAME1,ACCESS='DIRECT',RECL=NBYTE)
OPEN(64,FILE=FNAME2,ACCESS='DIRECT',RECL=NBYTE)
OPEN(74,FILE=FNAME3,ACCESS='DIRECT',RECL=NBYTE)
C
DO J=1,NDSETGV1
C
READ(54,REC=IREC1+1) TIMEOUTV1
WRITE(74,REC=IREC1+1) TIMEOUTV1
READ(54,REC=IREC1+2) ITV1
WRITE(74,REC=IREC1+2) ITV1
IREC1 = IREC1+2
C
READ(64,REC=IREC2+1) TIMEOUTV2
READ(64,REC=IREC2+2) ITV2
IREC2 = IREC2+2
C
DO I=1, NNODG
READ(54,REC=IREC1+2*I-1) UU1(I)
READ(54,REC=IREC1+2*I) VV1(I)
READ(64,REC=IREC2+2*I-1) UU2(I)
READ(64,REC=IREC2+2*I) VV2(I)
WRITE(74,REC=IREC1+2*I-1) SCALEFAC*(UU1(I)-UU2(I))
WRITE(74,REC=IREC1+2*I) SCALEFAC*(VV1(I)-VV2(I))
ENDDO
IREC1 = IREC1 + 2*NNODG
IREC2 = IREC2 + 2*NNODG
C
ENDDO
C
C--Close both Global fort.64 Files and Differences Log file
C
9999 CONTINUE
CLOSE(54)
CLOSE(64)
CLOSE(74)
C
80 FORMAT(A40)
2120 FORMAT(2X,E20.10,5X,I10)
2454 FORMAT(2X,I8,2(2X,E15.8))
3645 FORMAT(1X,I10,1X,I10,1X,E15.7,1X,I5,1X,I5)
C
RETURN
END SUBROUTINE DIFFMERGE64