da_read_ssmi_info.inc
References to this file elsewhere.
1 subroutine da_read_ssmi_info (iunit, ob, xb, xbx)
2
3 !---------------------------------------------------------------------------
4 ! Purpose: Read the header of a SSMI GTS observation file
5 !---------------------------------------------------------------------------
6
7 implicit none
8
9 integer, intent (in) :: iunit
10 type (xb_type), intent (in) :: xb
11 type (xbx_type),intent (in) :: xbx ! Header & non-gridded vars.
12 type (ob_type), intent (out) :: ob
13
14
15 integer :: iost, i, ii
16 character (LEN = 120) :: char_ned
17 logical :: connected
18
19 integer :: nssmis,nothers
20 integer :: ixc, jxc, iproj, idd, maxnes
21 integer, dimension(10) :: nestix, nestjx, numnc, nesti, nestj
22 real :: phic , xlonc , &
23 truelat1_3dv, truelat2_3dv, &
24 ts0 , ps0 , tlp , ptop
25 real , dimension(10) :: dis
26
27 logical :: CHECK_WRONG, CHECK_SUBdoMAin
28
29 iost = -99999
30
31 ! 1. open file
32 ! ---------
33
34 if (use_ssmiretrievalobs .or. use_ssmitbobs .or. &
35 use_ssmt1obs .or. use_ssmt2obs) then
36 open (unit = iunit, &
37 FORM = 'FORMATTED', &
38 ACCESS = 'SEQUENTIAL', &
39 iostat = iost, &
40 STATUS = 'OLD')
41
42 if (iost /= 0) then
43 Use_SsmiRetrievalObs = .false.
44 Use_SsmiTbObs = .false.
45 use_ssmt1obs = .false.
46 use_ssmt2obs = .false.
47
48 return
49 end if
50 else
51 return
52 end if
53
54 rewind (unit = iunit)
55
56
57 ! 2. read header
58 ! ===============
59
60 ! 2.1 read first line
61 ! ---------------
62
63 read (unit = iunit, fmt = '(a)', iostat = iost) char_ned
64
65 ! 2.2 process error
66 ! -------------
67
68 if (iost /= 0) then
69 Use_SsmiRetrievalObs = .false.
70 Use_SsmiTbObs = .false.
71 use_ssmt1obs = .false.
72 use_ssmt2obs = .false.
73 call da_warning(__FILE__,__LINE__, &
74 (/"Cannot read SSMI file"/))
75
76 return
77 else
78 write(unit=stdout, fmt='(/2a/)') &
79 'in da_read_ssmi_info.inc, char_ned=', trim(char_ned)
80 end if
81
82 ! 2.3 read NUMBER OF REPORTS
83 ! ---------------------
84
85 do
86 do i = 0, 120-14
87 select case (char_ned (I+1:I+5))
88 ! Number of observations
89 case ('SSMI ') ;
90 if (Use_SsmiRetrievalObs) &
91 read (char_ned (I+9:I+14),'(I6)', iostat = iost) &
92 ob%num_ssmi_retrieval
93 if (Use_SsmiTbObs) then
94 read (char_ned (I+9:I+14),'(I6)', iostat = iost) ob%num_ssmi_tb
95 end if
96 case ('OTHER') ;
97 read (char_ned (I+9:I+14),'(I6)', iostat = iost) nothers
98
99 ! Geographic area and reference atmosphere definition
100
101 case ('MISS.') ;
102 read (char_ned (I+8:I+15),'(F8.0)', iostat = iost) ob % missing
103 case ('PHIC ') ;
104 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) phic
105 case ('XLONC') ;
106 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) xlonc
107 case ('true1') ;
108 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) truelat1_3dv
109 case ('true2') ;
110 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) truelat2_3dv
111 case ('TS0 ') ;
112 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) ts0
113 case ('TLP ') ;
114 read (char_ned (I+8:I+14),'(F7.2)', iostat = iost) tlp
115 case ('PTOP ') ;
116 read (char_ned (I+8:I+14),'(F7.0)', iostat = iost) ptop
117 case ('PS0 ') ;
118 read (char_ned (I+8:I+14),'(F7.0)', iostat = iost) ps0
119 case ('IXC ') ;
120 read (char_ned (I+8:I+14),'(I7)', iostat = iost) ixc
121 case ('JXC ') ;
122 read (char_ned (I+8:I+14),'(I7)', iostat = iost) jxc
123 case ('IPROJ') ;
124 read (char_ned (I+8:I+14),'(I7)', iostat = iost) iproj
125 case ('IDD ') ;
126 read (char_ned (I+8:I+14),'(I7)', iostat = iost) idd
127 case ('MAXNE') ;
128 read (char_ned (I+8:I+14),'(I7)', iostat = iost) maxnes
129 case default ; read (char_ned (I+9:I+14),'(I6)', iostat = iost) nssmis
130 end select
131 end do
132
133 read (unit = iunit, fmt = '(A)', iostat = iost) char_ned
134
135 if (iost /= 0) then
136 Use_SsmiRetrievalObs = .false.
137 Use_SsmiTbObs = .false.
138 use_ssmt1obs = .false.
139 use_ssmt2obs = .false.
140 call da_warning(__FILE__,__LINE__, &
141 (/"Cannot read SSMI file"/))
142 return
143 end if
144 if (char_ned(1:6) == 'NESTIX') exit
145
146 end do
147
148 do
149 select case (char_ned (1:6))
150 ! Model domains definition
151
152 case ('NESTIX') ;
153 call da_read_ssmi_integer_array(nestix, maxnes, 8, 9)
154 case ('NESTJX') ;
155 call da_read_ssmi_integer_array(nestjx, maxnes, 8, 9)
156 case ('NUMC ') ;
157 call da_read_ssmi_integer_array(numnc , maxnes, 8, 9)
158 case ('DIS ') ;
159 call da_read_ssmi_real_array (dis , maxnes, 8, 9)
160 case ('NESTI ') ;
161 call da_read_ssmi_integer_array(nesti , maxnes, 8, 9)
162 case ('NESTJ ') ;
163 call da_read_ssmi_integer_array(nestj , maxnes, 8, 9)
164 end select
165
166 read (unit = iunit, fmt = '(A)', iostat = iost) char_ned
167 if (char_ned(1:6) == 'INFO ') exit
168 end do
169
170 read (unit = iunit, fmt = '(A)', iostat = iost) char_ned
171
172 contains
173
174 #include "da_read_ssmi_integer_array.inc"
175 #include "da_read_ssmi_real_array.inc"
176
177 end subroutine da_read_ssmi_info
178
179