NCEPLIBS-ip 5.2.0
Loading...
Searching...
No Matches
ipxwafs3.F90
Go to the documentation of this file.
1
5
88SUBROUTINE ipxwafs3(IDIR, NUMPTS_THIN, NUMPTS_FULL, KM, NUM_OPT, OPT_PTS, &
89 IGDTLEN, IGDTMPL_THIN, DATA_THIN, IB_THIN, BITMAP_THIN, &
90 IGDTMPL_FULL, DATA_FULL, IB_FULL, BITMAP_FULL, IRET)
91 IMPLICIT NONE
92!
93 INTEGER, INTENT(IN ) :: NUM_OPT
94 INTEGER, INTENT(INOUT) :: OPT_PTS(NUM_OPT)
95 INTEGER, INTENT(IN ) :: IDIR, KM, NUMPTS_THIN, NUMPTS_FULL
96 INTEGER, INTENT(IN ) :: IGDTLEN
97 INTEGER, INTENT(INOUT) :: IGDTMPL_THIN(IGDTLEN)
98 INTEGER, INTENT(INOUT) :: IGDTMPL_FULL(IGDTLEN)
99 INTEGER, INTENT(INOUT) :: IB_THIN(KM), IB_FULL(KM)
100 INTEGER, INTENT( OUT) :: IRET
101!
102 LOGICAL(KIND=1), INTENT(INOUT) :: BITMAP_THIN(NUMPTS_THIN,KM)
103 LOGICAL(KIND=1), INTENT(INOUT) :: BITMAP_FULL(NUMPTS_FULL,KM)
104!
105 REAL, INTENT(INOUT) :: DATA_THIN(NUMPTS_THIN,KM)
106 REAL, INTENT(INOUT) :: DATA_FULL(NUMPTS_FULL,KM)
107!
108 INTEGER, PARAMETER :: MISSING=-1
109!
110 INTEGER :: SCAN_MODE, I, J, K, IDLAT, IDLON
111 INTEGER :: IA, IB, IM, IM1, IM2, NPWAFS(73)
112 INTEGER :: IS1, IS2, ISCAN, ISCALE
113!
114 LOGICAL :: TEST1, TEST2
115!
116 REAL :: DLON, HI
117 REAL :: RAT1, RAT2, RLON1, RLON2
118 REAL :: WA, WB, X1, X2
119!
120 DATA npwafs/ &
121 73, 73, 73, 73, 73, 73, 73, 73, 72, 72, 72, 71, 71, 71, 70,&
122 70, 69, 69, 68, 67, 67, 66, 65, 65, 64, 63, 62, 61, 60, 60,&
123 59, 58, 57, 56, 55, 54, 52, 51, 50, 49, 48, 47, 45, 44, 43,&
124 42, 40, 39, 38, 36, 35, 33, 32, 30, 29, 28, 26, 25, 23, 22,&
125 20, 19, 17, 16, 14, 12, 11, 9, 8, 6, 5, 3, 2/
126! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
127! TRANSFORM GDS
128 iret=0
129! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
130! REG LAT/LON GRIDS HAVE 19 GDT ELEMENTS.
131 IF (igdtlen /= 19 .OR. numpts_thin/=3447 .OR. numpts_full/=5329) THEN
132 iret=1
133 RETURN
134 ENDIF
135! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
136! EXPAND THINNED GDS TO FULL GDS
137 IF(idir.GT.0) THEN
138 scan_mode=igdtmpl_thin(19)
139 iscale=igdtmpl_thin(10)*igdtmpl_thin(11)
140 IF(iscale==0) iscale=10**6
141 idlat=nint(1.25*float(iscale))
142 test1=all(opt_pts==npwafs)
143 test2=all(opt_pts==npwafs(73:1:-1))
144! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
145! SOME CHECKS TO ENSURE THIS IS A WAFS GRID
146 IF(scan_mode==64 .AND. igdtmpl_thin(9)==73 .AND. &
147 idlat==igdtmpl_thin(18) .AND. (test1 .OR. test2) ) THEN
148 igdtmpl_full=igdtmpl_thin
149 im=73
150 igdtmpl_full(8)=im
151 rlon1=float(igdtmpl_full(13))/float(iscale)
152 rlon2=float(igdtmpl_full(16))/float(iscale)
153 iscan=mod(igdtmpl_full(19)/128,2)
154 hi=(-1.)**iscan
155 dlon=hi*(mod(hi*(rlon2-rlon1)-1+3600,360.)+1)/(im-1)
156 igdtmpl_full(17)=nint(dlon*float(iscale))
157 ELSE
158 iret=1
159 ENDIF
160! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
161! CONTRACT FULL GDS TO THINNED GDS
162 ELSEIF(idir.LT.0) THEN
163 scan_mode=igdtmpl_full(19)
164 iscale=igdtmpl_full(10)*igdtmpl_full(11)
165 IF(iscale==0) iscale=10**6
166 idlat=nint(1.25*float(iscale))
167 idlon=idlat
168! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
169! SOME CHECKS TO ENSURE THIS IS A WAFS GRID
170 IF(scan_mode==64 .AND. igdtmpl_full(8)==73 .AND. igdtmpl_full(9)==73 .AND. &
171 num_opt==73 .AND. idlat==igdtmpl_full(18) .AND. idlon==igdtmpl_full(17))THEN
172 igdtmpl_thin=igdtmpl_full
173 igdtmpl_thin(8)=missing
174 igdtmpl_thin(17)=missing
175 IF(igdtmpl_thin(12)==0) THEN ! IS LATITUDE OF ROW 1 THE EQUATOR?
176 opt_pts=npwafs
177 ELSE
178 opt_pts=npwafs(73:1:-1)
179 ENDIF
180 ELSE
181 iret=1
182 ENDIF
183 ENDIF
184! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
185! TRANSFORM FIELDS
186 IF(iret.EQ.0) THEN
187! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
188! EXPAND THINNED FIELDS TO FULL FIELDS
189 IF(idir.EQ.1) THEN
190 DO k=1,km
191 is1=0
192 is2=0
193 ib_full(k)=0
194 DO j=1,igdtmpl_full(9)
195 im1=opt_pts(j)
196 im2=igdtmpl_full(8)
197 rat1=float(im1-1)/float(im2-1)
198 DO i=1,im2
199 x1=(i-1)*rat1+1
200 ia=int(x1)
201 ia=min(max(ia,1),im1-1)
202 ib=ia+1
203 wa=ib-x1
204 wb=x1-ia
205 IF(wa.GE.wb) THEN
206 IF(ib_thin(k).EQ.0.OR.bitmap_thin(is1+ia,k)) THEN
207 data_full(is2+i,k)=data_thin(is1+ia,k)
208 bitmap_full(is2+i,k)=.true.
209 ELSE
210 data_full(is2+i,k)=0.0
211 bitmap_full(is2+i,k)=.false.
212 ib_full(k)=1
213 ENDIF
214 ELSE
215 IF(ib_thin(k).EQ.0.OR.bitmap_thin(is1+ib,k)) THEN
216 data_full(is2+i,k)=data_thin(is1+ib,k)
217 bitmap_full(is2+i,k)=.true.
218 ELSE
219 data_full(is2+i,k)=0.0
220 bitmap_full(is2+i,k)=.false.
221 ib_full(k)=1
222 ENDIF
223 ENDIF
224 ENDDO
225 is1=is1+im1
226 is2=is2+im2
227 ENDDO
228 ENDDO
229! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
230! CONTRACT FULL FIELDS TO THINNED FIELDS
231 ELSEIF(idir.EQ.-1) THEN
232 DO k=1,km
233 is1=0
234 is2=0
235 ib_thin(k)=0
236 DO j=1,igdtmpl_full(9)
237 im1=opt_pts(j)
238 im2=igdtmpl_full(8)
239 rat2=float(im2-1)/float(im1-1)
240 DO i=1,im1
241 x2=(i-1)*rat2+1
242 ia=int(x2)
243 ia=min(max(ia,1),im2-1)
244 ib=ia+1
245 wa=ib-x2
246 wb=x2-ia
247 IF(wa.GE.wb) THEN
248 IF(ib_full(k).EQ.0.OR.bitmap_full(is2+ia,k)) THEN
249 data_thin(is1+i,k)=data_full(is2+ia,k)
250 bitmap_thin(is1+i,k)=.true.
251 ELSE
252 data_thin(is1+i,k)=0.0
253 bitmap_thin(is1+i,k)=.false.
254 ib_thin(k)=1
255 ENDIF
256 ELSE
257 IF(ib_full(k).EQ.0.OR.bitmap_full(is2+ib,k)) THEN
258 data_thin(is1+i,k)=data_full(is2+ib,k)
259 bitmap_thin(is1+i,k)=.true.
260 ELSE
261 data_thin(is1+i,k)=0.0
262 bitmap_thin(is1+i,k)=.false.
263 ib_thin(k)=1
264 ENDIF
265 ENDIF
266 ENDDO
267 is1=is1+im1
268 is2=is2+im2
269 ENDDO
270 ENDDO
271 ENDIF
272 ENDIF
273! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
274 END SUBROUTINE ipxwafs3
ipxwafs3
subroutine ipxwafs3(idir, numpts_thin, numpts_full, km, num_opt, opt_pts, igdtlen, igdtmpl_thin, data_thin, ib_thin, bitmap_thin, igdtmpl_full, data_full, ib_full, bitmap_full, iret)
Expand or contract wafs grids using neighbor interpolation and accout for bitmapped data.
Definition ipxwafs3.F90:91