Coverage Report: RWSHDFile.f90

Generated from GCOV analysis of Fortran source code

27.9%
Lines Executed
61 total lines
50.0%
Branches Executed
66 total branches
100.0%
Calls Executed
40 total calls
0
-
Source:RWSHDFile.f90
0
-
Graph:RWSHDFile.gcno
0
-
Data:RWSHDFile.gcda
0
-
Runs:29
1
-
!! Routines for reading and writing shade file (SHDFile)
2
-
MODULE RWSHDFile
3
-
!! Shade file I/O operations including binary format handling for acoustic field data
4
-
5
-
USE SourceReceiverPositions
6
-
USE FatalError
7
-
8
-
IMPLICIT NONE
9
-
PUBLIC
10
-
11
-
INTEGER, PARAMETER, PRIVATE :: SHDFile = 25
12
-
INTEGER :: LRecl
13
-
14
-
! variables taken from SourceReceiverPositions:
15
-
! freqVec vector of frequencies
16
-
! theta vector of bearing lines, theta( 1 : Ntheta )
17
-
! Sz vector of source depths, Sz( 1 : NSz )
18
-
! Rz vector of receiver depths, Rz( 1 : NRz )
19
-
! Rr vector of receiver ranges, Rr( 1 : NRr )
20
-
21
-
CONTAINS
22
#####
SUBROUTINE ReadHeader( FileName, Title, atten, PlotType )
23
-
24
-
! Read header from disk file
25
-
! This is not used anywhere in the Fortran code for the Acoustics Toolbox, since Matlab is used to process SHDFiles
26
-
27
-
! FileName is a SHDFIL for complex pressure or a GRNFIL for a Green's function
28
-
! Title arbitrary title
29
-
30
-
INTEGER, PARAMETER :: PRTFile = 6
31
-
REAL, INTENT( OUT ) :: atten ! stabilizing attenuation for SCOOTER FFP runs
32
-
CHARACTER (LEN=80), INTENT( OUT ) :: Title, FileName
33
-
CHARACTER (LEN=10), INTENT( OUT ) :: PlotType
34
-
INTEGER :: IAllocStat, IOStat
35
-
36
-
! Open file, read header
37
#####
IF ( FileName( 1 : 1 ) == ' ' ) FileName = 'SHDFIL'
38
-
39
-
! INQUIRE( FILE = FileName, RECL = IRECL )
40
-
OPEN( UNIT = SHDFile, FILE = FileName, STATUS = 'OLD', ACCESS = 'DIRECT', FORM = 'UNFORMATTED', RECL = 4, &
41
#####
IOSTAT = IOStaT, ACTION = 'READ' )
42
#####
IF ( IOStat /= 0 ) CALL ERROUT( 'ReadHeader', 'Unable to open shade file' )
43
-
44
#####
READ( SHDFile, REC = 1 ) LRecl
45
#####
CLOSE( UNIT = SHDFile )
46
#####
OPEN( UNIT = SHDFile, FILE = FileName, STATUS = 'OLD', ACCESS = 'DIRECT', FORM = 'UNFORMATTED', RECL = 4 * LRecl )
47
-
48
#####
READ( SHDFile, REC = 1 ) LRecl, Title
49
#####
READ( SHDFile, REC = 2 ) PlotType
50
#####
READ( SHDFile, REC = 3 ) Nfreq, Pos%Ntheta, Pos%NSx, Pos%NSy, Pos%NSz, Pos%NRz, Pos%NRr, atten
51
-
52
-
ALLOCATE( freqVec( Nfreq ), Pos%Sz( Pos%NSz ), Pos%Rz( Pos%NRz ), Pos%Rr( Pos%NRr ), &
53
#####
& Pos%theta( Pos%Ntheta ), Stat = IAllocStat )
54
#####
IF ( IAllocStat /= 0 ) CALL ERROUT( 'ReadHeader', 'Too many source/receiver combinations' )
55
-
56
#####
READ( SHDFile, REC = 4 ) freqVec
57
#####
READ( SHDFile, REC = 5 ) Pos%theta
58
#####
READ( SHDFile, REC = 6 ) Pos%Sx
59
#####
READ( SHDFile, REC = 7 ) Pos%Sy
60
#####
READ( SHDFile, REC = 8 ) Pos%Sz
61
#####
READ( SHDFile, REC = 9 ) Pos%Rz
62
#####
READ( SHDFile, REC = 10 ) Pos%Rr
63
-
64
-
! Pos%deltaR = Pos%r( Pos%NRr ) - Pos%r( Pos%NRr - 1 )
65
-
66
#####
END SUBROUTINE ReadHeader
67
-
68
-
! **********************************************************************!
69
-
70
#####
SUBROUTINE WriteHeader( FileName, Title, freq0, atten, PlotType )
71
-
72
-
! Write header to disk file
73
-
74
-
REAL, INTENT( IN ) :: freq0, atten ! Nominal frequency, stabilizing attenuation (for wavenumber integration only)
75
-
CHARACTER, INTENT( IN ) :: FileName*( * ) ! Name of the file (could be a shade file or a Green's function file)
76
-
CHARACTER, INTENT( IN ) :: Title*( * ) ! Arbitrary title
77
-
CHARACTER(LEN=10), INTENT(IN) :: PlotType ! If 'TL', writes only first and last Sx and Sy
78
-
79
-
! receiver bearing angles
80
4
IF ( .NOT. ALLOCATED( Pos%theta ) ) THEN
81
#####
ALLOCATE( Pos%theta( 1 ) )
82
#####
Pos%theta( 1 ) = 0 ! dummy bearing angle
83
-
END IF
84
-
85
-
! source x-coordinates
86
4
IF ( .NOT. ALLOCATED( Pos%Sx ) ) THEN
87
#####
ALLOCATE( Pos%Sx( 1 ) )
88
#####
Pos%sx( 1 ) = 0 ! dummy x-coordinate
89
-
END IF
90
-
91
-
! source y-coordinates
92
4
IF ( .NOT. ALLOCATED( Pos%Sy ) ) THEN
93
#####
ALLOCATE( Pos%Sy( 1 ) )
94
#####
Pos%sy( 1 ) = 0 ! dummy y-coordinate
95
-
END IF
96
-
97
4
IF ( PlotType( 1 : 2 ) /= 'TL' ) THEN
98
-
! MAX( 41, ... ) below because Title is already 40 words (or 80 bytes)
99
4
LRecl = MAX( 41, 2 * Nfreq, Pos%Ntheta, Pos%NSx, Pos%NSy, Pos%NSz, Pos%NRz, 2 * Pos%NRr ) ! words/record (NRr doubled for complex pressure storage)
100
-
101
4
OPEN ( FILE = FileName, UNIT = SHDFile, STATUS = 'REPLACE', ACCESS = 'DIRECT', RECL = 4 * LRecl, FORM = 'UNFORMATTED')
102
4
WRITE( SHDFile, REC = 1 ) LRecl, Title( 1 : 80 )
103
4
WRITE( SHDFile, REC = 2 ) PlotType
104
4
WRITE( SHDFile, REC = 3 ) Nfreq, Pos%Ntheta, Pos%NSx, Pos%NSy, Pos%NSz, Pos%NRz, Pos%NRr, freq0, atten
105
4*
WRITE( SHDFile, REC = 4 ) freqVec( 1 : Nfreq )
106
4*
WRITE( SHDFile, REC = 5 ) Pos%theta( 1 : Pos%Ntheta )
107
-
108
4*
WRITE( SHDFile, REC = 6 ) Pos%Sx( 1 : Pos%NSx )
109
4*
WRITE( SHDFile, REC = 7 ) Pos%Sy( 1 : Pos%NSy )
110
4*
WRITE( SHDFile, REC = 8 ) Pos%Sz( 1 : Pos%NSz )
111
-
112
4*
WRITE( SHDFile, REC = 9 ) Pos%Rz( 1 : Pos%NRz )
113
4*
WRITE( SHDFile, REC = 10 ) Pos%Rr( 1 : Pos%NRr )
114
-
115
-
ELSE ! compressed format for TL from FIELD3D
116
#####
LRecl = MAX( 41, 2 * Nfreq, Pos%Ntheta, Pos%NSz, Pos%NRz, 2 * Pos%NRr ) ! words/record (NR doubled for complex pressure storage)
117
-
118
#####
OPEN ( FILE = FileName, UNIT = SHDFile, STATUS = 'REPLACE', ACCESS = 'DIRECT', RECL = 4 * LRecl, FORM = 'UNFORMATTED')
119
#####
WRITE( SHDFile, REC = 1 ) LRecl, Title( 1 : 80 )
120
#####
WRITE( SHDFile, REC = 2 ) PlotType
121
#####
WRITE( SHDFile, REC = 3 ) Nfreq, Pos%Ntheta, Pos%NSx, Pos%NSy, Pos%NSz, Pos%NRz, Pos%NRr, freq0, atten
122
#####
WRITE( SHDFile, REC = 4 ) freqVec( 1 : Nfreq )
123
#####
WRITE( SHDFile, REC = 5 ) Pos%theta( 1 : Pos%Ntheta )
124
-
125
#####
WRITE( SHDFile, REC = 6 ) Pos%Sx( 1 ), Pos%Sx( Pos%NSx )
126
#####
WRITE( SHDFile, REC = 7 ) Pos%Sy( 1 ), Pos%Sy( Pos%NSy )
127
#####
WRITE( SHDFile, REC = 8 ) Pos%Sz( 1 : Pos%NSz )
128
-
129
#####
WRITE( SHDFile, REC = 9 ) Pos%Rz( 1 : Pos%NRz )
130
#####
WRITE( SHDFile, REC = 10 ) Pos%Rr( 1 : Pos%NRr )
131
-
END IF
132
-
133
4
END SUBROUTINE WriteHeader
134
-
135
-
! **********************************************************************!
136
-
137
#####
SUBROUTINE WriteField( P, NRz, NRr, IRec )
138
-
139
-
! Write the field to disk
140
-
141
-
INTEGER, INTENT( IN ) :: NRz, NRr ! Number of receiver depths, ranges
142
-
COMPLEX, INTENT( IN ) :: P( NRz, NRr ) ! Pressure field
143
-
INTEGER, INTENT( INOUT ) :: iRec ! last record read
144
-
INTEGER :: iRz
145
-
146
#####
DO iRz = 1, NRz
147
#####
iRec = iRec + 1
148
#####
WRITE( SHDFile, REC = iRec ) P( iRz, : )
149
-
END DO
150
-
151
#####
END SUBROUTINE WriteField
152
-
153
-
END MODULE RWSHDFile

Legend:

Execution Count: Number of times each line was executed. ##### indicates never executed, - indicates non-executable.