OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
general_science_module.f90
Go to the documentation of this file.
2 
3  implicit none
4 
5 contains
6 
7  subroutine set_drel(threshold_relative_azimuth, drel)
8 
11 
12  real, intent(in) :: threshold_relative_azimuth
13  real, intent(inout) :: drel
14 
15 
16  if (min_solar_zenith > 0.98 .or. min_sensor_zenith > 0.98) then
17  drel = 30.
18  else if (min_solar_zenith > 0.85 .or. min_sensor_zenith > 0.85) then
19  drel = 10.
20  else
21  drel = threshold_relative_azimuth
22  endif
23 
24  end subroutine set_drel
25 
26  subroutine set_interp_controls(i,j, scattering_angle, cur_wind_speed, drel, &
27  threshold_solar_zenith, &
28  threshold_sensor_zenith, &
29  wind_speed_only, interp_SS, interp_MS )
30 
33  use core_arrays
34 
35  real, intent(in) :: scattering_angle, cur_wind_speed, drel,threshold_solar_zenith, &
36  threshold_sensor_zenith
37 
38  integer, intent(in) :: i, j
39 
40  logical, intent(inout) :: wind_speed_only, interp_SS, interp_MS
41 
42  real :: dsol, dsen, dscat
43  real :: diff_scat_angle, diff_scat_angle_ss, diff_solar_zenith, &
44  diff_sensor_zenith, diff_relative_azimuth, diff_wind_speed
45 
46 
47 
48  dsol = threshold_solar_zenith
49  dsen = threshold_sensor_zenith
50 
51  diff_scat_angle = abs(scattering_angle - lastinterp_scat_angle)
52  diff_scat_angle_ss = abs(scattering_angle - lastinterp_scat_angle_ss)
53 
54  if (scattering_angle < 60. .or. (scattering_angle > 120. .and. scattering_angle <= 160.)) then
55  dscat = 2.0
56  dsen = 1.0
57  else if (scattering_angle >= 60 .and. scattering_angle <= 120.) then
58  dscat = dscat3
59  else ! more than 160 degrees
60  dscat = 1.0
61  dsen = 0.5
62  endif
63 
64 
65  diff_solar_zenith = abs(solar_zenith_angle(i,j) - lastinterp_solar_zenith)
66  diff_sensor_zenith= abs(sensor_zenith_angle(i,j)- lastinterp_sensor_zenith)
67  diff_relative_azimuth= abs(relative_azimuth_angle(i,j)-lastinterp_relative_azimuth)
68 
69 
70  diff_wind_speed = abs(cur_wind_speed - lastinterp_wind_speed)
71 
72 
73  if (cox_munk .and. diff_wind_speed > threshold_wind_speed .and. &
74  .not. (diff_solar_zenith > dsol) .and. &
75  .not. (diff_sensor_zenith > dsen) .and. &
76  .not. (diff_relative_azimuth > drel) .and. &
77  .not. (diff_scat_angle > dscat) .and. &
78  .not. (cox_munk .neqv. last_cox_munk)) then
79  wind_speed_only = .true.
80  else
81  ! WDR temp change set .true. to do every pt
82  wind_speed_only = .false.
83  !wind_speed_only = .true.
84  endif
85 
86 ! interpolate the libraries
87  ! WDR temp change set .true. to do every pt
88  interp_ms = .false.
89  !interp_MS = .true.
90 
91  if ( diff_solar_zenith > dsol .or. &
92  diff_sensor_zenith > dsen .or. &
93  diff_relative_azimuth > drel .or. &
94  diff_scat_angle > dscat .or. &
95  (cox_munk .neqv. last_cox_munk) .or. &
96  (cox_munk .and. diff_wind_speed > threshold_wind_speed)) then
97 
98  interp_ms = .true.
99 
100  if (diff_scat_angle > dscat) &
101  lastinterp_scat_angle = scattering_angle
102 
103  if (diff_solar_zenith > dsol) &
105  if (diff_sensor_zenith > dsen) &
107  if (diff_relative_azimuth > drel) &
109 
110  if (cox_munk .and. diff_wind_speed > threshold_wind_speed) &
111  lastinterp_wind_speed = cur_wind_speed
112 
113  if (cox_munk .neqv. last_cox_munk) &
115 
116 
117  endif
118 
119  ! WDR temp change set .true. to do every pt
120  interp_ss = .false.
121  !interp_SS = .true.
122 
123  if ((diff_scat_angle_ss > 0.1) .or. (cox_munk .neqv. last_cox_munk) .or. &
124  (cox_munk .and. diff_wind_speed > threshold_wind_speed)) then
125  interp_ss = .true.
126  lastinterp_scat_angle_ss = scattering_angle
127  end if
128 
129 
130  end subroutine set_interp_controls
131 
132 
133  subroutine set_water_path_answers(i,j, finalize_liq, finalize_ice)
134 
135  use libraryarrays
137  use core_arrays
140 
141  integer, intent(in) :: i, j
142  logical, dimension(:), intent(in) :: finalize_liq, finalize_ice
143 
144  if (allocated(liquid_water_path)) &
146  if (allocated(liquid_water_path_1621)) &
148 
149  if (allocated(liquid_water_path_16)) &
151  if (allocated(liquid_water_path_37)) &
153 
154  if (finalize_liq(1)) then
157  liquid_water_density, &
158  water_radii, &
159  extinction_water(1, :), &
161  endif
162  if (finalize_liq(2)) then
165  liquid_water_density, &
166  water_radii, &
167  extinction_water(1, :), &
168  liquid_water_path(i,j))
169  endif
170 
171  if (finalize_liq(3)) then
174  liquid_water_density, &
175  water_radii, &
176  extinction_water(1, :), &
178  endif
179 
180  if (finalize_liq(4)) then
183  liquid_water_density, &
184  water_radii, &
185  extinction_water(1, :), &
187  endif
188 
189  if (finalize_ice(1)) then
192  ice_water_density, &
193  ice_radii, &
194  extinction_ice(1, :), &
195  liquid_water_path_16(i,j))
196  endif
197 
198  if (finalize_ice(2)) then
201  ice_water_density, &
202  ice_radii, &
203  extinction_ice(1, :), &
204  liquid_water_path(i,j))
205 
206  endif
207 
208  if (finalize_ice(3)) then
211  ice_water_density, &
212  ice_radii, &
213  extinction_ice(1, :), &
215 
216  endif
217 
218  if (finalize_ice(4)) then
221  ice_water_density, &
222  ice_radii, &
223  extinction_ice(1, :), &
225  endif
226 
227  end subroutine set_water_path_answers
228 
229 
230  subroutine set_failure_answers(i,j, RSS_final, set_near)
231 
232  use core_arrays
235 
236  integer, intent(in) :: i,j
237  real, dimension(:), intent(in) :: RSS_final
238  logical, intent(in), dimension(:) :: set_near
239 
240 
241  if (set_near(1)) then
242  failure_metric_16(i,j)%tau = nint(optical_thickness_16_final(i,j)/retr_scale_factor)
244  failure_metric_16(i,j)%re = nint(effective_radius_16_final(i,j)/retr_scale_factor)
246  failure_metric_16(i,j)%RSS = nint(rss_final(re16)*100./retr_scale_factor)
250  endif
251 
252  if (set_near(2)) then
253  failure_metric(i,j)%tau = nint(optical_thickness_final(i,j)/retr_scale_factor)
254  if (optical_thickness_final(i,j) < 0) failure_metric(i,j)%tau = fillvalue_int2
255  failure_metric(i,j)%re = nint(effective_radius_21_final(i,j)/retr_scale_factor)
257  failure_metric(i,j)%RSS = nint(rss_final(re21)*100./retr_scale_factor)
261  endif
262 
263  if (set_near(3)) then
264  failure_metric_37(i,j)%tau = nint(optical_thickness_37_final(i,j)/retr_scale_factor)
266  failure_metric_37(i,j)%re = nint(effective_radius_37_final(i,j)/retr_scale_factor)
268  failure_metric_37(i,j)%RSS = nint(rss_final(re37)*100./retr_scale_factor)
272  endif
273 
274  if (set_near(4)) then
275  failure_metric_1621(i,j)%tau = nint(optical_thickness_1621_final(i,j)/retr_scale_factor)
277  failure_metric_1621(i,j)%re = nint(effective_radius_1621_final(i,j)/retr_scale_factor)
279  failure_metric_1621(i,j)%RSS = nint(rss_final(re1621)*100./retr_scale_factor)
283  endif
284 
285  end subroutine set_failure_answers
286 
287  subroutine init_science_arrays
288  ! W. Robinson, 1 may 2019 - set this to preserve lines processed
289  ! from a previous call and place them in the proper location
290  ! for the current scan
291  use generalauxtype
293  use core_arrays
294  use ch_xfr
295 
296  integer :: scan_sav = -999 ! saved scan from previous call
297  integer :: iln
298 
299  ! WDR OK, this sets up the lines to just transfer array values
300  ! to their new location relative to the new scan which points to
301  ! the center of the 3 line array (c2_scan). The transfer is done
302  ! from xfr_from to xfr_to for a total of xfr_num lines.
303  ! Otherwise, initialize here for lines scn_loop_st to scn_loop_en
304  ! and process in modis_science_module.f90
305  if( ( ( c2_scan - scan_sav ) .ge. 3 ) .or. &
306  ( ( c2_scan - scan_sav ) .le. -3 ) ) then
307  scn_loop_st = 1
308  scn_loop_en = 3 ! for the 3-line standard
309  !scn_loop_en = 5 ! for the 5-line test
310  xfr_num = 0
311  else if( ( c2_scan - scan_sav ) .eq. 2 ) then ! cur scan is 2 ahead
312  scn_loop_st = 2
313  scn_loop_en = 3
314  xfr_num = 1
315  xfr_from = (/ 3, 0 /)
316  xfr_to = (/ 1, 0 /)
317  else if( ( c2_scan - scan_sav ) .eq. 1 ) then ! cur scan is 1 ahead
318  ! for no mandatory re-compute of center line (fastest)
319  scn_loop_st = 3
320  scn_loop_en = 3
321  xfr_num = 2
322  xfr_from = (/ 2, 3 /)
323  xfr_to = (/ 1, 2 /)
324  ! for mandatory re-compute of center line (does a re-compute of
325  ! output line)
326  !scn_loop_st = 2
327  !scn_loop_en = 3
328  !xfr_num = 1
329  !xfr_from = (/ 2, 0 /)
330  !xfr_to = (/ 1, 0 /)
331  ! for no efficiency at all (Do all 3 lines again)
332  !scn_loop_st = 1
333  !scn_loop_en = 3
334  !xfr_num = 0
335  ! test to go back to 3-lin use - well, it works
336  !scn_loop_st = 1
337  ! WDR for 5-lin test scn_loop_en = 3
338  !scn_loop_en = 3
339  !scn_loop_en = 5
340  !xfr_num = 0
341  else if( ( c2_scan - scan_sav ) .eq. 0 ) then ! cur scan is unchanged
342  scn_loop_st = 0
343  scn_loop_en = 0
344  xfr_num = 0
345  else if( ( c2_scan - scan_sav ) .eq. -1 ) then ! cur scan is 1 behind
346  ! for no mandatory re-compute of center line
347  scn_loop_st = 1
348  scn_loop_en = 1
349  xfr_num = 2
350  xfr_from = (/ 2, 1 /)
351  xfr_to = (/ 3, 2 /)
352  !for mandatory re-compute of center line
353  !scn_loop_st = 1
354  !scn_loop_en = 2
355  !xfr_num = 1
356  !xfr_from = (/ 2, 0 /)
357  !xfr_to = (/ 3, 0 /)
358  else if( ( c2_scan - scan_sav ) .eq. -2 ) then ! cur scan is 2 behind
359  scn_loop_st = 1
360  scn_loop_en = 2
361  xfr_num = 1
362  xfr_from = (/ 1, 0 /)
363  xfr_to = (/ 3, 0 /)
364  endif
365 !print*, __FILE__, __LINE__
366 !print*, "scan_sav, c2_scan, scn_loop_st, scn_loop_en ", scan_sav, c2_scan, scn_loop_st, scn_loop_en
367 !print*, "xfr_num, xfr_from, xfr_to ", xfr_num, xfr_from, xfr_to
368  scan_sav = c2_scan
369  ! WDR We'll have a transfer phase (to put the lines in the right place)
370  ! and a init phase to put fill in the open lines of the array
371  !
372  ! Transfer phase
373  if( xfr_num > 0 ) then
374  do iln = 1, xfr_num
375  if (allocated(optical_thickness_final)) then
376 
389 
396 
397  failure_metric(:,xfr_to(iln))%tau = failure_metric_sav(:,xfr_from(iln))%tau
398  failure_metric(:,xfr_to(iln))%re = failure_metric_sav(:,xfr_from(iln))%re
399  failure_metric(:,xfr_to(iln))%RSS = failure_metric_sav(:,xfr_from(iln))%RSS
400 
404 
405  atm_corr_refl(:,:, xfr_to(iln)) = atm_corr_refl_sav(:,:, xfr_from(iln))
407 
408  endif
409 
410  if (allocated(seviri_cloudphase)) seviri_cloudphase(:, xfr_to(iln)) = seviri_cloudphase(:, xfr_from(iln))
411 
418 
425 
433  ml_test_flag(:, xfr_to(iln)) = ml_test_flag_sav(:, xfr_from(iln))
436 
437 
438  failure_metric_16(:,xfr_to(iln))%tau = failure_metric_16_sav(:,xfr_from(iln))%tau
440  failure_metric_16(:,xfr_to(iln))%RSS = failure_metric_16_sav(:,xfr_from(iln))%RSS
441 
442  failure_metric_37(:,xfr_to(iln))%tau = failure_metric_37_sav(:,xfr_from(iln))%tau
444  failure_metric_37(:,xfr_to(iln))%RSS = failure_metric_37_sav(:,xfr_from(iln))%RSS
445 
446  if (allocated(tau_liquid)) then
447  tau_liquid(:, xfr_to(iln)) = tau_liquid_sav(:, xfr_from(iln))
448  tau_ice(:, xfr_to(iln)) = tau_ice_sav(:, xfr_from(iln))
449  re21_liquid(:, xfr_to(iln)) = re21_liquid_sav(:, xfr_from(iln))
450  re21_ice(:, xfr_to(iln)) = re21_ice_sav(:, xfr_from(iln))
451  endif
452  ! WDR this may at least need transfer and was not in the orig code:
453  cloudsummary(:, xfr_to(iln)) = cloudsummary_sav(:, xfr_from(iln))
454  ! WDR 31jul19 add in transfer of processing_information
455  processing_information(:, xfr_to(iln)) = &
457  !
458  ! WDR The point, table reflectance diagnostic arrays
459  prd_out_refl_loc_2100( :, xfr_to(iln), : ) = &
460  prd_out_refl_loc_2100_sav( :, xfr_from(iln), : )
461  prd_out_refl_loc_1600( :, xfr_to(iln), : ) = &
462  prd_out_refl_loc_1600_sav( :, xfr_from(iln), : )
463  prd_out_refl_loc_1621( :, xfr_to(iln), : ) = &
464  prd_out_refl_loc_1621_sav( :, xfr_from(iln), : )
465  enddo
466  endif ! Transfer phase
467  !
468  ! Init phase
469  if( scn_loop_st .ne. 0 ) then
470  if (allocated(optical_thickness_final)) then
471 
484 
491 
495 
499 
502 
503  endif
504 
506 
513 
520 
531 
532 
536 
540 
541  if (allocated(tau_liquid)) then
546  endif
547  ! also the refl_loc initialize
551  endif ! Init phase
552  end subroutine init_science_arrays
553 
554  subroutine capture_arrays
555  ! W. Robinson, 3 May 2019 new routine to save the states of the 3
556  ! line science arrays after their derivation in modis_science_module.f90
557  ! for use in the next line (really 3 lines) of data processing
558  use generalauxtype
560  use core_arrays
561  use ch_xfr
562 
563  integer :: adims(3), np, nl, nb
564  integer :: checkvariable, sav_alloc = 0
565  !
566  ! if required, allocate the save arrays
567  if( sav_alloc .eq. 0 ) then
568  sav_alloc = 1
569  adims = shape( atm_corr_refl )
570  nb = adims(1)
571  np = adims(2)
572  nl = adims(3)
573 
574  allocate(optical_thickness_final_sav(np,nl), stat = checkvariable)
575  allocate(optical_thickness_1621_final_sav(np,nl), stat = checkvariable)
576  allocate(effective_radius_21_final_sav(np,nl), stat = checkvariable)
577  allocate(effective_radius_1621_final_sav(np,nl), stat = checkvariable)
578  allocate(liquid_water_path_sav(np,nl), stat = checkvariable)
579  allocate(liquid_water_path_1621_sav(np,nl), stat = checkvariable)
580  allocate(optical_thickness_final_pcl_sav(np,nl), stat = checkvariable)
581  allocate(optical_thickness_1621_final_pcl_sav(np,nl), stat = checkvariable)
582  allocate(effective_radius_21_final_pcl_sav(np,nl), stat = checkvariable)
583  allocate(effective_radius_1621_final_pcl_sav(np,nl), stat = checkvariable)
584  allocate(liquid_water_path_pcl_sav(np,nl), stat = checkvariable)
585  allocate(liquid_water_path_1621_pcl_sav(np,nl), stat = checkvariable)
586  allocate(optical_thickness_error_sav(np,nl), stat = checkvariable)
587  allocate(effective_radius_21_error_sav(np,nl), stat = checkvariable)
588  allocate(liquid_water_path_error_sav(np,nl), stat = checkvariable)
589  allocate(optical_thickness_1621_error_sav(np,nl), stat = checkvariable)
590  allocate(effective_radius_1621_error_sav(np,nl), stat = checkvariable)
591  allocate(liquid_water_path_1621_error_sav(np,nl), stat = checkvariable)
592  allocate(failure_metric_sav(np,nl), stat = checkvariable)
593  allocate(failure_metric_1621_sav(np,nl), stat = checkvariable)
594  allocate(atm_corr_refl_sav(nb,np,nl), stat = checkvariable)
595  allocate(precip_water_094_sav(np,nl), stat = checkvariable)
596  allocate(optical_thickness_16_final_sav(np,nl), stat = checkvariable)
597  allocate(optical_thickness_37_final_sav(np,nl), stat = checkvariable)
598  allocate(effective_radius_16_final_sav(np,nl), stat = checkvariable)
599  allocate(effective_radius_37_final_sav(np,nl), stat = checkvariable)
600  allocate(liquid_water_path_16_sav(np,nl), stat = checkvariable)
601  allocate(liquid_water_path_37_sav(np,nl), stat = checkvariable)
602  allocate(optical_thickness_16_final_pcl_sav(np,nl), stat = checkvariable)
603  allocate(optical_thickness_37_final_pcl_sav(np,nl), stat = checkvariable)
604  allocate(effective_radius_16_final_pcl_sav(np,nl), stat = checkvariable)
605  allocate(effective_radius_37_final_pcl_sav(np,nl), stat = checkvariable)
606  allocate(liquid_water_path_16_pcl_sav(np,nl), stat = checkvariable)
607  allocate(liquid_water_path_37_pcl_sav(np,nl), stat = checkvariable)
608  allocate(optical_thickness_16_error_sav(np,nl), stat = checkvariable)
609  allocate(optical_thickness_37_error_sav(np,nl), stat = checkvariable)
610  allocate(effective_radius_16_error_sav(np,nl), stat = checkvariable)
611  allocate(effective_radius_37_error_sav(np,nl), stat = checkvariable)
612  allocate(liquid_water_path_16_error_sav(np,nl), stat = checkvariable)
613  allocate(liquid_water_path_37_error_sav(np,nl), stat = checkvariable)
614  allocate(cloud_layer_flag_sav(np,nl), stat = checkvariable)
615  allocate(ml_test_flag_sav(np,nl), stat = checkvariable)
616  allocate(csr_flag_array_sav(np,nl), stat = checkvariable)
617  allocate(irw_temperature_sav(np,nl), stat = checkvariable)
618  allocate(failure_metric_16_sav(np,nl), stat = checkvariable)
619  allocate(failure_metric_37_sav(np,nl), stat = checkvariable)
620  if (allocated(tau_liquid)) then
621  allocate(tau_liquid_sav(np,nl), stat = checkvariable)
622  allocate(tau_ice_sav(np,nl), stat = checkvariable)
623  allocate(re21_liquid_sav(np,nl), stat = checkvariable)
624  allocate(re21_ice_sav(np,nl), stat = checkvariable)
625  endif
626  allocate(cloudsummary_sav(np,nl), stat = checkvariable)
627  allocate(processing_information_sav(np,nl), stat = checkvariable)
628  ! WDR add the point / table diagnostics
629  allocate( prd_out_refl_loc_2100_sav(np,nl,10), stat = checkvariable)
630  allocate( prd_out_refl_loc_1600_sav(np,nl,10), stat = checkvariable)
631  allocate( prd_out_refl_loc_1621_sav(np,nl,10), stat = checkvariable)
632  endif
633  ! and copy the data to the save arrays
680  if (allocated(tau_liquid)) then
685  endif
688  ! table point refl diagnostic
692 
693  end subroutine capture_arrays
694 
695  subroutine assign_retrieval_error(xpoint, ypoint)
698  use core_arrays
699  integer, intent(in) :: xpoint,ypoint
700 
701 
702  if (allocated(optical_thickness_final)) then
703 
704  optical_thickness_final(xpoint, ypoint) = fillvalue_real
706  effective_radius_21_final(xpoint, ypoint) = fillvalue_real
708  liquid_water_path(xpoint, ypoint) = fillvalue_real
709  liquid_water_path_1621(xpoint, ypoint) = fillvalue_real
710  optical_thickness_error(xpoint, ypoint) = fillvalue_int2
711  effective_radius_21_error(xpoint, ypoint) = fillvalue_int2
712  liquid_water_path_error(xpoint, ypoint) = fillvalue_int2
716 
717  endif
718 
721  effective_radius_16_final(xpoint, ypoint) = fillvalue_real
722  effective_radius_37_final(xpoint, ypoint) = fillvalue_real
723  liquid_water_path_16(xpoint, ypoint) = fillvalue_real
724  liquid_water_path_37(xpoint, ypoint) = fillvalue_real
727  effective_radius_16_error(xpoint, ypoint) = fillvalue_int2
728  effective_radius_37_error(xpoint, ypoint) = fillvalue_int2
731  cloud_layer_flag(xpoint, ypoint) = 0
732  ml_test_flag(xpoint, ypoint) = 0
733  csr_flag_array(xpoint, ypoint) = 0
734 
735  if (allocated(tau_liquid)) then
736  tau_liquid(xpoint, ypoint) = fillvalue_int2
737  tau_ice(xpoint, ypoint) = fillvalue_int2
738  re21_liquid(xpoint, ypoint) = fillvalue_int2
739  re21_ice(xpoint, ypoint) = fillvalue_int2
740  endif
741 
742 
743  end subroutine assign_retrieval_error
744 
745  subroutine split_pcl(xdim, ydim)
746 
747  use core_arrays
749 
750  integer, intent(in) :: xdim, ydim
751 
752  integer :: i,j
753 
754  do j=1, ydim
755  do i=1, xdim
756 
757  if (csr_flag_array(i,j) == 1 .or. csr_flag_array(i,j) == 3) then
758 
759 
760  if (allocated(optical_thickness_final)) then
761  if (optical_thickness_final(i,j) > 0.) &
762  optical_thickness_final_pcl(i,j) = nint(optical_thickness_final(i,j) / retr_scale_factor)
764 
765  if (optical_thickness_1621_final(i,j) > 0.) &
766  optical_thickness_1621_final_pcl(i,j) = nint(optical_thickness_1621_final(i,j) / retr_scale_factor)
768 
769  if (effective_radius_21_final(i,j) > 0.) &
770  effective_radius_21_final_pcl(i,j) = nint(effective_radius_21_final(i,j) / retr_scale_factor)
772 
773  if (effective_radius_1621_final(i,j) > 0.) &
774  effective_radius_1621_final_pcl(i,j) = nint(effective_radius_1621_final(i,j) / retr_scale_factor)
776 
777  if (liquid_water_path(i,j) > 0.) &
778  liquid_water_path_pcl(i,j) = nint(liquid_water_path(i,j))
780 
781  if (liquid_water_path_1621(i,j) > 0.) &
784  endif
785 
786  if (optical_thickness_37_final(i,j) > 0.) &
787  optical_thickness_37_final_pcl(i,j) = nint(optical_thickness_37_final(i,j) / retr_scale_factor)
789 
790 
791  if (optical_thickness_16_final(i,j) > 0.) &
792  optical_thickness_16_final_pcl(i,j) = nint(optical_thickness_16_final(i,j) / retr_scale_factor)
794 
795  if (effective_radius_16_final(i,j) > 0.) &
796  effective_radius_16_final_pcl(i,j) = nint(effective_radius_16_final(i,j) / retr_scale_factor)
798 
799 
800  if (effective_radius_37_final(i,j) > 0.) &
801  effective_radius_37_final_pcl(i,j) = nint(effective_radius_37_final(i,j) / retr_scale_factor)
803 
804 
805  if (liquid_water_path_16(i,j) > 0.) &
808 
809  if (liquid_water_path_37(i,j) > 0.) &
812 
813 
814  endif
815 
816  end do
817  end do
818 
819 
820 
821  end subroutine split_pcl
822 
823 
824 
825 
826 end module general_science_module
827 
integer *2, dimension(:,:), allocatable optical_thickness_37_error
Definition: core_arrays.f90:65
Definition: ch_xfr.f90:1
integer *2, dimension(:,:), allocatable effective_radius_16_final_pcl
Definition: core_arrays.f90:47
integer, parameter re21
subroutine compute_water_path(tau, re, density, library_re, extinction_efficiency, water_path)
real(single), dimension(:,:), allocatable liquid_water_path
Definition: core_arrays.f90:56
integer *2, dimension(:,:), allocatable liquid_water_path_1621_pcl_sav
real(single), dimension(:,:), allocatable liquid_water_path_16_sav
integer *2, dimension(:,:), allocatable effective_radius_1621_final_pcl
Definition: core_arrays.f90:50
integer *2, dimension(:,:), allocatable liquid_water_path_37_pcl_sav
integer *2, dimension(:,:), allocatable liquid_water_path_16_pcl
Definition: core_arrays.f90:52
integer *2, dimension(:,:), allocatable optical_thickness_16_error_sav
integer(integer_onebyte), dimension(:,:), allocatable cloud_layer_flag
Definition: core_arrays.f90:79
integer *2, dimension(:,:), allocatable optical_thickness_16_final_pcl_sav
integer *2, dimension(:,:), allocatable effective_radius_16_error
Definition: core_arrays.f90:68
integer *2, dimension(:,:), allocatable tau_liquid_sav
integer *2, dimension(:,:), allocatable effective_radius_37_error_sav
integer *2, dimension(:,:), allocatable liquid_water_path_16_error
Definition: core_arrays.f90:72
subroutine set_interp_controls(i, j, scattering_angle, cur_wind_speed, drel, threshold_solar_zenith, threshold_sensor_zenith, wind_speed_only, interp_SS, interp_MS)
real, dimension(:,:,:), allocatable prd_out_refl_loc_2100_sav
Definition: ch_xfr.f90:67
integer *2, dimension(:,:), allocatable effective_radius_1621_error_sav
real(single), dimension(:,:), allocatable optical_thickness_37_final
Definition: core_arrays.f90:36
integer *2, dimension(:,:), allocatable optical_thickness_37_final_pcl
Definition: core_arrays.f90:45
real(single), dimension(:,:), allocatable effective_radius_37_final
Definition: core_arrays.f90:40
real(single), dimension(:,:), allocatable optical_thickness_1621_final_sav
real(single), dimension(:,:), allocatable liquid_water_path_37_sav
integer *2, dimension(:,:), allocatable effective_radius_21_final_pcl
Definition: core_arrays.f90:48
integer, parameter re37
subroutine assign_retrieval_error(xpoint, ypoint)
integer *2, dimension(:,:), allocatable optical_thickness_1621_error
Definition: core_arrays.f90:75
integer *2, dimension(:,:), allocatable liquid_water_path_pcl
Definition: core_arrays.f90:51
integer *2, dimension(:,:), allocatable tau_liquid
Definition: core_arrays.f90:32
real(single), dimension(:,:), allocatable effective_radius_16_final_sav
real, dimension(:,:), allocatable irw_temperature
integer *2, dimension(:,:), allocatable optical_thickness_error
Definition: core_arrays.f90:63
real(single), dimension(:,:), allocatable optical_thickness_16_final_sav
real, dimension(:,:,:), allocatable prd_out_refl_loc_1621_sav
Definition: ch_xfr.f90:69
real(single), dimension(:,:), allocatable liquid_water_path_1621_sav
real, dimension(:,:,:), allocatable atm_corr_refl_sav
real, dimension(:,:,:), allocatable prd_out_refl_loc_1600
Definition: ch_xfr.f90:60
integer *2, dimension(:,:), allocatable effective_radius_21_final_pcl_sav
integer *2, parameter fillvalue_int2
real, dimension(:,:,:), allocatable atm_corr_refl
type(failed_type), dimension(:,:), allocatable failure_metric_1621
integer *2, dimension(:,:), allocatable liquid_water_path_error
Definition: core_arrays.f90:71
subroutine split_pcl(xdim, ydim)
type(failed_type), dimension(:,:), allocatable failure_metric_sav
type(failed_type), dimension(:,:), allocatable failure_metric_37_sav
type(failed_type), dimension(:,:), allocatable failure_metric_1621_sav
type(processflag), dimension(:,:), allocatable cloudsummary
Definition: core_arrays.f90:87
real(single), dimension(:), allocatable water_radii
integer *2, dimension(:,:), allocatable liquid_water_path_37_error
Definition: core_arrays.f90:73
integer *2, dimension(:,:), allocatable liquid_water_path_16_error_sav
integer *2, dimension(:,:), allocatable liquid_water_path_error_sav
integer *2, dimension(:,:), allocatable effective_radius_16_final_pcl_sav
integer *2, dimension(:,:), allocatable optical_thickness_16_final_pcl
Definition: core_arrays.f90:44
integer *2, dimension(:,:), allocatable liquid_water_path_16_pcl_sav
type(failed_type), dimension(:,:), allocatable failure_metric_16
subroutine set_water_path_answers(i, j, finalize_liq, finalize_ice)
real, dimension(:,:,:), allocatable prd_out_refl_loc_1600_sav
Definition: ch_xfr.f90:68
integer(integer_onebyte), dimension(:,:), allocatable csr_flag_array
Definition: core_arrays.f90:80
real, dimension(:,:), allocatable solar_zenith_angle
Definition: core_arrays.f90:6
integer *2, dimension(:,:), allocatable optical_thickness_final_pcl_sav
real(single), dimension(:,:), allocatable effective_radius_37_final_sav
real(single), dimension(:,:), allocatable effective_radius_21_final_sav
integer *2, dimension(:,:), allocatable effective_radius_16_error_sav
real(single), dimension(:,:), allocatable liquid_water_path_37
Definition: core_arrays.f90:58
integer *2, dimension(:,:), allocatable effective_radius_21_error_sav
real(single), dimension(:,:), allocatable extinction_ice
real(single), dimension(:,:), allocatable optical_thickness_final
Definition: core_arrays.f90:34
integer scn_loop_en
integer *2, dimension(:,:), allocatable liquid_water_path_37_error_sav
real(single), dimension(:,:), allocatable extinction_water
integer *2, dimension(:,:), allocatable optical_thickness_final_pcl
Definition: core_arrays.f90:43
type(failed_type), dimension(:,:), allocatable failure_metric
real(single), dimension(:,:), allocatable optical_thickness_final_sav
real(single), dimension(:,:), allocatable liquid_water_path_1621
Definition: core_arrays.f90:59
subroutine set_failure_answers(i, j, RSS_final, set_near)
real(single), dimension(:), allocatable ice_radii
integer *2, dimension(:,:), allocatable liquid_water_path_1621_error
Definition: core_arrays.f90:77
integer scn_loop_st
integer *2, dimension(:,:), allocatable effective_radius_37_final_pcl
Definition: core_arrays.f90:49
integer *2, dimension(:,:), allocatable optical_thickness_1621_final_pcl
Definition: core_arrays.f90:46
integer *2, dimension(:,:), allocatable re21_liquid
Definition: core_arrays.f90:32
real, dimension(:,:), allocatable precip_water_094
integer, dimension(2) xfr_to
real(single), dimension(:,:), allocatable liquid_water_path_sav
integer, dimension(2) xfr_from
subroutine set_drel(threshold_relative_azimuth, drel)
real, parameter dscat3
real, dimension(:,:,:), allocatable prd_out_refl_loc_1621
Definition: ch_xfr.f90:61
integer *2, dimension(:,:), allocatable optical_thickness_1621_error_sav
real, dimension(:,:), allocatable sensor_zenith_angle
integer(integer_onebyte), dimension(:,:), allocatable ml_test_flag
Definition: core_arrays.f90:79
real(single), dimension(:,:), allocatable relative_azimuth_angle
real(single), dimension(:,:), allocatable optical_thickness_1621_final
Definition: core_arrays.f90:37
integer(integer_onebyte), dimension(:,:), allocatable csr_flag_array_sav
integer *2, dimension(:,:), allocatable effective_radius_37_final_pcl_sav
integer *2, dimension(:,:), allocatable re21_ice
Definition: core_arrays.f90:32
integer *2, dimension(:,:), allocatable optical_thickness_37_error_sav
integer *2, dimension(:,:), allocatable optical_thickness_error_sav
integer *2, dimension(:,:), allocatable effective_radius_1621_error
Definition: core_arrays.f90:76
integer c2_scan
Definition: ch_xfr.f90:44
type(qualityanalysis), dimension(:,:), allocatable processing_information
integer *2, dimension(:,:), allocatable tau_ice_sav
integer *2, dimension(:,:), allocatable effective_radius_21_error
Definition: core_arrays.f90:67
real(single), dimension(:,:), allocatable liquid_water_path_16
Definition: core_arrays.f90:57
integer *2, dimension(:,:), allocatable optical_thickness_1621_final_pcl_sav
integer *1, dimension(:,:), allocatable seviri_cloudphase
real(single), dimension(:,:), allocatable effective_radius_1621_final_sav
type(failed_type), dimension(:,:), allocatable failure_metric_37
real, dimension(:,:), allocatable precip_water_094_sav
integer *2, dimension(:,:), allocatable liquid_water_path_pcl_sav
real(single), dimension(:,:), allocatable optical_thickness_16_final
Definition: core_arrays.f90:35
real(single), dimension(:,:), allocatable optical_thickness_37_final_sav
integer *2, dimension(:,:), allocatable re21_ice_sav
real(single), dimension(:,:), allocatable effective_radius_16_final
Definition: core_arrays.f90:38
integer *2, dimension(:,:), allocatable optical_thickness_37_final_pcl_sav
integer(integer_onebyte), dimension(:,:), allocatable ml_test_flag_sav
integer xfr_num
real, dimension(:,:), allocatable irw_temperature_sav
integer *2, dimension(:,:), allocatable optical_thickness_16_error
Definition: core_arrays.f90:64
integer(integer_onebyte), dimension(:,:), allocatable cloud_layer_flag_sav
integer *2, dimension(:,:), allocatable liquid_water_path_1621_error_sav
type(processflag), dimension(:,:), allocatable cloudsummary_sav
real, dimension(:,:,:), allocatable prd_out_refl_loc_2100
Definition: ch_xfr.f90:59
integer *2, dimension(:,:), allocatable tau_ice
Definition: core_arrays.f90:32
type(qualityanalysis), dimension(:,:), allocatable processing_information_sav
integer *2, dimension(:,:), allocatable effective_radius_37_error
Definition: core_arrays.f90:69
#define abs(a)
Definition: misc.h:90
real(single), dimension(:,:), allocatable effective_radius_1621_final
Definition: core_arrays.f90:41
integer *2, dimension(:,:), allocatable liquid_water_path_37_pcl
Definition: core_arrays.f90:53
integer *2, dimension(:,:), allocatable re21_liquid_sav
real, parameter threshold_wind_speed
integer *2, dimension(:,:), allocatable liquid_water_path_1621_pcl
Definition: core_arrays.f90:54
integer, parameter re1621
type(failed_type), dimension(:,:), allocatable failure_metric_16_sav
integer *2, dimension(:,:), allocatable effective_radius_1621_final_pcl_sav
integer, parameter re16
real(single), dimension(:,:), allocatable effective_radius_21_final
Definition: core_arrays.f90:39