Coverage Report: angleMod.f90

Generated from GCOV analysis of Fortran source code

40.5%
Lines Executed
74 total lines
58.1%
Branches Executed
86 total branches
100.0%
Calls Executed
35 total calls
0
-
Source:angleMod.f90
0
-
Graph:angleMod.gcno
0
-
Data:angleMod.gcda
0
-
Runs:73
1
-
!! Angle calculations and coordinate transformations for ray tracing
2
-
3
-
MODULE anglemod
4
-
!! Provides angle calculations and coordinate transformations
5
-
6
-
USE MathConstants
7
-
USE SubTabulate
8
-
USE SourceReceiverPositions
9
-
USE SortMod
10
-
USE FatalError
11
-
12
-
IMPLICIT NONE
13
-
PUBLIC
14
-
SAVE
15
-
16
-
INTEGER :: ialpha, ibeta
17
-
INTEGER, PRIVATE :: AllocateStatus
18
-
INTEGER, PRIVATE, PARAMETER :: ENVFile = 5, PRTFile = 6
19
-
REAL (KIND=8), PRIVATE, PARAMETER :: c0 = 1500.0
20
-
21
-
TYPE AnglesStructure
22
-
INTEGER :: Nalpha = 0, Nbeta = 1, iSingle_alpha = 0, iSingle_beta = 0
23
-
REAL (KIND=8) :: Dalpha, Dbeta
24
-
REAL (KIND=8), ALLOCATABLE:: alpha( : ), beta( : )
25
-
END TYPE AnglesStructure
26
-
27
-
Type( AnglesStructure ) :: Angles
28
-
29
-
CONTAINS
30
71*
SUBROUTINE ReadRayElevationAngles( freq, Depth, TopOpt, RunType )
31
-
32
-
REAL (KIND=8), INTENT( IN ) :: freq, Depth
33
-
CHARACTER (LEN= 6), INTENT( IN ) :: TopOpt, RunType
34
-
REAL (KIND=8) :: d_theta_recommended
35
-
36
71
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
37
1
READ( ENVFile, * ) Angles%Nalpha, Angles%iSingle_alpha ! option to trace a single beam
38
-
ELSE
39
70
READ( ENVFile, * ) Angles%Nalpha
40
-
END IF
41
-
42
71
IF ( Angles%Nalpha == 0 ) THEN ! automatically estimate Nalpha to use
43
58
IF ( RunType( 1 : 1 ) == 'R' ) THEN
44
5
Angles%Nalpha = 50 ! For a ray trace plot, we don't want too many rays ...
45
-
ELSE
46
-
! you're letting ME choose? OK: ideas based on an isospeed ocean
47
-
! limit based on phase of adjacent beams at maximum range
48
53*
Angles%Nalpha = MAX( INT( ( ( 0.3 * Pos%Rr( Pos%NRr ) ) * freq ) / c0 ), 300 )
49
-
50
-
! limit based on having beams that are thin with respect to the water depth
51
-
! assumes also a full 360 degree angular spread of rays
52
-
! Should check which Depth is used here, in case where there is a variable bathymetry
53
53*
d_theta_recommended = ATAN( Depth / ( 10.0 * Pos%Rr( Pos%NRr ) ) )
54
53
Angles%Nalpha = MAX( INT( pi / d_theta_recommended ), Angles%Nalpha )
55
-
END IF
56
-
END IF
57
-
58
71*
ALLOCATE( Angles%alpha( MAX( 3, Angles%Nalpha ) ), STAT = AllocateStatus )
59
71*
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayElevationAngles', 'Insufficient memory to store beam angles' )
60
-
61
71*
IF ( Angles%Nalpha > 2 ) Angles%alpha( 3 ) = -999.9
62
71
READ( ENVFile, * ) Angles%alpha
63
-
64
71*
CALL SubTab( Angles%alpha, Angles%Nalpha )
65
71
CALL Sort( Angles%alpha, Angles%Nalpha )
66
-
67
-
! full 360-degree sweep? remove duplicate beam
68
-
! LP: Changed from TINY( ), see README.md.
69
71
IF ( Angles%Nalpha > 1 .AND. &
70
71*
ABS( MOD( Angles%alpha( Angles%Nalpha ) - Angles%alpha( 1 ), 360.0D0 ) ) &
71
-
< 10.0 * SPACING( 360.0D0 ) ) THEN
72
3
Angles%Nalpha = Angles%Nalpha - 1
73
-
END IF
74
-
75
71
WRITE( PRTFile, * ) '__________________________________________________________________________'
76
71
WRITE( PRTFile, * )
77
71
WRITE( PRTFile, * ) ' Number of beams in elevation = ', Angles%Nalpha
78
71
IF ( Angles%iSingle_alpha > 0 ) WRITE( PRTFile, * ) 'Trace only beam number ', Angles%iSingle_alpha
79
71
WRITE( PRTFile, * ) ' Beam take-off angles (degrees)'
80
-
81
71*
IF ( Angles%Nalpha >= 1 ) WRITE( PRTFile, "( 5G14.6 )" ) Angles%alpha( 1 : MIN( Angles%Nalpha, Number_to_Echo ) )
82
71*
IF ( Angles%Nalpha > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', Angles%alpha( Angles%Nalpha )
83
-
84
71*
IF ( Angles%Nalpha > 1 .AND. Angles%alpha( Angles%Nalpha ) == Angles%alpha( 1 ) ) THEN
85
#####
CALL ERROUT( 'ReadRayElevationAngles', 'First and last beam take-off angle are identical' )
86
-
END IF
87
-
88
71
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
89
1
IF ( Angles%iSingle_alpha < 1 .OR. Angles%iSingle_alpha > Angles%Nalpha ) THEN
90
#####
CALL ERROUT( 'ReadRayElevationAngles', 'Selected beam, iSingle_alpha not in [ 1, Angles%Nalpha ]' )
91
-
END IF
92
-
END IF
93
-
94
71
END SUBROUTINE ReadRayElevationAngles
95
-
96
-
! **********************************************************************!
97
-
98
#####
SUBROUTINE ReadRayBearingAngles( freq, TopOpt, RunType )
99
-
100
-
REAL (KIND=8), INTENT( IN ) :: freq
101
-
CHARACTER (LEN= 6), INTENT( IN ) :: TopOpt, RunType
102
-
103
#####
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
104
#####
READ( ENVFile, * ) Angles%Nbeta, Angles%iSingle_beta ! option to trace a single beam
105
-
ELSE
106
#####
READ( ENVFile, * ) Angles%Nbeta
107
-
END IF
108
-
109
#####
IF ( Angles%Nbeta == 0 ) THEN ! automatically estimate Nbeta to use
110
#####
IF ( RunType( 1 : 1 ) == 'R' ) THEN
111
#####
Angles%Nbeta = 50 ! For a ray trace plot, we don't want too many rays ...
112
-
ELSE
113
#####
Angles%Nbeta = MAX( INT( ( ( 0.1 * Pos%rr( Pos%NRr ) ) * freq ) / c0 ), 300 )
114
-
END IF
115
-
END IF
116
-
117
#####
ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
118
#####
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles' )
119
-
120
#####
IF ( Angles%Nbeta > 2 ) Angles%beta( 3 ) = -999.9
121
#####
READ( ENVFile, * ) Angles%beta
122
-
123
#####
CALL SubTab( Angles%beta, Angles%Nbeta )
124
#####
CALL Sort( Angles%beta, Angles%Nbeta )
125
-
126
-
! full 360-degree sweep? remove duplicate beam
127
-
! LP: Changed from TINY( ), see README.md.
128
#####
IF ( Angles%Nbeta > 1 .AND. ABS( MOD( Angles%beta( Angles%Nbeta ) - Angles%beta( 1 ), &
129
-
360.0D0 ) ) < 10.0 * SPACING( 360.0D0 ) ) THEN
130
#####
Angles%Nbeta = Angles%Nbeta - 1
131
-
END IF
132
-
133
-
! Nx2D CASE: beams must lie on rcvr radials--- replace beta with theta
134
#####
IF ( RunType( 6 : 6 ) == '2' .AND. RunType( 1 : 1 ) /= 'R' ) THEN
135
#####
WRITE( PRTFile, * )
136
#####
WRITE( PRTFile, * ) 'Replacing beam take-off angles, beta, with receiver bearing lines, theta'
137
#####
DEALLOCATE( Angles%beta )
138
-
139
#####
Angles%Nbeta = Pos%Ntheta
140
#####
ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
141
#####
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles' )
142
#####
Angles%beta( 1 : Angles%Nbeta ) = Pos%theta( 1 : Pos%Ntheta ) ! Nbeta should = Ntheta
143
-
END IF
144
-
145
#####
WRITE( PRTFile, * )
146
#####
WRITE( PRTFile, * ) ' Number of beams in bearing = ', Angles%Nbeta
147
#####
IF ( Angles%iSingle_beta > 0 ) WRITE( PRTFile, * ) 'Trace only beam number ', Angles%iSingle_beta
148
#####
WRITE( PRTFile, * ) ' Beam take-off angles (degrees)'
149
-
150
#####
IF ( Angles%Nbeta >= 1 ) WRITE( PRTFile, "( 5G14.6 )" ) Angles%beta( 1 : MIN( Angles%Nbeta, Number_to_Echo ) )
151
#####
IF ( Angles%Nbeta > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', Angles%beta( Angles%Nbeta )
152
-
153
#####
IF ( Angles%Nbeta > 1 .AND. Angles%beta( Angles%Nbeta ) == Angles%beta( 1 ) ) THEN
154
#####
CALL ERROUT( 'ReadRayBearingAngles', 'First and last beam take-off angle are identical' )
155
-
END IF
156
-
157
#####
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
158
#####
IF ( Angles%iSingle_beta < 1 .OR. Angles%iSingle_beta > Angles%Nbeta ) THEN
159
#####
CALL ERROUT( 'ReadRayBearingAngles', 'Selected beam, iSingle_beta not in [ 1, Angles%Nbeta ]' )
160
-
END IF
161
-
END IF
162
#####
Angles%beta = DegRad * Angles%beta ! convert to radians
163
-
164
#####
Angles%Dbeta = 0.0
165
#####
IF ( Angles%Nbeta /= 1 ) Angles%Dbeta = ( Angles%beta( Angles%NBeta ) - Angles%beta( 1 ) ) / ( Angles%Nbeta - 1 )
166
-
167
#####
END SUBROUTINE ReadRayBearingAngles
168
-
169
#####
END MODULE anglemod
169
#####
END MODULE anglemod
169
#####
END MODULE anglemod

Legend:

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