-
Notifications
You must be signed in to change notification settings - Fork 2
/
write_rec.f
128 lines (123 loc) · 4.67 KB
/
write_rec.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
c=======================================================================
subroutine write_rec(ou, fmt_vers, nobs, itime, sec, msec, flag,
+ numsat, prn, char, clockerr, obs, lli, snr,
+ eventrecs)
c=======================================================================
c
c ... Write a record to a RINEX file, either RINEX version 1 or 2.
c
implicit none
c
integer ou, nobs, itime(5), prn(99), numsat, flag, sec,
+ msec, fmt_vers
character*80 outline, outline2, eventrecs(64), dynfmt, dynfmt2
character*80 dynfmt3
character*1 char(99), lli(18,99), snr(18,99)
real*8 obs(18,99), clockerr
integer i, i1, i2, itrack, j
c
c
outline = ' '
outline2 = ' '
c write(outline(1:32), fmt='(5I3,X,I2,''.'',I3.3,4X,2I3)')
write(outline(1:32), fmt='(5I3,X,I2,''.'',I7.7,2I3)')
+ (itime(i), i=1,5), sec, msec, flag, numsat
c Nacho08 - if numsat is above 12 need to write two lines
if (((numsat-1)/12).eq.1) then
write(outline2(1:32), fmt='(32X)')
endif
c
c ... Write the satellite ID numbers if this is a normal
c observation record, a record indicating a power
c failure since the previous epoch, or a cycle slip
c record.
c
c Nacho08 - if numsat is above 12 need to write two lines
do j=0,((numsat-1)/12)
if (flag.le.1 .or. flag.eq.6) then
do itrack = 1, 12
i1 = 33 + 3*(itrack-1)
i2 = 32 + 3*itrack
if ((itrack+(j*12)).le.numsat) then
if (j.eq.0) write(outline(i1:i2), fmt='(A1,I2)')
+ char(itrack+(j*12)),prn(itrack+(j*12))
if (j.eq.1) write(outline2(i1:i2), fmt='(A1,I2)')
+ char(itrack+(j*12)),prn(itrack+(j*12))
else
if (j.eq.0) write(outline(i1:i2), fmt='(A3)') ' '
if (j.eq.1) write(outline2(i1:i2), fmt='(A3)') ' '
endif
enddo
endif
enddo
c
c fix fmt error: 12.7 should be 12.9 ... JimR 30Apr99
if (fmt_vers.gt.1 .and. clockerr.ne.0.d0) then
write(outline(69:80), fmt='(F12.9)') clockerr
c Nacho08 - if numsat is above 12 need to write two lines
if (((numsat-1)/12).eq.1)
+ write(outline2(69:80), fmt='(F12.9)') clockerr
endif
call writeline(ou, outline, 80)
c Nacho08 - if numsat is above 12 need to write two lines
if (((numsat-1)/12).eq.1) call writeline(ou, outline2, 80)
c
if (flag .le. 1) then
c
c ... Write a normal observation record
c
do itrack = 1, numsat
if (nobs .le. 5) then
outline = ' '
write(dynfmt, fmt='(A, I3.3, A)')
+ "(", nobs, "(F14.3, 2A1))"
write(outline, fmt=dynfmt)
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=1,nobs)
call writeline(ou, outline, 80)
elseif (nobs .le. 10) then
c write first line of obs
outline = ' '
write(outline, fmt='( 5(F14.3, 2A1) )')
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=1,5)
call writeline(ou, outline, 80)
c write second line of obs
outline = ' '
write(dynfmt2, fmt='(A, I3.3, A)')
+ "(", nobs-5, "(F14.3, 2A1))"
write(outline, fmt=dynfmt2)
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=6,nobs)
call writeline(ou, outline, 80)
elseif (nobs .le. 15) then
c write first line of obs
outline = ' '
write(outline, fmt='( 5(F14.3, 2A1) )')
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=1,5)
call writeline(ou, outline, 80)
c write second line of obs
outline = ' '
write(dynfmt2, fmt='(A, I3.3, A)')
+ "(", nobs-5, "(F14.3, 2A1))"
write(outline, fmt=dynfmt2)
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=6,10)
call writeline(ou, outline, 80)
c write third line of obs
outline = ' '
write(dynfmt3, fmt='(A, I3.3, A)')
+ "(", nobs-10, "(F14.3, 2A1))"
write(outline, fmt=dynfmt3)
+ (obs(i,itrack),lli(i,itrack),snr(i,itrack), i=11,nobs)
call writeline(ou, outline, 80)
endif
enddo
else
c
c ... Write the (uninterpreted) event records
c
do itrack = 1, numsat
call writeline(ou, eventrecs(itrack), 80)
enddo
endif
c
return
end
c