da_scan_obs_radar.inc

References to this file elsewhere.
1 subroutine da_scan_obs_radar (iv, filename)
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Scan the radar observation file
5    !---------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (iv_type),    intent(inout) :: iv
10    character(len=*),  intent(in)    :: filename
11 
12    integer                       :: i, j, n, iost, nlevels, fm
13    integer                       :: file_radar
14    integer                       :: iunit
15 
16    type (radar_multi_level_type) :: platform
17 
18    character (LEN = 120)         :: char_file_radar
19    character (LEN = 120)         :: char_ned
20 
21    logical                       :: outside
22    integer                       :: n_dup, ndup
23 
24    if (trace_use) call da_trace_entry("da_scan_obs_radar")
25 
26    ! 1. open file
27    ! ============
28 
29    call da_get_unit(iunit)
30    open(unit   = iunit,     &
31         FILE   = trim(filename), &
32         FORM   = 'FORMATTED',  &
33         ACCESS = 'SEQUENTIAL', &
34         iostat =  iost,     &
35         STATUS = 'OLD')
36 
37    if (iost /= 0) then
38       ! Does not matter of radar file missing
39       call da_warning(__FILE__,__LINE__, &
40          (/"Cannot open radar file "//trim(filename)/))
41       call da_free_unit(iunit) 
42       if (trace_use) call da_trace_exit("da_scan_obs_radar")
43       return
44    end if
45 
46    ! 2. read total radar
47    ! ===================
48 
49    ! 2.1 read first line
50    !     ---------------
51 
52    read (unit=iunit, fmt = '(A)', iostat = iost) char_file_radar
53    if (iost /= 0) then
54       ! Does matter if present and unreadable
55       call da_error(__FILE__,__LINE__, &
56          (/"Cannot read radar file"/))
57    end if
58 
59    ! 2.3 total radar number
60 
61    read (unit=char_file_radar (15:17),fmt='(I3)', iostat = iost) file_radar
62 
63    ! 2.4 skip one lines
64 
65    read (unit=iunit, fmt = '(A)', iostat = iost)
66 
67    ! 3. read radar data
68 
69    do n = 1, file_radar
70 
71       ! 3.1 skip one blank line
72 
73       read (unit=iunit, fmt = '(A)', iostat = iost)
74 
75       ! 3.2 read header
76 
77       read (unit=iunit, fmt = '(A)', iostat = iost) char_ned
78 
79       ! 3.3 read header information
80 
81       read (unit=char_ned (69:74), fmt='(I6)', iostat = iost) platform % stn % numobs
82 
83       ! 3.4 skip two lines
84 
85       read (unit=iunit, fmt = '(A)', iostat = iost)
86       read (unit=iunit, fmt = '(A)', iostat = iost)
87 
88       ! 3.5 loop over records
89 
90       reports: do j = 1, platform % stn % numobs
91 
92          ! 3.5.1 read station general info
93 
94          read (unit = iunit, iostat = iost, &
95                       fmt = '(A12,3X,A19,2X,2(F12.3,2X),F8.1,2X,I6)') &
96                       platform % info % platform,  &
97                       platform % info % date_char, &
98                       platform % info % lat,       &
99                       platform % info % lon,       &
100                       platform % info % elv,       &
101                       platform % info % levels
102 
103          read(unit=platform % info % platform (4:6), fmt='(I3)') fm
104 
105          !     3.5.2 read each level
106 
107          do i = 1, platform % info % levels
108             ! height
109             platform%each (i) = radar_each_level_type(missing_r, missing, -1.0,&
110                field_type(missing_r, missing, missing_r), & ! rv
111                field_type(missing_r, missing, missing_r))   ! rf
112 
113             read (unit = iunit, fmt = '(3X, F12.1, 2(F12.3,I4,F12.3,2X))') &
114                              platform % each (i) % height,           &
115                              platform % each (i) % rv % inv,         &
116                              platform % each (i) % rv % qc,          &
117                              platform % each (i) % rv % error,       &
118                              platform % each (i) % rf % inv,         &
119                              platform % each (i) % rf % qc,          &
120                              platform % each (i) % rf % error
121          end do
122 
123          call da_llxy (platform%info, platform%loc, outside)
124 
125          nlevels = platform%info%levels
126 
127          if (nlevels > max_ob_levels) then
128              write(unit=message(1),fmt='(A,2I8)') &
129                 ' radar=> nlevels > max_ob_levels:',nlevels, max_ob_levels
130              call da_warning(__FILE__,__LINE__,message(1:1))
131 
132              nlevels = max_ob_levels
133              platform%info%levels = nlevels
134          else if (nlevels < 1) then
135             cycle reports
136          end if
137 
138          iv%info(radar)%ntotal = iv%info(radar)%ntotal + 1
139          if (outside) then
140             cycle reports
141          end if
142 
143          ! Loop over duplicating obs for global
144          n_dup = 1
145          if (global .and. &
146             (platform%loc%i == ids .or. platform%loc%i == ide)) n_dup= 2
147    
148          do ndup = 1, n_dup
149             select case (fm)
150 
151             case (128)
152                iv%info(radar)%nlocal = iv%info(radar)%nlocal + 1
153 
154                if (iv%info(radar)%nlocal > max_radar_input) then
155                   write(unit=message(1),fmt='(A,I6,A,I6)') &
156                      ' radar #= ',iv%info(radar)%nlocal, ' > max_radar_input = ', max_radar_input
157                   call da_error(__FILE__,__LINE__,message(1:1))
158                end if
159 
160             case default;
161                write(unit=stdout, fmt='(a)') 'Warning: unsaved obs found:'
162 
163                write(unit=stdout, fmt='(2a)') &
164                   'platform % info % platform=', platform % info % platform
165 
166                write(unit=stdout, fmt='(a, i3)') &
167                   'platform % info % levels=', platform % info % levels
168             end select
169 
170          iv%info(radar)%max_lev = max(iv%info(radar)%max_lev, platform%info%levels)
171          end do        !  loop over duplicate
172       end do reports
173    end do
174 
175    close (iunit)
176    call da_free_unit(iunit)
177 
178    if (trace_use) call da_trace_exit("da_scan_obs_radar")
179 
180 
181 end subroutine da_scan_obs_radar
182 
183