da_setup_bufrtovs_structures.inc

References to this file elsewhere.
1 subroutine da_setup_bufrtovs_structures( xp, ob, iv )
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Define, allocate and read of tovs raidance observation structure.
5    !---------------------------------------------------------------------------
6 
7    implicit none
8 
9    type (xpose_type), intent(in)   :: xp         ! Domain decomposition vars.
10    type ( y_type), intent(inout)   :: ob         ! Observation structure.
11    type (ob_type), intent(inout)   :: iv         ! O-B structure.
12 
13    character(len=200)           :: filename
14    integer                     :: i, j, n, ios
15    logical                     :: lprinttovs 
16    
17    if (trace_use) call da_trace_entry("da_setup_bufrtovs_structures")
18 
19    !-------------------------------------------------------------------
20    ! [1.0] Initialize RTTOV coefs and innovations vector for radiance
21    !-------------------------------------------------------------------
22 
23     if (rtm_option == rtm_option_rttov) then
24        call da_rttov_init(iv,ob)
25     end if
26 
27     if (rtm_option == rtm_option_crtm) then
28        call da_crtm_init(iv,ob)
29     end if
30 
31    !-------------------------------------------------------------------
32    ! [2.0] Read NCEP bufr tovs data in radiance innovations vector
33    !-------------------------------------------------------------------
34 
35    if (use_hirs2obs) then
36       write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs2.bufr'
37       filename = ' '
38       write(filename(1:10), fmt='(a)') 'hirs2.bufr'
39       call da_read_bufrtovs ('hirs2', iv, xp, filename)
40    end if
41 
42    if (use_msuobs) then
43       filename = ' '
44       write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from msu.bufr'
45       write(filename(1:8), fmt='(a)') 'msu.bufr'
46       call da_read_bufrtovs ('msu  ', iv, xp, filename)
47    end if
48 
49    if (use_hirs3obs) then
50       write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from hirs3.bufr'
51       filename = ' '
52       write(filename(1:10), fmt='(a)') 'hirs3.bufr'
53       call da_read_bufrtovs('hirs3', iv, xp, filename)
54    end if
55 
56    if (use_amsuaobs) then
57       write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsua.bufr'
58       filename = ' '
59       write(filename(1:10), fmt='(a)') 'amsua.bufr'
60       call da_read_bufrtovs ('amsua', iv, xp, filename)
61    end if
62 
63    if (use_amsubobs) then
64       write(unit=stdout,fmt='(a)') 'Reading radiance 1b data from amsub.bufr'
65       filename = ' '
66       write(filename(1:10), fmt='(a)') 'amsub.bufr'
67       call da_read_bufrtovs ('amsub', iv, xp, filename)
68    end if
69 
70    if (use_airsobs) then
71       write(unit=stdout,fmt='(a)') 'Reading airs 1b data from airs.bufr'
72       filename = ' '
73       write(filename(1:9), fmt='(a)') 'airs.bufr'
74       call da_read_bufrairs ('airs     ',iv, xp, filename)
75    end if
76 
77    if (use_eos_amsuaobs) then
78       write(unit=stdout,fmt='(a)') 'Reading eos_amsua 1b data from airs.bufr'
79       filename = ' '
80       write(filename(1:9), fmt='(a)') 'airs.bufr'
81       call da_read_bufrairs ('eos_amsua',iv, xp, filename)
82    end if
83 
84    if (use_hsbobs) then
85       write(unit=stdout,fmt='(a)') 'Reading hsb 1b data from airs.bufr'
86       filename = ' '
87       write(filename(1:9), fmt='(a)') 'airs.bufr'
88       call da_read_bufrairs ('hsb      ',iv, xp, filename)
89    end if
90 
91    if (use_filtered_rad) then
92       call da_read_filtered_rad (xp, iv)
93    end if
94 
95    if (use_kma1dvar) then
96       do i=1,rtminit_nsensor
97          filename = ' '
98          filename='kma1dvar-'//trim(iv%instid(i)%rttovid_string)//'.inv'
99          write(unit=stdout,fmt='(a,a)')  ' Reading KMA 1dvar innovation from  ', filename
100          call da_read_kma1dvar (i,iv, ob, xp, filename)
101       end do
102    end if
103 
104    ! sorting obs into FGAT time bins
105    call da_sort_rad(iv)
106 
107    ! allocate cloud_flag in iv structure
108    !   do i = 1,  iv % num_inst
109    !      if (iv % instid(i) % num_rad < 1) cycle
110    !         iv%instid(i)%cloud_flag(:,:) = 1  ! no cloud
111    !   end do
112 
113    !-----------------------------------------------------------------------------
114    ! [3.0] create (smaller) ob structure:
115    !-----------------------------------------------------------------------------
116 
117    if (.not. use_kma1dvar) then
118       do i = 1,  ob % num_inst
119          ob % instid(i) % num_rad = iv % instid(i) % num_rad
120          if (ob % instid(i) % num_rad < 1) cycle
121          allocate (ob % instid(i) % tb(ob % instid(i) % nchan,ob % instid(i)%num_rad))
122          ob % instid(i) % tb(:,:) = iv % instid(i) % tb_inv(:,:)
123       end do
124    end if
125 
126    if (trace_use) call da_trace_exit("da_setup_bufrtovs_structures")
127 
128 end subroutine da_setup_bufrtovs_structures
129