OB.DAAC Logo
NASA Logo
Ocean Color Science Software

ocssw V2022
rtm_support.f90
Go to the documentation of this file.
1 module rtm_support
2 !
3 ! Disclaimer: All this stuff is courtesy of UW-Madison. Author unknown.
4 ! There are no comments in the original code.
5 !
6 ! WDR Note that for the transition to l2gen, we changed the
7 ! model_info(...)%<val> to c2_model_info%<val> for l2gen anc values
8 !
9 !
10 ! have to use MASTER channel numbers in modis_planck, modis_bright, but MAS channels in PFAAST
11 
13  use names
14  use science_parameters, only : model_levels, d2r
16  use ch_xfr, only : c2_sensor_id, oci_id
17 #if !CT_CODE
19 #else
21 #endif
22 
23 ! use FASCODE_routines
24  use pfaast
25 #ifdef VIIRS_INST
26  use pfaast_modis
27 #endif
28 
29  implicit none
30 
31  private
32 
33 
34  integer :: start_level
35 
36 #ifdef CT_CODE
37 #if !MAS_INST & !EMAS_INST
38  integer, parameter :: nchan = set_number_of_bands
39 #else
40  integer, parameter :: nchan = set_number_of_bands-3
41 #endif
42 #else
43  integer, parameter :: nchan = 2
44 #endif
45 
46  real :: rtm_trans_2way(nchan, model_levels)
48  real :: rtm_rad_atm_clr(nchan, model_levels)
49  real :: rtm_cloud_prof(nchan, model_levels)
50 
51  real :: b_profile(nchan, model_levels)
52 
53 #ifndef CT_CODE
54 
56 
61 
66 
67 
68 #endif
69 
70 
71  integer :: last_i, last_j
72  real :: last_2way_angle
73  real :: last_zenith
74 
75 
76 
78  public :: init_rtm_vars
79 #ifndef CT_CODE
83 #endif
84 
85 contains
86 
87 
88  subroutine init_rtm_vars()
89 
90  last_zenith = -999.
91  last_2way_angle = -999.
92 
93  last_i = -1
94  last_j = -1
95 
96  start_level = 1
97 
98 #if MAS_INST || EMAS_INST
99  start_level = 36
100 #endif
101 
102  end subroutine init_rtm_vars
103 
104  subroutine get_rtm_parameters (platform, surface_emissivity, view_zenith, sun_zenith, i, j, x, y)
105 
106 ! WDR - this looks to be entirely for 3.7 um and up. Strictly speaking,
107 ! OCI should not need this, so try removing call to MODIS_fascode
108 ! True - OCI is unchanged, but Aqua does change - we'll have to do sensor
109 ! specific calling
111 
112  real, intent(in) :: view_zenith, surface_emissivity(:), sun_zenith
113  character(*), intent(in) :: platform
114  integer, intent(in) :: i, j, x, y
115 
116  real :: ozone(model_levels)
117  integer :: platform_id
118  integer :: idet, iok, sfc_level
119  real :: rtm_rad_clr, rtm_bt_clr
120  integer :: channels(nchan)
121  integer :: k, jj
122  integer :: emis_idx, path_len, channel_use
123  real :: angle_two_way, miu, miu0
124  logical :: do_2way, newatm, newang, new_2way
125 
126  real :: temp_mixr(model_levels)
127 
128 ! channels(1) = bands(band_0370)
129 #ifndef CT_CODE
130  channels(1) = set_bands(band_1100)
131  channels(2) = set_bands(band_0370)
132 #ifdef VIIRS_INST
133  if (modis_mode) then
134  channels(1) = set_bands_modis(band_1100)
135  channels(2) = set_bands_modis(band_0370)
136  endif
137 #endif
138 
139 
140  ozone = 0.
141 
142 #else
143  ! WDR, if I understand right, for modis, this is not used
144  ozone = c2_model_info%o3_profile
145 
146 #if !MAS_INST & !EMAS_INST
147  channels = set_bands
148 #else
149  channels = set_bands(1:set_number_of_bands-3)
150 #endif
151 
152 #endif
153 
154  idet = 0
155 
156 
157  ! re-execute the transmittance calculations only if it makes sense to do so.
158  ! There is more than one MODIS pixel that has the same vza and fits within same 1-degree box
159  ! so we will recycle the transmittance for points like that.
160 
161 
162  path_len = len(trim(act_lib_path))
163 
164  platform_id = -1
165  if (platform(1:5) == "Terra" .or. platform(1:5) == "terra") then
166  platform_id = 0
167  endif
168  if (platform(1:4) == "Aqua" .or. platform(1:4) == "aqua" ) then
169  platform_id = 1
170  endif
171 
172  miu0 = cos(d2r*sun_zenith)
173  miu = cos(d2r*view_zenith)
174 
175 
176  angle_two_way = acos( miu*miu0 / (miu+miu0)) / d2r
177 
178  newatm = .false.
179  newang = .false.
180  new_2way = .false.
181 
182  if (abs(view_zenith - last_zenith) > 0.005) newang = .true.
183  if (angle_two_way /= last_2way_angle) new_2way = .true.
184  if (last_i /= i .or. last_j /= j) newatm = .true.
185 
186  do_2way = .true.
187 
188 #ifdef CT_CODE
189  do_2way = .false.
190  new_2way = .false.
191 #endif
192  if (newatm) then
193  do k=1, nchan
194  do jj=start_level, model_levels
195  b_profile(k,jj) = modis_planck(platform, c2_model_info%temp_profile(jj), channels(k), 1)
196  end do
197  end do
198 
199  end if
200 
201  do k=1, nchan
202 
203 
204 #ifdef MODIS_INST
205 
206  if( c2_sensor_id .ne. oci_id ) then
207  call modis_fascode(trim(act_lib_path) // char(0), myyear, &
208  myday, c2_model_info%temp_profile, c2_model_info%mixr_profile, &
209  ozone, view_zenith, angle_two_way, platform_id, channels(k), &
210  idet, rtm_trans_atm_clr(k,:), rtm_trans_2way(k,:), &
211  newang, newatm, new_2way, do_2way, iok, x, y)
212  endif
213 
214 #endif
215 
216 #if MAS_INST || EMAS_INST
217  if (platform == "MASTER") then
218 #ifdef CT_CODE
219 ! channel_use = set_bands_mas(k)
220  channel_use = set_bands_master(k)
221 #else
222  if (k==1) then
223 ! channel_use = set_bands_mas(band_1100)
224  channel_use = set_bands_master(k)
225  else
226  channel_use = channels(k)
227  endif
228 #endif
229 
230  else
231  channel_use = channels(k)
232  endif
233 
234  call mas_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile(36:model_levels), &
235  c2_model_info%mixr_profile(36:model_levels), ozone(36:model_levels), view_zenith, &
236  angle_two_way, mymission, channel_use, &
237  rtm_trans_atm_clr(k,36:model_levels), rtm_trans_2way(k, 36:model_levels), newang, newatm, new_2way, &
238  do_2way, iok)
239 
240 
241 #endif
242 
243 ! need to get (and keep) information about which MSG satellite we have: 8 or 9
244 ! this information must be passed to the code somehow by the production crew
245 #ifdef SEVIRI_INST
246 
247 
248  call seviri_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
249  c2_model_info%mixr_profile, ozone, view_zenith, angle_two_way, mymsg, channels(k), &
250  rtm_trans_atm_clr(k,:), rtm_trans_2way(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
251 
252 #endif
253 
254 #ifdef AHI_INST
255 
256  call ahi_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
257  c2_model_info%mixr_profile, ozone, view_zenith, angle_two_way, channels(k), &
258  rtm_trans_atm_clr(k,:), rtm_trans_2way(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
259 
260 #endif
261 
262 
263 
264 #ifdef VIIRS_INST
265  if (modis_mode) then
266 
267  call modis_fascode(trim(act_lib_path) // char(0), myyear, myday, c2_model_info%temp_profile, &
268  c2_model_info%mixr_profile, ozone, view_zenith, angle_two_way, &
269  platform_id, channels(k), idet, rtm_trans_atm_clr(k,:), rtm_trans_2way(k,:), &
270  newang, newatm, new_2way, do_2way, iok, x, y)
271 
272  else
273 
274 
275  call viirs_fascode(trim(act_lib_path), myyear, myday, c2_model_info%temp_profile, &
276  c2_model_info%mixr_profile, ozone, view_zenith, angle_two_way, channels(k), &
277  rtm_trans_atm_clr(k,:), rtm_trans_2way(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
278  endif
279 #endif
280 
281 
282  end do
283 
284 #ifndef CT_CODE
285 
286 #ifdef MODIS_INST
287 ! we only need all this stuff for 3.7um channel, ever, so only run the 3.7um channel, don't waste time.
288  newatm = .true.
289  temp_mixr = c2_model_info%mixr_profile*0.8
290  do k=1, nchan
291 ! k = nchan
292  if( c2_sensor_id .ne. oci_id ) then
293  call modis_fascode(trim(act_lib_path) // char(0), myyear, myday, &
294  c2_model_info%temp_profile, temp_mixr, ozone, view_zenith, &
295  angle_two_way, platform_id, channels(k), idet, &
297  newang, newatm, new_2way, do_2way, iok, x, y)
298  endif
299  end do
300  newatm = .true.
301  temp_mixr = c2_model_info%mixr_profile*1.2
302  do k=1, nchan
303 ! k = nchan
304  if( c2_sensor_id .ne. oci_id ) then
305  call modis_fascode(trim(act_lib_path) // char(0), myyear, myday, &
306  c2_model_info%temp_profile, temp_mixr, ozone, view_zenith, &
307  angle_two_way, platform_id, channels(k), idet, &
309  newang, newatm, new_2way, do_2way, iok, x, y)
310  endif
311  end do
312 
314  abs(rtm_trans_2way_high(2,:) - rtm_trans_2way(2,:)) ) / 2.
315 
316 #endif
317 
318 #if MAS_INST || EMAS_INST
319 ! we only need all this stuff for 3.7um channel, ever, so only run the 3.7um channel, don't waste time.
320 ! the 3.7um channel is the same for MAS and MASTER
321  newatm = .true.
322  temp_mixr = c2_model_info%mixr_profile*0.8
323  do k=1, nchan
324 ! k = nchan
325 
326  call mas_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile(36:model_levels), &
327  temp_mixr(36:model_levels), ozone(36:model_levels), view_zenith, &
328  angle_two_way, mymission, channel_use, &
329  rtm_trans_atm_clr_low(k,36:model_levels), rtm_trans_2way_low(k, 36:model_levels), newang, newatm, new_2way, &
330  do_2way, iok)
331  end do
332 
333  newatm = .true.
334  temp_mixr = c2_model_info%mixr_profile*1.2
335  do k=1, nchan
336 ! k = nchan
337  call mas_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile(36:model_levels), &
338  temp_mixr(36:model_levels), ozone(36:model_levels), view_zenith, &
339  angle_two_way, mymission, channel_use, &
340  rtm_trans_atm_clr_high(k,36:model_levels), rtm_trans_2way_high(k, 36:model_levels), newang, newatm, new_2way, &
341  do_2way, iok)
342  end do
343 
345  abs(rtm_trans_2way_high(2,:) - rtm_trans_2way(2,:)) ) / 2.
346 
347 
348 #endif
349 
350 
351 
352 #ifdef SEVIRI_INST
353 ! we only need all this stuff for 3.7um channel, ever, so only run the 3.7um channel, don't waste time.
354  newatm = .true.
355  temp_mixr = c2_model_info%mixr_profile*0.8
356  do k=1, nchan
357 ! k = nchan
358  call seviri_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
359  temp_mixr, ozone, view_zenith, angle_two_way, mymsg, channels(k), &
360  rtm_trans_atm_clr_low(k,:), rtm_trans_2way_low(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
361  end do
362 
363  newatm = .true.
364  temp_mixr = c2_model_info%mixr_profile*1.2
365  do k=1, nchan
366 ! k = nchan
367  call seviri_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
368  temp_mixr, ozone, view_zenith, angle_two_way, mymsg, channels(k), &
369  rtm_trans_atm_clr_high(k,:), rtm_trans_2way_high(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
370  end do
371 
373  abs(rtm_trans_2way_high(2,:) - rtm_trans_2way(2,:)) ) / 2.
374 
375 
376 #endif
377 
378 #ifdef AHI_INST
379 ! we only need all this stuff for 3.7um channel, ever, so only run the 3.7um channel, don't waste time.
380  newatm = .true.
381  temp_mixr = c2_model_info%mixr_profile*0.8
382  do k=1, nchan
383 ! k = nchan
384  call ahi_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
385  temp_mixr, ozone, view_zenith, angle_two_way, channels(k), &
386  rtm_trans_atm_clr_low(k,:), rtm_trans_2way_low(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
387 
388  end do
389 
390  newatm = .true.
391  temp_mixr = c2_model_info%mixr_profile*1.2
392  do k=1, nchan
393 ! k = nchan
394 
395  call ahi_fascode(trim(act_lib_path), path_len, myyear, myday, c2_model_info%temp_profile, &
396  temp_mixr, ozone, view_zenith, angle_two_way, channels(k), &
397  rtm_trans_atm_clr_high(k,:), rtm_trans_2way_high(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
398 
399  end do
400 
402  abs(rtm_trans_2way_high(2,:) - rtm_trans_2way(2,:)) ) / 2.
403 
404 
405 #endif
406 
407 
408 #ifdef VIIRS_INST
409 ! we only need all this stuff for 3.7um channel, ever, so only run the 3.7um channel, don't waste time.
410 
411  newatm = .true.
412  temp_mixr = c2_model_info%mixr_profile*0.8
413  do k=1, nchan
414 ! k = nchan
415 
416  if (modis_mode) then
417  call modis_fascode(trim(act_lib_path) // char(0), myyear, myday, c2_model_info%temp_profile, &
418  temp_mixr, ozone, view_zenith, angle_two_way, &
419  platform_id, channels(k), idet, rtm_trans_atm_clr_low(k,:), rtm_trans_2way_low(k,:), &
420  newang, newatm, new_2way, do_2way, iok, x, y)
421  else
422  call viirs_fascode(trim(act_lib_path), myyear, myday, c2_model_info%temp_profile, &
423  temp_mixr, ozone, view_zenith, angle_two_way, channels(k), &
424  rtm_trans_atm_clr_low(k,:), rtm_trans_2way_low(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
425  endif
426  end do
427  newatm = .true.
428  temp_mixr = c2_model_info%mixr_profile*1.2
429  do k=1, nchan
430 ! k = nchan
431 
432  if (modis_mode) then
433  call modis_fascode(trim(act_lib_path) // char(0), myyear, myday, c2_model_info%temp_profile, &
434  temp_mixr, ozone, view_zenith, angle_two_way, &
435  platform_id, channels(k), idet, rtm_trans_atm_clr_high(k,:), rtm_trans_2way_high(k,:), &
436  newang, newatm, new_2way, do_2way, iok, x, y)
437  else
438  call viirs_fascode(trim(act_lib_path), myyear, myday, c2_model_info%temp_profile, &
439  temp_mixr, ozone, view_zenith, angle_two_way, channels(k), &
440  rtm_trans_atm_clr_high(k,:), rtm_trans_2way_high(k,:), newang, newatm, new_2way, do_2way, iok, x, y)
441  endif
442  end do
443 
445  abs(rtm_trans_2way_high(2,:) - rtm_trans_2way(2,:)) ) / 2.
446 #endif
447 
448 
449 
450 #endif
451 
452 
453  sfc_level = c2_model_info%surface_level
454 
455  last_zenith = view_zenith
456  last_2way_angle = angle_two_way
457  last_i = i
458  last_j = j
459 
460  do k=1, nchan
461 
462 #ifndef CT_CODE
463  emis_idx = nchan - k + 1
464 #else
465  emis_idx = k
466 #endif
467 
468  call clear_atm_rad(platform, b_profile(k,:), c2_model_info%Ts, sfc_level, &
469  surface_emissivity(emis_idx), &
471  channels(k), rtm_rad_clr, rtm_bt_clr)
472 
473 #ifndef CT_CODE
474 
475  call clear_atm_rad(platform, b_profile(k,:), c2_model_info%Ts, sfc_level, &
476  surface_emissivity(emis_idx), &
478  channels(k), rtm_rad_clr, rtm_bt_clr)
479 
480  call clear_atm_rad(platform, b_profile(k,:), c2_model_info%Ts, sfc_level, &
481  surface_emissivity(emis_idx), &
483  channels(k), rtm_rad_clr, rtm_bt_clr)
484 
485 
486 #endif
487 
488 
489  end do
490 
491  end subroutine get_rtm_parameters
492 
493 
494  subroutine clear_atm_rad(platform, B_prof, Tsfc, sfc_level, esfc, &
495  rt_trans_atm, rt_rad_atm_clr, rt_cloud_prof, channel, rt_rad_clr, rt_bt_clr)
496 
497  character(*), intent(in) :: platform
498  real, intent(in) :: B_prof(:), rt_trans_atm(:)
499  real, intent(in) :: Tsfc, esfc
500  integer, intent(in) :: sfc_level, channel
501  real, intent(inout) :: rt_rad_clr, rt_bt_clr, rt_rad_atm_clr(:), rt_cloud_prof(:)
502 
503  integer :: i
504  real :: B1, B2, dtrn
505 
506  rt_rad_atm_clr(1:start_level) = 0.
507 
508 ! B1 = modis_planck(platform, temp_profile(start_level), channel, 1)
509  b1 = b_prof(start_level)
510  rt_rad_atm_clr(start_level) = 0.
511  rt_cloud_prof(start_level) = b1*rt_trans_atm(start_level)
512 
513  do i=start_level+1, sfc_level
514 
515 ! B2 = modis_planck(platform, temp_profile(i), channel, 1)
516  b2 = b_prof(i)
517  dtrn = -(rt_trans_atm(i) - rt_trans_atm(i-1))
518  rt_rad_atm_clr(i) = rt_rad_atm_clr(i-1) + (b1 + b2) / 2.0 * dtrn
519  rt_cloud_prof(i) = rt_rad_atm_clr(i) + b2*rt_trans_atm(i)
520  b1 = b2
521 
522  end do
523 
524 ! call clear_toa_rad(platform, rt_rad_atm_clr(sfc_level), rt_trans_atm(sfc_level), Tsfc, &
525 ! esfc, channel, rt_rad_clr, rt_bt_clr, .false.)
526 
527 
528  end subroutine clear_atm_rad
529 
530  subroutine get_clear_toa_rad(platform, Tsfc, esfc, sfc_level, rad_clr, bt_clr, clear_rad_table, clear_trans_table, PRN)
531 
533 
534  character(*), intent(in) :: platform
535  real, intent(in) :: esfc(:)
536  integer, intent(in) :: sfc_level
537  real, intent(inout) :: rad_clr(:), bt_clr(:)
538  real, intent(in) :: clear_rad_table(:,:), clear_trans_table(:,:)
539  integer :: channels(nchan)
540  integer :: k
541  real, intent(in) :: tsfc
542  logical, intent(in) :: prn
543 
544 ! channels(1) = bands(band_0370)
545 #ifndef CT_CODE
546  channels(1) = set_bands(band_1100)
547  channels(2) = set_bands(band_0370)
548 #ifdef VIIRS_INST
549  if (modis_mode) then
550  channels(1) = set_bands_modis(band_1100)
551  channels(2) = set_bands_modis(band_0370)
552  endif
553 #endif
554 
555 
556 #else
557 
558 #if !MAS_INST & !EMAS_INST
559  channels = set_bands
560 #else
561  channels = set_bands(1:set_number_of_bands-3)
562 #endif
563 
564 #endif
565 
566 ! rtm_rad_atm_clr, rtm_trans_atm_clr
567  do k=1, nchan
568  call clear_toa_rad(platform, clear_rad_table(k, sfc_level), clear_trans_table(k, sfc_level), tsfc, &
569  esfc(k), channels(k), rad_clr(k), bt_clr(k), prn )
570  end do
571 
572 
573  end subroutine get_clear_toa_rad
574 
575 
576  subroutine clear_toa_rad(platform, rad_atm, tau_atm, tsfc, &
577  esfc, channel, rad_clr, bt_clr, PRN)
578 
579  character(*), intent(in) :: platform
580  real, intent(in) :: rad_atm, tau_atm, tsfc, esfc
581  real, intent(inout) :: rad_clr, bt_clr
582  integer, intent(in) :: channel
583  logical, intent(in) :: PRN
584 
585  real :: rad_temp
586 
587 
588  rad_temp = modis_planck(platform, tsfc, channel, 1)
589 
590  rad_clr = rad_atm + esfc*rad_temp*tau_atm
591 
592  bt_clr = modis_bright(platform, rad_clr, channel, 1)
593 
594 
595  end subroutine clear_toa_rad
596 
597 end module rtm_support
Definition: ch_xfr.f90:1
Definition: pfaast.f90:1
real, dimension(nchan, model_levels), public rtm_trans_atm_clr
Definition: rtm_support.f90:47
real, dimension(nchan, model_levels), public rtm_rad_atm_clr_low
Definition: rtm_support.f90:59
character(len=2) mymission
Definition: names.f90:11
real, dimension(nchan, model_levels), public rtm_trans_atm_clr_low
Definition: rtm_support.f90:58
subroutine clear_atm_rad(platform, B_prof, Tsfc, sfc_level, esfc, rt_trans_atm, rt_rad_atm_clr, rt_cloud_prof, channel, rt_rad_clr, rt_bt_clr)
real, dimension(nchan, model_levels), public rtm_cloud_prof_high
Definition: rtm_support.f90:65
character(len=500) act_lib_path
Definition: names.f90:44
character *15 platform_name
integer, parameter band_0370
subroutine, public init_rtm_vars()
Definition: rtm_support.f90:89
integer, parameter band_1100
real, dimension(nchan, model_levels), public rtm_trans_atm_clr_high
Definition: rtm_support.f90:63
real, dimension(nchan, model_levels), public rtm_rad_atm_clr
Definition: rtm_support.f90:48
subroutine clear_toa_rad(platform, rad_atm, tau_atm, tsfc, esfc, channel, rad_clr, bt_clr, PRN)
real, dimension(nchan, model_levels), public rtm_trans_2way_high
Definition: rtm_support.f90:62
real function, public modis_bright(platform_name, RAD, BAND, UNITS, cwn_array, tcs_array, tci_array)
real, dimension(nchan, model_levels), public rtm_cloud_prof_low
Definition: rtm_support.f90:60
real, dimension(nchan, model_levels), public rtm_trans_2way_low
Definition: rtm_support.f90:57
real, dimension(nchan, model_levels), public rtm_cloud_prof
Definition: rtm_support.f90:49
integer mymsg
Definition: names.f90:9
real function, public modis_planck(platform_name, TEMP, BAND, UNITS)
subroutine, public get_rtm_parameters(platform, surface_emissivity, view_zenith, sun_zenith, i, j, x, y)
integer c2_sensor_id
Definition: ch_xfr.f90:48
subroutine, public get_clear_toa_rad(platform, Tsfc, esfc, sfc_level, rad_clr, bt_clr, clear_rad_table, clear_trans_table, PRN)
integer myyear
Definition: names.f90:9
integer myday
Definition: names.f90:9
string & trim(string &s, const string &delimiters)
Definition: EnvsatUtil.cpp:29
integer, dimension(set_number_of_bands), parameter set_bands
type(ancillary_type) c2_model_info
integer, parameter model_levels
Definition: names.f90:1
integer, parameter set_number_of_bands
real, dimension(nchan, model_levels), public rtm_trans_2way
Definition: rtm_support.f90:46
integer oci_id
Definition: ch_xfr.f90:49
real, dimension(nchan, model_levels), public rtm_rad_atm_clr_high
Definition: rtm_support.f90:64
real, dimension(model_levels), public rtm_trans_2way_mean
Definition: rtm_support.f90:55
#define abs(a)
Definition: misc.h:90
subroutine, public modis_fascode(coeff_dir_path, year, jday, temp, wvmr, ozmr, theta, ang_2way, platform, kban, jdet, taut, taut_2way, newang, newatm, new_2way, do_2way, iok, xxx, yyy)
Definition: pfaast.f90:23