OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
specific_other.f90
Go to the documentation of this file.
2 
3  implicit none
4 
5  contains
6 
7  subroutine set_l1b_names(level1b_name)
8 
9  use names
10 
11  character(*), intent(inout) :: level1b_name(:)
12 
13  level1b_name(:) = "none"
14 
15  level1b_name(1) = alevel1b_name(1)
16 
17  end subroutine set_l1b_names
18 
19  subroutine set_irw_channel(IRW_channel)
21 
22  integer, intent(inout) :: IRW_channel
23 
24  irw_channel = 1
25 
26  end subroutine set_irw_channel
27 
28 
29 ! subroutine create_extra(file_id, modis_wid, modis_ht)
30 !
31 ! use core_arrays
32 !
33 ! include "hdf.f90"
34 ! include "dffunc.f90"
35 !
36 ! integer, dimension(:), intent(in) :: file_id
37 ! integer, intent(in) :: modis_wid, modis_ht
38 !
39 ! integer :: var_id, err_code
40 ! character(len=200) :: long_name, units
41 ! integer*2 :: fillValue_integer2, range_integer2(2)
42 ! real*8 :: add_offset, scale_factor
43 !
44 ! fillValue_integer2 = -9999
45 ! range_integer2 = (/0, 15000/)
46 ! add_offset = 0.
47 ! scale_factor = 0.01
48 !
49 ! var_id = sfselect(file_id(1), sfn2index(file_id(1), "Cloud_Optical_Thickness_All_Liquid"))
50 ! if (var_id == -1) then
51 ! var_id = sfcreate(file_id(1), "Cloud_Optical_Thickness_All_Liquid", DFNT_INT16, 2, (/modis_wid, modis_ht/))
52 ! long_name = "Optical Thickness from VNSWIR-2.1um retrieval, all liquid attempts"
53 ! err_code = sfsattr(var_id, "long_name", DFNT_CHAR, len(trim(long_name)), trim(long_name))
54 ! units = "none"
55 ! err_code = sfsattr(var_id, "units", DFNT_CHAR, len(trim(units)), trim(units))
56 ! err_code = sfsattr(var_id, "_FillValue", DFNT_INT16, 1, fillValue_integer2)
57 ! err_code = sfsattr(var_id, "valid_range", DFNT_INT16, 2, range_integer2)
58 ! err_code = sfsattr(var_id, "scale_factor", DFNT_DOUBLE, 1, scale_factor)
59 ! err_code = sfsattr(var_id, "add_offset", DFNT_DOUBLE, 1, add_offset)
60 ! err_code = sfendacc(var_id)
61 ! endif
62 !
63 ! var_id = sfselect(file_id(1), sfn2index(file_id(1), "Cloud_Optical_Thickness_All_Ice"))
64 ! if (var_id == -1) then
65 ! var_id = sfcreate(file_id(1), "Cloud_Optical_Thickness_All_Ice", DFNT_INT16, 2, (/modis_wid, modis_ht/))
66 ! long_name = "Optical Thickness from VNSWIR-2.1um retrieval, all ice attempts"
67 ! err_code = sfsattr(var_id, "long_name", DFNT_CHAR, len(trim(long_name)), trim(long_name))
68 ! units = "none"
69 ! err_code = sfsattr(var_id, "units", DFNT_CHAR, len(trim(units)), trim(units))
70 ! err_code = sfsattr(var_id, "_FillValue", DFNT_INT16, 1, fillValue_integer2)
71 ! err_code = sfsattr(var_id, "valid_range", DFNT_INT16, 2, range_integer2)
72 ! err_code = sfsattr(var_id, "scale_factor", DFNT_DOUBLE, 1, scale_factor)
73 ! err_code = sfsattr(var_id, "add_offset", DFNT_DOUBLE, 1, add_offset)
74 ! err_code = sfendacc(var_id)
75 ! endif
76 !
77 ! var_id = sfselect(file_id(1), sfn2index(file_id(1), "Cloud_Effective_Radius_All_Liquid"))
78 ! if (var_id == -1) then
79 ! var_id = sfcreate(file_id(1), "Cloud_Effective_Radius_All_Liquid", DFNT_INT16, 2, (/modis_wid, modis_ht/))
80 ! long_name = "Effective Radius from VNSWIR-2.1um retrieval, all liquid attempts"
81 ! err_code = sfsattr(var_id, "long_name", DFNT_CHAR, len(trim(long_name)), trim(long_name))
82 ! units = "microns"
83 ! err_code = sfsattr(var_id, "units", DFNT_CHAR, len(trim(units)), trim(units))
84 ! err_code = sfsattr(var_id, "_FillValue", DFNT_INT16, 1, fillValue_integer2)
85 ! err_code = sfsattr(var_id, "valid_range", DFNT_INT16, 2, range_integer2)
86 ! err_code = sfsattr(var_id, "scale_factor", DFNT_DOUBLE, 1, scale_factor)
87 ! err_code = sfsattr(var_id, "add_offset", DFNT_DOUBLE, 1, add_offset)
88 ! err_code = sfendacc(var_id)
89 ! endif
90 !
91 ! var_id = sfselect(file_id(1), sfn2index(file_id(1), "Cloud_Effective_Radius_All_Ice"))
92 ! if (var_id == -1) then
93 ! var_id = sfcreate(file_id(1), "Cloud_Effective_Radius_All_Ice", DFNT_INT16, 2, (/modis_wid, modis_ht/))
94 ! long_name = "Effective Radius from VNSWIR-2.1um retrieval, all ice attempts"
95 ! err_code = sfsattr(var_id, "long_name", DFNT_CHAR, len(trim(long_name)), trim(long_name))
96 ! units = "microns"
97 ! err_code = sfsattr(var_id, "units", DFNT_CHAR, len(trim(units)), trim(units))
98 ! err_code = sfsattr(var_id, "_FillValue", DFNT_INT16, 1, fillValue_integer2)
99 ! err_code = sfsattr(var_id, "valid_range", DFNT_INT16, 2, range_integer2)
100 ! err_code = sfsattr(var_id, "scale_factor", DFNT_DOUBLE, 1, scale_factor)
101 ! err_code = sfsattr(var_id, "add_offset", DFNT_DOUBLE, 1, add_offset)
102 ! err_code = sfendacc(var_id)
103 ! endif
104 !
105 !
106 ! end subroutine create_extra
107 
108  subroutine set_esfc(os_flag_in, x, y, esfc, os_flag )
109 
112  use core_arrays
113 
114  logical, intent(in) :: os_flag_in
115  real, dimension(:), intent(inout) :: esfc
116  logical, intent(inout) :: os_flag
117  integer, intent(in):: x, y
118 
119  if (os_flag_in) then
120  os_flag = .true.
121  else
122  os_flag = .false.
123  endif
124 
125  if (os_flag .and. cox_munk) then
126  esfc(1) = int_surface_emissivity_water(1,2,1)
127  esfc(2) = int_surface_emissivity_water(1,1,1)
128  else
129  esfc(1) = surface_emissivity_land(x,y,2)
130  esfc(2) = surface_emissivity_land(x,y,1)
131  endif
132 
133  end subroutine set_esfc
134 
135 
136 
137 ! this subroutine is intentionally left blank
138  subroutine set_cox_munk_albedo(albedo, lib_albedo)
139 
141 
142  real, dimension(:), intent(in) :: albedo
143  real, dimension(:), intent(in) :: lib_albedo
144 
145 
146  end subroutine set_cox_munk_albedo
147 
148  subroutine get_band_idx(idx16, idx21, idx37, channel_37, idx_11, idx_alb37, idx_alb16)
149 
151 
152  integer, intent(inout) :: idx16, idx21, idx37, channel_37, idx_11, idx_alb37, idx_alb16
153 
154  idx16 = band_0163
155  idx21 = band_0213
156  idx37 = band_0370-1
157  idx_11 = band_0370 !(it's 7 in MODIS)
158  channel_37 = set_bands(band_0370)
159  idx_alb37 = band_0370 - 1
160  idx_alb16 = band_0163
161 
162  end subroutine get_band_idx
163 
164  ! this subroutine is intentionally left blank
165  subroutine get_channels
166 
168 
169  end subroutine get_channels
170 
171  ! this subroutine is intentionally left blank
172  subroutine allocate_extra(xdim, ydim)
173 
174  use core_arrays
175 
176  integer, intent(in) :: xdim, ydim
177 #if 0
178  allocate(tau_liquid(xdim, ydim))
179  allocate(re21_liquid(xdim, ydim))
180  allocate(tau_ice(xdim, ydim))
181  allocate(re21_ice(xdim, ydim))
182 #endif
183 
184  end subroutine allocate_extra
185 
186  ! this subroutine is intentionally left blank
187  subroutine deallocate_extra
188 
189  use core_arrays
190 #if 0
191  deallocate(tau_liquid, tau_ice, re21_liquid, re21_ice)
192 #endif
193 
194  end subroutine deallocate_extra
195 
196  subroutine get_data_dims(filename, start, stride, edge)
197 
199 
200  integer, dimension(:), intent(inout) :: start, stride, edge
201  character(len=*), intent(in) :: filename
202 
203  start = set_start
204  stride = set_stride
205  edge = set_edge
206 
207 
208  end subroutine get_data_dims
209 
210 
211  ! this subroutine is intentionally left blank
212  subroutine set_process_time(file_id)
213 
214  integer, intent(in) :: file_id
215 
216  end subroutine set_process_time
217 
218  subroutine set_ph_desert(surface, R040, thres)
219 
220  logical, intent(in) :: surface
221  real, intent(in) :: R040
222  real, intent(inout) :: thres
223 
224  if (surface .and. r040 < 0.5) thres = 9999.
225 
226 
227  end subroutine set_ph_desert
228 
229  logical function set_ice_ratio(ice_ratio)
230 
231  real, intent(in) :: ice_ratio
232 
233  if (ice_ratio < 1.3) then
234  set_ice_ratio = .true.
235  else
236  set_ice_ratio = .false.
237  endif
238 
239  end function set_ice_ratio
240 
241 
242 ! this subroutine is intentionally left blank
243  subroutine set_albedo
244 
245  end subroutine set_albedo
246 
247 ! this subroutine is intentionally left blank
248  subroutine set_processing_extra(file_id)
249 
250  integer, intent(in) :: file_id
251 
252  end subroutine set_processing_extra
253 
254 
255 ! subroutine check_datasize(l1b_filedata, start, stride, edge, status)
256 !
257 !! use GeneralAuxType
258 ! use nonscience_parameters
259 !
260 ! implicit none
261 !
262 ! include "hdf.f90"
263 ! include "dffunc.f90"
264 !
265 ! integer, dimension(:), intent(in) :: l1b_filedata
266 ! integer, dimension (2), intent(inout) :: start, edge, stride
267 ! integer, intent(out) :: status
268 !
269 ! integer :: Scans_Per_Granule
270 ! character*40 :: att_N, dtype
271 ! integer :: RTN
272 !
273 ! integer :: attr_id, file_id
274 !
275 ! status = success
276 !
277 !! get number of scans
278 ! att_N = 'Number of Scans'
279 ! dtype = 'INTEGER*4'
280 !
281 ! file_id = l1b_filedata(1)
282 ! attr_id = sffattr(file_id, att_N)
283 !
284 ! RTN = sfrattr(file_id, attr_id, Scans_Per_Granule)
285 ! print*, Scans_Per_Granule
286 !
287 !
288 ! if (rtn /= 0) then
289 ! call MODIS_SMF_SETDYNAMICMSG(1, &
290 ! 'MAPI function GMFIN for Number of Scans failed', &
291 ! 'check_datasize')
292 ! status = failure
293 ! endif
294 !
295 ! edge(2) = Scans_Per_Granule * 10
296 !
297 ! end subroutine check_datasize
298 
299 subroutine aggregate_statistics_1km
300 
302  use core_arrays
303 
304  implicit none
305 
306  integer :: i, j, wid, ht
307 
308 
309  wid = size(optical_thickness_final, 1)
310  ht = size(optical_thickness_final, 2)
311 
312  do j=1, ht
313  do i=1, wid
314 
315  if (.not. cloudsummary(i,j)%ocean_surface) &
316  statistics_1km%land_fraction = statistics_1km%land_fraction + 1
317  if (cloudsummary(i,j)%snowice_surface) statistics_1km%snow_fraction = statistics_1km%snow_fraction + 1
318  if (cloudsummary(i,j)%ocean_surface) statistics_1km%water_fraction = statistics_1km%water_fraction + 1
319 
320 
321  if (cloudsummary(i,j)%watercloud) then
322  if (optical_thickness_final(i,j) > 0.) &
323  statistics_1km%mean_liquid_tau = statistics_1km%mean_liquid_tau + optical_thickness_final(i,j)
324  if (effective_radius_21_final(i,j) > 0.) &
325  statistics_1km%mean_liquid_re21 = statistics_1km%mean_liquid_re21 + effective_radius_21_final(i,j)
326  if (cloud_top_pressure(i,j) > 0.) &
327  statistics_1km%ctp_liquid = statistics_1km%ctp_liquid + cloud_top_pressure(i,j)
328  if (cloud_top_temperature(i,j) > 0.) &
329  statistics_1km%ctt_liquid = statistics_1km%ctt_liquid + cloud_top_temperature(i,j)
330  endif
331 
332  if (cloudsummary(i,j)%icecloud) then
333  if (optical_thickness_final(i,j) > 0.) &
334  statistics_1km%mean_ice_tau = statistics_1km%mean_ice_tau + optical_thickness_final(i,j)
335  if (effective_radius_21_final(i,j) > 0.) &
336  statistics_1km%mean_ice_re21 = statistics_1km%mean_ice_re21 + effective_radius_21_final(i,j)
337  if (cloud_top_pressure(i,j) > 0.) &
338  statistics_1km%ctp_ice = statistics_1km%ctp_ice + cloud_top_pressure(i,j)
339  if (cloud_top_temperature(i,j) > 0.) &
340  statistics_1km%ctt_ice = statistics_1km%ctt_ice + cloud_top_temperature(i,j)
341  endif
342 
343  if (cloudsummary(i,j)%unknowncloud) then
344  if (cloud_top_pressure(i,j) > 0.) &
345  statistics_1km%ctp_undetermined = statistics_1km%ctp_undetermined + cloud_top_pressure(i,j)
346  if (cloud_top_temperature(i,j) > 0.) &
347  statistics_1km%ctt_undetermined = statistics_1km%ctt_undetermined + cloud_top_temperature(i,j)
348  endif
349 
350  end do
351  end do
352 
353 
354 end subroutine aggregate_statistics_1km
355 
356 
357 ! subroutine openclose_files ( directive, &
358 ! l1b_filedata, &
359 ! cloudmask_filedata, &
360 ! geolocation_filedata,&
361 ! mod06_filedata, &
362 ! status)
363 !
364 ! use nonscience_parameters
365 ! use mod06_run_settings
366 ! use names
367 ! use core_arrays, only: platform_name
368 !! WDR no need use general_array_io, only : open_file, close_file
369 ! use ch_xfr, only : cm_from_l2
370 !
371 !
372 ! implicit none
373 !
374 ! include "hdf.f90"
375 ! include "dffunc.f90"
376 !
377 ! character(*), intent(in) :: directive
378 ! integer, dimension(:), intent(inout) :: l1b_filedata, cloudmask_filedata, &
379 ! geolocation_filedata,mod06_filedata
380 !
381 ! integer, intent(out) :: status
382 !
383 ! integer :: err_code, i, nbands
384 !
385 ! status = success
386 !
387 ! nbands = 1
388 !
389 ! if (directive == 'open') then
390 !
391 !
392 ! l1b_filedata(:) = -1
393 !! WDR knock out the l1b opens
394 !! do i=1, nbands
395 !! if (trim(Alevel1b_name(i)) == "none") cycle
396 !! call open_file(Alevel1b_name(i), l1b_filedata(i), DFACC_READ)
397 !! end do
398 !!
399 !! WDR conditional use of work file cm data
400 ! if ( cm_from_l2 .EQ. 0 ) THEN
401 !! WDR out for l2gen xfr call open_file(Acloudmask_name, cloudmask_filedata(1), DFACC_READ)
402 ! end if
403 !! WDR don't open output (and input) file
404 !! call open_file(Amod06_name, mod06_filedata(1), DFACC_WRITE)
405 !! WDR knock out the geo opens
406 !! call open_file(Ageolocation_name, geolocation_filedata(1), DFACC_READ)
407 !
408 !
409 ! else
410 !
411 !! do i=1, nbands
412 !! if (l1b_filedata(i) == -1) cycle
413 !! call close_file(Alevel1b_name(i), l1b_filedata(i))
414 !! end do
415 !
416 ! if ( cm_from_l2 .EQ. 0 ) THEN
417 !! WDR out for l2gen xfr call close_file(Acloudmask_name, cloudmask_filedata(1))
418 ! endif
419 !! WDR call close_file(Ageolocation_name, geolocation_filedata(1))
420 !! WDR call close_file(Amod06_name, mod06_filedata(1))
421 !
422 ! endif
423 !
424 !
425 ! end subroutine openclose_files
426 
427 
428 
429  subroutine convert_binary_qa( quality_assurance_1km, &
430  status)
434 
435  implicit none
436 
437  integer*1 , intent(out) :: quality_assurance_1km(:,:,:)
438  integer, intent(inout) :: status
439 
440  integer :: i,j, blah, cm_wid, cm_ht
441 
442  quality_assurance_1km = 0
443 
444  cm_wid = size(processing_information, 1)
445  cm_ht = size(processing_information, 2)
446 
447 
448  do j= 1, cm_ht
449  do i = 1, cm_wid
450 
451 
452 ! Quality Assurance 1KM, byte 1 ----------------------------------------------------------------------------
453  quality_assurance_1km(1,i,j) = processing_information(i,j)%optical_thickness_GC
454 
455  if (cloudmask(i,j)%ocean_no_snow == 1) then
456  ! value of 00 for bits 4,3
457  else if (cloudmask(i,j)%ocean_snow == 1) then
458  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),3)
459  else if (cloudmask(i,j)%land_no_snow == 1) then
460  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),4)
461  else if (cloudmask(i,j)%land_snow == 1) then
462  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),3)
463  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),4)
464  endif
465 
466  if (processing_information(i,j)%effective_radius_GC /= 0) then
467  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),5)
468  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),6)
469  quality_assurance_1km(1,i,j) = ibset(quality_assurance_1km(1,i,j),7)
470  endif
471 
472 
473 
474 ! Quality Assurance 1KM, byte 2 ----------------------------------------------------------------------------
475 
476  quality_assurance_1km(2,i,j) = ishft(processing_information(i,j)%path_and_outcome_1621, 3)
477 
478  if (processing_information(i,j)%water_path_GC /= 0) then
479  quality_assurance_1km(2,i,j) = ibset(quality_assurance_1km(2,i,j),0)
480  quality_assurance_1km(2,i,j) = ibset(quality_assurance_1km(2,i,j),1)
481  quality_assurance_1km(2,i,j) = ibset(quality_assurance_1km(2,i,j),2)
482  endif
483 
484 ! Quality Assurance 1KM, byte 3 ----------------------------------------------------------------------------
485 
486  quality_assurance_1km(3,i,j) = processing_information(i,j)%path_and_outcome
487 
488  if(processing_information(i,j)%rayleigh_correction == 1) &
489  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),4)
490 
491 ! atmospheric correction is always done.
492  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),5)
493 
494  if(processing_information(i,j)%band_used_for_optical_thickness ==1 ) then
495  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),6)
496  elseif(processing_information(i,j)%band_used_for_optical_thickness == 2 ) then
497  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),7)
498  elseif(processing_information(i,j)%band_used_for_optical_thickness == 3 ) then
499  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),6)
500  quality_assurance_1km(3,i,j) = ibset(quality_assurance_1km(3,i,j),7)
501  endif
502 
503 ! Quality Assurance 1KM, byte 4 ----------------------------------------------------------------------------
504 
505  quality_assurance_1km(4,i,j) = processing_information(i,j)%optical_thickness_1621_GC
506 
507  if (processing_information(i,j)%effective_radius_1621_GC /= 0) then
508  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),3)
509  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),4)
510  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),5)
511  endif
512 
513  ! CSR QA added by G.Wind 4.7.05
514  if (processing_information(i,j)%CSR_flag == 1) &
515  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),6)
516  if (processing_information(i,j)%CSR_flag == 2) &
517  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),7)
518  if (processing_information(i,j)%CSR_flag == 3) then
519  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),6)
520  quality_assurance_1km(4,i,j) = ibset(quality_assurance_1km(4,i,j),7)
521  endif
522 
523 
524 ! Quality Assurance 1KM, byte 5 ----------------------------------------------------------------------------
525 
526  quality_assurance_1km(5,i,j) = processing_information(i,j)%water_path_1621_GC
527 
528  if (processing_information(i,j)%multi_layer_cloud == 1) then
529  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),3)
530  elseif(processing_information(i,j)%multi_layer_cloud == 2) then
531  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),4)
532  elseif(processing_information(i,j)%multi_layer_cloud == 3) then
533  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),3)
534  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),4)
535  elseif(processing_information(i,j)%multi_layer_cloud == 4) then
536  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),5)
537  elseif(processing_information(i,j)%multi_layer_cloud == 5) then
538  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),3)
539  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),5)
540  elseif(processing_information(i,j)%multi_layer_cloud == 6) then
541  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),4)
542  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),5)
543  elseif(processing_information(i,j)%multi_layer_cloud == 7) then
544  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),3)
545  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),4)
546  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),5)
547  endif
548 
549  !This is a COPY of the retrieval_outcome bit for Level 3 compatibility
550  if(processing_information(i,j)%path_and_outcome > 4) &
551  quality_assurance_1km(5,i,j) = ibset(quality_assurance_1km(5,i,j),6)
552 
553 
554 
555 ! Quality Assurance 1KM, byte 6 ----------------------------------------------------------------------------
556  quality_assurance_1km(6,i,j) = processing_information(i,j)%ml_test_mark
557 ! Quality Assurance 1KM, byte 7 ----------------------------------------------------------------------------
558  quality_assurance_1km(7,i,j) = processing_information(i,j)%path_and_outcome_16
559  quality_assurance_1km(7,i,j) = ior(quality_assurance_1km(7,i,j), &
560  ishft(processing_information(i,j)%path_and_outcome_16_PCL, 4))
561 
562 ! Quality Assurance 1KM, byte 8 ----------------------------------------------------------------------------
563  quality_assurance_1km(8,i,j) = processing_information(i,j)%path_and_outcome_37
564  quality_assurance_1km(8,i,j) = ior(quality_assurance_1km(8,i,j), &
565  ishft(processing_information(i,j)%path_and_outcome_37_PCL, 4))
566 
567 ! Quality Assurance 1KM, byte 9 ----------------------------------------------------------------------------
568  quality_assurance_1km(9,i,j) = processing_information(i,j)%path_and_outcome_1621_PCL
569  quality_assurance_1km(9,i,j) = ior(quality_assurance_1km(9,i,j), &
570  ishft(processing_information(i,j)%path_and_outcome_PCL, 4))
571 
572 
573  enddo
574  enddo
575 
576  end subroutine convert_binary_qa
577 
578 
579 
580 
581  end module specific_other
subroutine allocate_extra(xdim, ydim)
integer, dimension(2), parameter set_edge
subroutine deallocate_extra
type(cloudmask_type), dimension(:,:), allocatable cloudmask
real(single), dimension(:,:), allocatable cloud_top_pressure
integer *2, dimension(:,:), allocatable tau_liquid
Definition: core_arrays.f90:32
character *15 platform_name
integer, parameter band_0370
subroutine set_esfc(os_flag_in, x, y, esfc, os_flag)
subroutine set_l1b_names(level1b_name)
subroutine set_processing_extra(file_id)
subroutine get_data_dims(filename, start, stride, edge)
subroutine set_albedo
integer, parameter band_0213
type(processflag), dimension(:,:), allocatable cloudsummary
Definition: core_arrays.f90:87
subroutine set_cox_munk_albedo(albedo, lib_albedo)
type(stat_type) statistics_1km
real(single), dimension(:,:), allocatable optical_thickness_final
Definition: core_arrays.f90:34
integer, dimension(2), parameter set_stride
real(single), dimension(:,:,:), allocatable int_surface_emissivity_water
subroutine set_ph_desert(surface, R040, thres)
integer, parameter band_0163
integer *2, dimension(:,:), allocatable re21_liquid
Definition: core_arrays.f90:32
real(single), dimension(:,:), allocatable cloud_top_temperature
real(single), dimension(:,:,:), allocatable surface_emissivity_land
integer, dimension(set_number_of_bands), parameter set_bands
Definition: names.f90:1
integer *2, dimension(:,:), allocatable re21_ice
Definition: core_arrays.f90:32
type(qualityanalysis), dimension(:,:), allocatable processing_information
subroutine set_process_time(file_id)
subroutine set_irw_channel(IRW_channel)
subroutine get_band_idx(idx16, idx21, idx37, channel_37, idx_11, idx_alb37, idx_alb16)
subroutine get_channels
logical function set_ice_ratio(ice_ratio)
integer *2, dimension(:,:), allocatable tau_ice
Definition: core_arrays.f90:32
subroutine aggregate_statistics_1km
integer, dimension(2), parameter set_start
subroutine convert_binary_qa(quality_assurance_1km, status)
real(single), dimension(:,:), allocatable effective_radius_21_final
Definition: core_arrays.f90:39