Coverage Report: angleMod.f90

Generated from GCOV analysis of Fortran source code

35.6%
Lines Executed
73 total lines
52.4%
Branches Executed
84 total branches
100.0%
Calls Executed
27 total calls
0
-
Source:angleMod.f90
0
-
Graph:angleMod.gcno
0
-
Data:angleMod.gcda
0
-
Runs:29
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
14*
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
14
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
37
#####
READ( ENVFile, * ) Angles%Nalpha, Angles%iSingle_alpha ! option to trace a single beam
38
-
ELSE
39
14
READ( ENVFile, * ) Angles%Nalpha
40
-
END IF
41
-
42
14
IF ( Angles%Nalpha == 0 ) THEN ! automatically estimate Nalpha to use
43
13
IF ( RunType( 1 : 1 ) == 'R' ) THEN
44
1
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
12*
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
12*
d_theta_recommended = ATAN( Depth / ( 10.0 * Pos%Rr( Pos%NRr ) ) )
54
12
Angles%Nalpha = MAX( INT( pi / d_theta_recommended ), Angles%Nalpha )
55
-
END IF
56
-
END IF
57
-
58
14*
ALLOCATE( Angles%alpha( MAX( 3, Angles%Nalpha ) ), STAT = AllocateStatus )
59
14*
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayElevationAngles', 'Insufficient memory to store beam angles' )
60
-
61
14*
IF ( Angles%Nalpha > 2 ) Angles%alpha( 3 ) = -999.9
62
14
READ( ENVFile, * ) Angles%alpha
63
-
64
14*
CALL SubTab( Angles%alpha, Angles%Nalpha )
65
14
CALL Sort( Angles%alpha, Angles%Nalpha )
66
-
67
-
! full 360-degree sweep? remove duplicate beam
68
-
! LP: Changed from TINY( ), see README.md.
69
14*
IF ( Angles%Nalpha > 1 .AND. ABS( MOD( Angles%alpha( Angles%Nalpha ) - Angles%alpha( 1 ), &
70
-
360.0D0 ) ) < 10.0 * SPACING( 360.0D0 ) ) &
71
#####
Angles%Nalpha = Angles%Nalpha - 1
72
-
73
14
WRITE( PRTFile, * ) '__________________________________________________________________________'
74
14
WRITE( PRTFile, * )
75
14
WRITE( PRTFile, * ) ' Number of beams in elevation = ', Angles%Nalpha
76
14*
IF ( Angles%iSingle_alpha > 0 ) WRITE( PRTFile, * ) 'Trace only beam number ', Angles%iSingle_alpha
77
14
WRITE( PRTFile, * ) ' Beam take-off angles (degrees)'
78
-
79
14*
IF ( Angles%Nalpha >= 1 ) WRITE( PRTFile, "( 5G14.6 )" ) Angles%alpha( 1 : MIN( Angles%Nalpha, Number_to_Echo ) )
80
14*
IF ( Angles%Nalpha > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', Angles%alpha( Angles%Nalpha )
81
-
82
14*
IF ( Angles%Nalpha > 1 .AND. Angles%alpha( Angles%Nalpha ) == Angles%alpha( 1 ) ) &
83
#####
CALL ERROUT( 'ReadRayElevationAngles', 'First and last beam take-off angle are identical' )
84
-
85
14
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
86
#####
IF ( Angles%iSingle_alpha < 1 .OR. Angles%iSingle_alpha > Angles%Nalpha ) &
87
#####
CALL ERROUT( 'ReadRayElevationAngles', 'Selected beam, iSingle_alpha not in [ 1, Angles%Nalpha ]' )
88
-
END IF
89
-
90
14
END SUBROUTINE ReadRayElevationAngles
91
-
92
-
! **********************************************************************!
93
-
94
#####
SUBROUTINE ReadRayBearingAngles( freq, TopOpt, RunType )
95
-
96
-
REAL (KIND=8), INTENT( IN ) :: freq
97
-
CHARACTER (LEN= 6), INTENT( IN ) :: TopOpt, RunType
98
-
99
#####
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
100
#####
READ( ENVFile, * ) Angles%Nbeta, Angles%iSingle_beta ! option to trace a single beam
101
-
ELSE
102
#####
READ( ENVFile, * ) Angles%Nbeta
103
-
END IF
104
-
105
#####
IF ( Angles%Nbeta == 0 ) THEN ! automatically estimate Nbeta to use
106
#####
IF ( RunType( 1 : 1 ) == 'R' ) THEN
107
#####
Angles%Nbeta = 50 ! For a ray trace plot, we don't want too many rays ...
108
-
ELSE
109
#####
Angles%Nbeta = MAX( INT( ( ( 0.1 * Pos%rr( Pos%NRr ) ) * freq ) / c0 ), 300 )
110
-
END IF
111
-
END IF
112
-
113
#####
ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
114
#####
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles' )
115
-
116
#####
IF ( Angles%Nbeta > 2 ) Angles%beta( 3 ) = -999.9
117
#####
READ( ENVFile, * ) Angles%beta
118
-
119
#####
CALL SubTab( Angles%beta, Angles%Nbeta )
120
#####
CALL Sort( Angles%beta, Angles%Nbeta )
121
-
122
-
! full 360-degree sweep? remove duplicate beam
123
-
! LP: Changed from TINY( ), see README.md.
124
#####
IF ( Angles%Nbeta > 1 .AND. ABS( MOD( Angles%beta( Angles%Nbeta ) - Angles%beta( 1 ), &
125
-
360.0D0 ) ) < 10.0 * SPACING( 360.0D0 ) ) &
126
#####
Angles%Nbeta = Angles%Nbeta - 1
127
-
128
-
! Nx2D CASE: beams must lie on rcvr radials--- replace beta with theta
129
#####
IF ( RunType( 6 : 6 ) == '2' .AND. RunType( 1 : 1 ) /= 'R' ) THEN
130
#####
WRITE( PRTFile, * )
131
#####
WRITE( PRTFile, * ) 'Replacing beam take-off angles, beta, with receiver bearing lines, theta'
132
#####
DEALLOCATE( Angles%beta )
133
-
134
#####
Angles%Nbeta = Pos%Ntheta
135
#####
ALLOCATE( Angles%beta( MAX( 3, Angles%Nbeta ) ), STAT = AllocateStatus )
136
#####
IF ( AllocateStatus /= 0 ) CALL ERROUT( 'ReadRayBearingAngles', 'Insufficient memory to store beam angles' )
137
#####
Angles%beta( 1 : Angles%Nbeta ) = Pos%theta( 1 : Pos%Ntheta ) ! Nbeta should = Ntheta
138
-
END IF
139
-
140
#####
WRITE( PRTFile, * )
141
#####
WRITE( PRTFile, * ) ' Number of beams in bearing = ', Angles%Nbeta
142
#####
IF ( Angles%iSingle_beta > 0 ) WRITE( PRTFile, * ) 'Trace only beam number ', Angles%iSingle_beta
143
#####
WRITE( PRTFile, * ) ' Beam take-off angles (degrees)'
144
-
145
#####
IF ( Angles%Nbeta >= 1 ) WRITE( PRTFile, "( 5G14.6 )" ) Angles%beta( 1 : MIN( Angles%Nbeta, Number_to_Echo ) )
146
#####
IF ( Angles%Nbeta > Number_to_Echo ) WRITE( PRTFile, "( G14.6 )" ) ' ... ', Angles%beta( Angles%Nbeta )
147
-
148
#####
IF ( Angles%Nbeta > 1 .AND. Angles%beta( Angles%Nbeta ) == Angles%beta( 1 ) ) &
149
#####
CALL ERROUT( 'ReadRayBearingAngles', 'First and last beam take-off angle are identical' )
150
-
151
#####
IF ( TopOpt( 6 : 6 ) == 'I' ) THEN
152
#####
IF ( Angles%iSingle_beta < 1 .OR. Angles%iSingle_beta > Angles%Nbeta ) &
153
#####
CALL ERROUT( 'ReadRayBearingAngles', 'Selected beam, iSingle_beta not in [ 1, Angles%Nbeta ]' )
154
-
END IF
155
#####
Angles%beta = DegRad * Angles%beta ! convert to radians
156
-
157
#####
Angles%Dbeta = 0.0
158
#####
IF ( Angles%Nbeta /= 1 ) Angles%Dbeta = ( Angles%beta( Angles%NBeta ) - Angles%beta( 1 ) ) / ( Angles%Nbeta - 1 )
159
-
160
#####
END SUBROUTINE ReadRayBearingAngles
161
-
162
#####
END MODULE anglemod
162
#####
END MODULE anglemod
162
#####
END MODULE anglemod

Legend:

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