code_repo.tar

lkcs_diag/0002750002177400414130000000000014237551523013065 5ustar  bhooverdras-aidalkcs_diag/fix/0002750002177400414130000000000014237551526013656 5ustar  bhooverdras-aidalkcs_diag/fix/fix_gsi/0002750002177400414130000000000014237551534015305 5ustar  bhooverdras-aidalkcs_diag/fix/fix_gsi/gfsv16_historical/0002750002177400414130000000000014237551547020646 5ustar  bhooverdras-aidalkcs_diag/fix/fix_gsi/gfsv16_historical/global_convinfo.txt.2021031712_hu30000750002177400414130000007604214237551505026374 0ustar  bhooverdras-aida! otype   = observation type (a7, t, uv, q, etc.)                                     
! type    = prepbufr observation type (if available) 
! sub     = prepbufr subtype (not yet available)
! iuse    = flag if to use/not use / monitor data
!         = 1  use data
!         = 0  do not use data
!         = -1 monitor data
!         = -3 skip reading data
! twindow = time window (+/- hours)
! numgrp  = cross validation parameter - number of groups
! ngroup  = cross validation parameter - group to remove from data use
! nmiter  = cross validation parameter - external iteration to introduce removed data
! gross   = gross error parameter - gross error
! ermax   = gross error parameter - max error  
! ermin   = gross error parameter - min error
! var_b   = variational quality control parameter -  b parameter
! var_pg ithin rmesh npred  = variational quality control parameter -  pg parameter
! pmot: the optione to keep thinned datai as monitored, 0: not to keep, other values: to keep
! ptime: time interval for thinning, 0, no temporal thinning, other values define time interval (less than 6)
! ib,ip:  new nonlinear qc parameter, ib:betta, ip:kappa
!otype   type  sub iuse twindow numgrp ngroup nmiter gross ermax ermin var_b    var_pg ithin rmesh  pmesh  npred  pmot  ptime   ib   ip
 tcp      112    0    1     3.0      0      0      0  75.0   5.0   1.0  75.0  0.000000     0    0.     0.      0    0.     0.    0    0
 ps       120    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    4   -9
 ps       132    0   -1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    0    0
 ps       180    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 ps       180    01   1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    8   -9
 ps       181    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    4   -9
 ps       182    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 ps       183    0   -1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    0    0
 ps       187    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 t        120    0    1     3.0      0      0      0   8.0   5.6   1.3   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 t        126    0   -1     3.0      0      0      0   8.0   5.6   1.3   8.0  0.001000     0    0.     0.      0    0.     0.    0    0
 t        130    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    7   -9
 t        131    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    7   -9
 t        132    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    3   -6
 t        133    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -9
 t        134    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        135    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        136    0    1     3.0      0      0      0   2.0   5.6   1.3  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 t        180    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -6
 t        180    01   1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    8   -9 
 t        181    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        182    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -6 
 t        183    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        187    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 q        120    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    7   -6
 q        130    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        131    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        132    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -6
 q        133    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -6
 q        134    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        135    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        136    0    1     3.0      0      0      0   2.0  50.0   5.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 q        180    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    6   -1
 q        180    01   1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    6   -9
 q        181    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    0    0
 q        182    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -1
 q        183    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        187    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 pw       152    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       153    0   -1     3.0      0      0      0   5.0   5.0   2.0   5.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       156    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       157    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       158    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 pw       159    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      181    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      182    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      183    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      184    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      185    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      186    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      187    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      188    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      189    0    1     3.0      0      0      0   1.0   2.0   0.2   1.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      190    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      191    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      192    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      193    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      194    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      195    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      196    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      197    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      198    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      199    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 uv       210    0   -1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       220    0    1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       221    0    1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       223    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       224    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       228    0   -1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       229    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       230    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.000100    20  100.   800.      0    0.     1.    7   -4
 uv       231    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000100    20  100.   800.      0    0.     1.    6   -5
 uv       232    0    1     3.0      0      0      0   7.0   6.1   1.4   7.0  0.000100     0    0.     0.      0    0.     0.    3   -7
 uv       233    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100    20  100.   800.      0    0.     1.    6   -4
 uv       234    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       235    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       236    0    1     3.0      0      0      0   2.0   6.1   1.4  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 uv       240    0   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       240  257   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  259   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  270   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  271   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       241    0   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       242    0   -1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   13   -8
 uv       242  171    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  172    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  173    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  174    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243    0   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     0    0.     0.      0    0.     0.   15   -8   
 uv       243   54   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   55    1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   56   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   57   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   70    1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       244    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8   
 uv       244    3    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244    4    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  206    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  207    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  209    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  223    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       245    0   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  257   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  259   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  270    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  271    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246    0   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  257   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  259   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  270    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  271    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       247    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  257   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  259   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  270    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  271    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       248    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       249    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       250    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       250  171    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       250  172    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8 
 uv       250  173    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       250  174    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       251    0   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       251  257   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       251  259   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       251  270   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       251  271   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       252    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       252  171    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  172    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  173    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  174    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       253    0   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0  200.   100.      0    0.     2.    0    0
 uv       253   54   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8 
 uv       253   55    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   56   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   57   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   70    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254    0   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       254   54   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254   55    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0    0.     0.      0    0.     2.   15   -8
 uv       254   56   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0  200.   100.      0    0.     2.   15   -8
 uv       254   57   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254   70    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       255    0   -3     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       255  854   -3     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9 
 uv       256    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       257    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       257  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       257  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9 
 uv       258    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       258  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       258  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       259    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       259  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       259  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       260    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       260  224    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9
 uv       260  225    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9
 uv       270    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       280    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.   11   -9
 uv       280    01   1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.   11   -9
 uv       281    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       282    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       284    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       285    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       286    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       287    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       289    0    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.   14   -9
 uv       290    4    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       290    3    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       290    5   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     1  100.  1200.      0    0.     0.    0    0
 uv       290    6   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       291    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     1  100.  1200.      0    0.     0.    0    0
 uv       296    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0  100.  1200.      0    0.     0.    0    0
 spd      283    0   -1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000000     0    0.     0.      0    0.     0.    0    0
 dw       999    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000000     0    0.     0.      0    0.     0.    0    0
 dw       201    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 dw       202    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 dw       100    0   -1     3.0      0      0      0   4.0   5.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0 
 dw       101    0   -1     3.0      0      0      0   4.0   5.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 srw      999    0   -1     2.5      0      0      0  10.0  10.0   1.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 rw       999    0   -1     2.5      0      0      0  10.0  10.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      004    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      041    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      722    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      723    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      740    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      741    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      742    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      743    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      744    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      745    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      820    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      042    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      043    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      786    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      421    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      003    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      821    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      825    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      440    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pm2_5    102    0   -1     1.0      0      0      0 100.0   1.5   0.75 10.0  0.000000     0    0.     0.      0    0.     0.    0    0  
 pm10     102    0   -1     1.0      0      0      0 150.0   1.5   0.75 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      750    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      751    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      752    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      753    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      754    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      755    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      724    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      725    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      726    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      727    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      728    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      729    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      044    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      005    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      265    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      266    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      267    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      268    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      269    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
lkcs_diag/gsi.fd/0002750002177400414130000000000014237551331014234 5ustar  bhooverdras-aidalkcs_diag/gsi.fd/src/0002750002177400414130000000000014237551332015024 5ustar  bhooverdras-aidalkcs_diag/gsi.fd/src/gsi/0002750002177400414130000000000014237551547015616 5ustar  bhooverdras-aidalkcs_diag/gsi.fd/src/gsi/read_obs.F900000640002177400414130000024640014237551413017651 0ustar  bhooverdras-aidamodule read_obsmod
!$$$   module documentation block
!                .      .    .                                       .
! module:    read_obsmod extra inquire routine for reading obs
!   prgmmr: parrish          org: np22                date: 2005-06-06
!
! abstract:
!
! program history log:
!   2009-01-05  todling - add gsi_inquire
!   2015-05-01  Liu Ling - Add call to read_rapidscat 
!   2015-08-20  zhu  - add flexibility for enabling all-sky and using aerosol info in radiance 
!                      assimilation. Use radiance_obstype_search from radiance_mod.  
!   2016-09-xx  CAPS(G. Zhao) - Add read radar reflectivtiy dbz bufr 
!                               (from MRMS grib2 in BUFR for direct reflectivity DA)
!   2017-05-12  Y. Wang and X. Wang - add dbz to be read in, POC: xuguang.wang@ou.edu
!
! subroutines included:
!   sub gsi_inquire   -  inquire statement supporting fortran earlier than 2003
!   sub read_obs      -  read, select, reformat obs data
!
! Variable Definitions:
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$ end documentation block

! set default to private
  private
! set subroutines to public
  public :: gsi_inquire
  public :: read_obs

contains

subroutine gsi_inquire (lbytes,lexist,filename,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    gsi_inquire        inquire file presence and size
!   prgmmr: todling      org: np22                date: 2009-01-05
!
! abstract:  Inquire file presence and size; to be used when fortran
!            2003 not available or non-compliant.
!
! program history log:
!   2009-01-05  todling
!   2013-05-14  guo     - changed the compiler #ifdef dependency on _size_
!                         inquire to a more portable way.
!
!   input argument list:
!     mype     - mpi task id
!    filename  - input filename
!
!   output argument list:
!    lexist     - file presence flag
!    lbytes     - file size (bytes)
!
! attributes:
!   language: f90
!   machine:  Linux-cluster
!
!$$$  end documentation block
!

  use kinds, only: i_kind,i_llong

  implicit none

  integer(i_llong),intent(  out) :: lbytes
  logical         ,intent(  out) :: lexist
  character(len=*),intent(in   ) :: filename
  integer(i_kind) ,intent(in   ) :: mype

  character(len=256) command, fname

#if defined(__INTEL_COMPILER) && (__INTEL_COMPILER < 1110)
#define __X_OR_Y_OR_Z_FORTRAN_COMPILERS__
#endif

#ifdef __X_OR_Y_OR_Z_FORTRAN_COMPILERS__
#define _DO_NOT_SUPPORT_SIZE_INQUIRE_
#endif

  lbytes=-1  ! in case that _size_ specifier is not supported.
#ifndef _DO_NOT_SUPPORT_SIZE_INQUIRE_
  inquire(file=trim(filename),exist=lexist,size=lbytes)
  ! Note that the value of _size_ is defined by Fortran in "file storage units",
  ! which is not neccesary in byte units.  It is not clear if this code had
  ! assumed the size value to be in byte units, or in whatever units.
#else
  inquire(file=trim(filename),exist=lexist)
#endif
  if(lexist) then
     ! Even with a compiler supporting 'size=' specifier, the size value may
     ! return -1, if a compiler considers that the size can not be determined.
     ! In that case, the size may be obtained through a user supported
     ! mechanism, such as reading the size from a system("wc -c") call result.
     if(lbytes<0) then
        write(fname,'(2a,i4.4)') 'fsize_',trim(filename),mype
        write(command,'(4a)') 'wc -c ', trim(filename),' > ', trim(fname)
        call system(command)
        open(unit=999,file=trim(fname),form='formatted')
        read(999,*) lbytes
        close(999)
        lexist = lbytes>0_i_llong ! skip this file if lbytes <=0
     endif
  endif

  return
end subroutine gsi_inquire

subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    read_obs_check     inquire file presence and size
!   prgmmr: todling      org: np22                date: 2010-03-05
!
! abstract:  Reset file status depending on whether observation time
!            matches analysis time and how offtime_date is set. This
!            also checks for consistency in satellite data files and 
!            known types.  
!            WARNING: some of it looks inconsistent with long-window 4dvar
!
! program history log:
!   2009-xx-xx  derber   - originally placed inside inquire
!   2009-01-05  todling  - move time/type-check out of inquire
!   2010-09-13  pagowski - add anow bufr and one obs chem
!   2013-01-26  parrish - WCOSS debug compile fails with satid not initialized.
!                         Set satid=1 at start of subroutine to allow debug compile.
!   2013-02-13  eliu     - add ssmis 
!   2013-07-01  todling/guo - allow user to bypass this check (old bufr support)
!   2014-10-01  ejones   - add gmi and amsr2
!   2015-01-16  ejones   - add saphir
!   2016-09-xx  CAPS(G. Zhao) - skipping check BUFR dbz when using dbzbufr for direct reflectivity DA
!   2016-09-19  guo      - properly initialized nread, in case of for quick-return cases.
!   2017-11-16  dutta    - adding KOMPSAT5 bufr i.d for reading the data.
!   2019-03-27  h. liu   - add abi
!   2019-09-20  X.Su     -add read new variational qc table
!   2019-08-21  H. Shao  - add METOPC-C, COSMIC-2 and PAZ to the GPS check list                           
!   2020-05-21  H. Shao  - add commercial GNSSRO (Spire, PlanetIQ, GeoOptics) and other existing missions to the check list                           
!
!   input argument list:
!    lexist    - file status
!    filename  - input filename
!    jsatid    - satellite id
!    dtype     - satellite type
!
!   output argument list:
!    lexist    - file status
!
! attributes:
!   language: f90
!   machine:  Linux-cluster
!
!$$$  end documentation block

  use kinds, only: i_kind,i_llong,r_kind,r_double
  use gsi_4dvar, only: iadatebgn,iadateend
  use obsmod, only: offtime_data
  use convinfo, only: nconvtype,ictype,ioctype,icuse
  use chemmod, only : oneobtest_chem,oneob_type_chem,&
       code_pm25_ncbufr,code_pm25_anowbufr,code_pm10_ncbufr,code_pm10_anowbufr
  use directDA_radaruse_mod, only: l_use_dbz_directDA

  implicit none

  logical         ,intent(inout)  :: lexist
  character(len=*),intent(in)     :: filename
  character(len=*),intent(in)     :: jsatid
  character(len=*),intent(in)     :: dtype
  integer(i_kind) ,intent(in)     :: minuse
  integer(i_kind) ,intent(inout)  :: nread

  integer(i_kind) :: lnbufr,idate,idate2,iret,kidsat
  integer(i_kind) :: ireadsb,ireadmg,kx,nc,said
  real(r_double) :: satid,rtype
  character(8) subset
  logical,parameter:: GMAO_READ=.false.

  satid=1      ! debug executable wants default value ???
  idate=0
  nread=0; if(lexist) nread=1   ! in case of a quick return
#ifdef _SKIP_READ_OBS_CHECK_
  return
#endif
  if(trim(dtype) == 'tcp' .or. trim(filename) == 'tldplrso')return
  if(trim(filename) == 'mitmdat' .or. trim(filename) == 'mxtmdat')return
  if(trim(filename) == 'satmar')return
  if ( .not. l_use_dbz_directDA) then
     if(trim(dtype) == 'dbz' )return
  end if

! Use routine as usual

  if(lexist .and. trim(dtype) /= 'tcp' )then
      lnbufr = 15
      open(lnbufr,file=trim(filename),form='unformatted',status ='unknown')
      call openbf(lnbufr,'IN',lnbufr)
      call datelen(10)
      call readmg(lnbufr,subset,idate,iret)
      if(iret == 0)then

!        Extract date and check for consistency with analysis date
         if (idate<iadatebgn.or.idate>iadateend) then
            if(offtime_data) then
              write(6,*)'***read_obs_check analysis and data file date differ, but use anyway'
            else
               write(6,*)'***read_obs_check*** ',&
                 'incompatable analysis and observation date/time',trim(filename),trim(dtype)
               lexist=.false.
            end if
            write(6,*)'Analysis start  :',iadatebgn
            write(6,*)'Analysis end    :',iadateend
            write(6,*)'Observation time:',idate
        endif
      else
         write(6,*)'***read_obs_check*** iret/=0 for reading date for ',trim(filename),dtype,jsatid,iret
         lexist=.false.
      end if
      if(lexist)then
       if(jsatid == '')then
         kidsat=0
       else if(jsatid == 'metop-a')then
         kidsat=4
       else if(jsatid == 'metop-b')then
         kidsat=3
       else if(jsatid == 'metop-c')then
         kidsat=5
       else if(jsatid == 'm08')then
         kidsat = 55 
       else if(jsatid == 'm09')then
         kidsat = 56 
       else if(jsatid == 'm10')then
         kidsat = 57 
       else if(jsatid == 'm11')then
         kidsat = 70 
       else if(jsatid == 'n08')then
         kidsat=200
       else if(jsatid == 'n09')then
         kidsat=201
       else if(jsatid == 'n10')then
         kidsat=202
       else if(jsatid == 'n11')then
         kidsat=203
       else if(jsatid == 'n12')then
         kidsat=204
       else if(jsatid == 'n14')then
         kidsat=205
       else if(jsatid == 'n15')then
         kidsat=206
       else if(jsatid == 'n16')then
         kidsat=207
       else if(jsatid == 'n17')then
         kidsat=208
       else if(jsatid == 'n18')then
         kidsat=209
       else if(jsatid == 'n19')then
         kidsat=223
       else if(jsatid == 'npp')then
         kidsat=224
       else if(jsatid == 'n20')then
         kidsat=225
       else if(jsatid == 'n21')then
         kidsat=226
       else if(jsatid == 'f08')then
         kidsat=241
       else if(jsatid == 'f10')then
         kidsat=243
       else if(jsatid == 'f11')then
         kidsat=244
       else if(jsatid == 'f13')then
         kidsat=246
       else if(jsatid == 'f14')then
         kidsat=247
       else if(jsatid == 'f15')then
         kidsat=248
       else if(jsatid == 'f16')then
         kidsat=249    
       else if(jsatid == 'trmm')then
         kidsat=282    
       else if(jsatid == 'f17')then
         kidsat=285                  
       else if(jsatid == 'f18')then  
         kidsat=286                  
       else if(jsatid == 'f19')then  
         kidsat=287                  
       else if(jsatid == 'g08' .or. jsatid == 'g08_prep')then
         kidsat=252
       else if(jsatid == 'g09' .or. jsatid == 'g09_prep')then
         kidsat=253
       else if(jsatid == 'g10' .or. jsatid == 'g10_prep')then
         kidsat=254
       else if(jsatid == 'g11' .or. jsatid == 'g11_prep')then
         kidsat=255
       else if(jsatid == 'g12' .or. jsatid == 'g12_prep')then
         kidsat=256
       else if(jsatid == 'g13' .or. jsatid == 'g13_prep')then
         kidsat=257
       else if(jsatid == 'g14' .or. jsatid == 'g14_prep')then
         kidsat=258
       else if(jsatid == 'g15' .or. jsatid == 'g15_prep')then
         kidsat=259
       else if(jsatid == 'g16' .or. jsatid == 'g16_prep')then
         kidsat=270
       else if(jsatid == 'g17' .or. jsatid == 'g17_prep')then
         kidsat=271
       else if(jsatid == 'n05')then
         kidsat=705
       else if(jsatid == 'n06')then
         kidsat=706
       else if(jsatid == 'n07')then
         kidsat=707
       else if(jsatid == 'tirosn')then
         kidsat=708
       else if ( jsatid == 'terra' ) then
         kidsat = 783
       else if ( jsatid == 'aqua'  ) then
         kidsat = 784
       else if ( jsatid == 'aura'  ) then
         kidsat = 785
       else if ( jsatid == 'gcom-w1' ) then
         kidsat = 122
! Temporary comment gpm out here; discrepancy between SAID in bufr file and
! kidsat.
!       else if ( jsatid == 'gpm' ) then
!         kidsat = 288
       else if ( jsatid == 'meghat' ) then
         kidsat = 440
       else
         kidsat = 0
       end if

       call closbf(lnbufr)
       close(lnbufr)
       open(lnbufr,file=trim(filename),form='unformatted',status ='unknown')
       call openbf(lnbufr,'IN',lnbufr)
       call datelen(10)

       if(kidsat /= 0)then
        lexist = .false.
        satloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
           if(ireadsb(lnbufr)==0)then
              call ufbint(lnbufr,satid,1,1,iret,'SAID')
           end if
           if(nint(satid) == kidsat) then
             lexist=.true.
             exit satloop
           end if
           nread = nread + 1
        end do satloop
       else if(trim(filename) == 'prepbufr')then  ! RTod: wired-in filename is not a good idea
         lexist = .false.
         fileloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit fileloop
             end if
           end do
          end do 
          nread = nread + 1
         end do fileloop
        else if(trim(filename) == 'wcpbufr')then
         lexist = .false.
         file2loop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit file2loop
             end if
           end do
          end do
          nread = nread + 1
         end do file2loop
       else if(trim(filename) == 'gps_ref' .or.  trim(filename) == 'gps_bnd')then
         lexist = .false.
         gpsloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
           if(ireadsb(lnbufr)==0)then 
              call ufbint(lnbufr,satid,1,1,iret,'SAID') 
           end if 
 
           said=nint(satid) 
           if(((said > 739) .and.(said < 746)).or. (said == 820) .or. &
               (said == 825).or. (said == 786).or. (said == 4)   .or. &
               (said == 3)  .or. (said == 421).or. (said == 440) .or. &
               (said == 821).or. ((said > 749).and.(said < 756)) .or. &
               (said == 44) .or. (said == 5)  .or. (said == 41)  .or. &
               (said == 42) .or. (said == 43) .or. (said == 722) .or. & 
               (said == 723).or. (said == 265).or. (said == 266) .or. &
               (said == 267).or. (said == 268).or. (said == 269)) then
             lexist=.true. 
             exit gpsloop 
           end if 
           nread = nread + 1
         end do gpsloop
       else if(trim(filename) == 'prepbufr_profl')then  
         lexist = .false.
         airploop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           if (trim(dtype)=='uv') then
              if (kx==330 .or. kx==430 .or. kx==530) kx=230
              if (kx==331 .or. kx==431 .or. kx==531) kx=231
              if (kx==332 .or. kx==432 .or. kx==532) kx=232
              if (kx==333 .or. kx==433 .or. kx==533) kx=233
              if (kx==334 .or. kx==434 .or. kx==534) kx=234
              if (kx==335 .or. kx==435 .or. kx==535) kx=235
           else
              if (kx==330 .or. kx==430 .or. kx==530) kx=130
              if (kx==331 .or. kx==431 .or. kx==531) kx=131
              if (kx==332 .or. kx==432 .or. kx==532) kx=132
              if (kx==333 .or. kx==433 .or. kx==533) kx=133
              if (kx==334 .or. kx==434 .or. kx==534) kx=134
              if (kx==335 .or. kx==435 .or. kx==535) kx=135
           end if
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit airploop
             end if
           end do
          end do
          nread = nread + 1
         end do airploop
       else if(trim(filename) == 'satwndbufr')then
         lexist = .false.
         loop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
!        5 GOES-R AMVs (NC005030, NC005031, NC005032, NC005034 and NC005039)
!        are added as the GOES-R bufr file provide do not contain other winds.
!        May not be necessary with the operational satwnd BUFR
            if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or.&
               trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071' .or.&
               trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or.&
               trim(subset) == 'NC005046' .or. trim(subset) == 'NC005064' .or.&
               trim(subset) == 'NC005065' .or. trim(subset) == 'NC005066' .or.& 
               trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or.& 
               trim(subset) == 'NC005032' .or. trim(subset) == 'NC005034' .or.&
               trim(subset) == 'NC005039' .or. &
               trim(subset) == 'NC005090' .or. trim(subset) == 'NC005091' .or.&
               trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or. trim(subset) == 'NC005069' .or.&
               trim(subset) == 'NC005081' .or. &
               trim(subset) == 'NC005072' ) then
               lexist = .true.
               exit loop
            endif
            nread = nread + 1
         end do loop
       else if(trim(filename) == 'oscatbufr')then
         lexist = .false.
         oscatloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC012255') then
               lexist = .true.
               exit oscatloop
            endif
         end do oscatloop
       else if(trim(filename) == 'rapidscatbufr')then
         lexist = .false.
         rapidscatloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC012255') then
               lexist = .true.
               exit rapidscatloop
            endif
            nread = nread + 1
         end do rapidscatloop
       else if(trim(filename) == 'hdobbufr')then
         lexist = .false.
         loop_hdob: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC004015') then
               lexist = .true.
               exit loop_hdob
            endif
            nread = nread + 1
         end do loop_hdob
       else if(trim(dtype) == 'pm2_5')then
          if (oneobtest_chem .and. oneob_type_chem=='pm2_5') then
             lexist=.true.
          else
             lexist = .false.
             fileloopanow_pm2_5:do while(ireadmg(lnbufr,subset,idate2) >= 0)
                do while(ireadsb(lnbufr)>=0)
                   if (subset == 'ANOWPM') then
                      call ufbint(lnbufr,rtype,1,1,iret,'TYP')
                      kx=nint(rtype)
                   else if ( (subset == 'NC008031') .or. &
                          (subset == 'NC008032' ) ) then
                      call ufbint(lnbufr,rtype,1,1,iret,'TYPO')
                      kx=nint(rtype)
                      if (kx/=code_pm25_ncbufr) then
                         cycle
                      else
                         kx=code_pm25_anowbufr
                      endif
                   else
                      cycle
                   endif
                   
                   do nc=1,nconvtype
                      if(trim(ioctype(nc)) == trim(dtype) .and. &
                           kx == ictype(nc) .and. icuse(nc) > minuse)then
                         lexist = .true.
                         exit fileloopanow_pm2_5
                      end if
                   end do
                end do
                nread = nread + 1
             enddo fileloopanow_pm2_5
          endif

          if (lexist) then
             write(6,*)'found pm2_5 in anow bufr'
          else
             write(6,*)'did not find pm2_5 in anow bufr'
          endif
           
       else if(trim(dtype) == 'pm10')then
          lexist = .false.
          fileloopanow_pm10:do while(ireadmg(lnbufr,subset,idate2) >= 0)
             do while(ireadsb(lnbufr)>=0)
                if (subset == 'NC008033') then
                   call ufbint(lnbufr,rtype,1,1,iret,'TYPO')
                   kx=nint(rtype)
                   IF (kx/=code_pm10_ncbufr) then
                      cycle
                   else
                      kx=code_pm10_anowbufr
                   endif
                else
                   cycle
                endif

                do nc=1,nconvtype
                   if(trim(ioctype(nc)) == trim(dtype) .and. &
                        kx == ictype(nc) .and. icuse(nc) > minuse)then
                      lexist = .true.
                      exit fileloopanow_pm10
                   end if
                end do
             end do
             nread = nread + 1
          enddo fileloopanow_pm10

          if (lexist) then
             write(6,*)'found pm10 in anow bufr'
          else
             write(6,*)'did not find pm10 in anow bufr'
          endif


       end if
      end if

      call closbf(lnbufr)
      close(lnbufr)
  end if
  if(lexist)then
      write(6,*)'read_obs_check: bufr file date is ',idate,trim(filename),' ',dtype,jsatid
  else
      write(6,*)'read_obs_check: bufr file ',dtype,jsatid,' not available ',trim(filename)
  end if
  return
end subroutine read_obs_check

subroutine read_obs(ndata,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    read_obs              read, select, reformat obs data
!   prgmmr: parrish          org: np22                date: 1990-10-07
!
! abstract:  This routine is a driver for routines which read different
!            types of observational data.
!
! program history log:
!   1990-10-07  parrish
!   1998-05-15  weiyu yang 
!   1999-08-24  derber, j., treadon, r., yang, w., first frozen mpp version
!   2004-06-16  treadon - update documentation
!   2004-07-23  derber - modify to include conventional sst
!   2004-07-29  treadon - add only to module use, add intent in/out
!   2005-01-20  okamoto - add calling read_ssmi
!   2005-06-14  wu      - add OMI oz
!   2005-07-06  derber - add mhs, hirs/4 and ears data 
!   2005-08-02  derber - modify to use convinfo file
!   2005-09-08  derber - modify to use input group time window
!   2005-09-20  xu & pawlak - modify calling read_ssmis and read_amsre
!   2005-09-28  derber - modify to simplify obs handling      
!   2005-10-17  derber - pass obs_load1 into read_amsre and read_ssmis 
!   2005-10-18  treadon - remove obs_load and obs_load1
!   2005-10-20  kazumori - modify to read real AMSR-E data
!   2005-11-28  derber move determination of which ob data sets to read inside read_obs
!   2005-11-14  li, xu - modify sst obs read and add avhrr gac 1b obs read
!   2006-01-25  treadon - remove read_ieeetovs
!   2006-02-01  parrish - add getsfc and destroy_sfc for full surface fields
!   2006-02-03  derber  - modify for new obs control and obs count
!   2005-02-03  treadon - gather guess 3d pressure to full grid array
!   2006-02-08  derber  - modify to use new convinfo module
!   2006-02-01  liu - add ssu
!   2006-02-24  derber  - modify to take advantage of convinfo module
!   2006-03-07  derber - consolidate processing of 1x1 and 5x5 goessndr
!   2006-04-20  kistler - moved conv_read to gsisub
!   2006-05-25  treadon - rename goesimg and goes_img and pcp_ssm/i as
!                         pcp_ssmi to make consistent with other obstype
!   2006-09-20  treadon - add mpi_io for select data file (obstype)s
!   2006-10-12  treadon - remove tendsflag check for pcp data (now in gsimain)
!   2007-02-21  sienkiewicz - bring in changes for MLS ozone
!   2007-03-15       su - add reading conventional error table option
!   2007-06-05  treadon - restructure mpi_querybf section to improve efficiency
!   2007-10-03  todling - skip most of this in 4dvar inner loop
!   2008-03-28       wu - move random seed for perturb_obs from setuprhsall
!   2008-04-18  safford - rm unused vars and uses
!   2008-05-01    h.liu - add gome ozone
!   2008-06-20   derber - move destroy_sfc to this routine 
!   2008-09-08   lueken - merged ed''s cahnges into q1fy09 code
!   2008-12-30  todling - handle inquire for diff versions of fortran
!   2009-01-05  todling - need tendency alloc in observer mode
!   2009-01-23  todling - echo surface state info 
!   2009-03-18  meunier - add a if statement to read lagrangian data
!   2009-08-19  guo     - moved destroy_sfc_grid() to observer_finalize().
!   2009-12-20  gayno - modify argument lists so that fov-based surface
!                       calculation may be used.
!   2010-03-29  hu    - add code to read in cloud observations  including:
!                            prepbufr (metar, nesdis cloud product)
!                            radar reflectivity, lightning, NASA LaRC cloud
!   2010-04-01  treadon - move strip and reorder to gridmod
!   2010-04-08  hliu - add seviri
!
!   2010-04-05  huang   - add aero and modis for reading modis aod from satellite
!                         currently read BUFR file only
!   2010-04-22  tangborn - read for carbon monoxide
!   2010-08-23  tong    - add calcuation of hgtl_full used in read_radar.f90
!   2011-04-02  li       - add nst_gsi, getnst and destroy_nst
!   2011-05-20  mccarty  - add cris/atms handling
!   2011-05-26  todling  - add call to create_nst
!   2012-03-07  akella   - set NST variables; init & destroy in guess_grids 
!                          [see create_sfc_grids & destroy_sfc_grids] 
!   2012-05-16  todling  - protect call to prebufr when NST is on (should be mods)
!   2012-09-08  wargan   - add OMI with efficiency factors
!   2013-01-26  parrish - WCOSS debug compile fails--extra arguments in call read_aerosol.
!                         Commented out extra line of arguments not used.
!   2013-02-13  eliu     - turn off parallel I/O for SSMIS (due to the need to
!                          do spatial averaging for noise reduction) 
!   2013-06-01  zhu     - add mype_airobst to handle aircraft temperature bias correction 
!   2013-08-08  s.liu     - add read NASA_LaRC_cloud product
!   2013-10-25  todling - reposition ltosi and others to commvars
!   2014-01-01  xli     - add option to read NSST marine BUFR data file nsstbufr (on the
!                         top of prepbufr and modsbufr)
!   2014-02-03  guo     - Hid processing (read) of non-EMC ozone obstypes
!                         through module m_extOzone, separated from read_ozone.
!                       - Added some -do- and -if- construct names, for easier
!                         understanding of the code.
!   2014-06-19  carley/zhu - Add tcamt and lcbas
!   2014-11-12  carley  - Add call to read goes imager sky cover data for tcamt
!   2014-12-03  derber - modify for no radiance cases and read processor for
!                        surface fields
!   2015-01-16  ejones  - added saphir, gmi, and amsr2 handling
!   2015-03-23  zaizhong ma - add Himawari-8 ahi
!   2015-05-30  li     - modify for no radiance cases but sst (nsstbufr) and read processor for
!                        surface fields (use_sfc = .true. for data type of sst),
!                        to use deter_sfc in read_nsstbufr.f90)
!   2015-07-10  pondeca - add cloud ceiling height (cldch)
!   2015-08-12  pondeca - add capability to read min/maxT obs from ascii file
!   2015-08-20  zhu     - use centralized radiance info from radiance_mod to specify
!                         all-sky and aerosol usages in radiance assimilation
!   2015-09-04  J. Jung - Added mods for CrIS full spectral resolution (FSR)
!   2015-10-19  lippi   - Added logic to read l2rw or rw radial winds.
!   2016-03-02  s.liu/carley - remove use_reflectivity and use i_gsdcldanal_type
!   2016-04-28  J. Jung - added logic for RARS and direct broadcast data from NESDIS/UW.
!   2016-05-05  pondeca - add 10-m u-wind and v-wind (uwnd10m, vwnd10m)
!   2016-09-xx  CAPS(G. Zhao) - read mosaic dbz in BUFR (read_Radarref_directDA)
!   2016-09-19  Guo     - replaced open(obs_input_common) with "call unformatted_open(obs_input_common)"
!   2017-05-12  Y. Wang and X. Wang - add multi-interface to read in dBZ (nc) and radial velocity (ascii)
!   2016-12-14  lippi   - Fixed bug of using observations twice when both
!                         l2rwbufr and radarbufr are in the OBS_INPUT table.
!                         Changed the dsis entries for l2rwbufr and radarbufr to
!                         l2rw and l3rw respectively. Also make use of nml
!                         option vadwnd_l2rw_qc. 
!   2017-08-31  Li      - move gsi_nstcoupler_init & gsi_nstcoupler_set to getsfc in sathin.F90
!                       - move gsi_nstcoupler_final from create_sfc_grids to here
!   2017-12-05  Wargan  - added OMPS ozone
!   2018-01-23 Apodaca  - add GOES/GLM lightning data
!   2018-07-09 Todlng   - move gsi_nstcoupler_final to destroy_sfc (consistency)
!   2019-01-15  Li      - add to handle mbuoyb
!   2019-03-27  h. liu   - add abi
!   2022-05-06 Hoover   - add HU-3 ASCAT wind read via read_hu3ascat
!   
!
!   input argument list:
!     mype     - mpi task id
!
!   output argument list:
!     ndata(*,1)- number of prefiles retained for further processing
!     ndata(*,2)- number of observations read
!     ndata(*,3)- number of observations keep after read
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$  end documentation block
    use kinds, only: r_kind,i_kind,i_llong,r_double
    use gridmod, only: nlon,nlat,nsig,iglobal,ijn,itotsub,lat1,lon1,&
         displs_g,strip,reorder
    use general_commvars_mod, only: ltosi,ltosj
    use obsmod, only: iadate,ndat,time_window,dplat,dsfcalc,dfile,dthin, &
           dtype,dval,dmesh,obsfile_all,ref_obs,nprof_gps,dsis,ditype,&
           perturb_obs,lobserver,lread_obs_save,obs_input_common, &
           reduce_diag,nobs_sub,dval_use,hurricane_radar,l2rwthin 
    use gsi_nstcouplermod, only: nst_gsi
!   use gsi_nstcouplermod, only: gsi_nstcoupler_set
    use hdraobmod, only: read_hdraob,nhdt,nhdq,nhduv,nhdps,hdtlist,hdqlist,hduvlist,hdpslist,nodet,nodeq,nodeuv,nodeps
    use qcmod, only: njqc,vadwnd_l2rw_qc,nvqc
    use gsi_4dvar, only: l4dvar
    use satthin, only: super_val,super_val1,superp,makegvals,getsfc,destroy_sfc
    use mpimod, only: ierror,mpi_comm_world,mpi_sum,mpi_max,mpi_rtype,mpi_integer,npe,&
         setcomm
    use constants, only: one,zero,izero
    use converr, only: converr_read
    use converr_ps, only: converr_ps_read
    use converr_q, only: converr_q_read
    use converr_t, only: converr_t_read
    use converr_uv, only: converr_uv_read
    use converr_pw, only: converr_pw_read
    use convb_ps,only: convb_ps_read
    use convb_q,only:convb_q_read
    use convb_t,only:convb_t_read
    use convb_uv,only:convb_uv_read
    use pvqc,only: readvqcdatfile
    use guess_grids, only: ges_prsl,geop_hgtl,ntguessig
    use radinfo, only: nusis,iuse_rad,jpch_rad,diag_rad
    use insitu_info, only: mbuoy_info,mbuoyb_info,read_ship_info
    use aeroinfo, only: nusis_aero,iuse_aero,jpch_aero,diag_aero
    use ozinfo, only: nusis_oz,iuse_oz,jpch_oz,diag_ozone
    use pcpinfo, only: npcptype,nupcp,iusep,diag_pcp
    use convinfo, only: nconvtype,ioctype,icuse,diag_conv,ithin_conv
    use chemmod, only : oneobtest_chem,oneob_type_chem,oneobschem
    use lightinfo, only: nlighttype,iuse_light,diag_light
    use aircraftinfo, only: aircraft_t_bc,aircraft_t_bc_pof,aircraft_t_bc_ext,mype_airobst
    use gsi_io, only: mype_io
    use rapidrefresh_cldsurf_mod, only: i_gsdcldanal_type
    use radiance_mod, only: rad_obs_type,radiance_obstype_search

    use m_extOzone, only: is_extOzone
    use m_extOzone, only: extOzone_read
    use mpeu_util, only: warn
    use gsi_unformatted, only: unformatted_open

    use mrmsmod,only: l_mrms_sparse_netcdf
    use directDA_radaruse_mod, only: l_use_dbz_directDA

    implicit none

!   Declare passed variables
    integer(i_kind)                  ,intent(in   ) :: mype
    integer(i_kind),dimension(ndat,3),intent(  out) :: ndata

!   Declare local parameters
    integer(i_llong),parameter:: lenbuf=8388608_i_llong  ! lenbuf=8*1024*1024

!   Declare local variables
    logical :: lexist,ssmis,amsre,sndr,hirs,avhrr,lexistears,lexistdb,use_prsl_full,use_hgtl_full
    logical :: use_sfc,nuse,use_prsl_full_proc,use_hgtl_full_proc,seviri,mls,abi
    logical,dimension(ndat):: belong,parallel_read,ears_possible,db_possible
    logical :: modis,use_sfc_any
    logical :: acft_profl_file
    character(10):: obstype,platid
    character(22):: string
    character(120):: infile
    character(20):: sis
    integer(i_kind) i,j,k,ii,nmind,lunout,isfcalc,ithinx,ithin,nread,npuse,nouse
    integer(i_kind) nprof_gps1,npem1,krsize,len4file,npemax,ilarge,nlarge,npestart
    integer(i_llong) :: lenbytes
    integer(i_kind):: npetot,npeextra,mmdat,nodata
    integer(i_kind):: iworld,iworld_group,next_mype,mm1,iix
    integer(i_kind):: mype_root
    integer(i_kind),dimension(8):: nhd,nhd1
    integer(i_kind):: minuse,lunsave,maxproc,minproc
    integer(i_kind),dimension(ndat):: npe_sub,npe_sub3,mpi_comm_sub,mype_root_sub,npe_order
    integer(i_kind),dimension(ndat):: ntasks1,ntasks
    integer(i_kind),dimension(ndat):: read_rec1,read_rec
    integer(i_kind),dimension(ndat):: read_ears_rec1,read_ears_rec
    integer(i_kind),dimension(ndat):: read_db_rec1,read_db_rec
    integer(i_kind),dimension(ndat,3):: ndata1
    integer(i_kind),dimension(npe,ndat):: mype_work,nobs_sub1
    integer(i_kind),dimension(npe,ndat):: mype_sub
    integer(i_kind),allocatable,dimension(:):: nrnd
    integer(i_kind):: nmls_type,mype_io_sfc
    integer(i_kind):: iread,ipuse,iouse

    real(r_kind) gstime,val_dat,rmesh,twind,rseed
    real(r_kind),allocatable,dimension(:) :: prslsm,hgtlsm,work1
    real(r_kind),allocatable,dimension(:,:,:):: prsl_full,hgtl_full

    type(rad_obs_type) :: radmod

    data lunout / 81 /
    data lunsave  / 82 /

!*****************************************************************************

!   Set analysis time and allocate/initialize arrays and variables
    call w3fs21(iadate,nmind)
    gstime=real(nmind,r_kind)
    allocate(nobs_sub(npe,ndat))
    nobs_sub = 0
    nobs_sub1 = 0

    call makegvals
    do ii=1,ndat
       ndata1(ii,1)=0
       ndata1(ii,2)=0
       ndata1(ii,3)=0
       ntasks1(ii) =0
       parallel_read=.false.
    end do
    npem1=npe-1
    nprof_gps1=0

    if(njqc) then
       call converr_ps_read(mype)
       call converr_q_read(mype)
       call converr_t_read(mype)
       call converr_uv_read(mype)
       call converr_pw_read(mype)
       call convb_ps_read(mype)
       call convb_q_read(mype)
       call convb_t_read(mype)
       call convb_uv_read(mype)
    else
       call converr_read(mype)
    endif
    if(nvqc) call readvqcdatfile('vqctp001.dat',20,10,20,10,200,2)

!   Optionally set random seed to perturb observations
    if (perturb_obs) then
       rseed=iadate(4)+iadate(3)*100+iadate(2)*10000+iadate(1)*1000000+mype
       call random_seed(size=krsize)
       allocate(nrnd(krsize))
       do i=1,krsize
          nrnd(i)=rseed
       end do
       call random_seed(put=nrnd)
       deallocate(nrnd)
    endif

!   Set number of high definition stations to zero
    nhdt=izero
    nhdq=izero
    nhduv=izero
    nhdps=izero
    nodet=izero
    nodeq=izero
    nodeuv=izero
    nodeps=izero

!   Set data class and number of reader tasks.  Set logical flag to indicate 
!   type type of GPS data (if present)
    ii=0
    ref_obs = .false.    !.false. = assimilate GPS bending angle
    ears_possible = .false.
    db_possible = .false.
    nmls_type=0
    read_rec1 = 0
    read_ears_rec1=0
    read_db_rec1=0
    do i=1,ndat
       obstype=dtype(i)                   !     obstype  - observation types to process
       amsre= index(obstype,'amsre') /= 0
       ssmis= index(obstype,'ssmis') /= 0
       sndr = index(obstype,'sndr') /= 0
       hirs = index(obstype,'hirs') /= 0
       avhrr = index(obstype,'avhrr') /= 0
       modis = index(obstype,'modis') /= 0
       seviri = index(obstype,'seviri') /= 0
       abi = index(obstype,'abi') /= 0
       mls = index(obstype,'mls') /= 0
       if(obstype == 'mls20' ) nmls_type=nmls_type+1
       if(obstype == 'mls22' ) nmls_type=nmls_type+1
       if(obstype == 'mls30' ) nmls_type=nmls_type+1
       if(nmls_type>1) then
          write(6,*) '******ERROR***********: there is more than one MLS data type, not allowed, please check'
          call stop2(339)
       end if
       if (obstype == 't'  .or. obstype == 'uv' .or. &
           obstype == 'q'  .or. obstype == 'ps' .or. &
           obstype == 'pw' .or. obstype == 'spd'.or. &
           obstype == 'sst'.or. &
           obstype == 'tcp'.or. obstype == "lag".or. &
           obstype == 'dw' .or. obstype == 'rw' .or. &
           obstype == 'mta_cld' .or. obstype == 'gos_ctp' .or. &
           obstype == 'rad_ref' .or. obstype=='lghtn' .or. &
           obstype == 'larccld' .or. obstype == 'pm2_5' .or. obstype == 'pm10' .or. &
           obstype == 'gust' .or. obstype=='vis' .or. &
           obstype == 'pblh' .or. obstype=='wspd10m' .or. &
           obstype == 'td2m' .or. obstype=='mxtm' .or. &
           obstype == 'mitm' .or. obstype=='pmsl' .or. &
           obstype == 'howv' .or. obstype=='tcamt' .or. &
           obstype=='lcbas' .or. obstype=='cldch' .or. obstype == 'larcglb' .or. &
           obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' ) then
          ditype(i) = 'conv'
       else if (obstype == 'swcp' .or. obstype == 'lwcp') then
          ditype(i) = 'wcp'
       else if( hirs   .or. sndr      .or.  seviri .or. abi .or.        &
               obstype == 'airs'      .or. obstype == 'amsua'     .or.  &
               obstype == 'msu'       .or. obstype == 'iasi'      .or.  &
               obstype == 'amsub'     .or. obstype == 'mhs'       .or.  &
               obstype == 'hsb'       .or. obstype == 'goes_img'  .or.  &
               obstype == 'ahi'       .or. avhrr                  .or.  &
               amsre  .or. ssmis      .or. obstype == 'ssmi'      .or.  &
               obstype == 'ssu'       .or. obstype == 'atms'      .or.  &
               obstype == 'cris'      .or. obstype == 'cris-fsr'  .or.  &
               obstype == 'amsr2'     .or.  &
               obstype == 'gmi'       .or. obstype == 'saphir'   ) then
          ditype(i) = 'rad'
       else if (is_extOzone(dfile(i),obstype,dplat(i))) then
          ditype(i) = 'ozone'
       else if (obstype == 'sbuv2' &
           .or. obstype == 'omi' &
           .or. obstype == 'ompstc8' &
           .or. obstype == 'ompsnp' &
           .or. obstype == 'gome' &
           .or. index(obstype, 'omps') /= 0 &
           .or. mls &
           ) then
          ditype(i) = 'ozone'
       else if (obstype == 'mopitt') then
          ditype(i) = 'co'
       else if (index(obstype,'pcp')/=0 )then
          ditype(i) = 'pcp'
       else if (obstype == 'gps_ref' .or. obstype == 'gps_bnd') then
          ditype(i) = 'gps'
       else if ( index(obstype,'aod') /= 0 ) then
          ditype(i) = 'aero'
       else if (obstype == 'goes_glm') then
          ditype(i) = 'light'
       else
          write(6,*)'READ_OBS:  ***ERROR*** - unknown ob type ',trim(obstype)
       end if

!   Set data class and number of reader tasks.  Set logical flag to indicate 
!   type type of GPS data (if present)
       if (index(dtype(i),'gps_ref') /= 0) ref_obs = .true.

!   Check info files to see if data is read.

       nuse=.false.
       minuse=-1
       if(ditype(i) == 'conv')then
          if(diag_conv .and. .not. reduce_diag)minuse=-2
          do j=1,nconvtype
             if(trim(dtype(i)) == trim(ioctype(j)) .and. icuse(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'rad')then
          if(diag_rad .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_rad
             if(trim(dsis(i)) == trim(nusis(j)) .and. iuse_rad(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'ozone')then
          if(diag_ozone .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_oz
             if(trim(dsis(i)) == trim(nusis_oz(j)) .and. iuse_oz(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'pcp')then
          if(diag_pcp .and. .not. reduce_diag)minuse=-2
          do j=1,npcptype
             if(trim(dsis(i)) == trim(nupcp(j)) .and. iusep(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'aero')then
          if(diag_aero .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_aero
             if(trim(dsis(i)) == trim(nusis_aero(j)) .and. iuse_aero(j) > minuse)nuse=.true.
          end do
        else if(ditype(i) == 'light')then
          if(diag_light .and. .not. reduce_diag)minuse=-2
          do j=1,nlighttype
             if(iuse_light(j) > minuse) nuse=.true.
          end do
       else
          nuse=.true.
       end if

       if(nuse)then

!     Control parallel read for each ob type (currently just rad obs).  
!     To remove parallel read comment out line.
          ithin=dthin(i)
          if(ithin > 0 )then
            if(dmesh(ithin) > one)then
             if(hirs)then
                parallel_read(i)= .true.
             else if(obstype == 'amsua')then
                parallel_read(i)= .true.
             else if(obstype == 'airs' )then
                parallel_read(i)= .true.
             else if(obstype == 'iasi')then
                parallel_read(i)= .true.
             else if(obstype == 'amsub')then
                parallel_read(i)= .true.
             else if(obstype == 'mhs' )then
                parallel_read(i)= .true.
             else if(sndr )then
                parallel_read(i)= .true.
! N.B. ATMS must be run on one processor for the filtering code to work.
             else if(obstype == 'atms')then
!                 parallel_read(i)= .true.
             else if(ssmis)then
!               parallel_read(i)= .true.  
             else if(seviri)then
                parallel_read(i)= .true.
             else if(abi)then
                parallel_read(i)= .true.
             else if(obstype == 'cris' .or. obstype == 'cris-fsr')then
                parallel_read(i)= .true.
             else if(avhrr)then
                parallel_read(i)= .true.
             else if(amsre)then
                parallel_read(i)= .true.
             else if(obstype == 'goes_img' )then
                parallel_read(i)= .true.
             else if(obstype == 'ahi' )then
                parallel_read(i)= .true.
             else if(obstype == 'hsb' )then
                parallel_read(i)= .true.
             else if(obstype == 'ssmi' )then
                parallel_read(i)= .true.
             else if(obstype == 'ssu' )then
                parallel_read(i)= .true.
             else if(obstype == 'amsr2')then    
!                parallel_read(i)= .true.     ! turn parallel read off for spatial averaging
             else if(obstype == 'gmi')then
!                parallel_read(i)= .true.     ! turn parallel read off for spatial averaging
!   Parallel read for SAPHIR not currently working. Leave parallel read off.
!             else if(obstype == 'saphir')then
!                parallel_read(i)= .true.

             end if
           end if
          end if
! direct broadcast from EUMETSAT (EARS)
          ears_possible(i) = ditype(i) == 'rad'  .and. & 
                  (obstype == 'amsua' .or. obstype == 'amsub' .or. & 
                   obstype == 'mhs'   .or. obstype == 'hirs3' .or. &
                   obstype == 'cris'  .or. obstype == 'cris-fsr' .or. &
                   obstype == 'iasi'  .or. obstype == 'atms') .and. &
                  (dplat(i) == 'n17' .or. dplat(i) == 'n18' .or. & 
                   dplat(i) == 'n19' .or. dplat(i) == 'npp' .or. &
                   dplat(i) == 'n20' .or. &
                   dplat(i) == 'metop-a' .or. dplat(i) == 'metop-b' .or. &
                   dplat(i) == 'metop-c') 
! direct broadcast from NESDIS/UW
          db_possible(i) = ditype(i) == 'rad'  .and.       & 
                  (obstype == 'amsua' .or.  obstype == 'amsub' .or.  & 
                   obstype == 'mhs' .or. obstype == 'atms' .or. &
                   obstype == 'cris' .or. obstype == 'cris-fsr' .or. &
                   obstype == 'iasi') .and. &
                  (dplat(i) == 'n17' .or. dplat(i) == 'n18' .or. & 
                   dplat(i) == 'n19' .or. dplat(i) == 'npp' .or. &
                   dplat(i) == 'n20' .or. &
                   dplat(i) == 'metop-a' .or. dplat(i) == 'metop-b' .or. &
                   dplat(i) == 'metop-c') 

!   Inquire data set to deterimine if input data available and size of dataset
          ii=ii+1
          if (ii>npem1) ii=0
          if(mype==ii)then
             call gsi_inquire(lenbytes,lexist,trim(dfile(i)),mype)
             call read_obs_check (lexist,trim(dfile(i)),dplat(i),dtype(i),minuse,read_rec1(i))
             
!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

             if(.not. lexist)read_rec1(i) = 999999
             len4file=lenbytes/4
             if (ears_possible(i))then

                call gsi_inquire(lenbytes,lexistears,trim(dfile(i))//'ears',mype)
                call read_obs_check (lexistears,trim(dfile(i))//'ears',dplat(i),dtype(i),minuse, &
                    read_ears_rec1(i))

!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

                if(.not. lexistears)read_ears_rec1(i) = 999999
                lexist=lexist .or. lexistears
                len4file=len4file+lenbytes/4
             else
               read_ears_rec1(i) = 999999
             end if
             if (db_possible(i))then

                call gsi_inquire(lenbytes,lexistdb,trim(dfile(i))//'_db',mype)
                call read_obs_check (lexistdb,trim(dfile(i))//'_db',dplat(i),dtype(i),minuse, &
                    read_db_rec1(i))

!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

                if(.not. lexistdb)read_db_rec1(i) = 999999
                lexist=lexist .or. lexistdb
                len4file=len4file+lenbytes/4
             else
               read_db_rec1(i) = 999999
             end if

 
             if(lexist) then
!      Initialize number of reader tasks to 1.  For the time being
!      only allow number of reader tasks >= 1 for select obstype.

                ntasks1(i)=1
                if(parallel_read(i)) then

!  Allow up to 16 processors/file increase loop bounds to increase number of processors allowed
                   do j=1,4
                      if(len4file < lenbuf)exit
                      ntasks1(i)=2*ntasks1(i)
                      len4file=len4file/2
                   end do
!               if(ntasks1(i)*lenbuf < len4file) ntasks1(i)=ntasks1(i)+1
                end if
             end if
          end if
       else
          if(mype == 0)write(6,*) 'data type ',dsis(i), &
                'not used in info file -- do not read file ',trim(dfile(i))
       end if
    end do


!   Distribute optimal number of reader tasks to all mpi tasks
    call mpi_allreduce(ntasks1,ntasks,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror)
    call mpi_allreduce(read_rec1,read_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 
    call mpi_allreduce(read_ears_rec1,read_ears_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 
    call mpi_allreduce(read_db_rec1,read_db_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 

!   Limit number of requested tasks per type to be <= total available tasks
    npemax=0
    npetot=0
    do i=1,ndat
       if (ntasks(i)>npe) then
          write(6,*)'read_obs:  ***WARNING*** i=',i,' dtype=',dtype(i),' dsis=',dsis(i),&
               ' requested ntasks=',ntasks(i),' > npe=',npe,' reset ntasks=',npe
          ntasks(i)=npe
       endif
       npe_sub(i)=ntasks(i)
       npetot=npetot+npe_sub(i)
       npemax=max(npemax,npe_sub(i))
    end do

    if(l4dvar.and.(.not.lobserver)) then
!_RTod use_sfc=.false.
!_RTod call getsfc(mype,use_sfc)
       return
    endif
    
    npeextra=0
    if(mod(npetot,npe) > 0) npeextra=npe-mod(npetot,npe)
    maxproc=32
    if(npeextra > 0)then
       if(mype == 0)write(6,*) ' number of extra processors ',npeextra
       extraloop: do j=1,npeextra
          npe_sub3=ntasks
          minproc=999999
          do i=1,ndat
            if(ntasks(i) > 0 .and.  parallel_read(i))minproc=min(minproc,ntasks(i))
          end do
          if(npeextra < minproc) exit extraloop
          iix=minproc
          do ii=1,6
             do i=1,ndat
                if(iix == npe_sub3(i) .and. parallel_read(i))then
                   if(ntasks(i) <= npeextra .and. ntasks(i) < maxproc)then
                      npeextra=npeextra-ntasks(i)
                      ntasks(i)=2*ntasks(i)
                      if(npeextra < iix)cycle extraloop
                   end if
                end if
             end do
             iix=2*iix
             if(iix >= maxproc) cycle extraloop
          end do
       end do extraloop
    end if

!   Set up locations of first processor

    ilarge=0
    npestart=0
    npe_sub3=npe_sub
    mype_root_sub=0
    mmdat=0
    loopx: do j=1,ndat
       nlarge=0
       do i=1,ndat
          if(npe_sub3(i) > nlarge .and. npe_sub3(i)+npestart <= npe)then
             ilarge=i
             nlarge=npe_sub3(i)
          end if
       end do
       if(nlarge == 0)exit loopx
       npe_order(j)=ilarge
       mype_root_sub(ilarge)=npestart
       npestart=npestart+npe_sub3(ilarge)
       mmdat=mmdat+1
       npe_sub3(ilarge)=0
       if(npestart + minval(npe_sub3, mask=npe_sub3>0)>= npe) npestart=0
    end do loopx

!   Define sub-communicators for each data file
    mm1=mype+1
    belong=.false.
    mype_sub=-999
    mype_root=0
    next_mype=0
    do ii=1,mmdat
       i=npe_order(ii)
       if(npe_sub(i) > 0)then
          next_mype=mype_root_sub(i)
          do k=1,npe_sub(i)
             mype_work(k,i) = next_mype
             mype_sub(mype_work(k,i)+1,i)=k-1
             if(next_mype == mype)belong(i) = .true.
             next_mype = next_mype + 1
             if (next_mype>npem1) next_mype=0
          end do               

          call setcomm(iworld,iworld_group,npe_sub(i),mype_work(1,i),&
                 mpi_comm_sub(i),ierror)
       end if

    end do
    mype_airobst = mype_root
    do ii=1,mmdat
       i=npe_order(ii)
       if(mype == 0 .and. npe_sub(i) > 0) write(6,'(1x,a,i4,1x,a,1x,2a,2i4,1x,i6,1x,i6,1x,i6)') &
        'READ_OBS:  read ',i,dtype(i),dsis(i),' using ntasks=',ntasks(i),mype_root_sub(i), & 
               read_rec(i),read_ears_rec(i),read_db_rec(i)

       acft_profl_file = index(dfile(i),'_profl')/=0
       if ((aircraft_t_bc_pof .or. aircraft_t_bc_ext .or. &
          (aircraft_t_bc .and. acft_profl_file)) .and. dtype(i) == 't') &
                   mype_airobst = mype_root_sub(i)

    end do


    use_prsl_full=.false.
    use_hgtl_full=.false.
    use_sfc=.false.
    use_prsl_full_proc=.false.
    use_hgtl_full_proc=.false.
    mype_io_sfc=mype_io
    do ii=1,mmdat
       i=npe_order(ii)
       if(ditype(i) =='conv')then
          obstype=dtype(i)
          if (obstype == 't' .or. obstype == 'q'  .or. &
              obstype == 'uv' .or. obstype == 'wspd10m' .or. &
              obstype == 'uwnd10m' .or. obstype == 'vwnd10m') then
              use_prsl_full=.true.
              if(belong(i))use_prsl_full_proc=.true.
          else
            do j=1,nconvtype
               if(obstype == trim(ioctype(j)) .and. ithin_conv(j) > 0)then
                  use_prsl_full=.true.
                  if(belong(i))use_prsl_full_proc=.true.
               end if
            end do
          end if
          if(dfile(i) == 'uprair')then
             use_prsl_full=.true.
             use_hgtl_full = .true.
             if(belong(i))use_hgtl_full_proc=.true.
             if(belong(i))use_prsl_full_proc=.true.
          else if(obstype == 'rw')then
             use_hgtl_full=.true.
             if(belong(i))use_hgtl_full_proc=.true.
          else if(obstype == 'dbz')then
             use_hgtl_full=.true.
             if(belong(i))use_hgtl_full_proc=.true.
          end if
          if(obstype == 'sst')then
            if(belong(i))use_sfc=.true.
          endif
       else if(ditype(i) == 'rad' )then
          if(belong(i)) use_sfc=.true.
       end if
    end do
    use_sfc_any=.false.
    loop: do ii=1,mmdat
       i=npe_order(ii)
       if(ditype(i) == 'rad' .or. ditype(i) == 'sst')then
          mype_io_sfc=mype_root_sub(i)
          use_sfc_any=.true.
          exit loop
       end if
    end do loop
    if(use_sfc_any .and. mype == mype_io)use_sfc=.true.

!   Create full horizontal surface fields from local fields in guess_grids
    call getsfc(mype,mype_io_sfc,use_sfc,use_sfc_any)

    if(mype == mype_io) call prt_guessfc2('sfcges2',use_sfc)

!   Get guess 3d pressure on full grid
    allocate(work1(max(iglobal,itotsub)),prslsm(lat1*lon1))
    if(use_prsl_full)then
       if(use_prsl_full_proc)then
          allocate(prsl_full(nlat,nlon,nsig))
       else
          allocate(prsl_full(1,1,1))
       end if
       do k=1,nsig
          call strip(ges_prsl(:,:,k,ntguessig),prslsm)
          call mpi_allgatherv(prslsm,ijn(mype+1),mpi_rtype,&
               work1,ijn,displs_g,mpi_rtype,mpi_comm_world,ierror)
          if(use_prsl_full_proc)then
             call reorder(work1,1,1)
             do ii=1,iglobal
                i=ltosi(ii)
                j=ltosj(ii)
                prsl_full(i,j,k)=work1(ii)
             end do
          end if
       end do
    else
       allocate(prsl_full(1,1,1))
    end if
!   Get guess 3d geopotential height on full grid
    if(use_hgtl_full)then
       allocate(hgtlsm(lat1*lon1))
       if(use_hgtl_full_proc)then
          allocate(hgtl_full(nlat,nlon,nsig))
       else
          allocate(hgtl_full(1,1,1))
       end if
       do k=1,nsig
          call strip(geop_hgtl(:,:,k,ntguessig),hgtlsm)
          call mpi_allgatherv(hgtlsm,ijn(mype+1),mpi_rtype,&
               work1,ijn,displs_g,mpi_rtype,mpi_comm_world,ierror)
          if(use_hgtl_full_proc)then
             call reorder(work1,1,1)
             do ii=1,iglobal
                i=ltosi(ii)
                j=ltosj(ii)
                hgtl_full(i,j,k)=work1(ii)
             end do
           end if
       end do
       deallocate(hgtlsm)
    else
      allocate(hgtl_full(1,1,1))
    end if
    deallocate(work1,prslsm)

!   Create moored buoy station ID
    call mbuoy_info(mype)

!   Create moored buoy station ID for mbuoyb with 7-digit station ID
    call mbuoyb_info(mype)

!   Create ships info(ID, Depth & Instrument)
    call read_ship_info(mype)

!   Loop over data files.  Each data file is read by a sub-communicator
    loop_of_obsdata_files: &
    do ii=1,mmdat

       i=npe_order(ii)
       task_belongs: &
       if (i > 0 .and. belong(i)) then

          platid=dplat(i)                    !     platid   - satellites to read
          obstype=dtype(i)                   !     obstype  - observation types to process
          infile=trim(dfile(i))              !     infile   - units from which to read data
          sis=dsis(i)                        !     sensor/instrument/satellite indicator
          val_dat=dval(i)                    !     weighting factors applied to super obs
          ithin=dthin(i)                     !     ithin    - flags to thin data
          ithinx=max(1,abs(ithin))
          rmesh=dmesh(ithinx)                !     rmesh    - thinning mesh sizes (km)
          twind=time_window(i)               !     time window (hours) for input group
          isfcalc=dsfcalc(i)                 !     method to calculate surface fields within fov
          nread=0
          nouse=0
          npuse=0

          if (mype_sub(mm1,i)==mype_root) then
             open(lunout,file=obsfile_all(i),form='unformatted')
             rewind(lunout)
          endif

!         Process conventional (prepbufr) data
          string="--"//trim(ditype(i))
          ditype_select: &
          if(ditype(i) == 'conv')then
             conv_obstype_select: &
             if (obstype == 't' .or. obstype == 'q'  .or. obstype == 'ps' .or. &
                 obstype == 'pw' .or. obstype == 'spd'.or. & 
                 obstype == 'gust' .or. obstype == 'vis'.or. &
                 obstype == 'td2m' .or. &
!                 obstype=='mxtm' .or. obstype == 'mitm' .or. &
!                 obstype=='howv' .or. obstype=='pmsl' .or. &    #howv #ww3 
                 obstype=='pmsl' .or. &
                 obstype == 'mta_cld' .or. obstype == 'gos_ctp' .or. &
                 obstype == 'lcbas' .or. obstype == 'cldch' ) then

!               Process flight-letel high-density data not included in prepbufr
                if ( index(infile,'hdobbufr') /=0 ) then
                  call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                                    prsl_full,nobs_sub1(1,i))
                  string='READ_FL_HDOB'
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
                else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'

                endif
             else if(obstype == 'howv') then
                 if ( index(infile,'satmar') /=0) then
                   
                    call read_satmar (nread, npuse, nouse                                  &
                                     , infile, obstype, lunout, gstime, twind, sis         &
                                     , nobs_sub1(1,i))
                    string='READ_SATMAR'
                 else 
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'

                 endif
             else if(obstype == 'mitm') then
                if ( index(infile,'mitmdat') /=0) then
                   call read_mitm_mxtm(nread,npuse,nouse,infile,obstype,lunout,gstime,sis, & 
                                       nobs_sub1(1,i))
                   string='READ_ASCII_MITM'
                 else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                 endif

             else if(obstype == 'mxtm') then
                if ( index(infile,'mxtmdat') /=0) then
                   call read_mitm_mxtm(nread,npuse,nouse,infile,obstype,lunout,gstime,sis, & 
                                       nobs_sub1(1,i))
                   string='READ_ASCII_MXTM'
                 else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                 endif

!            Process total cloud amount (tcamt) in prepbufr -or- from goes imager sky cover products
             else if(obstype == 'tcamt') then
!             Process GOES Imager Sky Cover product separately from prepbufr-based sky cover obs
                if ( index(infile,'goessky') /=0 ) then
                   call read_goesimgr_skycover(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                        prsl_full,nobs_sub1(1,i))
                   string='READ_GOESIMGR_SKYCOVER'
                else
!              else read from prepbufr
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,prsl_full, &
                         nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                end if

!             Process winds in the prepbufr
            else if(obstype == 'uv' .or. obstype == 'wspd10m' .or. &
                    obstype == 'uwnd10m' .or. obstype == 'vwnd10m') then
!             Process satellite winds which seperate from prepbufr
                if ( index(infile,'satwnd') /=0 ) then
                  call read_satwnd(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_SATWND'
!             Process high resolution radiosonde data
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
!             Process oscat winds which seperate from prepbufr
                elseif ( index(infile,'oscatbufr') /=0 ) then
                  call read_sfcwnd(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_SFCWND'
!             Process HU-3 ASCAT winds which are separate from prepbufr
                elseif ( index(infile,'hu3ascatbufr') /=0 ) then
                  call read_hu3ascat(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_HU3ASCAT'
!             Process rapidscat winds which seperate from prepbufr
                elseif ( index(infile,'rapidscatbufr') /=0 ) then
                  call read_rapidscat(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_RAPIDSCAT'
                else if ( index(infile,'hdobbufr') /=0 ) then
                  call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                       prsl_full,nobs_sub1(1,i))
                  string='READ_FL_HDOB'
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
                else
                  call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                     prsl_full,nobs_sub1(1,i),read_rec(i))
                  string='READ_PREPBUFR'
                endif

!            Process conventional SST (nsstbufr, at this moment) data
             elseif ( obstype == 'sst' ) then
                string="--"//trim(ditype(i))//":sst:"//trim(platid)
                if ( platid == 'nsst') then
                   call read_nsstbufr(nread,npuse,nouse,gstime,infile,obstype, &
                        lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_NSSTBUFR'
                elseif ( platid == 'mods') then
                   call read_modsbufr(nread,npuse,nouse,gstime,infile,obstype, &
                        lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_MODSBUFR'
                else
                   if(nst_gsi>0)then
                      write(6,*)'read_obs: should not handle SST via read_prepbufr when NSST on'
                      call stop2(999)
                   endif

                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                endif

!            Process radar reflectivity Mosaic
             else if (obstype == 'rad_ref' ) then
                call read_radarref_mosaic(nread,npuse,infile,obstype,lunout,twind,sis, &
                      nobs_sub1(1,i))
                string='READ_RADARREF_MOSAIC'

!            Process  lightning
             else if (obstype == 'lghtn' ) then
                if(i_gsdcldanal_type==2) then
                   call read_lightning(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                else if(i_gsdcldanal_type==1 .or. i_gsdcldanal_type==6 &
                        .or. i_gsdcldanal_type==3 .or. i_gsdcldanal_type==7) then
                   call read_lightning_grid(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                endif
                string='READ_LIGHTNING'

!            Process  NASA LaRC 
             ! for regional obs that are already mapped to analysis grid
             else if (obstype == 'larccld' ) then
                if(i_gsdcldanal_type==2) then
                   call read_NASA_LaRC_cloud(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                else if(i_gsdcldanal_type==1 .or. i_gsdcldanal_type==6 &
                        .or. i_gsdcldanal_type==3 .or. i_gsdcldanal_type==7) then
                   call read_nasa_larc(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                end if
                string='READ_NASA_LaRC'
             ! for global NASA LaRC obs 
             else if (obstype == 'larcglb' ) then
                call read_NASA_LaRC_cloud(nread,npuse,nouse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                string='READ_NASA_LaRC'

!            Process radar winds
             else if (obstype == 'rw') then
                if( trim(infile) == 'vr_vol' )then
                  call read_radar_wind_ascii(nread,npuse,nouse,infile,lunout,obstype,sis,&
                                  hgtl_full,nobs_sub1(1,i))
                  string='READ_RADAR_WIND'
                else if (hurricane_radar) then
                   if (sis == 'rw' ) then
                      write(6,*)'READ_OBS: radial wind,read_radar,dfile=',infile,',dsis=',sis
                      call read_radar(nread,npuse,nouse,infile,lunout,obstype,twind,sis,&
                                   hgtl_full,nobs_sub1(1,i))
                      string='READ_RADAR'
                   else if (sis == 'l2rw') then
                      if (l2rwthin)then 
                         call read_radar_l2rw(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i),hgtl_full) 
                         string='READ_RADAR_L2RW_NOVADQC'
                      else
                         write(6,*)'READ_OBS: radial wind,read_radar_l2rw_novadqc,dfile=',infile,',dsis=',sis
                         call read_radar_l2rw_novadqc(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i))
                         string='READ_RADAR_L2RW_NOVADQC'
                      end if
                   end if                  
                else
                   if (vadwnd_l2rw_qc) then
                      write(6,*)'READ_OBS: radial wind,read_radar,dfile=',infile,',dsis=',sis 
                     call read_radar(nread,npuse,nouse,infile,lunout,obstype,twind,sis,&
                                     hgtl_full,nobs_sub1(1,i))
                     string='READ_RADAR'
                   else if (sis == 'l2rw') then
                      write(6,*)'READ_OBS: radial wind,read_radar_l2rw_novadqc,dfile=',infile,',dsis=',sis
                     call read_radar_l2rw_novadqc(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i))
                     string='READ_RADAR_L2RW_NOVADQC'
                   end if
                end if
!            Process radar reflectivity from MRMS
             else if (obstype == 'dbz' ) then
                print *, "calling read_dbz"

                if(trim(infile)=='dbzobs.nc')then
                  call read_dbz_nc(nread,npuse,nouse,infile,lunout,obstype,sis,hgtl_full,nobs_sub1(1,i))
                  string='READ_dBZ'
                else if ( l_use_dbz_directDA ) then
                  call read_radarref_directDA(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                                           nobs_sub1(1,i))
                  string='READ_RADARREF_DIRECTDA'
                else
                  call read_dbz_mrms_detect_format(infile,l_mrms_sparse_netcdf)
                  if(l_mrms_sparse_netcdf) then
                     call read_dbz_mrms_sparse_netcdf(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                     string='READ_dbz_mrms_sparse_netcdf'
                  else
                     call read_dbz_mrms_netcdf(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                     string='READ_dbz_mrms_netcdf'
                  endif
                end if

!            Process lagrangian data
             else if (obstype == 'lag') then
                call read_lag(nread,npuse,nouse,infile,lunout,obstype,&
                 &twind,gstime,sis)
                string='READ_LAG'

!            Process lidar winds
             else if (obstype == 'dw') then
                call read_lidar(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                     nobs_sub1(1,i))
                string='READ_LIDAR'

!            Process synthetic tc-mslp obs
             else if (obstype == 'tcp') then
                call read_tcps(nread,npuse,nouse,infile,obstype,lunout,sis, &
                     nobs_sub1(1,i))
                string='READ_TCPS'

             else if (obstype == 'pm2_5' .or. obstype == 'pm10') then

                if (oneobtest_chem .and. oneob_type_chem=='pm2_5') then
                   call oneobschem(nread,npuse,nouse,gstime,&
                        &infile,obstype,lunout,sis,nobs_sub1(1,i))
                   string='ONEOBSCHEM'
                else
                   call read_anowbufr(nread,npuse,nouse,gstime,&
                        &infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_ANOWBUFR'
                endif

!            Process pblh
             else if (obstype == 'pblh') then
                call read_pblh(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                    nobs_sub1(1,i))
                string='READ_PBLH'
             end if conv_obstype_select
!            Process swcp and lwcp
          else if (ditype(i) == 'wcp') then
             if ( obstype == 'swcp' .or. obstype == 'lwcp' ) then
                call read_wcpbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                   prsl_full,nobs_sub1(1,i),read_rec(i))
                string='READ_WCPBUFR'
             end if
          else if (ditype(i) == 'rad')then

             call radiance_obstype_search(obstype,radmod)

!            Process TOVS 1b data
             rad_obstype_select: &
             if (platid /= 'aqua' .and. (obstype == 'amsua' .or. &
                  obstype == 'amsub' .or. obstype == 'msu'   .or.  &
                  obstype == 'mhs'   .or. obstype == 'hirs4' .or.  &
                  obstype == 'hirs3' .or. obstype == 'hirs2' .or.  &
                  obstype == 'ssu' )) then
                call read_bufrtovs(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use,radmod)
                string='READ_BUFRTOVS'

!            Process atms data
             else if (obstype == 'atms') then
                call read_atms(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i),&
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use,radmod)
                string='READ_ATMS'

!            Process saphir data
             else if (obstype == 'saphir') then
                call read_saphir(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),dval_use)
                string='READ_SAPHIR'


!            Process airs data        
             else if(platid == 'aqua' .and. (obstype == 'airs' .or.   &
                  obstype == 'amsua'  .or.  obstype == 'hsb' ))then
                call read_airs(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AIRS'

!            Process iasi data
             else if(obstype == 'iasi')then
                call read_iasi(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use)
                string='READ_IASI'

!            Process cris data
             else if(obstype == 'cris' .or. obstype =='cris-fsr' )then
                call read_cris(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use)
                string='READ_CRIS'

!            Process GOES sounder data
!            Process raw or prepbufr files (1x1 or 5x5)
             else if (obstype == 'sndr' .or.                            &
                      obstype == 'sndrd1' .or. obstype == 'sndrd2' .or. &
                      obstype == 'sndrd3' .or. obstype == 'sndrd4') then
                call read_goesndr(mype,val_dat,ithin,rmesh,platid,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,gstime,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_GOESNDR'

!            Process ssmi data
             else if (obstype == 'ssmi' ) then
                call read_ssmi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SSMI'

!            Process amsre data
             else if ( obstype == 'amsre_low' .or. obstype == 'amsre_mid' .or. &
                       obstype == 'amsre_hig' ) then
                call read_amsre(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AMSRE'
                
!            Process ssmis data
             else if (obstype == 'ssmis'     .or. &
                      obstype == 'ssmis_las' .or. obstype == 'ssmis_uas' .or. &
                      obstype == 'ssmis_img' .or. obstype == 'ssmis_env' ) then
                call read_ssmis(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                      infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                      mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                      nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SSMIS'

!            Process AMSR2 data
             else if(obstype == 'amsr2')then
                call read_amsr2(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i))
                string='READ_AMSR2'

!            Process GOES IMAGER RADIANCE  data
             else if(obstype == 'goes_img') then
                call read_goesimg(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_GOESMIMG'

!            Process GMI data
             else if (obstype == 'gmi') then
                call read_gmi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),dval_use)
                string='READ_GMI'

!            Process Meteosat SEVIRI RADIANCE  data
             else if(obstype == 'seviri') then
                 call read_seviri(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SEVIRI'
!            Process GOES-R ABI RADIANCE  data
             else if(obstype == 'abi') then
                call read_abi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_ABI'

        !    Process Himawari-8 AHI RADIANCE  data
             else if(obstype == 'ahi') then
                call read_ahi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AHI'


!            Process NAVY AVHRR RADIANCE  data
               else if(obstype == 'avhrr_navy') then
                  call read_avhrr_navy(mype,val_dat,ithin,rmesh,platid,gstime,&
                       infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                       mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                       nobs_sub1(1,i),read_rec(i),dval_use)
                  string='READ_AVH_NAVY'

  !            Process NESDIS AVHRR RADIANCE  data
               else if(obstype == 'avhrr') then
                  call read_avhrr(mype,val_dat,ithin,rmesh,platid,gstime,&
                       infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                       mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                       nobs_sub1(1,i),read_rec(i),dval_use)
                  string='READ_AVHRR'
               end if rad_obstype_select

!         Process ozone data
          else if (ditype(i) == 'ozone')then
             ozone_obstype_select: &
             if (is_extOzone(infile,obstype,dplat(i))) then

                call extOzone_read(infile,obstype,dplat(i),dsis(i), &
                   iread,ipuse,iouse, platid,gstime,lunout,twind,ithin,rmesh, &
                   nobs_sub1(:,i))
                string='extOzone_read'

                nread=nread+iread
                npuse=npuse+ipuse
                nouse=nouse+iouse

             else
                call read_ozone(nread,npuse,nouse,&
                   platid,infile,gstime,lunout,obstype,twind,sis,ithin,rmesh, &
                   nobs_sub1(1,i))
                string='READ_OZONE'
             endif ozone_obstype_select

!         Process co data
          else if (ditype(i) =='co')then 
             call read_co(nread,npuse,nouse,infile,gstime,lunout,obstype,sis, &
                  nobs_sub1(1,i))
             string='READ_CO'

!         Process precipitation             
          else if (ditype(i) == 'pcp')then
             call read_pcp(nread,npuse,nouse,gstime,infile,lunout,obstype,twind,sis, &
                  nobs_sub1(1,i))
             string='READ_PCP'

!         Process gps observations
          else if (ditype(i) == 'gps')then
             call read_gps(nread,npuse,nouse,infile,lunout,obstype,twind, &
                  nprof_gps1,sis,nobs_sub1(1,i))
             string='READ_GPS'

!         Process aerosol data
          else if (ditype(i) == 'aero' )then
             call read_aerosol(nread,npuse,nouse,&
                  platid,infile,gstime,lunout,obstype,twind,sis,ithin,rmesh, &
                  mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                  nobs_sub1(1,i))
             string='READ_AEROSOL'

!         Process satellite lightning observations (e.g. GOES/GLM)                     
          else if(ditype(i) == 'light')then
               if (obstype == 'goes_glm' ) then
             call read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twind,sis)
             string='READ_GOESGLM'
               endif

          end if ditype_select

!         Accumulate data counts on "root" task
          if (mype_sub(mm1,i)==mype_root) then
             close(lunout)
             ndata1(i,1)=ndata1(i,1)+npuse
             ndata1(i,2)=ndata1(i,2)+nread
             ndata1(i,3)=ndata1(i,3)+nouse

             if(string(1:2)=='--') then
               call warn('read_obs','task without reader, i =',i)
               call warn('read_obs','                infile =',trim(infile))
               call warn('read_obs','             ditype(i) =',trim(ditype(i)))
               call warn('read_obs','               obstype =',trim(obstype))
               call warn('read_obs','                platid =',trim(platid))
               call warn('read_obs','                string =',trim(string))
             endif

             write(6, '(a,'': file='',a,'' type='',a,'' sis='',a,'' nread='',i10,&
                  '' ithin='',i2,'' rmesh='',f11.6,'' isfcalc='',i2,'' nkeep='',i10,&
                  '' ntask='',i3)')

          endif
       endif task_belongs

    end do loop_of_obsdata_files
    deallocate(prsl_full)
    deallocate(hgtl_full)

!   Broadcast aircraft new tail numbers for aircraft
!   temperature bias correction
!   if (aircraft_t_bc) then
!      call mpi_barrier(mpi_comm_world,ierror)
!      call mpi_bcast(ntail_update,1,mpi_itype,mype_airobst,mpi_comm_world,ierror)
!      call mpi_bcast(idx_tail,max_tail,mpi_itype,mype_airobst,mpi_comm_world,ierror)
!      call mpi_bcast(taillist,max_tail,MPI_CHARACTER,mype_airobst,mpi_comm_world,ierror)
!   end if

!   Deallocate arrays containing full horizontal surface fields
    call destroy_sfc
!   Sum and distribute number of obs read and used for each input ob group
    call mpi_allreduce(ndata1,ndata,ndat*3,mpi_integer,mpi_sum,mpi_comm_world,&
       ierror)

!   Collect super obs factors
    if(mype == 0)write(6,*) ' dval_use = ',dval_use
    if(dval_use)then
       call mpi_allreduce(super_val,super_val1,superp+1,mpi_rtype,&
            mpi_sum,mpi_comm_world,ierror)
    else
       super_val1=zero
    end if
    super_val1(0)=one
    deallocate(super_val)
    nhd(1)=nhdt
    nhd(2)=nhdq
    nhd(3)=nhduv
    nhd(4)=nhdps
    nhd(5)=nodet
    nhd(6)=nodeq
    nhd(7)=nodeuv
    nhd(8)=nodeps
!   get number of high resolution stations on every processor
    call mpi_allreduce(nhd,nhd1,8,mpi_integer,mpi_max,mpi_comm_world,ierror)
    nhdt=nhd1(1)
    nhdq=nhd1(2)
    nhduv=nhd1(3)
    nhdps=nhd1(4)
    nodet=nhd1(5)
    nodeq=nhd1(6)
    nodeuv=nhd1(7)
    nodeps=nhd1(8)
    if(nhdt > 0)then
      if(.not. allocated(hdtlist))allocate(hdtlist(nhdt))
      call mpi_bcast(hdtlist,nhdt,mpi_integer,nodet,mpi_comm_world,ierror)
    end if
    if(nhdq > 0) then
      if(.not. allocated(hdqlist))allocate(hdqlist(nhdq))
      call mpi_bcast(hdqlist,nhdq,mpi_integer,nodeq,mpi_comm_world,ierror)
    end if
    if(nhduv > 0) then
      if(.not. allocated(hduvlist))allocate(hduvlist(nhduv))
      call mpi_bcast(hduvlist,nhduv,mpi_integer,nodeuv,mpi_comm_world,ierror)
    end if
    if(nhdps > 0)then
      if(.not. allocated(hdpslist))allocate(hdpslist(nhduv))
      call mpi_bcast(hdpslist,nhdps,mpi_integer,nodeps,mpi_comm_world,ierror)
    end if
    
    if(mype == 0)write(6,*)'number of HD stations',nhdt,nhdq,nhduv,nhdps
    if(mype == 0)write(6,*)'processors           ',nodet,nodeq,nodeuv,nodeps

!   Collect number of gps profiles (needed later for qc)
    call mpi_allreduce(nprof_gps1,nprof_gps,1,mpi_integer,mpi_sum,mpi_comm_world,ierror)
    call mpi_allreduce(nobs_sub1,nobs_sub,npe*ndat,mpi_integer,mpi_sum,mpi_comm_world,& 
         ierror)

!   Write collective obs selection information to scratch file.
    if (lread_obs_save .and. mype==0) then
       write(6,*)'READ_OBS:  write collective obs selection info to ',trim(obs_input_common)
       call unformatted_open(lunsave,file=obs_input_common,class=".obs_input.")
       write(lunsave) ndata,ndat,npe,superp,nprof_gps,ditype
       write(lunsave) super_val1
       write(lunsave) nobs_sub
       close(lunsave)
    endif

!   End of routine
    return
end subroutine read_obs


end module read_obsmod
lkcs_diag/gsi.fd/src/gsi/setupw.f900000640002177400414130000022424614237551424017470 0ustar  bhooverdras-aidamodule w_setup
  implicit none
  private
  public:: setup
        interface setup; module procedure setupw; end interface

contains
!-------------------------------------------------------------------------
!    NOAA/NCEP, National Centers for Environmental Prediction GSI        !
!-------------------------------------------------------------------------
!BOP
!
! !ROUTINE:  setupw --- Compute rhs of oi for wind component obs
!
! !INTERFACE:
!

subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsave)

! !USES:

  use mpeu_util, only: die,perr,getindex
  use state_vectors, only: svars3d, levels
  use kinds, only: r_kind,r_single,r_double,i_kind
  use m_obsdiagNode, only: obs_diag
  use m_obsdiagNode, only: obs_diags
  use m_obsdiagNode, only: obsdiagLList_nextNode
  use m_obsdiagNode, only: obsdiagNode_set
  use m_obsdiagNode, only: obsdiagNode_get
  use m_obsdiagNode, only: obsdiagNode_assert

  use obsmod, only: rmiss_single,perturb_obs,oberror_tune,lobsdiag_forenkf,&
       lobsdiagsave,nobskeep,lobsdiag_allocated,&
       time_offset,bmiss,ianldate,aircraft_recon
  use m_obsNode, only: obsNode
  use m_wNode, only: wNode
  use m_wNode, only: wNode_appendto
  use m_wNode, only: wNode_ich0
  use m_wNode, only: wNode_ich0_PBL_pseudo
  use m_obsLList, only: obsLList

  use obsmod, only: luse_obsdiag
  use obsmod, only: netcdf_diag, binary_diag, dirname
  use obsmod, only: neutral_stability_windfact_2dvar,use_similarity_2dvar
  use nc_diag_write_mod, only: nc_diag_init, nc_diag_header, nc_diag_metadata, &
       nc_diag_write, nc_diag_data2d
  use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim, nc_diag_read_close
  use gsi_4dvar, only: nobs_bins,hr_obsbin,min_offset
  use qcmod, only: npres_print,ptop,pbot,dfact,dfact1,qc_satwnds,njqc,vqc
  use qcmod, only: nvqc
  use oneobmod, only: oneobtest,oneob_type,magoberr,maginnov 
  use gridmod, only: get_ijk,nsig,twodvar_regional,regional,wrf_nmm_regional,&
      rotate_wind_xy2ll,pt_ll,fv3_regional
  use guess_grids, only: nfldsig,hrdifsig,geop_hgtl,sfcmod_gfs
  use guess_grids, only: tropprs,sfcmod_mm5
  use guess_grids, only: ges_lnprsl,comp_fact10,pbl_height
  use constants, only: zero,half,one,tiny_r_kind,two, &
           three,rd,grav,four,five,huge_single,r1000,wgtlim,r10,r400
  use constants, only: grav_ratio,flattening,deg2rad, &
       grav_equator,somigliana,semi_major_axis,eccentricity
  use jfunc, only: jiter,last,jiterstart,miter
  use convinfo, only: nconvtype,cermin,cermax,cgross,cvar_b,cvar_pg,ictype
  use convinfo, only: icsubtype,ibeta,ikapa
  use converr_uv, only: ptabl_uv
  use converr, only: ptabl
  use rapidrefresh_cldsurf_mod, only: l_PBL_pseudo_SurfobsUV, pblH_ration,pps_press_incr
  use rapidrefresh_cldsurf_mod, only: l_closeobs, i_gsdqc

  use m_dtime, only: dtime_setup, dtime_check

  use gsi_bundlemod, only : gsi_bundlegetpointer
  use hdraobmod, only: nhduv,hduvlist
  use gsi_metguess_mod, only : gsi_metguess_get,gsi_metguess_bundle
  use sparsearr, only: sparr2, new, size, writearray, fullarray
  use aux2dvarflds, only: rtma_comp_fact10


  ! The following variables are the coefficients that describe the
  ! linear regression fits that are used to define the dynamic
  ! observation error (DOE) specifications for all reconnissance
  ! observations collected within hurricanes/tropical cyclones; these
  ! apply only to the regional forecast models (e.g., HWRF); Henry
  ! R. Winterbottom (henry.winterbottom@noaa.gov).
  
  use obsmod, only: uv_doe_a_236,uv_doe_a_237,uv_doe_b_236,uv_doe_b_237

  implicit none
  
  type(obsLList ),target,dimension(:),intent(in):: obsLL
  type(obs_diags),target,dimension(:),intent(in):: odiagLL

! !INPUT PARAMETERS:

   integer(i_kind)                                  ,intent(in   ) :: lunin ! unit from which to read observations
   integer(i_kind)                                  ,intent(in   ) :: mype  ! mpi task id
   integer(i_kind)                                  ,intent(in   ) :: nele  ! number of data elements per observation
   integer(i_kind)                                  ,intent(in   ) :: nobs  ! number of observations
   integer(i_kind)                                  ,intent(in   ) :: is    ! ndat index
   logical                                          ,intent(in   ) :: conv_diagsave ! logical to save innovation dignostics
   
! !INPUT/OUTPUT PARAMETERS:

   real(r_kind),dimension(npres_print,nconvtype,5,3),intent(inout) :: bwork ! obs-ges stats
   real(r_kind),dimension(100+7*nsig)               ,intent(inout) :: awork ! data counts and gross checks

!
! !DESCRIPTION:  For wind component observations, this routine
!  \begin{enumerate}
!       \item reads obs assigned to given mpi task (geographic region),
!       \item simulates obs from guess,
!       \item apply some quality control to obs,
!       \item load weight and innovation arrays used in minimization
!       \item collects statistics for runtime diagnostic output
!       \item writes additional diagnostic information to output file
!  \end{enumerate}
!
! !REVISION HISTORY:
!
!   1990-10-06  parrish
!   1998-04-10  weiyu yang
!   1999-03-01  wu - ozone processing moved into setuprhs from setupoz
!   1999-08-24  derber, j., treadon, r., yang, w., first frozen mpp version
!   2004-06-17  treadon - update documentation
!   2004-07-15  todling - protex-compliant prologue; added intent/only's
!   2004-10-06  parrish - increase size of vwork array for nonlinear qc
!   2004-11-22  derber - remove weight, add logical for boundary point
!   2004-12-22  treadon - move logical conv_diagsave from obsmod to argument list
!   2005-03-02  dee - remove garbage from diagnostic file
!   2005-03-09  parrish - nonlinear qc change to account for inflated obs error
!   2005-05-27  derber - level output change
!   2005-07-22  jung - add modis winds
!   2005-07-27  derber  - add print of monitoring and reject data
!   2005-09-28  derber  - combine with prep,spr,remove tran and clean up
!   2005-10-14  derber  - input grid location and fix regional lat/lon
!   2005-10-21  su  - modified variational qc and diagnose output
!   2005-11-03  treadon - correct error in ilone,ilate data array indices
!   2005-11-22  wu - add option to perturb conventional obs
!   2005-11-29 derber - remove psfcg and use ges_lnps instead
!   2006-01-13 treadon - correct bugs in modis wind qc
!   2006-01-31  todling - storing wgt/wgtlim in diag file instead of wgt only
!   2006-02-02  treadon - rename lnprsl as ges_lnprsl
!   2006-02-08  treadon - correct vertical dimension (nsig) in call tintrp2a(ges_tv...)
!   2006-02-15  treadon - use height when processing type 223, 224, 229 winds
!   2006-02-24  derber  - modify to take advantage of convinfo module
!   2006-03-21  treadon - modify optional perturbation to observation
!   2006-04-03  derber  - fix bugs and move all surface data to height calculation
!   2006-05-30  su,derber,treadon - modify diagnostic output
!   2006-06-06  su - move to wgtlim to constants module
!   2006-07-28  derber  - modify to use new inner loop obs data structure
!                       - modify handling of multiple data at same location
!   2006-07-31  kleist - use ges_ps instead of ln(ps)
!   2006-08-28      su - fix a bug in variational qc
!   2006-11-30  jung/sienkiewicz - add type 259 for modis winds
!   2006-10-28      su - turn off rawinsonde Vqc at south hemisphere
!   2007-03-09  su     - modify observation pertabation for adjusting obs error
!   2007-03-19  tremolet - binning of observations
!   2007-03-27  li.bi - add qc for type 289 windsat winds
!   2007-06-05  tremolet - add observation diagnostics structure
!   2007-08-28  su     - modify observation gross check error 
!   2008-03-24  wu     - oberror tuning and perturb obs
!   2008-03-31  li.bi - add qc for type 290 ascat winds
!   2008-05-20  safford - rm unused vars
!   2008-09-08  lueken  - merged ed's changes into q1fy09 code
!   2008-12-03  todling - changed handle of tail%time
!   2009-08-19  guo     - changed for multi-pass setup with dtime_check().
!   2009-02-06  pondeca - for each observation site, add the following to the
!                         diagnostic file: local terrain height, dominate surface
!                         type, station provider name, and station subprovider name
!   2010-11-25  su      - data items to hold quality mark for satellite wind 
!   2011-03-08  parrish - for regional=.true., convert wind components in rdiagbuf from grid relative
!                           to earth relative, using subroutine rotate_wind_xy2ll.
!   2011-05-05  su      - ome quality control for satellite satellite winds 
!   2012-01-10  hu      - add additional quality control for PBL profiler 223, 224, 227 
!   2011-12-14  wu      - add code for rawinsonde level enhancement ( ext_sonde )
!   2012-07-19  todling - add qc_satwnds flag to allow bypass QC-satwinds (QC not good for GMAO)
!   2011-10-14  Hu      - add code for producing pseudo-obs in PBL 
!                               layer based on surface obs UV
!   2013-01-08  Su      -add more quality control for satellite winds and profiler winds
!   2013-01-26  parrish - change grdcrd to grdcrd1, intrp2a to intrp2a11, tintrp2a to tintrp2a1, tintrp2a11,
!                           tintrp3 to tintrp31 (so debug compile works on WCOSS)
!   2013-02-15  parrish - WCOSS debug runtime error--ikx outside range 1 to nconvtype.  Add counter
!                            num_bad_ikx and print 1st 10 instances of ikx out of range
!                            and also print num_bad_ikx after all data processed if > 0 .
!   2013-05-24  wu      - move rawinsonde level enhancement ( ext_sonde ) to read_prepbufr
!   2013-07-19  Hu/Olson/Carley  - Add tall tower (type=261) winds
!   2013-10-19  todling - metguess now holds background
!   2014-01-28  todling - write sensitivity slot indicator (ioff) to header of diagfile
!   2014-04-12       su - add non linear qc from Purser's scheme
!   2014-12-30  derber  - Modify for possibility of not using obsdiag
!   2015-05-01  Liu Ling - Added ISS Rapidscat wind (u,v) qc 
!   2015-03-14  Nebuda  - add departure check and near surface check for clear air WV AMV (WVCS) from GOES type 247
!   2015-10-01  guo     - full res obvsr: index to allow redistribution of obsdiags
!   2015-12-21  yang    - Parrish's correction to the previous code in new varqc.
!   2016-05-18  guo     - replaced ob_type with polymorphic obsNode through type casting
!   2016-06-24  guo     - fixed the default value of obsdiags(:,:)%tail%luse to luse(i)
!                       . removed (%dlat,%dlon) debris.
!   2016-11-29  shlyaeva - save linearized H(x) for EnKF
!   2016-12-09  mccarty - add netcdf_diag capability
!   2016-12-13  pondeca - add Tyndall & Horel QC for mesonet winds (WAF 2013, Vol. 8, pg. 285) to GSI's 2dvar option
!   2017-03-31  Hu      -  addd option l_closeobs to use closest obs to analysis
!                                     time in analysis
!   2017-02-09  guo     - Remove m_alloc, n_alloc.
!                       . Remove my_node with corrected typecast().
!   2018-04-09  pondeca -  introduce duplogic to correctly handle the characterization of
!                          duplicate obs in twodvar_regional applications
!   2019-06-07  levine/pondeca - for twodvar_regional applications, switch from processing surface obs 
!                                with reported pressure to surface obs with reported geometric height.
!                                This is mainly to account for mesonets with sensor height < 10 m.
!   2019-07-12  levine  -  introduce logic to read in mesonet wind sensor heights from prepbufr
!                          rather than assuming sensor height is 10 m AGL.
!   2019-08-12  zhang/levine/pondeca -  add option to adjust 10-m bckg wind with the help of similarity
!                                       theory in twodvar_regional applications
!   2019-09-20  Su      -  remove current VQC part and add subroutine call on VQC
!   2019-09-25  Su      -  put hibert curve on aircraft data
!   2020-01-27  Winterbottom - moved the linear regression derived
!                              coefficients for the dynamic observation
!                              error (DOE) calculation to the namelist
!                              level; they are now loaded by
!                              aircraftinfo.
!   2020-05-04  wu   - no rotate_wind for fv3_regional
!
! REMARKS:
!   language: f90
!   machine:  ibm RS/6000 SP; SGI Origin 2000; Compaq HP
!
! !AUTHOR: parrish          org: np22                date: 1990-10-06
!
!EOP
!-------------------------------------------------------------------------

! Declare local parameters
  real(r_kind),parameter:: r0_7=0.7_r_kind
  real(r_kind),parameter:: r0_1=1.0_r_kind
  real(r_kind),parameter:: r6=6.0_r_kind
  real(r_kind),parameter:: r7=7.0_r_kind
  real(r_kind),parameter:: r15=15.0_r_kind
  real(r_kind),parameter:: r20=20.0_r_kind
  real(r_kind),parameter:: r50=50.0_r_kind
  real(r_kind),parameter:: r200=200.0_r_kind
  real(r_kind),parameter:: r360=360.0_r_kind
  real(r_kind),parameter:: r0_1_bmiss=0.1_r_kind*bmiss

  character(len=*),parameter:: myname='setupw'

! Declare external calls for code analysis
  external:: intrp2a11,tintrp2a1,tintrp2a11
  external:: tintrp31
  external:: grdcrd1
  external:: stop2

! Declare local variables

  real(r_double) rstation_id
  real(r_kind) qcu,qcv,trop5,tfact,fact
  real(r_kind) scale,ratio,obserror,obserrlm
  real(r_kind) residual,ressw,ress,vals,val2,dudiff,dvdiff,rat_err2u
  real(r_kind) valqc,valu,valv,dx10,rlow,rhgh,drpx,prsfc,var_jb,rat_err2v
  real(r_kind) cg_t,cvar,wgt,term,qcgross,valqcu,valqcv
  real(r_kind) presw,factw,dpres,ugesin,vgesin,rwgt,dpressave
  real(r_kind) sfcchk,prsln2,error,dtime,dlon,dlat,r0_001,rsig,thirty,rsigp
  real(r_kind) ratio_errors,goverrd,spdges,spdob,ten,psges,zsges
  real(r_kind) slat,sin2,termg,termr,termrg,pobl,uob,vob
  real(r_kind) uob_reg,vob_reg,uob_e,vob_e,dlon_e,uges_e,vges_e,dudiff_e,dvdiff_e
  real(r_kind) dz,zob,z1,z2,p1,p2,dz21,dlnp21,spdb,dstn
  real(r_kind) errinv_input,errinv_adjst,errinv_final
  real(r_kind) err_input,err_adjst,err_final,skint,sfcr
  real(r_kind) dudiff_opp, dvdiff_opp, vecdiff, vecdiff_opp
  real(r_kind) dudiff_opp_rs, dvdiff_opp_rs, vecdiff_rs, vecdiff_opp_rs
  real(r_kind) oscat_vec,ascat_vec,rapidscat_vec
  real(r_kind),dimension(nele,nobs):: data
  real(r_kind),dimension(nobs):: dup
  real(r_kind),dimension(nsig)::prsltmp,tges,zges
  real(r_kind) wdirob,wdirgesin,wdirdiffmax
  real(r_kind),dimension(34)::ptabluv
  real(r_single),allocatable,dimension(:,:)::rdiagbuf
  integer(i_kind) i,nchar,nreal,k,j,l,ii,itype,ijb
! Variables needed for new polar winds QC based on Log Normalized Vector Departure (LNVD)
  real(r_kind) LNVD_wspd
  real(r_kind) LNVD_omb
  real(r_kind) LNVD_ratio
  real(r_kind) LNVD_threshold

  integer(i_kind) jsig,mm1,iptrbu,iptrbv,jj,icat
  integer(i_kind) k1,k2,ikxx,nn,isli,ibin,ioff,ioff0
  integer(i_kind) ier,ilon,ilat,ipres,iuob,ivob,id,itime,ikx,ielev,iqc
  integer(i_kind) ihgt,ier2,iuse,ilate,ilone
  integer(i_kind) izz,iprvd,isprvd
  integer(i_kind) idomsfc,isfcr,iskint,iff10
  integer(i_kind) ibb,ikk,ihil,idddd

  integer(i_kind) num_bad_ikx,iprev_station

  character(8) station_id
  character(8),allocatable,dimension(:):: cdiagbuf
  character(8),allocatable,dimension(:):: cprvstg,csprvstg
  character(8) c_prvstg,c_sprvstg
  real(r_double) r_prvstg,r_sprvstg

  type(sparr2) :: dhx_dx_u, dhx_dx_v
  integer(i_kind) :: iz, u_ind, v_ind, nnz, nind
  real(r_kind) :: delz
  logical z_height,sfc_data
  logical,dimension(nobs):: luse,muse
  logical:: muse_u,muse_v
  integer(i_kind),dimension(nobs):: ioid ! initial (pre-distribution) obs ID
  logical lowlevelsat,duplogic
  logical msonetob
  logical proceed

  logical:: l_pbl_pseudo_itype
  integer(i_kind):: ich0

  logical:: in_curbin, in_anybin, save_jacobian
  type(wNode),pointer :: my_head
  type(obs_diag),pointer :: jj_diag
  type(obs_diag),pointer :: my_diagu, my_diagu_pbl
  type(obs_diag),pointer :: my_diagv, my_diagv_pbl
  type(obs_diags),pointer :: my_diagLL
  real(r_kind) :: thisPBL_height,ratio_PBL_height,prest,prestsfc,dudiffsfc,dvdiffsfc
  real(r_kind) :: hr_offset
  real(r_kind) :: magomb


  equivalence(rstation_id,station_id)
  equivalence(r_prvstg,c_prvstg)
  equivalence(r_sprvstg,c_sprvstg)

  real(r_kind),allocatable,dimension(:,:,:  ) :: ges_ps
  real(r_kind),allocatable,dimension(:,:,:  ) :: ges_z
  real(r_kind),allocatable,dimension(:,:,:,:) :: ges_u
  real(r_kind),allocatable,dimension(:,:,:,:) :: ges_v
  real(r_kind),allocatable,dimension(:,:,:,:) :: ges_tv

  type(obsLList),pointer,dimension(:):: whead
  whead => obsLL(:)

  save_jacobian = conv_diagsave .and. jiter==jiterstart .and. lobsdiag_forenkf

! Check to see if required guess fields are available
  call check_vars_(proceed)
  if(.not.proceed) return  ! not all vars available, simply return

! If require guess vars available, extract from bundle ...
  call init_vars_

!******************************************************************************
! Read and reformat observations in work arrays.
  spdb=zero

  read(lunin)data,luse,ioid


!    index information for data array (see reading routine)
  ier=1       ! index of obs error
  ilon=2      ! index of grid relative obs location (x)
  ilat=3      ! index of grid relative obs location (y)
  ipres=4     ! index of pressure
  ihgt=5      ! index of height
  iuob=6      ! index of u observation
  ivob=7      ! index of v observation
  id=8        ! index of station id
  itime=9     ! index of observation time in data array
  ikxx=10     ! index of ndex ob type in convinfo file
  ielev=11    ! index of station elevation
  iqc=12      ! index of quality mark
  ier2=13     ! index of original-original obs error ratio
  iuse=14     ! index of use parameter
  idomsfc=15  ! index of dominant surface type
  iskint=16   ! index of surface skin temperature
  iff10=17    ! index of 10 meter wind factor
  isfcr=18    ! index of surface roughness
  ilone=19    ! index of longitude (degrees)
  ilate=20    ! index of latitude (degrees)
  izz=21      ! index of surface height
  iprvd=22    ! index of observation provider
  isprvd=23   ! index of observation subprovider
  icat=24     ! index of data level category
  ijb=25      ! index of non linear qc parameter
  ihil=26     ! index of  hilbert curve weight
  iptrbu=27   ! index of u perturbation
  iptrbv=28   ! index of v perturbation

  mm1=mype+1
  scale=one
  rsig=nsig
  thirty = 30.0_r_kind
  ten = 10.0_r_kind
  r0_001=0.001_r_kind
  rsigp=rsig+one
  goverrd=grav/rd
  var_jb=zero

! If requested, save select data for output to diagnostic file
  if(conv_diagsave)then
     ii=0
     nchar=1
     ioff0=25
     nreal=ioff0
     if (lobsdiagsave) nreal=nreal+7*miter+2
     if (twodvar_regional) then; nreal=nreal+2; allocate(cprvstg(nobs),csprvstg(nobs)); endif
     if (save_jacobian) then
       nnz   = 2                   ! number of non-zero elements in dH(x)/dx profile
       nind   = 1
       call new(dhx_dx_u, nnz, nind)
       call new(dhx_dx_v, nnz, nind)
       nreal = nreal + 2*size(dhx_dx_u)
     endif

     allocate(cdiagbuf(nobs),rdiagbuf(nreal,nobs))
     if (netcdf_diag) call init_netcdf_diag_
  end if

  num_bad_ikx=0
  do i=1,nobs
     muse(i)=nint(data(iuse,i)) <= jiter
     ikx=nint(data(ikxx,i))
     if(ikx < 1 .or. ikx > nconvtype) then
        num_bad_ikx=num_bad_ikx+1
        if(num_bad_ikx<=10) write(6,*)' in setupw ',ikx,i,nconvtype,mype
     end if
  end do
!  If HD raobs available move prepbufr version to monitor
  if(nhduv > 0)then
     iprev_station=0
     do i=1,nobs
        ikx=nint(data(ikxx,i))
        itype=ictype(ikx)
        if(itype == 220 .or. itype == 221) then
           rstation_id     = data(id,i)
           read(station_id,'(i5,3x)',err=1200) idddd
           if(idddd == iprev_station)then
             data(iuse,i)=108._r_kind
             muse(i) = .false.
           else
              stn_loop:do j=1,nhduv
                if(idddd == hduvlist(j))then
                   iprev_station=idddd
                   data(iuse,i)=108._r_kind
                   muse(i) = .false.
                   exit stn_loop
                end if
              end do stn_loop
           end if
        end if
1200    continue
     end do
  end if

!  handle multiple-report observations at a station
  hr_offset=min_offset/60.0_r_kind
  dup=one
  do k=1,nobs
     do l=k+1,nobs
        if (twodvar_regional) then
           duplogic=data(ilat,k) == data(ilat,l) .and.  &
           data(ilon,k) == data(ilon,l) .and.  &
           data(ier,k) < r1000 .and. data(ier,l) < r1000 .and. &
           muse(k) .and. muse(l)
         else
           duplogic=data(ilat,k) == data(ilat,l) .and.  &
           data(ilon,k) == data(ilon,l) .and.  &
           data(ipres,k) == data(ipres,l) .and. &
           data(ier,k) < r1000 .and. data(ier,l) < r1000 .and. &
           muse(k) .and. muse(l)
        end if

        if (duplogic) then
           if(l_closeobs) then
              if(abs(data(itime,k)-hr_offset)<abs(data(itime,l)-hr_offset)) then
                  muse(l)=.false.
              else
                  muse(k)=.false.
              endif
!              write(*,'(a,2f10.5,2I8,2L10)') 'chech wind obs time==',&
!              data(itime,k)-hr_offset,data(itime,l)-hr_offset,k,l,&
!                           muse(k),muse(l)
           else
              tfact=min(one,abs(data(itime,k)-data(itime,l))/dfact1)
              dup(k)=dup(k)+one-tfact*tfact*(one-dfact)
              dup(l)=dup(l)+one-tfact*tfact*(one-dfact)
           endif
        end if
     end do
  end do

  call dtime_setup()
  num_bad_ikx=0
  loop_for_all_obs: &
  do i=1,nobs
     dtime=data(itime,i)
     call dtime_check(dtime, in_curbin, in_anybin)
     if(.not.in_anybin) cycle

     ikx=nint(data(ikxx,i))

     if(in_curbin) then
        dlat=data(ilat,i)
        dlon=data(ilon,i)
        rstation_id     = data(id,i)
        error=data(ier2,i)
        var_jb=data(ijb,i)
        if(ikx < 1 .or. ikx > nconvtype) then
           num_bad_ikx=num_bad_ikx+1
           if(num_bad_ikx<=10) write(6,*)' in setupw, bad ikx, ikx,i,nconvtype=',ikx,i,nconvtype,mype
           cycle
        end if
        isli = data(idomsfc,i)
     endif

     if(ikx < 1 .or. ikx > nconvtype) cycle
     itype=ictype(ikx)

!    Link observation to appropriate observation bin
     if (nobs_bins>1) then
        ibin = NINT( dtime/hr_obsbin ) + 1
     else
        ibin = 1
     endif

     IF (ibin<1.OR.ibin>nobs_bins) write(6,*)mype,'Error nobs_bins,ibin= ',nobs_bins,ibin

!    Link obs to diagnostics structure
     if (luse_obsdiag) my_diagLL => odiagLL(ibin)

     ! Flag static conditions to turn pbl_pseudo_surfobs on
     l_pbl_pseudo_itype = l_PBL_pseudo_SurfobsUV .and.        &
                          ( itype==281 .or. itype==283 .or.itype==287 )

     if (luse_obsdiag) then
        my_diagu => null()
        my_diagv => null()
        my_diagu_pbl => null()
        my_diagv_pbl => null()

        ich0 = wNode_ich0
        if(l_pbl_pseudo_itype) ich0 = wNode_ich0_pbl_pseudo

        do jj=1,ich0+2  ! "2" for there are u and v components
           jj_diag => obsdiagLList_nextNode(my_diagLL, &
                create = .not.lobsdiag_allocated ,&
                   idv = is             ,&
                   iob = ioid(i)        ,&
                   ich = jj             ,&
                  elat = data(ilate,i)  ,&
                  elon = data(ilone,i)  ,&
                  luse = luse(i)        ,&
                 miter = miter          )

           if(.not.associated(jj_diag)) then
             call perr(myname,'obsdiagLList_nextNode(), create =',.not.lobsdiag_allocated)
             call perr(myname,'                           ich0 =',ich0)
             call perr(myname,'                             jj =',jj)
             call  die(myname)
           endif

           select case(jj)
           case(1); my_diagu => jj_diag
           case(2); my_diagv => jj_diag
           case(3); my_diagu_pbl => jj_diag
           case(4); my_diagv_pbl => jj_diag
           end select
        enddo
     endif

     if(.not.in_curbin) cycle

!    Load observation error and values into local variables
     obserror = max(cermin(ikx),min(cermax(ikx),data(ier,i)))
     uob = data(iuob,i)
     vob = data(ivob,i)
     spdob=sqrt(uob*uob+vob*vob)
     call tintrp2a11(ges_ps,psges,dlat,dlon,dtime,hrdifsig,&
          mype,nfldsig)
     call tintrp2a1(ges_lnprsl,prsltmp,dlat,dlon,dtime,hrdifsig,&
          nsig,mype,nfldsig)

!    Type 221=pibal winds contain a mixture of wind observations reported
!    by pressure and others by height.  Those levels only reported by 
!    pressure have a missing value (ie, large) value for the reported 
!    height.  The logic below determines whether to process type 221 
!    wind observations using height or pressure as the vertical coordinate.
!    If height is not bad (less than r0_1_bmiss), we use height in the
!    forward model.  Otherwise, use reported pressure.

     z_height = .false.
     if ((itype>=221 .and. itype <= 229) .and. (data(ihgt,i)<r0_1_bmiss)) z_height = .true.
     if ((itype==261) .and. (data(ihgt,i)<r0_1_bmiss)) z_height = .true.
     if (itype == 218) z_height = .true.


!    Process observations reported with height differently than those
!    reported with pressure.  Type 223=profiler and 224=vadwnd are 
!    encoded in NCEP prepbufr files with geometric height above 
!    sea level.  Type 229=pibal profiler is reported using 
!    geopotenital height.  Some type 221=pibal wind observations are
!    also repoted using geopotential height.

     sfc_data = (itype >=280 .and. itype < 300)
     if (z_height .or. sfc_data) then

        drpx = zero
        dpres = data(ihgt,i)
        dstn = data(ielev,i)
!       BTH: If HU-3 ASCAT data (Type=290,Subtype=6), we are
!            passing likelihood to this routine through the
!            data(ielev,i) slot. Reassign to zero (default 
!            for ASCAT data)
        if (itype==290 .and. icsubtype(ikx)==6) then ! HU-3 ASCAT
            dstn=0
        end if
        call tintrp2a11(ges_z,zsges,dlat,dlon,dtime,hrdifsig,&
             mype,nfldsig)
!       Subtract off combination of surface station elevation and
!       model elevation depending on how close to surface
        fact = zero
        if(dpres-dstn > 10._r_kind)then
           if(dpres-dstn > r1000)then
              fact = one
           else
              fact=(dpres-dstn)/990._r_kind
           end if
        end if
        dpres=dpres-(dstn+fact*(zsges-dstn))
        if(itype==261) dpres = data(ihgt,i)

!       Get guess surface elevation and geopotential height profile 
!       at observation location.
        call tintrp2a1(geop_hgtl,zges,dlat,dlon,dtime,hrdifsig,&
             nsig,mype,nfldsig)

!       For observation reported with geometric height above sea level,
!       convert geopotential to geometric height.

        if (((itype>=223 .and. itype<=228) .or. itype == 218 .or. sfc_data) .and. .not.twodvar_regional) then
!          Convert geopotential height at layer midpoints to geometric 
!          height using equations (17, 20, 23) in MJ Mahoney's note 
!          "A discussion of various measures of altitude" (2001).  
!          Available on the web at
!          http://mtp.jpl.nasa.gov/notes/altitude/altitude.html
!
!          termg  = equation 17
!          termr  = equation 21
!          termrg = first term in the denominator of equation 23
!          zges  = equation 23

           slat = data(ilate,i)*deg2rad
           sin2  = sin(slat)*sin(slat)
           termg = grav_equator * &
                ((one+somigliana*sin2)/sqrt(one-eccentricity*eccentricity*sin2))
           termr = semi_major_axis /(one + flattening + grav_ratio -  &
                two*flattening*sin2)
           termrg = (termg/grav)*termr
           do k=1,nsig
              zges(k) = (termr*zges(k)) / (termrg-zges(k))  ! eq (23)
           end do
        else if (twodvar_regional) then
           zges(1) = ten
        endif

!       Given observation height, (1) adjust 10 meter wind factor if
!       necessary, (2) convert height to grid relative units, (3) compute
!       compute observation pressure (for diagnostic purposes only), and
!       (4) compute location of midpoint of first model layer above surface
!       in grid relative units

!       Adjust 10m wind factor if necessary.  Rarely do we have a
!       profiler/vad obs within 10 meters of the surface.  Almost always,
!       the code below resets the 10m wind factor to 1.0 (i.e., no
!       reduction in wind speed due to surface friction).

!       Convert observation height (in dpres) from meters to grid relative
!       units.  Save the observation height in zob for later use.
        zob = dpres
        call grdcrd1(dpres,zges,nsig,1)

!       Interpolate guess u and v to observation location and time.
 
        call tintrp31(ges_u,ugesin,dlat,dlon,dpres,dtime, &
           hrdifsig,mype,nfldsig)
        call tintrp31(ges_v,vgesin,dlat,dlon,dpres,dtime, &
           hrdifsig,mype,nfldsig)

        iz = max(1, min( int(dpres), nsig))
        delz = max(zero, min(dpres - float(iz), one))

        if (save_jacobian) then

           u_ind = getindex(svars3d, 'u')
           if (u_ind < 0) then
              print *, 'Error: no variable u in state vector. Exiting.'
              call stop2(1300)
           endif
           v_ind = getindex(svars3d, 'v')
           if (v_ind < 0) then
              print *, 'Error: no variable v in state vector. Exiting.'
              call stop2(1300)
           endif

           dhx_dx_u%st_ind(1)  = iz               + sum(levels(1:u_ind-1))
           dhx_dx_u%end_ind(1) = min(iz + 1,nsig) + sum(levels(1:u_ind-1))
           dhx_dx_v%st_ind(1)  = iz               + sum(levels(1:v_ind-1))
           dhx_dx_v%end_ind(1) = min(iz + 1,nsig) + sum(levels(1:v_ind-1))

           dhx_dx_u%val(1) = one - delz
           dhx_dx_u%val(2) = delz
           dhx_dx_v%val = dhx_dx_u%val
        endif

        msonetob=itype==288.or.itype==295

        if (zob <= zero .and. twodvar_regional) zob=ten !trap for stations with negative zob

        if (zob > zges(1)) then
           factw=one
        else
           factw = data(iff10,i)
           if(sfcmod_gfs .or. sfcmod_mm5) then
              sfcr = data(isfcr,i)
              skint = data(iskint,i)
              call comp_fact10(dlat,dlon,dtime,skint,sfcr,isli,mype,factw)
           end if

           if (zob <= ten) then
              if(zob < ten)then
                 if (msonetob .and. twodvar_regional .and. use_similarity_2dvar) then
                    if (neutral_stability_windfact_2dvar) then
                       sfcr = data(isfcr,i)
                       factw=log(max(sfcr,zob)/sfcr)/log(ten/sfcr)
                    else
                       sfcr = data(isfcr,i)
                       skint = data(iskint,i)
                       call rtma_comp_fact10(dlat,dlon,dtime,zob,skint,sfcr,isli,mype,factw)
                    endif
                 else
                    term = max(zob,zero)/ten
                    factw = term*factw
                 endif
              end if
           else
              term = (zges(1)-zob)/(zges(1)-ten)
              factw = one-term+factw*term
           end if

           ugesin=factw*ugesin
           vgesin=factw*vgesin

           if (save_jacobian) then
              dhx_dx_u%val = factw * dhx_dx_u%val
              dhx_dx_v%val = factw * dhx_dx_v%val
           endif
        endif

        if(sfc_data .or. dpres < one) then
           drpx=0.005_r_kind*abs(dstn-zsges)*(one-fact)
        end if
 
!       Compute observation pressure (only used for diagnostics)
        
        if (twodvar_regional) then
           presw = ten*exp(data(ipres,i))
        else
!          Set indices of model levels below (k1) and above (k2) observation.
           if (dpres<one) then
              z1=zero;    p1=log(psges)
              z2=zges(1); p2=prsltmp(1)
           elseif (dpres>nsig) then
              z1=zges(nsig-1); p1=prsltmp(nsig-1)
              z2=zges(nsig);   p2=prsltmp(nsig)
              drpx = 1.e6_r_kind
           else
              k=dpres
              k1=min(max(1,k),nsig)
              k2=max(1,min(k+1,nsig))
              z1=zges(k1); p1=prsltmp(k1)
              z2=zges(k2); p2=prsltmp(k2)
           endif
        
           dz21     = z2-z1
           dlnp21   = p2-p1
           dz       = zob-z1
           pobl     = p1 + (dlnp21/dz21)*dz
           presw    = ten*exp(pobl)
        endif
!          Determine location in terms of grid units for midpoint of
!          first layer above surface
        sfcchk=zero
!       call grdcrd1(sfcchk,zges,nsig,1)

!    Process observations with reported pressure
     else
        dpres = data(ipres,i)
        presw = ten*exp(dpres)
        dpres = dpres-log(psges)
        drpx=zero

        prsfc=psges
        prsln2=log(exp(prsltmp(1))/prsfc)
        dpressave=dpres

!       Put obs pressure in correct units to get grid coord. number
        dpres=log(exp(dpres)*prsfc)
        call grdcrd1(dpres,prsltmp(1),nsig,-1)
 
!       Interpolate guess u and v to observation location and time.
 
        call tintrp31(ges_u,ugesin,dlat,dlon,dpres,dtime, &
           hrdifsig,mype,nfldsig)
        call tintrp31(ges_v,vgesin,dlat,dlon,dpres,dtime, &
           hrdifsig,mype,nfldsig)

        iz = max(1, min( int(dpres), nsig))
        delz = max(zero, min(dpres - float(iz), one))

        if (save_jacobian) then
           u_ind = getindex(svars3d, 'u')
           if (u_ind < 0) then
              print *, 'Error: no variable u in state vector. Exiting.'
              call stop2(1300)
           endif
           v_ind = getindex(svars3d, 'v')
           if (v_ind < 0) then
              print *, 'Error: no variable v in state vector. Exiting.'
              call stop2(1300)
           endif

           dhx_dx_u%st_ind(1)  = iz               + sum(levels(1:u_ind-1))
           dhx_dx_u%end_ind(1) = min(iz + 1,nsig) + sum(levels(1:u_ind-1))
           dhx_dx_v%st_ind(1)  = iz               + sum(levels(1:v_ind-1))
           dhx_dx_v%end_ind(1) = min(iz + 1,nsig) + sum(levels(1:v_ind-1))

           dhx_dx_u%val(1) = one - delz
           dhx_dx_u%val(2) = delz
           dhx_dx_v%val = dhx_dx_u%val
        endif

        if(dpressave <= prsln2)then
           factw=one
        else
           factw = data(iff10,i)
           if(sfcmod_gfs .or. sfcmod_mm5) then
              sfcr = data(isfcr,i)
              skint = data(iskint,i)
              call comp_fact10(dlat,dlon,dtime,skint,sfcr,isli,mype,factw)
           end if
 
           call tintrp2a1(ges_tv,tges,dlat,dlon,dtime,hrdifsig,&
              nsig,mype,nfldsig)
!          Apply 10-meter wind reduction factor to guess winds
           dx10=-goverrd*ten/tges(1)
           if (dpressave < dx10)then
              term=(prsln2-dpressave)/(prsln2-dx10)
              factw=one-term+factw*term
           end if
           ugesin=factw*ugesin   
           vgesin=factw*vgesin

           if (save_jacobian) then
              dhx_dx_u%val = factw * dhx_dx_u%val
              dhx_dx_v%val = factw * dhx_dx_v%val 
           endif
        end if
       
!       Get approx k value of sfc by using surface pressure
        sfcchk=log(psges)
        call grdcrd1(sfcchk,prsltmp(1),nsig,-1)
 
     endif


!    Checks based on observation location relative to model surface and top
     rlow=max(sfcchk-dpres,zero)
     rhgh=max(dpres-r0_001-rsigp,zero)
     if(luse(i))then
        awork(1) = awork(1) + one
        if(rlow/=zero) awork(2) = awork(2) + one
        if(rhgh/=zero) awork(3) = awork(3) + one
     end if
     ratio_errors=error/(data(ier,i)+drpx+1.0e6_r_kind*rhgh+four*rlow)

!    Compute innovations
     lowlevelsat=itype==242.or.itype==243.or.itype==245.or.itype==246.or. &
                 itype==247.or.itype==250.or.itype==251.or.itype==252.or. &
                 itype==253.or.itype==254.or.itype==257.or.itype==258.or. &
                 itype==259
     if (lowlevelsat .and. twodvar_regional) then
         call windfactor(presw,factw)
         data(iuob,i)=factw*data(iuob,i)
         data(ivob,i)=factw*data(ivob,i)
         uob = data(iuob,i)
         vob = data(ivob,i)
     endif
     dudiff=uob-ugesin
     dvdiff=vob-vgesin
     spdb=sqrt(uob**2+vob**2)-sqrt(ugesin**2+vgesin**2)
    
!    Setup dynamic ob error specification for aircraft recon in hurricanes 
     if (aircraft_recon) then
       if (itype==236) then
         magomb=sqrt(dudiff*dudiff+dvdiff*dvdiff)
         ratio_errors=error/((uv_doe_a_236*magomb+uv_doe_b_236)+drpx+1.0e6_r_kind*rhgh+four*rlow)
       endif
       if (itype==237) then
         magomb=sqrt(dudiff*dudiff+dvdiff*dvdiff)
         ratio_errors=error/((uv_doe_a_237*magomb+uv_doe_b_237)+drpx+1.0e6_r_kind*rhgh+four*rlow)
       endif
     endif

!    Invert observation error
     error=one/error

!    Check to see if observation below model surface or above model top.
!    If so, don't use observation
     if (dpres > rsig )then
        if( regional .and. presw > pt_ll )then
           dpres=rsig
        else
           ratio_errors=zero
        endif
     endif

     if ( (itype>=221 .and. itype<=229).and. (dpres<zero) ) ratio_errors=zero


! QC PBL profiler  227 and 223, 224
     if(itype==227 .or. itype==223 .or. itype==224 .or. itype==228 .or. itype==229) then
        if(abs(uob) < 1.0_r_kind .and. abs(vob) <1.0_r_kind )  then
           muse(i)=.false.
           error=zero
        endif
     endif

!    VADWND and aircraft winds quality control
     if( itype ==224 .and. presw < 226.0_r_kind) then
        error=zero
     endif
     if(itype >=230 .and. itype <=239 .and.  presw <126.0_r_kind ) then
        error=zero
     endif

!    Quality control for satellite winds

     if ( qc_satwnds ) then
        if (itype >=240 .and. itype <=260) then
           call intrp2a11(tropprs,trop5,dlat,dlon,mype)
           if(presw < trop5-r50) error=zero            ! tropopose check for all satellite winds 
        endif  
   
        if(itype >=240 .and. itype <=260) then
           if(i_gsdqc==2) then
              prsfc = r10*psges
              if( prsfc-presw < 100.0_r_kind) error =zero ! add check for obs within 100 hPa of sfc
           else
              if( presw >950.0_r_kind) error =zero       ! screen data beloww 950mb
           endif
        endif
        if(itype ==242 .or. itype ==243 ) then  !  visible winds from JMA and EUMETSAT
           if(presw <700.0_r_kind) error=zero    !  no visible winds above 700mb
        endif
        if(itype ==245 ) then
           if( presw >399.0_r_kind .and. presw <801.0_r_kind) then  !GOES IR  winds
              error=zero                          !  no data between 400-800mb
           endif
        endif
        if(itype == 252 .and. presw >499.0_r_kind .and. presw <801.0_r_kind) then  ! JMA IR winds
           error=zero
        endif
        if(itype == 253 )  then
           if(presw >401.0_r_kind .and. presw <801.0_r_kind) then  ! EUMET IR winds
              error=zero
           endif
        endif
        if( itype == 246 .or. itype == 250 .or. itype == 254 )   then     ! water vapor cloud top
           if(presw >399.0_r_kind) error=zero
        endif
        if(itype ==257 .and. presw <249.0_r_kind) error=zero
        if(itype ==258 .and. presw >600.0_r_kind) error=zero
        if(itype ==259 .and. presw >600.0_r_kind) error=zero
        if(itype ==259 .and. presw <249.0_r_kind) error=zero
     endif ! qc_satwnds

!    QC GOES CAWV - some checks above as well
     if (itype==247) then
        prsfc = r10*psges       ! surface pressure in hPa

!       Compute observed and guess wind speeds (m/s).  
        spdges = sqrt(ugesin* ugesin +vgesin* vgesin )

!       Set and compute GOES CAWV specific departure parameters
        LNVD_wspd = spdob
        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
        LNVD_threshold = 3.0_r_kind
        if( .not. wrf_nmm_regional) then   ! LNVD check not use for CAWV winds in HWRF
           if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
              (presw > prsfc-110.0_r_kind .and. isli /= 0))then ! near surface check 110 ~1km
              error = zero
           endif
        endif
! check for direction departure gt 50 deg 
        wdirdiffmax=50._r_kind
        call getwdir(uob,vob,wdirob)
        call getwdir(ugesin,vgesin,wdirgesin)
        if ( min(abs(wdirob-wdirgesin),abs(wdirob-wdirgesin+r360), &
                 abs(wdirob-wdirgesin-r360)) > wdirdiffmax ) then
           error = zero
        endif
     endif
   
!    QC MODIS winds
     if (itype==257 .or. itype==258 .or. itype==259 .or. itype ==260) then
!       Get guess values of tropopause pressure and sea/land/ice
!       mask at observation location
        prsfc = r10*prsfc       ! surface pressure in hPa

!       Compute observed and guess wind speeds (m/s).  
        spdges = sqrt(ugesin* ugesin +vgesin* vgesin )
 
!       Set and computes modis specific qc parameters
        LNVD_wspd = spdob
        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
        LNVD_threshold = 3.0_r_kind
        if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
            (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
           error = zero
        endif
     endif ! ???

!    QC AVHRR winds
     if (itype==244) then
!       Get guess values of tropopause pressure and sea/land/ice
!       mask at observation location
        prsfc = r10*prsfc       ! surface pressure in hPa

!       Set and computes modis specific qc parameters
        LNVD_wspd = spdob
        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
        LNVD_threshold = 3.0_r_kind

        if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
            (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
           error = zero
        endif
     endif                                                  ! end if all satellite winds
     

!    QC WindSAT winds
     if (itype==289) then
        qcu = r6
        qcv = r6
        if ( spdob > r20 .or. &          ! high wind speed check
             abs(dudiff) > qcu  .or. &   ! u component check
             abs(dvdiff) > qcv ) then    ! v component check
           error = zero
        endif
     endif

!    QC ASCAT winds
     if (itype==290) then
        qcu = five
        qcv = five
!       Compute innovations for opposite vectors
        dudiff_opp = -uob - ugesin
        dvdiff_opp = -vob - vgesin
        vecdiff = sqrt(dudiff**2 + dvdiff**2)
        vecdiff_opp = sqrt(dudiff_opp**2 + dvdiff_opp**2)
        ascat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)       

        if ( abs(dudiff) > qcu  .or. &       ! u component check
             abs(dvdiff) > qcv  .or. &       ! v component check
             vecdiff > vecdiff_opp ) then    ! ambiguity check
 
           error = zero
        endif
     endif

!    QC RAPIDSCAT winds
     if (itype==296) then
        qcu = five
        qcv = five
!       Compute innovations for opposite vectors
        dudiff_opp_rs = -uob - ugesin
        dvdiff_opp_rs = -vob - vgesin
        vecdiff_rs = sqrt(dudiff**2 + dvdiff**2)
        vecdiff_opp_rs = sqrt(dudiff_opp_rs**2 + dvdiff_opp_rs**2)
        rapidscat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)
        if ( abs(dudiff) > qcu  .or. &       ! u component check
             abs(dvdiff) > qcv  .or. &       ! v component check
             vecdiff_rs > vecdiff_opp_rs ) then    ! ambiguity check
           error = zero
        endif
     endif

!    QC OSCAT winds     
     if (itype==291) then
        qcu = r6
        qcv = r6
        oscat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)

!        if ( spdob > r20 .or. &          ! high wind speed check
!             abs(dudiff) > qcu  .or. &   ! u component check
!             oscat_vec > r0_1 .or. &
!             abs(dvdiff) > qcv ) then    ! v component check
!           error = zero
!        else
!           write(6,2000) "999291291", data(ilate,i), &
!                      data(ilone,i), uob, vob, ugesin, vgesin, &
!                      jiter 
!        endif

        if (spdob > r20 .or. &
            abs(dudiff) > qcu .or. &
            oscat_vec > r0_1 .or. &
            abs(dvdiff) > qcv) then                                               
           error = zero
        endif
     endif


2000 format(a9,1x,2(f8.2,1x),4(f8.2,1x),3x,i3)
2001 format(a6,1x,2(f8.2,1x),4(f8.2,1x),3x,i3,3x,f8.2)

!    If requested, setup for single obs test.
     if (oneobtest) then
        if (oneob_type=='u') then
           dudiff=maginnov
           dvdiff=zero
        elseif (oneob_type=='v') then
           dudiff=zero
           dvdiff=maginnov
        endif
        error=one/magoberr
        ratio_errors=one
     end if
 
!    Gross error checks
     obserror = one/max(ratio_errors*error,tiny_r_kind)
     obserrlm = max(cermin(ikx),min(cermax(ikx),obserror))
     residual = sqrt(dudiff**2+dvdiff**2)
     ratio    = residual/obserrlm
!!   modify cgross depending on the quality mark, qcmark=3, cgross=0.7*cgross
!!   apply asymetric gross check for satellite winds
     qcgross=cgross(ikx)
     if(data(iqc,i) == three  ) then
        qcgross=r0_7*cgross(ikx)
     endif

     if(spdb <0 )then
        if(itype ==244) then   ! AVHRR, use same as MODIS
          qcgross=r0_7*cgross(ikx)
        endif
        if( itype == 245 .or. itype ==246) then
           if(presw <400.0_r_kind .and. presw >300.0_r_kind ) qcgross=r0_7*cgross(ikx)
        endif
        if(itype == 253 .or. itype ==254) then
           if( presw <400.0_r_kind .and. presw >200.0_r_kind) qcgross=r0_7*cgross(ikx)
        endif
        if(itype >=257 .and. itype <=259 ) then
          qcgross=r0_7*cgross(ikx)
        endif
     endif

     if (ratio>qcgross .or. ratio_errors < tiny_r_kind) then
        if (luse(i)) awork(4) = awork(4)+one
        error = zero
        ratio_errors = zero
     else
        ratio_errors = ratio_errors/sqrt(dup(i))
     end if

     if (lowlevelsat .and. twodvar_regional) then
        if (data(idomsfc,i) /= 0 .and. data(idomsfc,i) /= 3 ) then
           error = zero
           ratio_errors = zero
        endif
     endif

     if (twodvar_regional) then
        if (lowlevelsat .or. itype==289 .or. itype==290) then
            wdirdiffmax=45._r_kind
          else
           wdirdiffmax=100000._r_kind
        endif
        if (spdob > zero .and. (spdob-spdb) > zero) then
           call getwdir(uob,vob,wdirob)
           call getwdir(ugesin,vgesin,wdirgesin)
           if ( min(abs(wdirob-wdirgesin),abs(wdirob-wdirgesin+r360), &
                          abs(wdirob-wdirgesin-r360)) > wdirdiffmax ) then
               error = zero
               ratio_errors = zero
           endif
        endif
        if (itype==288 .or. itype==295) then !Tyndall & Horel QC for mesonet winds /(WAF 2013, Vol. 28, pg. 285)
           if (spdob < one .and. (spdob-spdb) > five) then
               error = zero
               ratio_errors = zero
           endif
        endif
     endif

     if (ratio_errors*error <=tiny_r_kind) muse(i)=.false.
     if ( (itype==261) .and. (ratio_errors*error <= 1.0E-100_r_kind) ) muse(i)=.false.

        ! As a 2-component observation, muse(i) is not the same as muse_u or muse_v in an obs_diag.
     if (nobskeep>0 .and. luse_obsdiag) then
       call obsdiagNode_get(my_diagu, jiter=nobskeep, muse=muse_u)
       call obsdiagNode_get(my_diagv, jiter=nobskeep, muse=muse_v)
       muse(i) = muse_u.and.muse_v
     endif

!    Oberror Tuning and Perturb Obs
     if(muse(i)) then
        if(oberror_tune )then
           if( jiter > jiterstart ) then
              dudiff=dudiff+data(iptrbu,i)/error/ratio_errors
              dvdiff=dvdiff+data(iptrbv,i)/error/ratio_errors
           endif
        else if(perturb_obs )then
           dudiff=dudiff+data(iptrbu,i)/error/ratio_errors
           dvdiff=dvdiff+data(iptrbv,i)/error/ratio_errors
        endif
     endif
 
     valu     = error*dudiff
     valv     = error*dvdiff
     if(nvqc .and. ibeta(ikx) >0  ) ratio_errors=0.8_r_kind*ratio_errors
     ratio_errors=ratio_errors*sqrt(data(ihil,i))       ! hilbert weight
!    Compute penalty terms (linear & nonlinear qc).
     if(luse(i))then
        if(vqc) then
           cg_t=cvar_b(ikx)
           cvar=cvar_pg(ikx)
        else
           cg_t=zero
           cvar=zero
        endif
        if(nvqc) then
           ibb=ibeta(ikx)
           ikk=ikapa(ikx)
        else
           ibb=0
           ikk=0
        endif
        vals=valu
        call vqc_setup(vals,ratio_errors,error,cvar,&
                      cg_t,ibb,ikk,var_jb,rat_err2u,wgt,valqcu)
        rwgt = 0.5_r_kind*wgt/wgtlim
        vals=valv
        call vqc_setup(vals,ratio_errors,error,cvar,&
                      cg_t,ibb,ikk,var_jb,rat_err2v,wgt,valqcv)
        rwgt = rwgt+0.5_r_kind*wgt/wgtlim
        valqc=valqcu+valqcv

!       Accumulate statistics for obs belonging to this task
        if (muse(i)) then
           if(rwgt < one) awork(21) = awork(21)+one
           jsig = dpres
           jsig=max(1,min(jsig,nsig))
           awork(4*nsig+jsig+100)=awork(4*nsig+jsig+100)+valu*valu*rat_err2u
           awork(5*nsig+jsig+100)=awork(5*nsig+jsig+100)+valv*valv*rat_err2v
           awork(6*nsig+jsig+100)=awork(6*nsig+jsig+100)+one
           awork(3*nsig+jsig+100)=awork(3*nsig+jsig+100)+valqc
        end if

!       Loop over pressure level groupings and obs to accumulate statistics
!       as a function of observation type.
        ress  = scale*sqrt(dudiff**2+dvdiff**2)
        ressw = ress*ress
        val2    = half*(valu*valu*rat_err2u+valv*valv*rat_err2v)
        nn=1
        if (.not. muse(i)) then
           nn=2
           if(ratio_errors*error >=tiny_r_kind)nn=3
        end if
        do k = 1,npres_print
           if(presw >ptop(k) .and. presw<=pbot(k))then
              bwork(k,ikx,1,nn) = bwork(k,ikx,1,nn)+one            ! count
              bwork(k,ikx,2,nn) = bwork(k,ikx,2,nn)+spdb           ! speed bias
              bwork(k,ikx,3,nn) = bwork(k,ikx,3,nn)+ressw          ! (o-g)**2
              bwork(k,ikx,4,nn) = bwork(k,ikx,4,nn)+val2           ! penalty
              bwork(k,ikx,5,nn) = bwork(k,ikx,5,nn)+valqc          ! nonlin qc penalty
 
           end if
        end do
     end if


!    Fill obs to diagnostics structure
     if (luse_obsdiag) then
     ! U
        call obsdiagNode_set(my_diagu, wgtjo=(error*ratio_errors)**2 ,&
                jiter=jiter, muse=muse(i), nldepart=dudiff   )
     ! V
        call obsdiagNode_set(my_diagv, wgtjo=(error*ratio_errors)**2 ,&
                jiter=jiter, muse=muse(i), nldepart=dvdiff   )
     endif

!    If obs is "acceptable", load array with obs info for use
!    in inner loop minimization (int* and stp* routines)
 
     if (.not. last .and. muse(i)) then

        allocate(my_head)
        call wNode_appendto(my_head,whead(ibin))

        my_head%idv = is
        my_head%iob = ioid(i)
        my_head%ich0= wNode_ich0        ! Flagged as a normal obs.
        my_head%elat= data(ilate,i)
        my_head%elon= data(ilone,i)

        my_head%dlev = dpres
        my_head%factw= factw
        call get_ijk(mm1,dlat,dlon,dpres,my_head%ij,my_head%wij)

        do j=1,8
           my_head%wij(j)=factw*my_head%wij(j)
        end do

        my_head%ures=dudiff
        my_head%vres=dvdiff
        my_head%err2=error**2
        my_head%raterr2=ratio_errors **2  
        my_head%time = dtime
        my_head%b=cvar_b(ikx)
        my_head%pg=cvar_pg(ikx)
        my_head%jb=var_jb
        my_head%ib=ibeta(ikx)
        my_head%ik=ikapa(ikx)
        my_head%luse=luse(i)
!        if( i==3) print *,'SETUPW',my_head%ures,my_head%vres,my_head%err2

        if (luse_obsdiag) then
        endif ! (luse_obsdiag)

        if(oberror_tune) then
           my_head%upertb=data(iptrbu,i)/error/ratio_errors
           my_head%vpertb=data(iptrbv,i)/error/ratio_errors
           my_head%kx=ikx
           if (njqc) then
              ptabluv=ptabl_uv
           else
              ptabluv=ptabl
           endif
           if(presw > ptabluv(2))then
              my_head%k1=1
           else if( presw <= ptabluv(33)) then
              my_head%k1=33
           else
              k_loop: do k=2,32
                 if(presw > ptabluv(k+1) .and. presw <= ptabluv(k)) then
                    my_head%k1=k
                    exit k_loop
                 endif
              enddo k_loop
           endif
        endif

        if (luse_obsdiag) then
           call obsdiagNode_assert(my_diagu, my_head%idv,my_head%iob,my_head%ich0+1_i_kind,myname,"my_diagu:my_head")
           call obsdiagNode_assert(my_diagv, my_head%idv,my_head%iob,my_head%ich0+2_i_kind,myname,"my_diagv:my_head")

           my_head%diagu => my_diagu
           my_head%diagv => my_diagv
        endif ! (luse_obsdiag)
 
        my_head => null()
     end if

!    Save select output for diagnostic file
     if (conv_diagsave .and. luse(i)) then
        ii=ii+1
        rstation_id     = data(id,i)
        err_input = data(ier2,i)
        err_adjst = data(ier,i)
        if (ratio_errors*error>tiny_r_kind) then
           err_final = one/(ratio_errors*error)
        else
           err_final = huge_single
        endif
 
        errinv_input = huge_single
        errinv_adjst = huge_single
        errinv_final = huge_single
        if (err_input>tiny_r_kind) errinv_input = one/err_input
        if (err_adjst>tiny_r_kind) errinv_adjst = one/err_adjst
        if (err_final>tiny_r_kind) errinv_final = one/err_final
 
        if (binary_diag) call contents_binary_diag_(my_diagu,my_diagv)
        if (netcdf_diag) call contents_netcdf_diag_(my_diagu,my_diagv)

     endif

!!!!!!!!!!!!!!  PBL pseudo surface obs  !!!!!!!!!!!!!!!!
     if( .not. last .and. l_pbl_pseudo_itype .and.        &
           muse(i) .and. dpres > -1.0_r_kind ) then
        prest=presw     ! in mb
        prestsfc=prest
        dudiffsfc=dudiff
        dvdiffsfc=dvdiff
        call tintrp2a11(pbl_height,thisPBL_height,dlat,dlon,dtime,hrdifsig,&
             mype,nfldsig)
        ratio_PBL_height = (prest - thisPBL_height) * pblH_ration
        if(ratio_PBL_height > zero) thisPBL_height = prest - ratio_PBL_height
        prest = prest - pps_press_incr
        DO while (prest > thisPBL_height)
           ratio_PBL_height=1.0_r_kind-(prestsfc-prest)/(prestsfc-thisPBL_height)

           allocate(my_head)
           call wNode_appendto(my_head,whead(ibin))

           my_head%idv = is             ! information needed for re-distribution
           my_head%iob = ioid(i)
           my_head%ich0= wNode_ich0_PBL_pseudo  ! Flagged as a PBL pseudo obs for %diag
           my_head%elat= data(ilate,i)
           my_head%elon= data(ilone,i)

!!! find uob and vob 
           uob = data(iuob,i)
           vob = data(ivob,i)


!    Put obs pressure in correct units to get grid coord. number
           dpres=log(prest/r10)
           call grdcrd1(dpres,prsltmp(1),nsig,-1)

!    Interpolate guess u and v to observation location and time.

           call tintrp31(ges_u,ugesin,dlat,dlon,dpres,dtime, &
              hrdifsig,mype,nfldsig)
           call tintrp31(ges_v,vgesin,dlat,dlon,dpres,dtime, &
              hrdifsig,mype,nfldsig)

!!! Set (i,j,k) indices of guess gridpoint that bound obs location
           my_head%dlev = dpres
           my_head%factw= 1._r_kind
           call get_ijk(mm1,dlat,dlon,dpres,my_head%ij,my_head%wij)
!!! find ddiff

           dudiff = dudiffsfc*(0.5_r_kind + 0.5_r_kind*ratio_PBL_height)
           dvdiff = dvdiffsfc*(0.5_r_kind + 0.5_r_kind*ratio_PBL_height)

           error=one/data(ier2,i)

           my_head%ures=dudiff
           my_head%vres=dvdiff
           my_head%err2=error**2
           my_head%raterr2=ratio_errors **2
           my_head%time = dtime
           my_head%b=cvar_b(ikx)
           my_head%pg=cvar_pg(ikx)
           my_head%jb=var_jb
           my_head%ib=ibeta(ikx)
           my_head%ik=ikapa(ikx)
           my_head%luse=luse(i)

           if (luse_obsdiag) then
              call obsdiagNode_assert(my_diagu_pbl, my_head%idv,my_head%iob,my_head%ich0+1_i_kind,myname,"my_diagu_pbl:my_head")
              call obsdiagNode_assert(my_diagv_pbl, my_head%idv,my_head%iob,my_head%ich0+2_i_kind,myname,"my_diagv_pbl:my_head")

              !U_pbl_pseudo
              call obsdiagNode_set(my_diagu_pbl, wgtjo=(error*ratio_errors)**2 ,&
                      jiter=jiter, muse=muse(i), nldepart=dudiff )
              !V_pbl_pseudo
              call obsdiagNode_set(my_diagv_pbl, wgtjo=(error*ratio_errors)**2 ,&
                      jiter=jiter, muse=muse(i), nldepart=dvdiff )

              my_head%diagu => my_diagu_pbl
              my_head%diagv => my_diagv_pbl
           endif

           prest = prest - pps_press_incr

           my_head => null()
        ENDDO

     endif  ! 281,283,287
!!!!!!!!!!!!!!!!!!  PBL pseudo surface obs  !!!!!!!!!!!!!!!!!!!!!!!

  end do loop_for_all_obs
! End of loop over observations
  if(num_bad_ikx > 0) write(6,*)' in setupw, num_bad_ikx ( ikx<1 or ikx>nconvtype ) = ',num_bad_ikx

! Release memory of local guess arrays
  call final_vars_

! Write information to diagnostic file
  if(conv_diagsave)then
    if(netcdf_diag) call nc_diag_write
    if(binary_diag .and. ii>0)then
       write(7)' uv',nchar,nreal,ii,mype,ioff0
       write(7)cdiagbuf(1:ii),rdiagbuf(:,1:ii)
       deallocate(cdiagbuf,rdiagbuf)
  
       if (twodvar_regional) then
          write(7)cprvstg(1:ii),csprvstg(1:ii)
          deallocate(cprvstg,csprvstg)
       endif
    end if
  end if


! End of routine

  return
  contains

  subroutine check_vars_ (proceed)
  logical,intent(inout) :: proceed
  integer(i_kind) ivar, istatus
! Check to see if required guess fields are available
  call gsi_metguess_get ('var::ps', ivar, istatus )
  proceed=ivar>0
  call gsi_metguess_get ('var::z' , ivar, istatus )
  proceed=proceed.and.ivar>0
  call gsi_metguess_get ('var::u' , ivar, istatus )
  proceed=proceed.and.ivar>0
  call gsi_metguess_get ('var::v' , ivar, istatus )
  proceed=proceed.and.ivar>0
  call gsi_metguess_get ('var::tv', ivar, istatus )
  proceed=proceed.and.ivar>0
  end subroutine check_vars_ 

  subroutine init_vars_

  real(r_kind),dimension(:,:  ),pointer:: rank2=>NULL()
  real(r_kind),dimension(:,:,:),pointer:: rank3=>NULL()
  character(len=5) :: varname
  integer(i_kind) ifld, istatus

! If require guess vars available, extract from bundle ...
  if(size(gsi_metguess_bundle)==nfldsig) then
!    get ps ...
     varname='ps'
     call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus)
     if (istatus==0) then
         if(allocated(ges_ps))then
            write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc '
            call stop2(999)
         endif
         allocate(ges_ps(size(rank2,1),size(rank2,2),nfldsig))
         ges_ps(:,:,1)=rank2
         do ifld=2,nfldsig
            call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus)
            ges_ps(:,:,ifld)=rank2
         enddo
     else
         write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus
         call stop2(999)
     endif
!    get z ...
     varname='z'
     call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank2,istatus)
     if (istatus==0) then
         if(allocated(ges_z))then
            write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc '
            call stop2(999)
         endif
         allocate(ges_z(size(rank2,1),size(rank2,2),nfldsig))
         ges_z(:,:,1)=rank2
         do ifld=2,nfldsig
            call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank2,istatus)
            ges_z(:,:,ifld)=rank2
         enddo
     else
         write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus
         call stop2(999)
     endif
!    get u ...
     varname='u'
     call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus)
     if (istatus==0) then
         if(allocated(ges_u))then
            write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc '
            call stop2(999)
         endif
         allocate(ges_u(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig))
         ges_u(:,:,:,1)=rank3
         do ifld=2,nfldsig
            call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus)
            ges_u(:,:,:,ifld)=rank3
         enddo
     else
         write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus
         call stop2(999)
     endif
!    get v ...
     varname='v'
     call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus)
     if (istatus==0) then
         if(allocated(ges_v))then
            write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc '
            call stop2(999)
         endif
         allocate(ges_v(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig))
         ges_v(:,:,:,1)=rank3
         do ifld=2,nfldsig
            call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus)
            ges_v(:,:,:,ifld)=rank3
         enddo
     else
         write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus
         call stop2(999)
     endif
!    get tv ...
     varname='tv'
     call gsi_bundlegetpointer(gsi_metguess_bundle(1),trim(varname),rank3,istatus)
     if (istatus==0) then
         if(allocated(ges_tv))then
            write(6,*) trim(myname), ': ', trim(varname), ' already incorrectly alloc '
            call stop2(999)
         endif
         allocate(ges_tv(size(rank3,1),size(rank3,2),size(rank3,3),nfldsig))
         ges_tv(:,:,:,1)=rank3
         do ifld=2,nfldsig
            call gsi_bundlegetpointer(gsi_metguess_bundle(ifld),trim(varname),rank3,istatus)
            ges_tv(:,:,:,ifld)=rank3
         enddo
     else
         write(6,*) trim(myname),': ', trim(varname), ' not found in met bundle, ier= ',istatus
         call stop2(999)
     endif
  else
     write(6,*) trim(myname), ': inconsistent vector sizes (nfldsig,size(metguess_bundle) ',&
                 nfldsig,size(gsi_metguess_bundle)
     call stop2(999)
  endif
  end subroutine init_vars_

  subroutine init_netcdf_diag_
  character(len=80) string
  character(len=128) diag_conv_file
  integer(i_kind) ncd_fileid,ncd_nobs
  logical append_diag
  logical,parameter::verbose=.false.

     write(string,900) jiter
900  format('conv_uv_',i2.2,'.nc4')
     diag_conv_file=trim(dirname) // trim(string)

     inquire(file=diag_conv_file, exist=append_diag)

     if (append_diag) then
        call nc_diag_read_init(diag_conv_file,ncd_fileid)
        ncd_nobs = nc_diag_read_get_dim(ncd_fileid,'nobs')
        call nc_diag_read_close(diag_conv_file)

        if (ncd_nobs > 0) then
           if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists.  Appending.  nobs,mype=',ncd_nobs,mype
        else
           if(verbose) print *,'file ' // trim(diag_conv_file) // ' exists but contains no obs.  Not appending. nobs,mype=',ncd_nobs,mype
           append_diag = .false. ! if there are no obs in existing file, then do not try to append
        endif
     end if

     call nc_diag_init(diag_conv_file, append=append_diag)

     if (.not. append_diag) then ! don't write headers on append - the module will break?
        call nc_diag_header("date_time",ianldate )
        if (save_jacobian) then
          call nc_diag_header("jac_nnz", nnz)
          call nc_diag_header("jac_nind", nind)
        endif
     endif
  end subroutine init_netcdf_diag_
  subroutine contents_binary_diag_(udiag,vdiag)
     type(obs_diag),pointer,intent(in):: udiag,vdiag
        cdiagbuf(ii)    = station_id         ! station id
 
        rdiagbuf(1,ii)  = ictype(ikx)        ! observation type
        rdiagbuf(2,ii)  = icsubtype(ikx)     ! observation subtype

        rdiagbuf(3,ii)  = data(ilate,i)      ! observation latitude (degrees)
        rdiagbuf(4,ii)  = data(ilone,i)      ! observation longitude (degrees)
        rdiagbuf(5,ii)  = data(ielev,i)      ! station elevation (meters) 
        rdiagbuf(6,ii)  = presw              ! observation pressure (hPa)
        rdiagbuf(7,ii)  = data(ihgt,i)       ! observation height (meters)
        rdiagbuf(8,ii)  = dtime-time_offset  ! obs time (hours relative to analysis time)

        rdiagbuf(9,ii)  = data(iqc,i)        ! input prepbufr qc or event mark
        rdiagbuf(10,ii) = data(ihil,i)       ! hilbert curve weight 
        rdiagbuf(11,ii) = data(iuse,i)       ! read_prepbufr data usage flag
        if(muse(i)) then
           rdiagbuf(12,ii) = one             ! analysis usage flag (1=use, -1=not used)
        else
           rdiagbuf(12,ii) = -one
        endif

        rdiagbuf(13,ii) = rwgt               ! nonlinear qc relative weight
        rdiagbuf(14,ii) = errinv_input       ! prepbufr inverse obs error (m/s)**-1
        rdiagbuf(15,ii) = errinv_adjst       ! read_prepbufr inverse obs error (m/s)**-1
        rdiagbuf(16,ii) = errinv_final       ! final inverse observation error (m/s)**-1

        rdiagbuf(17,ii) = data(iuob,i)       ! u wind component observation (m/s)
        rdiagbuf(18,ii) = dudiff             ! u obs-ges used in analysis (m/s)
        rdiagbuf(19,ii) = uob-ugesin         ! u obs-ges w/o bias correction (m/s) (future slot)

        rdiagbuf(20,ii) = data(ivob,i)       ! v wind component observation (m/s)
        rdiagbuf(21,ii) = dvdiff             ! v obs-ges used in analysis (m/s)
        rdiagbuf(22,ii) = vob-vgesin         ! v obs-ges w/o bias correction (m/s) (future slot)

        if(regional .and. .not. fv3_regional) then

!           replace positions 17-22 with earth relative wind component information

           uob_reg=data(iuob,i)
           vob_reg=data(ivob,i)
           dlon_e=data(ilone,i)*deg2rad
           call rotate_wind_xy2ll(uob_reg,vob_reg,uob_e,vob_e,dlon_e,dlon,dlat)
           call rotate_wind_xy2ll(ugesin,vgesin,uges_e,vges_e,dlon_e,dlon,dlat)
           call rotate_wind_xy2ll(dudiff,dvdiff,dudiff_e,dvdiff_e,dlon_e,dlon,dlat)
           rdiagbuf(17,ii) = uob_e         ! earth relative u wind component observation (m/s)
           rdiagbuf(18,ii) = dudiff_e      ! earth relative u obs-ges used in analysis (m/s)
           rdiagbuf(19,ii) = uob_e-uges_e  ! earth relative u obs-ges w/o bias correction (m/s) (future slot)

           rdiagbuf(20,ii) = vob_e         ! earth relative v wind component observation (m/s)
           rdiagbuf(21,ii) = dvdiff_e      ! earth relative v obs-ges used in analysis (m/s)
           rdiagbuf(22,ii) = vob_e-vges_e  ! earth relative v obs-ges w/o bias correction (m/s) (future slot)
        end if

        rdiagbuf(23,ii) = factw            ! 10m wind reduction factor
        rdiagbuf(24,ii) = 1.e+10_r_single  ! u spread (filled in by EnKF)
        rdiagbuf(25,ii) = 1.e+10_r_single  ! v spread (filled in by EnKF)

        ioff=ioff0
        if (lobsdiagsave) then
              !?? In this implmentation, only udiag%muse is used.  Is this by design
              !?? or an unexpected bug?
           do jj=1,miter
              ioff=ioff+1
              if (udiag%muse(jj)) then
                 rdiagbuf(ioff,ii) = one
              else
                 rdiagbuf(ioff,ii) = -one
              endif
           enddo
              !?? Both u-diag and v-diag are implemented for binary diag output,
              !?? but not so for netcdf diag output!  See below in subroutine
              !?? contents_netcdf_diag_()
           do jj=1,miter+1
              ioff=ioff+1
              rdiagbuf(ioff,ii) = udiag%nldepart(jj)
              ioff=ioff+1
              rdiagbuf(ioff,ii) = vdiag%nldepart(jj)
           enddo
           do jj=1,miter
              ioff=ioff+1
              rdiagbuf(ioff,ii) = udiag%tldepart(jj)
              ioff=ioff+1
              rdiagbuf(ioff,ii) = vdiag%tldepart(jj)
           enddo
           do jj=1,miter
              ioff=ioff+1
              rdiagbuf(ioff,ii) = udiag%obssen(jj)
              ioff=ioff+1
              rdiagbuf(ioff,ii) = vdiag%obssen(jj)
           enddo
        endif

        if (twodvar_regional) then
           ioff = ioff + 1
           rdiagbuf(ioff,ii) = data(idomsfc,i) ! dominate surface type
           ioff = ioff + 1
           rdiagbuf(ioff,ii) = data(izz,i)     ! model terrain at ob location
           r_prvstg            = data(iprvd,i)
           cprvstg(ii)         = c_prvstg        ! provider name
           r_sprvstg           = data(isprvd,i)
           csprvstg(ii)        = c_sprvstg       ! subprovider name
        endif

        if (save_jacobian) then
           call writearray(dhx_dx_u, rdiagbuf(ioff+1:nreal,ii))
           ioff = ioff + size(dhx_dx_u)
           call writearray(dhx_dx_v, rdiagbuf(ioff+1:nreal,ii))
           ioff = ioff + size(dhx_dx_v)
        endif

  end subroutine contents_binary_diag_
  subroutine contents_netcdf_diag_(udiag,vdiag)
  type(obs_diag),pointer,intent(in):: udiag,vdiag
! Observation class
  character(7),parameter     :: obsclass = '     uv'
  real(r_kind),dimension(miter) :: obsdiag_iuse

           call nc_diag_metadata("Station_ID",              station_id             )
           call nc_diag_metadata("Observation_Class",       obsclass               )
           call nc_diag_metadata("Observation_Type",        ictype(ikx)            )
           call nc_diag_metadata("Observation_Subtype",     icsubtype(ikx)         )
           call nc_diag_metadata("Latitude",                sngl(data(ilate,i))    )
           call nc_diag_metadata("Longitude",               sngl(data(ilone,i))    )
           call nc_diag_metadata("Station_Elevation",       sngl(data(ielev,i))    )
           call nc_diag_metadata("Pressure",                sngl(presw)            )
           call nc_diag_metadata("Height",                  sngl(data(ihgt,i))     )
           call nc_diag_metadata("Time",                    sngl(dtime-time_offset))
           call nc_diag_metadata("Prep_QC_Mark",            sngl(data(iqc,i))      )
!           call nc_diag_metadata("Setup_QC_Mark",           rmiss_single           )
           call nc_diag_metadata("Setup_QC_Mark",           sngl(bmiss)            )
           call nc_diag_metadata("Nonlinear_QC_Var_Jb",     sngl(var_jb)           )
           call nc_diag_metadata("Prep_Use_Flag",           sngl(data(iuse,i))     )
           if(muse(i)) then
              call nc_diag_metadata("Analysis_Use_Flag",    sngl(one)              )
           else
              call nc_diag_metadata("Analysis_Use_Flag",    sngl(-one)             )
           endif

           call nc_diag_metadata("Nonlinear_QC_Rel_Wgt",    sngl(rwgt)             )
           call nc_diag_metadata("Errinv_Input",            sngl(errinv_input)     )
           call nc_diag_metadata("Errinv_Adjust",           sngl(errinv_adjst)     )
           call nc_diag_metadata("Errinv_Final",            sngl(errinv_final)     )

           call nc_diag_metadata("Wind_Reduction_Factor_at_10m", sngl(factw)       )

           if (.not. regional .or. fv3_regional) then
              call nc_diag_metadata("u_Observation",                              sngl(data(iuob,i))    )
              call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted",              sngl(dudiff)          )
              call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted",            sngl(uob-ugesin)      )

              call nc_diag_metadata("v_Observation",                              sngl(data(ivob,i))    )
              call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted",              sngl(dvdiff)          )
              call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted",            sngl(vob-vgesin)      )
           else ! (if regional)
!              replace positions 17-22 with earth relative wind component information
   
              uob_reg=data(iuob,i)
              vob_reg=data(ivob,i)
              dlon_e=data(ilone,i)*deg2rad
              call rotate_wind_xy2ll(uob_reg,vob_reg,uob_e,vob_e,dlon_e,dlon,dlat)
              call rotate_wind_xy2ll(ugesin,vgesin,uges_e,vges_e,dlon_e,dlon,dlat)
              call rotate_wind_xy2ll(dudiff,dvdiff,dudiff_e,dvdiff_e,dlon_e,dlon,dlat)

              call nc_diag_metadata("u_Observation",                              sngl(uob_e)           )
              call nc_diag_metadata("u_Obs_Minus_Forecast_adjusted",              sngl(dudiff_e)        )
              call nc_diag_metadata("u_Obs_Minus_Forecast_unadjusted",            sngl(uob_e-uges_e)    )

              call nc_diag_metadata("v_Observation",                              sngl(vob_e)           )
              call nc_diag_metadata("v_Obs_Minus_Forecast_adjusted",              sngl(dvdiff_e)        )
              call nc_diag_metadata("v_Obs_Minus_Forecast_unadjusted",            sngl(vob_e-vges_e)    )
           endif

           if (lobsdiagsave) then
              !?? In current implmentation, only udiag is used.  Is this by design
              !?? or an unexpected bug?
              do jj=1,miter
                 if (udiag%muse(jj)) then
                    obsdiag_iuse(jj) =  one
                 else
                    obsdiag_iuse(jj) = -one
                 endif
              enddo

              call nc_diag_data2d("ObsDiagSave_iuse",     obsdiag_iuse                             )
              call nc_diag_data2d("ObsDiagSave_nldepart", udiag%nldepart )
              !++ call nc_diag_data2d("ObsDiagSave_nldepart", vdiag%nldepart )
              call nc_diag_data2d("ObsDiagSave_tldepart", udiag%tldepart )
              !++ call nc_diag_data2d("ObsDiagSave_tldepart", vdiag%tldepart )
              call nc_diag_data2d("ObsDiagSave_obssen",   udiag%obssen   )
              !++ call nc_diag_data2d("ObsDiagSave_obssen",   vdiag%obssen   )
           endif

           if (twodvar_regional) then
              call nc_diag_metadata("Dominant_Sfc_Type", data(idomsfc,i)              )
              call nc_diag_metadata("Model_Terrain",     data(izz,i)                  )
              r_prvstg            = data(iprvd,i)
              call nc_diag_metadata("Provider_Name",     c_prvstg                     )
              r_sprvstg           = data(isprvd,i)
              call nc_diag_metadata("Subprovider_Name",  c_sprvstg                    )
           endif
           if (save_jacobian) then
              call nc_diag_data2d("u_Observation_Operator_Jacobian_stind", dhx_dx_u%st_ind)
              call nc_diag_data2d("u_Observation_Operator_Jacobian_endind", dhx_dx_u%end_ind)
              call nc_diag_data2d("u_Observation_Operator_Jacobian_val", real(dhx_dx_u%val,r_single))
              call nc_diag_data2d("v_Observation_Operator_Jacobian_stind", dhx_dx_v%st_ind)
              call nc_diag_data2d("v_Observation_Operator_Jacobian_endind", dhx_dx_v%end_ind)
              call nc_diag_data2d("v_Observation_Operator_Jacobian_val", real(dhx_dx_v%val,r_single))
           endif


  end subroutine contents_netcdf_diag_

  subroutine final_vars_
    if(allocated(ges_tv)) deallocate(ges_tv)
    if(allocated(ges_v )) deallocate(ges_v )
    if(allocated(ges_u )) deallocate(ges_u )
    if(allocated(ges_z )) deallocate(ges_z )
    if(allocated(ges_ps)) deallocate(ges_ps)
  end subroutine final_vars_

end subroutine setupw
end module w_setup
lkcs_diag/gsi.fd/src/gsi/read_hu3ascat.f900000640002177400414130000007022514237551406020643 0ustar  bhooverdras-aidasubroutine read_hu3ascat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis,&
     prsl_full,nobs)
!$$$  subprogram documentation block
! subroutine based primarily on read_sfcwnd.f90: documentation block for that
! routine follows the history log.
! program history log:
!   2022-05-12: Hoover - HU-3 (AI-derived) ASCAT processed as ASCAT winds
!                      - Optimal uob, vob determined from max likelihood of
!                        ambiguities
!                      - Ob likelihood passed through cdata_all as elevation
!                .      .    .                                       .
! subprogram:    read_sfcwnd                    read scatterometer winds
!   prgmmr: Li Bi                               date: 2012-08-20
!
! abstract:  This routine reads OSCAT scatterometer winds from dump.        
!            it also has options to thin the data by using conventional 
!            thinning programs 
!            When running the gsi in regional mode, the code only
!            retains those observations that fall within the regional
!            domain
!
! program history log:
!   2012-08-20 Li Bi      
!   2014-04-15 Su -  new error table
!   2015-02-23  Rancic/Thomas - add thin4d to time window logical
!   2015-03-23  Su      -fix array size with maximum message and subset number from fixed number to
!                        dynamic allocated array
!   2015-10-01  guo     - consolidate use of ob location (in deg)
!   2016-03-15  Su      - modified the code so that the program won't stop when
!                         no subtype is found in non linear qc error table and b table
!   2020-05-04  wu   - no rotate_wind for fv3_regional
!
!   input argument list:
!     ithin    - flag to thin data
!     rmesh    - thinning mesh size (km)
!     gstime   - analysis time in minutes from reference date
!     infile   - unit from which to read BUFR data
!     lunout   - unit to which to write data for further processing
!     obstype  - observation type to process
!     twind    - input group time window (hours)
!     sis      - satellite/instrument/sensor indicator
!
!   output argument list:
!     nread    - number of satellite winds read 
!     ndata    - number of satellite winds retained for further processing
!     nodata   - number of satellite winds retained for further processing
!     nobs     - array of observations on each subdomain for each processor
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
! Changes relative to read_sfcwnd
! 
!$$$
  use kinds, only: r_kind,r_double,i_kind,r_single
  use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,&
       tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,&
       rlats,rlons,fv3_regional
  use qcmod, only: errormod,noiqc,njqc

  use convthin, only: make3grids,map3grids,del3grids,use_all
  use constants, only: deg2rad,zero,rad2deg,one_tenth,&
        tiny_r_kind,huge_r_kind,r60inv,one_tenth,&
        one,two,three,four,five,half,quarter,r60inv,r10,r100,r2000
  use converr,only: etabl
  use converr_uv,only: etabl_uv,isuble_uv,maxsub_uv
  use convb_uv,only: btabl_uv
  use obsmod, only: ran01dom,bmiss
  use convinfo, only: nconvtype, &
       icuse,ictype,icsubtype,ioctype, &
       ithin_conv,rmesh_conv,pmesh_conv
  use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen,time_4dvar,thin4d
  use deter_sfc_mod, only: deter_sfc_type,deter_sfc2
  use mpimod, only: npe
  implicit none

! Declare passed variables
  character(len=*)                      ,intent(in   ) :: infile,obstype
  character(len=20)                     ,intent(in   ) :: sis
  integer(i_kind)                       ,intent(in   ) :: lunout
  integer(i_kind)                       ,intent(inout) :: nread,ndata,nodata
  integer(i_kind),dimension(npe)        ,intent(inout) :: nobs
  real(r_kind)                          ,intent(in   ) :: twind
  real(r_kind),dimension(nlat,nlon,nsig),intent(in   ) :: prsl_full

! Declare local parameters

  real(r_kind),parameter:: r6= 6.0_r_kind
  real(r_kind),parameter:: r90= 90.0_r_kind
  real(r_kind),parameter:: r110= 110.0_r_kind
  real(r_kind),parameter:: r360 = 360.0_r_kind
  real(r_kind),parameter:: r421=421.0_r_kind
  real(r_kind),parameter:: r1200= 1200.0_r_kind
  
  

! Declare local variables
  logical outside
  logical luse,ithinp
  logical,allocatable,dimension(:,:):: lmsg     ! set true when convinfo entry id found in a message

  character(70) obstr,hdrtr,wndstr
  character(8) subset
  character(8) c_prvstg,c_sprvstg

  integer(i_kind) ireadmg,ireadsb,iuse,mxtb,nmsgmax
  integer(i_kind) i,maxobs,idomsfc,nsattype,j,ncount
  integer(i_kind) nc,nx,isflg,itx,nchanl
  integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread
  integer(i_kind) kk,klon1,klat1,klonp1,klatp1
  integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k
  integer(i_kind) nreal,ithin,iout,ntmp,icount,iiout,ii
  integer(i_kind) itype,iosub,ixsub,isubsub,iobsub 
  integer(i_kind) lim_qm
  integer(i_kind) nlevp         ! vertical level for thinning
  integer(i_kind) pflag
  integer(i_kind) ntest,nvtest
  integer(i_kind) kl,k1,k2
  integer(i_kind) nmsg                ! message index
  integer(i_kind) qc1,qc2,qc3,ierr
  
  
 
  integer(i_kind),dimension(nconvtype) :: ntxall 
  integer(i_kind),dimension(nconvtype+1) :: ntx  
  
  integer(i_kind),dimension(5):: idate5 
  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
  integer(i_kind),allocatable,dimension(:,:)::tab

! integer(i_kind) itypex,lcount,iflag,m
  integer(i_kind),dimension(1):: opt_idx
  integer(i_kind) itypey
  real(r_kind) toff,t4dv
  real(r_kind) rmesh,ediff,usage,tdiff
  real(r_kind) u0,v0,uob,vob,dx,dy,dx1,dy1,w00,w10,w01,w11
  real(r_kind) dlnpob,ppb,ppb2,qifn,qify,ee,var_jb
  real(r_kind) woe,dlat,dlon,dlat_earth,dlon_earth,oelev
  real(r_kind) dlat_earth_deg,dlon_earth_deg
  real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
  real(r_kind) vdisterrmax,u00,v00,uob1,vob1
  real(r_kind) del,werrmin,obserr,ppb1,wjbmin
  real(r_kind) tsavg,ff10,sfcr,sstime,gstime,zz
  real(r_kind) crit1,timedif,xmesh,pmesh
  real(r_kind),dimension(nsig):: presl
  real(r_kind) uob_1,uob_2,uob_3,uob_4,vob_1,vob_2,vob_3,vob_4
  real(r_kind) lkcs_1,lkcs_2,lkcs_3,lkcs_4
  real(r_kind),dimension(4):: lkcs_vec
  real(r_kind),dimension(4):: uob_vec
  real(r_kind),dimension(4):: vob_vec

  real(r_double),dimension(8):: hdrdat
  real(r_double),dimension(2):: satqc
  real(r_double),dimension(3):: obsdat
  real(r_double),dimension(3,4):: wnddat
  real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
  real(r_kind),allocatable,dimension(:):: presl_thin
  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out

! equivalence to handle character names
  equivalence(r_prvstg(1,1),c_prvstg)
  equivalence(r_sprvstg(1,1),c_sprvstg)

!******** Modify below from the bufrtable: 
  data hdrtr /'SAID CLATH CLONH YEAR MNTH DAYS HOUR MINU'/ 
  data obstr/'WVCQ NWVA ISWV'/ 
  data wndstr/'WS10 WD10 LKCS'/ 
  
  
  data ithin / -9 /
  data lunin / 11 /
  data rmesh / -99.999_r_kind /

!**************************************************************************

write(6,*) ' READ_HU3ASCAT: entering routine'

! Set lower limits for observation errors
! ** keep this way for now
! nreal keep the dimension of cdata_all 
  werrmin=one
  nsattype=0
  nreal=24
  if (noiqc) then
     lim_qm=8
  else
     lim_qm=4
  endif

! ** read convtype from convinfo file 
! ** only read in ASCAT 290 for now ** 
  ntread=1
  ntmatch=0
  ntx(ntread)=0
  ntxall=0
  do nc=1,nconvtype
     if(trim(ioctype(nc)) == 'uv' .and. ictype(nc) == 290) then
        ntmatch=ntmatch+1
        ntxall(ntmatch)=nc
        ithin=ithin_conv(nc)
        if(ithin > 0)then
           ntread=ntread+1
           ntx(ntread)=nc
        end if
     end if
  end do
  if(ntmatch == 0)then
     write(6,*) ' READ_HU3ASCAT: no matching obstype found in convinfo ',obstype
     return
  end if
      
!!  go through the satedump to find out how many subset to process
!** Open and read data from bufr data file

  open(lunin,file=trim(infile),form='unformatted')
  call openbf(lunin,'IN',lunin)
  call datelen(10)

!! get message and subset counts

  call getcount_bufr(infile,nmsgmax,mxtb)

  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))

  lmsg = .false.
  maxobs=0
  tab=0
  nmsg=0
  nrep=0
  ntb =0
  ncount=0
  msg_report: do while (ireadmg(lunin,subset,idate) == 0)

!    Time offset
     if(nmsg == 0) call time_4dvar(idate,toff)
     nmsg=nmsg+1
     if (nmsg>nmsgmax) then
        write(6,*)'READ_HU3ASCAT: messages exceed maximum ',nmsgmax
        call stop2(49)
     endif
     loop_report: do while (ireadsb(lunin) == 0)
        ntb = ntb+1
        maxobs=maxobs+1
        nrep(nmsg)=nrep(nmsg)+1
        if (ntb>mxtb) then
           write(6,*)'READ_HU3ASCAT: reports exceed maximum ',mxtb   
           call stop2(49)
        endif
!** Extract sat ID information from BUFR and assign type 
!   This part will extract information from the bufrtable
!   iobsub is the prepbufr subtype, still part of the convinfo file
!********* iobsub= 3 or 4 for existing ASCAT winds
!********* we will use iobsub=6 to distinguish HU-3 ASCAT winds
!********* NOTE: Max subtype=7 for uv obs

        call ufbint(lunin,hdrdat,8,1,iret,hdrtr)
!       determine the satellite wind type 
!       BTH: Spoofing with HU3ASCAT: subset=NC012122, hdrdat(1)=5.0                                       
        iobsub=6
        itype=-1
        if(trim(subset) == 'NC012122') then
           if( hdrdat(1) < r6 ) then           !    HU3ASCAT data == 5.0
             itype=290
           endif
        endif
!  Match ob to proper convinfo type
        ncsave=0
        matchloop:do ncx=1,ntmatch
           nc=ntxall(ncx)
           if (itype /= ictype(nc)) cycle matchloop
        write(6,*) 'BTH: nc=',nc
!  Find convtype which match ob type and subtype
           if(icsubtype(nc) == iobsub) then
              ncsave=nc
              exit matchloop
           else
!  Find convtype which match ob type and subtype group (isubtype == ?*)
!       where ? specifies the group and icsubtype = ?6)
              ixsub=icsubtype(nc)/10
              iosub=iobsub/10
              isubsub=icsubtype(nc)-ixsub*10
              if(ixsub == iosub .and. isubsub == 0) then
                 ncsave=nc
!  Find convtype which match ob type and subtype is all remaining
!       (icsubtype(nc) = 6)
              else if (ncsave == 0 .and. icsubtype(nc) == 6) then
                 ncsave=nc
              end if
           end if
        end do matchloop
!  Save information for next read
        if(ncsave /= 0) then
           maxobs=maxobs+1
           nx=1
           if(ithin_conv(ncsave) > 0)then
              do ii=2,ntread
                 if(ntx(ii) == ncsave)nx=ii
              end do
           end if
           tab(ntb,1)=ncsave
           tab(ntb,2)=nx
           tab(ntb,3)=1
           lmsg(nmsg,nx) = .true.
        end if
     enddo loop_report
  enddo msg_report

! Loop over convinfo file entries; operate on matches
  write(6,*) 'BTH: maxobs final=',maxobs
  allocate(cdata_all(nreal,maxobs),isort(maxobs))
  isort = 0
  cdata_all=zero
  nread=0
  ntest=0
  nvtest=0
  nchanl=0
  ilon=2
  ilat=3

!!  read satellite winds one type a time
!   same as in the read_prepbufr.f90 file

  loop_convinfo: do nx=1,ntread 
     use_all = .true.
     ithin=0
     if(nx >1) then
        nc=ntx(nx)
        ithin=ithin_conv(nc)
        if (ithin > 0 ) then
           rmesh=rmesh_conv(nc)
           pmesh=pmesh_conv(nc)
           use_all = .false.
           if(pmesh > zero) then
              pflag=1
              nlevp=r1200/pmesh
           else
              pflag=0
              nlevp=nsig
           endif
           xmesh=rmesh

           call make3grids(xmesh,nlevp)

           if (.not.use_all) then
              allocate(presl_thin(nlevp))
              if (pflag==1) then
                 do k=1,nlevp
                    presl_thin(k)=(r1200-(k-1)*pmesh)*one_tenth
                 enddo
              endif
           endif

           write(6,*)'READ_HU3ASCAT: ictype(nc),rmesh,pflag,nlevp,pmesh,nc ',&
                   ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc
        endif
     endif

     call closbf(lunin)
     close(lunin)
     open(lunin,file=trim(infile),form='unformatted')
     call openbf(lunin,'IN',lunin)
     call datelen(10)

! Big loop over BUFR file

     ntb = 0
     nmsg = 0
     loop_msg:  do while(ireadmg(lunin,subset,idate) == 0)
        nmsg = nmsg+1
        if(.not.lmsg(nmsg,nx)) then
           ntb=ntb+nrep(nmsg)
           write(6,*) 'BTH: nmsg no useable reports, skip ahead',nmsg
           cycle loop_msg ! no useable reports this mesage, skip ahead report count
        end if

        loop_readsb: do while(ireadsb(lunin) == 0)
!          use msg lookup table to decide which messages to skip
!          use report id lookup table to only process matching reports
           ntb = ntb+1
           nc=tab(ntb,1)
           if(nc <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb

           hdrdat=bmiss
           obsdat=bmiss
           wnddat=bmiss
           satqc=bmiss
           iobsub=6
           itype=-1
           uob=bmiss
           vob=bmiss
           ppb=bmiss
           ppb1=bmiss
           ppb2=bmiss
           uob1=bmiss
           vob1=bmiss
           ee=r110
           qifn=r110
           qify=r110
           uob_1=bmiss
           vob_1=bmiss
           uob_2=bmiss
           vob_2=bmiss
           uob_3=bmiss
           vob_3=bmiss
           uob_4=bmiss
           vob_4=bmiss
           lkcs_1=bmiss
           lkcs_2=bmiss
           lkcs_3=bmiss
           lkcs_4=bmiss
 
! Extract type, date, and location information
           call ufbint(lunin,hdrdat,8,1,iret,hdrtr) 
           call ufbint(lunin,obsdat,3,1,iret,obstr)
           call ufbrep(lunin,wnddat,3,4,iret,wndstr)


!** potential can reject bad cell, etc, place holder for now
!   reject the data with bad quality mark from SDM
!** cycle loop means skip to the next record     

           if(hdrdat(1) >= r6) cycle loop_readsb
!       Compare relative obs time with window.  If obs 
!       falls outside of window, don't use this obs
           idate5(1) = hdrdat(4)     ! year
           idate5(2) = hdrdat(5)     ! month
           idate5(3) = hdrdat(6)     ! day
           idate5(4) = hdrdat(7)     ! hours
           idate5(5) = hdrdat(8)     ! minutes
           call w3fs21(idate5,nmind)
           t4dv = real((nmind-iwinbgn),r_kind)*r60inv
           if (l4dvar.or.l4densvar) then
              if (t4dv<zero .OR. t4dv>winlen) cycle loop_readsb 
           else
              sstime = real(nmind,r_kind) 
              tdiff=(sstime-gstime)*r60inv
              if (abs(tdiff)>twind) cycle loop_readsb 
           endif


!       determine the satellite wind type as in prepbufr
!       290: ASCAT winds                              
           iosub=6
           if(abs(hdrdat(2)) >r90 ) cycle loop_readsb 
           if(hdrdat(3) <zero) hdrdat(3)=hdrdat(3)+r360
           if(hdrdat(3) == r360) hdrdat(3)=hdrdat(3)-r360
           if(hdrdat(3) >r360) cycle loop_readsb 
           !if(abs(obsdat(2)) >= 100) cycle loop_readsb
             ! applied to wind direction, move to lower bloc
             ! when optimal wind vector has been selected
           if(obsdat(1) >=1) cycle loop_readsb

           if(trim(subset) == 'NC012122') then    ! HU3ASCAT wind
              if( hdrdat(1) < r6) then          
                   itype=290
              endif
           endif

           nread=nread+2
           dlon_earth_deg=hdrdat(3)
           dlat_earth_deg=hdrdat(2)
           dlon_earth=hdrdat(3)*deg2rad
           dlat_earth=hdrdat(2)*deg2rad
                              
!       If regional, map obs lat,lon to rotated grid.
           if(regional)then
              call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)
              if(diagnostic_reg) then
                 call txy2ll(dlon,dlat,rlon00,rlat00)
                 ntest=ntest+1
                 cdist=sin(dlat_earth)*sin(rlat00)+cos(dlat_earth)*cos(rlat00)* &
                       (sin(dlon_earth)*sin(rlon00)+cos(dlon_earth)*cos(rlon00))
                 cdist=max(-one,min(cdist,one))
                 disterr=acos(cdist)*rad2deg
                 disterrmax=max(disterrmax,disterr)
              end if
              if(outside) cycle loop_readsb ! check to see if outside regional 
           else
              dlon=dlon_earth
              dlat=dlat_earth
              call grdcrd1(dlat,rlats,nlat,1)
              call grdcrd1(dlon,rlons,nlon,1)
           endif

!     If ASCAT data, determine primary surface type.  If not open sea,
!     skip this observation.  This check must be done before thinning.
!     isflg    - surface flag 0:sea 1:land 2:sea ice 3:snow 4:mixed

           if (itype==290) then                              
              call deter_sfc_type(dlat_earth,dlon_earth,t4dv,isflg,tsavg)
              if (isflg /= 0) cycle loop_readsb
              if (tsavg <= 273.0_r_kind) cycle loop_readsb
           endif

       
!!    convert from wind direction and speed to u,v component
           !uob=-obsdat(2)*sin(obsdat(1)*deg2rad)
           !vob=-obsdat(2)*cos(obsdat(1)*deg2rad)
               ! no optimal wind vector in hu3_ascat BUFR file,
               ! we will select one from the available ambiguities
               ! based on assigned likelihood, below

           qc1=obsdat(1) ! WVCQ: wind vector cell quality
           qc2=obsdat(2) ! NWVA: number of wind vector ambiguities
           qc3=obsdat(3) ! ISWV: index of selected wind vector

           uob_1=-wnddat(1,1)*sin(wnddat(2,1)*deg2rad)
           vob_1=-wnddat(1,1)*cos(wnddat(2,1)*deg2rad)
           uob_2=-wnddat(1,2)*sin(wnddat(2,2)*deg2rad)
           vob_2=-wnddat(1,2)*cos(wnddat(2,2)*deg2rad)
           uob_3=-wnddat(1,3)*sin(wnddat(2,3)*deg2rad)
           vob_3=-wnddat(1,3)*cos(wnddat(2,3)*deg2rad)
           uob_4=-wnddat(1,4)*sin(wnddat(2,4)*deg2rad)
           vob_4=-wnddat(1,4)*cos(wnddat(2,4)*deg2rad)
           ! load uob, vob values into vectors
           uob_vec(1)=uob_1
           uob_vec(2)=uob_2
           uob_vec(3)=uob_3
           uob_vec(4)=uob_4
           vob_vec(1)=vob_1
           vob_vec(2)=vob_2
           vob_vec(3)=vob_3
           vob_vec(4)=vob_4
           lkcs_1=wnddat(3,1)
           lkcs_2=wnddat(3,2)
           lkcs_3=wnddat(3,3)
           lkcs_4=wnddat(3,4)
           ! missing-value lkcs will be represented by a very large number
           ! (>>r110): Reverse the sign of these members so they are not
           ! selected by maxloc() as the optimal wind vector
           if(lkcs_1 > r110) lkcs_1 = -lkcs_1
           if(lkcs_2 > r110) lkcs_2 = -lkcs_2
           if(lkcs_3 > r110) lkcs_3 = -lkcs_3
           if(lkcs_4 > r110) lkcs_4 = -lkcs_4
           ! load LKCS values into vector
           lkcs_vec(1)=lkcs_1
           lkcs_vec(2)=lkcs_2
           lkcs_vec(3)=lkcs_3
           lkcs_vec(4)=lkcs_4
           ! select optimal wind vector based on maxloc(lkcs_vec)
           opt_idx=maxloc(lkcs_vec)
           write(6,*) 'BTH: abs(wnddat),lkcs=',abs(wnddat(1,opt_idx(1))),lkcs_vec(opt_idx(1))
           ! insert wind speed threshold criteria from above
           if(abs(wnddat(1,opt_idx(1))) >= r100) cycle loop_readsb
           ! reject any optimal wind vector with likelihood > 1 or less than 0
           if(lkcs_vec(opt_idx(1))>1.) cycle loop_readsb
           if(lkcs_vec(opt_idx(1))<0.) cycle loop_readsb
           ! define wind vector from optimal wnddat index
           uob=uob_vec(opt_idx(1))
           vob=vob_vec(opt_idx(1))
           write(6,*) 'BTH: selected wind uob,vob,lkcs=',uob,vob,lkcs_vec(opt_idx(1))           
!!  Get observation error from PREPBUFR observation error table
!   only need read the 4th column for type 290 from the right
 
           ppb=max(zero,min(ppb,r2000))
           itypey=itype
           if(njqc) then
              ierr=0
              do i =1,maxsub_uv
                 if( icsubtype(nc) == isuble_uv(itypey,i) ) then
                    ierr=i+1
                    exit
                 else if( i == maxsub_uv .and. icsubtype(nc) /= isuble_uv(itypey,i)) then
                    ncount=ncount+1
                    do j=1,maxsub_uv
                       if(isuble_uv(itypey,j) ==0 ) then
                          ierr=j+1
                          exit
                       endif
                    enddo
                    if (ncount ==1) then
                       write(6,*) 'READ_HU3ASCAT,WARNING!! cannot find subtyep in the error table,&
                                   itype,iobsub=',itypey,icsubtype
                       write(6,*) 'read error table at colomn subtype as 0,error table column=',j
                    endif
                 endif
              enddo
              if(ppb>=etabl_uv(itypey,1,1)) k1=1
              do kl=1,32
                 if(ppb>=etabl_uv(itypey,kl+1,1).and.ppb<=etabl_uv(itypey,kl,1)) k1=kl
              end do
              if(ppb<=etabl_uv(itypey,33,1)) k1=5
              k2=k1+1
              ediff = etabl_uv(itypey,k2,1)-etabl_uv(itypey,k1,1)
              if (abs(ediff) > tiny_r_kind) then
                 del = (ppb-etabl_uv(itypey,k1,1))/ediff
              else
                 del = huge_r_kind
              endif
              del=max(zero,min(del,one))
              obserr=(one-del)*etabl_uv(itypey,k1,ierr)+del*etabl_uv(itypey,k2,ierr)
              obserr=max(obserr,werrmin)
! get non linear qc parameter from b table
              var_jb=(one-del)*btabl_uv(itypey,k1,ierr)+del*btabl_uv(itypey,k2,ierr)
              var_jb=max(var_jb,wjbmin)
              if (var_jb >= 10.0_r_kind) var_jb=zero
          else
             if(ppb>=etabl(itype,1,1)) k1=1
              do kl=1,32
                 if(ppb>=etabl(itype,kl+1,1).and.ppb<=etabl(itype,kl,1)) k1=kl
              end do
              if(ppb<=etabl(itype,33,1)) k1=5
              k2=k1+1
              ediff = etabl(itype,k2,1)-etabl(itype,k1,1)
              if (abs(ediff) > tiny_r_kind) then
                 del = (ppb-etabl(itype,k1,1))/ediff
              else
                 del = huge_r_kind
              endif
              del=max(zero,min(del,one))
              obserr=(one-del)*etabl(itype,k1,4)+del*etabl(itype,k2,4)
              obserr=max(obserr,werrmin)
           endif

!         Set usage variable
           usage = 0 
           iuse=icuse(nc)
           if(iuse <= 0)usage=r100

! Get information from surface file necessary for conventional data here
! This is different from the previous sfc_type call
           call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz)
 
!!    process the thining procedure
                
           ithin=ithin_conv(nc)
           ithinp = ithin > 0 .and. pflag /= 0
           if(ithinp   )then
!          Interpolate guess pressure profile to observation location
              klon1= int(dlon);  klat1= int(dlat)
              dx   = dlon-klon1; dy   = dlat-klat1
              dx1  = one-dx;     dy1  = one-dy
              w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy

              klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
              if (klon1==0) klon1=nlon
              klatp1=min(nlat,klat1+1); klonp1=klon1+1
              if (klonp1==nlon+1) klonp1=1
              do kk=1,nsig
                 presl(kk)=w00*prsl_full(klat1 ,klon1 ,kk) +  &
                           w10*prsl_full(klatp1,klon1 ,kk) + &
                           w01*prsl_full(klat1 ,klonp1,kk) + &
                           w11*prsl_full(klatp1,klonp1,kk)
              end do
           end if

! The following two lines are new in SATWND:
           dlnpob=log(one_tenth*ppb)  ! ln(pressure in cb)
           ppb=one_tenth*ppb         ! from mb to cb

 !         Special block for data thinning - if requested
           if (ithin > 0 .and. iuse >=0) then
              ntmp=ndata  ! counting moved to map3gridS

 !         Set data quality index for thinning
              if (thin4d) then
                 timedif = zero
              else
                 timedif=abs(t4dv-toff)
              endif

              crit1 = timedif/r6+half

              if (pflag==0) then
                 do kk=1,nsig
                    presl_thin(kk)=presl(kk)
                 end do
              endif
 
              call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
                              ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)

              if (.not. luse) cycle loop_readsb
              if(iiout > 0) isort(iiout)=0
              if (ndata > ntmp) then
                 nodata=nodata+2
              endif
              isort(ntb)=iout

           else
              ndata=ndata+1
              nodata=nodata+2
              iout=ndata
              isort(ntb)=iout
           endif

           woe=obserr
           oelev=r10

           if(regional .and. .not. fv3_regional)then
              u0=uob
              v0=vob
              call rotate_wind_ll2xy(u0,v0,uob,vob,dlon_earth,dlon,dlat)
              if(diagnostic_reg) then
                 call rotate_wind_xy2ll(uob,vob,u00,v00,dlon_earth,dlon,dlat)
                 nvtest=nvtest+1
                 disterr=sqrt((u0-u00)**2+(v0-v00)**2)
                 vdisterrmax=max(vdisterrmax,disterr)
              end if
           endif
           write(6,*) 'BTH: Getting to cdata_all write-out'
! Output result to array, need restruct from here.

           cdata_all(1,iout)=woe                  ! wind error
           cdata_all(2,iout)=dlon                 ! grid relative longitude
           cdata_all(3,iout)=dlat                 ! grid relative latitude
           cdata_all(4,iout)=dlnpob               ! ln(pressure in cb)
           cdata_all(5,iout)=oelev                 ! index of height        
           cdata_all(6,iout)=uob                  ! u obs
           cdata_all(7,iout)=vob                  ! v obs 
           cdata_all(8,iout)=ndata                ! station id 
           cdata_all(9,iout)=t4dv                 ! time
           cdata_all(10,iout)=nc                  ! index of type in convinfo file
           cdata_all(11,iout)=lkcs_vec(opt_idx(1))                   ! index of station elevation
           cdata_all(12,iout)=qc1                 ! index of quality mark
           cdata_all(13,iout)=obserr              ! original obs error
           cdata_all(14,iout)=usage               ! usage parameter
           cdata_all(15,iout)=idomsfc             ! dominate surface type
           cdata_all(16,iout)=tsavg               ! skin temperature
           cdata_all(17,iout)=ff10                ! 10 meter wind factor
           cdata_all(18,iout)=sfcr                ! surface roughness
           cdata_all(19,iout)=dlon_earth_deg      ! earth relative longitude (degrees)
           cdata_all(20,iout)=dlat_earth_deg      ! earth relative latitude (degrees)
           cdata_all(21,iout)=zz                  ! terrain height at ob location
           cdata_all(22,iout)=r_prvstg(1,1)       ! provider name
           cdata_all(23,iout)=r_sprvstg(1,1)      ! subprovider name
           cdata_all(24,iout)=var_jb              ! non linear qc parameter

        enddo  loop_readsb

     enddo loop_msg

!    Close unit to bufr file
!    Deallocate arrays used for thinning data
     if (.not.use_all) then
        deallocate(presl_thin)
        call del3grids
     endif
! Normal exit

  enddo loop_convinfo! loops over convinfo entry matches
  call closbf(lunin)
  deallocate(lmsg,nrep,tab)
 

  ! Write header record and data to output file for further processing
  allocate(iloc(ndata))
  icount=0
  do i=1,maxobs
     if(isort(i) > 0)then
        icount=icount+1
        iloc(icount)=isort(i)
     end if
  end do
  if(ndata /= icount)then
     write(6,*) ' READ_HU3ASCAT: mix up in read_hu3ascat ,ndata,icount ',ndata,icount
     call stop2(49)
  end if

  allocate(cdata_out(nreal,ndata))
  do i=1,ndata
     itx=iloc(i)
     do k=1,nreal
        cdata_out(k,i)=cdata_all(k,itx)
     end do
  end do
  deallocate(iloc,isort,cdata_all)
!  deallocate(etabl)
  
  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
  write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
  write(lunout) cdata_out

  deallocate(cdata_out)
900 continue
  if(diagnostic_reg .and. ntest>0) write(6,*)'READ_HU3ASCAT:  ',&
       'ntest,disterrmax=',ntest,disterrmax
  if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_HU3ASCAT:  ',&
       'nvtest,vdisterrmax=',ntest,vdisterrmax

  if (ndata == 0) then
     write(6,*)'READ_HU3ASCAT:  closbf(',lunin,') no data'
  endif
  
  write(6,*) 'READ_HU3ASCAT,nread,ndata,nreal,nodata=',nread,ndata,nreal,nodata

  close(lunin)

! End of routine
  return



end subroutine read_hu3ascat
production/0002750002177400414130000000000014237551236013334 5ustar  bhooverdras-aidaproduction/fix/0002750002177400414130000000000014237551222014115 5ustar  bhooverdras-aidaproduction/fix/fix_gsi/0002750002177400414130000000000014237551231015545 5ustar  bhooverdras-aidaproduction/fix/fix_gsi/gfsv16_historical/0002750002177400414130000000000014237551236021107 5ustar  bhooverdras-aidaproduction/fix/fix_gsi/gfsv16_historical/global_convinfo.txt.2021031712_hu30000750002177400414130000007604214237551172026642 0ustar  bhooverdras-aida! otype   = observation type (a7, t, uv, q, etc.)                                     
! type    = prepbufr observation type (if available) 
! sub     = prepbufr subtype (not yet available)
! iuse    = flag if to use/not use / monitor data
!         = 1  use data
!         = 0  do not use data
!         = -1 monitor data
!         = -3 skip reading data
! twindow = time window (+/- hours)
! numgrp  = cross validation parameter - number of groups
! ngroup  = cross validation parameter - group to remove from data use
! nmiter  = cross validation parameter - external iteration to introduce removed data
! gross   = gross error parameter - gross error
! ermax   = gross error parameter - max error  
! ermin   = gross error parameter - min error
! var_b   = variational quality control parameter -  b parameter
! var_pg ithin rmesh npred  = variational quality control parameter -  pg parameter
! pmot: the optione to keep thinned datai as monitored, 0: not to keep, other values: to keep
! ptime: time interval for thinning, 0, no temporal thinning, other values define time interval (less than 6)
! ib,ip:  new nonlinear qc parameter, ib:betta, ip:kappa
!otype   type  sub iuse twindow numgrp ngroup nmiter gross ermax ermin var_b    var_pg ithin rmesh  pmesh  npred  pmot  ptime   ib   ip
 tcp      112    0    1     3.0      0      0      0  75.0   5.0   1.0  75.0  0.000000     0    0.     0.      0    0.     0.    0    0
 ps       120    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    4   -9
 ps       132    0   -1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    0    0
 ps       180    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 ps       180    01   1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    8   -9
 ps       181    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    4   -9
 ps       182    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 ps       183    0   -1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    0    0
 ps       187    0    1     3.0      0      0      0   5.0   3.0   1.0   5.0  0.000300     0    0.     0.      0    0.     0.    6   -7
 t        120    0    1     3.0      0      0      0   8.0   5.6   1.3   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 t        126    0   -1     3.0      0      0      0   8.0   5.6   1.3   8.0  0.001000     0    0.     0.      0    0.     0.    0    0
 t        130    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    7   -9
 t        131    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    7   -9
 t        132    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.001000     0    0.     0.      0    0.     0.    3   -6
 t        133    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -9
 t        134    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        135    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        136    0    1     3.0      0      0      0   2.0   5.6   1.3  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 t        180    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -6
 t        180    01   1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    8   -9 
 t        181    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        182    0    1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    7   -6 
 t        183    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 t        187    0   -1     3.0      0      0      0   7.0   5.6   1.3   7.0  0.004000     0    0.     0.      0    0.     0.    0    0
 q        120    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    7   -6
 q        130    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        131    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        132    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -6
 q        133    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -6
 q        134    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        135    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        136    0    1     3.0      0      0      0   2.0  50.0   5.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 q        180    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    6   -1
 q        180    01   1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    6   -9
 q        181    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000500     0    0.     0.      0    0.     0.    0    0
 q        182    0    1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    6   -1
 q        183    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 q        187    0   -1     3.0      0      0      0   8.0 100.0  10.0   8.0  0.000600     0    0.     0.      0    0.     0.    0    0
 pw       152    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       153    0   -1     3.0      0      0      0   5.0   5.0   2.0   5.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       156    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       157    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pw       158    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 pw       159    0   -1     3.0      0      0      0  10.0   8.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      181    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      182    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      183    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      184    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      185    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      186    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      187    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      188    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      189    0    1     3.0      0      0      0   1.0   2.0   0.2   1.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      190    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      191    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      192    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      193    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      194    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      195    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      196    0    1     3.0      0      0      0   2.0   2.0   0.2   2.0  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      197    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      198    0    1     3.0      0      0      0   1.5   2.0   0.2   1.5  0.000000     0    0.     0.      0    0.     0.    0    0
 sst      199    0    1     3.0      0      0      0   3.0   2.0   0.2   3.0  0.000000     0    0.     0.      0    0.     0.    0    0
 uv       210    0   -1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       220    0    1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       221    0    1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       223    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       224    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       228    0   -1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       229    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000001     0    0.     0.      0    0.     0.    3   -6
 uv       230    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.000100    20  100.   800.      0    0.     1.    7   -4
 uv       231    0    1     3.0      0      0      0   6.5   6.1   1.4   6.5  0.000100    20  100.   800.      0    0.     1.    6   -5
 uv       232    0    1     3.0      0      0      0   7.0   6.1   1.4   7.0  0.000100     0    0.     0.      0    0.     0.    3   -7
 uv       233    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100    20  100.   800.      0    0.     1.    6   -4
 uv       234    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       235    0    1     3.0      0      0      0   7.5   6.1   1.4   7.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       236    0    1     3.0      0      0      0   2.0   6.1   1.4  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 uv       240    0   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       240  257   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  259   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  270   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       240  271   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0  100.    50.      0    0.     0.    0    0
 uv       241    0   -1     3.0      0      0      0   2.5   6.1   1.4   2.5  0.000100     0    0.     0.      0    0.     0.    0    0
 uv       242    0   -1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   13   -8
 uv       242  171    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  172    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  173    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       242  174    1     3.0      0      0      0   2.5  15.0   1.4   2.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243    0   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     0    0.     0.      0    0.     0.   15   -8   
 uv       243   54   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   55    1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   56   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   57   -1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       243   70    1     3.0      0      0      0   1.5  15.0   1.4   1.5  0.055000     1  200.   100.      0    0.     2.   15   -8
 uv       244    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8   
 uv       244    3    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244    4    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  206    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  207    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  209    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       244  223    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       245    0   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  257   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  259   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  270    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       245  271    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246    0   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  257   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  259   -1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  270    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       246  271    1     3.0      0      0      0   1.3  20.0   1.4   1.3  0.005000     0  200.   100.      0    0.     0.   15   -8
 uv       247    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  257   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  259   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  270    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       247  271    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.005000     0    0.     0.      0    0.     0.   15   -8
 uv       248    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       249    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       250    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       250  171    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       250  172    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8 
 uv       250  173    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       250  174    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       251    0   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       251  257   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       251  259   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       251  270   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       251  271   -3     3.0      0      0      0   1.3  20.0   1.4   1.3  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       252    0   -1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     0    0.     0.      0    0.     0.    0    0
 uv       252  171    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  172    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  173    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       252  174    1     3.0      0      0      0   2.5  20.0   1.4   2.5  0.050050     1  200.   100.      0    0.     2.   15   -8
 uv       253    0   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0  200.   100.      0    0.     2.    0    0
 uv       253   54   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8 
 uv       253   55    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   56   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   57   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       253   70    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254    0   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0    0.     0.      0    0.     0.    0    0
 uv       254   54   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254   55    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0    0.     0.      0    0.     2.   15   -8
 uv       254   56   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     0  200.   100.      0    0.     2.   15   -8
 uv       254   57   -1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       254   70    1     3.0      0      0      0   1.5  20.0   1.4   1.5  0.050500     1  200.   100.      0    0.     2.   15   -8
 uv       255    0   -3     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       255  854   -3     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9 
 uv       256    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       257    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       257  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       257  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9 
 uv       258    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       258  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       258  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       259    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       259  783    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       259  784    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.005500     0    0.     0.      0    0.     0.   15   -9
 uv       260    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       260  224    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9
 uv       260  225    1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.   15   -9
 uv       270    0   -1     3.0      0      0      0   2.5  20.1   1.4   2.5  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       280    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.   11   -9
 uv       280    01   1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.   11   -9
 uv       281    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       282    0    1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       284    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       285    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       286    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.005500     0    0.     0.      0    0.     0.    0    0
 uv       287    0   -1     3.0      0      0      0   6.0   6.1   1.4   6.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       289    0    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.   14   -9
 uv       290    4    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       290    3    1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       290    5   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     1  100.  1200.      0    0.     0.    0    0
 uv       290    6   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0    0.     0.      0    0.     0.    0    0
 uv       291    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     1  100.  1200.      0    0.     0.    0    0
 uv       296    0   -1     3.0      0      0      0   5.0   6.1   1.4   5.0  0.000500     0  100.  1200.      0    0.     0.    0    0
 spd      283    0   -1     3.0      0      0      0   8.0   6.1   1.4   8.0  0.000000     0    0.     0.      0    0.     0.    0    0
 dw       999    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000000     0    0.     0.      0    0.     0.    0    0
 dw       201    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 dw       202    0   -1     3.0      0      0      0   8.0  10.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 dw       100    0   -1     3.0      0      0      0   4.0   5.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0 
 dw       101    0   -1     3.0      0      0      0   4.0   5.0   2.0   8.0  0.000001     0    0.     0.      0    0.     0.    0    0
 srw      999    0   -1     2.5      0      0      0  10.0  10.0   1.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 rw       999    0   -1     2.5      0      0      0  10.0  10.0   2.0  10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      004    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      041    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      722    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      723    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      740    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      741    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      742    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      743    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      744    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      745    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      820    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      042    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      043    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      786    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      421    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      003    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      821    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      825    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      440    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 pm2_5    102    0   -1     1.0      0      0      0 100.0   1.5   0.75 10.0  0.000000     0    0.     0.      0    0.     0.    0    0  
 pm10     102    0   -1     1.0      0      0      0 150.0   1.5   0.75 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      750    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      751    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      752    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      753    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      754    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      755    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      724    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      725    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      726    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      727    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      728    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      729    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      044    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      005    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0 
 gps      265    0    1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      266    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      267    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      268    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
 gps      269    0   -1     3.0      0      0      0  0.024  0.024 0.01 10.0  0.000000     0    0.     0.      0    0.     0.    0    0
production/gsi.fd/0002750002177400414130000000000014237551214014502 5ustar  bhooverdras-aidaproduction/gsi.fd/src/0002750002177400414130000000000014237551014015267 5ustar  bhooverdras-aidaproduction/gsi.fd/src/gsi/0002750002177400414130000000000014237551024016052 5ustar  bhooverdras-aidaproduction/gsi.fd/src/gsi/read_obs.F900000640002177400414130000024640014237551000020107 0ustar  bhooverdras-aidamodule read_obsmod
!$$$   module documentation block
!                .      .    .                                       .
! module:    read_obsmod extra inquire routine for reading obs
!   prgmmr: parrish          org: np22                date: 2005-06-06
!
! abstract:
!
! program history log:
!   2009-01-05  todling - add gsi_inquire
!   2015-05-01  Liu Ling - Add call to read_rapidscat 
!   2015-08-20  zhu  - add flexibility for enabling all-sky and using aerosol info in radiance 
!                      assimilation. Use radiance_obstype_search from radiance_mod.  
!   2016-09-xx  CAPS(G. Zhao) - Add read radar reflectivtiy dbz bufr 
!                               (from MRMS grib2 in BUFR for direct reflectivity DA)
!   2017-05-12  Y. Wang and X. Wang - add dbz to be read in, POC: xuguang.wang@ou.edu
!
! subroutines included:
!   sub gsi_inquire   -  inquire statement supporting fortran earlier than 2003
!   sub read_obs      -  read, select, reformat obs data
!
! Variable Definitions:
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$ end documentation block

! set default to private
  private
! set subroutines to public
  public :: gsi_inquire
  public :: read_obs

contains

subroutine gsi_inquire (lbytes,lexist,filename,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    gsi_inquire        inquire file presence and size
!   prgmmr: todling      org: np22                date: 2009-01-05
!
! abstract:  Inquire file presence and size; to be used when fortran
!            2003 not available or non-compliant.
!
! program history log:
!   2009-01-05  todling
!   2013-05-14  guo     - changed the compiler #ifdef dependency on _size_
!                         inquire to a more portable way.
!
!   input argument list:
!     mype     - mpi task id
!    filename  - input filename
!
!   output argument list:
!    lexist     - file presence flag
!    lbytes     - file size (bytes)
!
! attributes:
!   language: f90
!   machine:  Linux-cluster
!
!$$$  end documentation block
!

  use kinds, only: i_kind,i_llong

  implicit none

  integer(i_llong),intent(  out) :: lbytes
  logical         ,intent(  out) :: lexist
  character(len=*),intent(in   ) :: filename
  integer(i_kind) ,intent(in   ) :: mype

  character(len=256) command, fname

#if defined(__INTEL_COMPILER) && (__INTEL_COMPILER < 1110)
#define __X_OR_Y_OR_Z_FORTRAN_COMPILERS__
#endif

#ifdef __X_OR_Y_OR_Z_FORTRAN_COMPILERS__
#define _DO_NOT_SUPPORT_SIZE_INQUIRE_
#endif

  lbytes=-1  ! in case that _size_ specifier is not supported.
#ifndef _DO_NOT_SUPPORT_SIZE_INQUIRE_
  inquire(file=trim(filename),exist=lexist,size=lbytes)
  ! Note that the value of _size_ is defined by Fortran in "file storage units",
  ! which is not neccesary in byte units.  It is not clear if this code had
  ! assumed the size value to be in byte units, or in whatever units.
#else
  inquire(file=trim(filename),exist=lexist)
#endif
  if(lexist) then
     ! Even with a compiler supporting 'size=' specifier, the size value may
     ! return -1, if a compiler considers that the size can not be determined.
     ! In that case, the size may be obtained through a user supported
     ! mechanism, such as reading the size from a system("wc -c") call result.
     if(lbytes<0) then
        write(fname,'(2a,i4.4)') 'fsize_',trim(filename),mype
        write(command,'(4a)') 'wc -c ', trim(filename),' > ', trim(fname)
        call system(command)
        open(unit=999,file=trim(fname),form='formatted')
        read(999,*) lbytes
        close(999)
        lexist = lbytes>0_i_llong ! skip this file if lbytes <=0
     endif
  endif

  return
end subroutine gsi_inquire

subroutine read_obs_check (lexist,filename,jsatid,dtype,minuse,nread)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    read_obs_check     inquire file presence and size
!   prgmmr: todling      org: np22                date: 2010-03-05
!
! abstract:  Reset file status depending on whether observation time
!            matches analysis time and how offtime_date is set. This
!            also checks for consistency in satellite data files and 
!            known types.  
!            WARNING: some of it looks inconsistent with long-window 4dvar
!
! program history log:
!   2009-xx-xx  derber   - originally placed inside inquire
!   2009-01-05  todling  - move time/type-check out of inquire
!   2010-09-13  pagowski - add anow bufr and one obs chem
!   2013-01-26  parrish - WCOSS debug compile fails with satid not initialized.
!                         Set satid=1 at start of subroutine to allow debug compile.
!   2013-02-13  eliu     - add ssmis 
!   2013-07-01  todling/guo - allow user to bypass this check (old bufr support)
!   2014-10-01  ejones   - add gmi and amsr2
!   2015-01-16  ejones   - add saphir
!   2016-09-xx  CAPS(G. Zhao) - skipping check BUFR dbz when using dbzbufr for direct reflectivity DA
!   2016-09-19  guo      - properly initialized nread, in case of for quick-return cases.
!   2017-11-16  dutta    - adding KOMPSAT5 bufr i.d for reading the data.
!   2019-03-27  h. liu   - add abi
!   2019-09-20  X.Su     -add read new variational qc table
!   2019-08-21  H. Shao  - add METOPC-C, COSMIC-2 and PAZ to the GPS check list                           
!   2020-05-21  H. Shao  - add commercial GNSSRO (Spire, PlanetIQ, GeoOptics) and other existing missions to the check list                           
!
!   input argument list:
!    lexist    - file status
!    filename  - input filename
!    jsatid    - satellite id
!    dtype     - satellite type
!
!   output argument list:
!    lexist    - file status
!
! attributes:
!   language: f90
!   machine:  Linux-cluster
!
!$$$  end documentation block

  use kinds, only: i_kind,i_llong,r_kind,r_double
  use gsi_4dvar, only: iadatebgn,iadateend
  use obsmod, only: offtime_data
  use convinfo, only: nconvtype,ictype,ioctype,icuse
  use chemmod, only : oneobtest_chem,oneob_type_chem,&
       code_pm25_ncbufr,code_pm25_anowbufr,code_pm10_ncbufr,code_pm10_anowbufr
  use directDA_radaruse_mod, only: l_use_dbz_directDA

  implicit none

  logical         ,intent(inout)  :: lexist
  character(len=*),intent(in)     :: filename
  character(len=*),intent(in)     :: jsatid
  character(len=*),intent(in)     :: dtype
  integer(i_kind) ,intent(in)     :: minuse
  integer(i_kind) ,intent(inout)  :: nread

  integer(i_kind) :: lnbufr,idate,idate2,iret,kidsat
  integer(i_kind) :: ireadsb,ireadmg,kx,nc,said
  real(r_double) :: satid,rtype
  character(8) subset
  logical,parameter:: GMAO_READ=.false.

  satid=1      ! debug executable wants default value ???
  idate=0
  nread=0; if(lexist) nread=1   ! in case of a quick return
#ifdef _SKIP_READ_OBS_CHECK_
  return
#endif
  if(trim(dtype) == 'tcp' .or. trim(filename) == 'tldplrso')return
  if(trim(filename) == 'mitmdat' .or. trim(filename) == 'mxtmdat')return
  if(trim(filename) == 'satmar')return
  if ( .not. l_use_dbz_directDA) then
     if(trim(dtype) == 'dbz' )return
  end if

! Use routine as usual

  if(lexist .and. trim(dtype) /= 'tcp' )then
      lnbufr = 15
      open(lnbufr,file=trim(filename),form='unformatted',status ='unknown')
      call openbf(lnbufr,'IN',lnbufr)
      call datelen(10)
      call readmg(lnbufr,subset,idate,iret)
      if(iret == 0)then

!        Extract date and check for consistency with analysis date
         if (idate<iadatebgn.or.idate>iadateend) then
            if(offtime_data) then
              write(6,*)'***read_obs_check analysis and data file date differ, but use anyway'
            else
               write(6,*)'***read_obs_check*** ',&
                 'incompatable analysis and observation date/time',trim(filename),trim(dtype)
               lexist=.false.
            end if
            write(6,*)'Analysis start  :',iadatebgn
            write(6,*)'Analysis end    :',iadateend
            write(6,*)'Observation time:',idate
        endif
      else
         write(6,*)'***read_obs_check*** iret/=0 for reading date for ',trim(filename),dtype,jsatid,iret
         lexist=.false.
      end if
      if(lexist)then
       if(jsatid == '')then
         kidsat=0
       else if(jsatid == 'metop-a')then
         kidsat=4
       else if(jsatid == 'metop-b')then
         kidsat=3
       else if(jsatid == 'metop-c')then
         kidsat=5
       else if(jsatid == 'm08')then
         kidsat = 55 
       else if(jsatid == 'm09')then
         kidsat = 56 
       else if(jsatid == 'm10')then
         kidsat = 57 
       else if(jsatid == 'm11')then
         kidsat = 70 
       else if(jsatid == 'n08')then
         kidsat=200
       else if(jsatid == 'n09')then
         kidsat=201
       else if(jsatid == 'n10')then
         kidsat=202
       else if(jsatid == 'n11')then
         kidsat=203
       else if(jsatid == 'n12')then
         kidsat=204
       else if(jsatid == 'n14')then
         kidsat=205
       else if(jsatid == 'n15')then
         kidsat=206
       else if(jsatid == 'n16')then
         kidsat=207
       else if(jsatid == 'n17')then
         kidsat=208
       else if(jsatid == 'n18')then
         kidsat=209
       else if(jsatid == 'n19')then
         kidsat=223
       else if(jsatid == 'npp')then
         kidsat=224
       else if(jsatid == 'n20')then
         kidsat=225
       else if(jsatid == 'n21')then
         kidsat=226
       else if(jsatid == 'f08')then
         kidsat=241
       else if(jsatid == 'f10')then
         kidsat=243
       else if(jsatid == 'f11')then
         kidsat=244
       else if(jsatid == 'f13')then
         kidsat=246
       else if(jsatid == 'f14')then
         kidsat=247
       else if(jsatid == 'f15')then
         kidsat=248
       else if(jsatid == 'f16')then
         kidsat=249    
       else if(jsatid == 'trmm')then
         kidsat=282    
       else if(jsatid == 'f17')then
         kidsat=285                  
       else if(jsatid == 'f18')then  
         kidsat=286                  
       else if(jsatid == 'f19')then  
         kidsat=287                  
       else if(jsatid == 'g08' .or. jsatid == 'g08_prep')then
         kidsat=252
       else if(jsatid == 'g09' .or. jsatid == 'g09_prep')then
         kidsat=253
       else if(jsatid == 'g10' .or. jsatid == 'g10_prep')then
         kidsat=254
       else if(jsatid == 'g11' .or. jsatid == 'g11_prep')then
         kidsat=255
       else if(jsatid == 'g12' .or. jsatid == 'g12_prep')then
         kidsat=256
       else if(jsatid == 'g13' .or. jsatid == 'g13_prep')then
         kidsat=257
       else if(jsatid == 'g14' .or. jsatid == 'g14_prep')then
         kidsat=258
       else if(jsatid == 'g15' .or. jsatid == 'g15_prep')then
         kidsat=259
       else if(jsatid == 'g16' .or. jsatid == 'g16_prep')then
         kidsat=270
       else if(jsatid == 'g17' .or. jsatid == 'g17_prep')then
         kidsat=271
       else if(jsatid == 'n05')then
         kidsat=705
       else if(jsatid == 'n06')then
         kidsat=706
       else if(jsatid == 'n07')then
         kidsat=707
       else if(jsatid == 'tirosn')then
         kidsat=708
       else if ( jsatid == 'terra' ) then
         kidsat = 783
       else if ( jsatid == 'aqua'  ) then
         kidsat = 784
       else if ( jsatid == 'aura'  ) then
         kidsat = 785
       else if ( jsatid == 'gcom-w1' ) then
         kidsat = 122
! Temporary comment gpm out here; discrepancy between SAID in bufr file and
! kidsat.
!       else if ( jsatid == 'gpm' ) then
!         kidsat = 288
       else if ( jsatid == 'meghat' ) then
         kidsat = 440
       else
         kidsat = 0
       end if

       call closbf(lnbufr)
       close(lnbufr)
       open(lnbufr,file=trim(filename),form='unformatted',status ='unknown')
       call openbf(lnbufr,'IN',lnbufr)
       call datelen(10)

       if(kidsat /= 0)then
        lexist = .false.
        satloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
           if(ireadsb(lnbufr)==0)then
              call ufbint(lnbufr,satid,1,1,iret,'SAID')
           end if
           if(nint(satid) == kidsat) then
             lexist=.true.
             exit satloop
           end if
           nread = nread + 1
        end do satloop
       else if(trim(filename) == 'prepbufr')then  ! RTod: wired-in filename is not a good idea
         lexist = .false.
         fileloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit fileloop
             end if
           end do
          end do 
          nread = nread + 1
         end do fileloop
        else if(trim(filename) == 'wcpbufr')then
         lexist = .false.
         file2loop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit file2loop
             end if
           end do
          end do
          nread = nread + 1
         end do file2loop
       else if(trim(filename) == 'gps_ref' .or.  trim(filename) == 'gps_bnd')then
         lexist = .false.
         gpsloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
           if(ireadsb(lnbufr)==0)then 
              call ufbint(lnbufr,satid,1,1,iret,'SAID') 
           end if 
 
           said=nint(satid) 
           if(((said > 739) .and.(said < 746)).or. (said == 820) .or. &
               (said == 825).or. (said == 786).or. (said == 4)   .or. &
               (said == 3)  .or. (said == 421).or. (said == 440) .or. &
               (said == 821).or. ((said > 749).and.(said < 756)) .or. &
               (said == 44) .or. (said == 5)  .or. (said == 41)  .or. &
               (said == 42) .or. (said == 43) .or. (said == 722) .or. & 
               (said == 723).or. (said == 265).or. (said == 266) .or. &
               (said == 267).or. (said == 268).or. (said == 269)) then
             lexist=.true. 
             exit gpsloop 
           end if 
           nread = nread + 1
         end do gpsloop
       else if(trim(filename) == 'prepbufr_profl')then  
         lexist = .false.
         airploop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
          do while(ireadsb(lnbufr)>=0)
           call ufbint(lnbufr,rtype,1,1,iret,'TYP')
           kx=nint(rtype)
           if (trim(dtype)=='uv') then
              if (kx==330 .or. kx==430 .or. kx==530) kx=230
              if (kx==331 .or. kx==431 .or. kx==531) kx=231
              if (kx==332 .or. kx==432 .or. kx==532) kx=232
              if (kx==333 .or. kx==433 .or. kx==533) kx=233
              if (kx==334 .or. kx==434 .or. kx==534) kx=234
              if (kx==335 .or. kx==435 .or. kx==535) kx=235
           else
              if (kx==330 .or. kx==430 .or. kx==530) kx=130
              if (kx==331 .or. kx==431 .or. kx==531) kx=131
              if (kx==332 .or. kx==432 .or. kx==532) kx=132
              if (kx==333 .or. kx==433 .or. kx==533) kx=133
              if (kx==334 .or. kx==434 .or. kx==534) kx=134
              if (kx==335 .or. kx==435 .or. kx==535) kx=135
           end if
           do nc=1,nconvtype
             if(trim(ioctype(nc)) == trim(dtype) .and. kx == ictype(nc) .and. icuse(nc) > minuse)then
               lexist = .true.
               exit airploop
             end if
           end do
          end do
          nread = nread + 1
         end do airploop
       else if(trim(filename) == 'satwndbufr')then
         lexist = .false.
         loop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
!        5 GOES-R AMVs (NC005030, NC005031, NC005032, NC005034 and NC005039)
!        are added as the GOES-R bufr file provide do not contain other winds.
!        May not be necessary with the operational satwnd BUFR
            if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or.&
               trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071' .or.&
               trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or.&
               trim(subset) == 'NC005046' .or. trim(subset) == 'NC005064' .or.&
               trim(subset) == 'NC005065' .or. trim(subset) == 'NC005066' .or.& 
               trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or.& 
               trim(subset) == 'NC005032' .or. trim(subset) == 'NC005034' .or.&
               trim(subset) == 'NC005039' .or. &
               trim(subset) == 'NC005090' .or. trim(subset) == 'NC005091' .or.&
               trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or. trim(subset) == 'NC005069' .or.&
               trim(subset) == 'NC005081' .or. &
               trim(subset) == 'NC005072' ) then
               lexist = .true.
               exit loop
            endif
            nread = nread + 1
         end do loop
       else if(trim(filename) == 'oscatbufr')then
         lexist = .false.
         oscatloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC012255') then
               lexist = .true.
               exit oscatloop
            endif
         end do oscatloop
       else if(trim(filename) == 'rapidscatbufr')then
         lexist = .false.
         rapidscatloop: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC012255') then
               lexist = .true.
               exit rapidscatloop
            endif
            nread = nread + 1
         end do rapidscatloop
       else if(trim(filename) == 'hdobbufr')then
         lexist = .false.
         loop_hdob: do while(ireadmg(lnbufr,subset,idate2) >= 0)
            if(trim(subset) == 'NC004015') then
               lexist = .true.
               exit loop_hdob
            endif
            nread = nread + 1
         end do loop_hdob
       else if(trim(dtype) == 'pm2_5')then
          if (oneobtest_chem .and. oneob_type_chem=='pm2_5') then
             lexist=.true.
          else
             lexist = .false.
             fileloopanow_pm2_5:do while(ireadmg(lnbufr,subset,idate2) >= 0)
                do while(ireadsb(lnbufr)>=0)
                   if (subset == 'ANOWPM') then
                      call ufbint(lnbufr,rtype,1,1,iret,'TYP')
                      kx=nint(rtype)
                   else if ( (subset == 'NC008031') .or. &
                          (subset == 'NC008032' ) ) then
                      call ufbint(lnbufr,rtype,1,1,iret,'TYPO')
                      kx=nint(rtype)
                      if (kx/=code_pm25_ncbufr) then
                         cycle
                      else
                         kx=code_pm25_anowbufr
                      endif
                   else
                      cycle
                   endif
                   
                   do nc=1,nconvtype
                      if(trim(ioctype(nc)) == trim(dtype) .and. &
                           kx == ictype(nc) .and. icuse(nc) > minuse)then
                         lexist = .true.
                         exit fileloopanow_pm2_5
                      end if
                   end do
                end do
                nread = nread + 1
             enddo fileloopanow_pm2_5
          endif

          if (lexist) then
             write(6,*)'found pm2_5 in anow bufr'
          else
             write(6,*)'did not find pm2_5 in anow bufr'
          endif
           
       else if(trim(dtype) == 'pm10')then
          lexist = .false.
          fileloopanow_pm10:do while(ireadmg(lnbufr,subset,idate2) >= 0)
             do while(ireadsb(lnbufr)>=0)
                if (subset == 'NC008033') then
                   call ufbint(lnbufr,rtype,1,1,iret,'TYPO')
                   kx=nint(rtype)
                   IF (kx/=code_pm10_ncbufr) then
                      cycle
                   else
                      kx=code_pm10_anowbufr
                   endif
                else
                   cycle
                endif

                do nc=1,nconvtype
                   if(trim(ioctype(nc)) == trim(dtype) .and. &
                        kx == ictype(nc) .and. icuse(nc) > minuse)then
                      lexist = .true.
                      exit fileloopanow_pm10
                   end if
                end do
             end do
             nread = nread + 1
          enddo fileloopanow_pm10

          if (lexist) then
             write(6,*)'found pm10 in anow bufr'
          else
             write(6,*)'did not find pm10 in anow bufr'
          endif


       end if
      end if

      call closbf(lnbufr)
      close(lnbufr)
  end if
  if(lexist)then
      write(6,*)'read_obs_check: bufr file date is ',idate,trim(filename),' ',dtype,jsatid
  else
      write(6,*)'read_obs_check: bufr file ',dtype,jsatid,' not available ',trim(filename)
  end if
  return
end subroutine read_obs_check

subroutine read_obs(ndata,mype)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:    read_obs              read, select, reformat obs data
!   prgmmr: parrish          org: np22                date: 1990-10-07
!
! abstract:  This routine is a driver for routines which read different
!            types of observational data.
!
! program history log:
!   1990-10-07  parrish
!   1998-05-15  weiyu yang 
!   1999-08-24  derber, j., treadon, r., yang, w., first frozen mpp version
!   2004-06-16  treadon - update documentation
!   2004-07-23  derber - modify to include conventional sst
!   2004-07-29  treadon - add only to module use, add intent in/out
!   2005-01-20  okamoto - add calling read_ssmi
!   2005-06-14  wu      - add OMI oz
!   2005-07-06  derber - add mhs, hirs/4 and ears data 
!   2005-08-02  derber - modify to use convinfo file
!   2005-09-08  derber - modify to use input group time window
!   2005-09-20  xu & pawlak - modify calling read_ssmis and read_amsre
!   2005-09-28  derber - modify to simplify obs handling      
!   2005-10-17  derber - pass obs_load1 into read_amsre and read_ssmis 
!   2005-10-18  treadon - remove obs_load and obs_load1
!   2005-10-20  kazumori - modify to read real AMSR-E data
!   2005-11-28  derber move determination of which ob data sets to read inside read_obs
!   2005-11-14  li, xu - modify sst obs read and add avhrr gac 1b obs read
!   2006-01-25  treadon - remove read_ieeetovs
!   2006-02-01  parrish - add getsfc and destroy_sfc for full surface fields
!   2006-02-03  derber  - modify for new obs control and obs count
!   2005-02-03  treadon - gather guess 3d pressure to full grid array
!   2006-02-08  derber  - modify to use new convinfo module
!   2006-02-01  liu - add ssu
!   2006-02-24  derber  - modify to take advantage of convinfo module
!   2006-03-07  derber - consolidate processing of 1x1 and 5x5 goessndr
!   2006-04-20  kistler - moved conv_read to gsisub
!   2006-05-25  treadon - rename goesimg and goes_img and pcp_ssm/i as
!                         pcp_ssmi to make consistent with other obstype
!   2006-09-20  treadon - add mpi_io for select data file (obstype)s
!   2006-10-12  treadon - remove tendsflag check for pcp data (now in gsimain)
!   2007-02-21  sienkiewicz - bring in changes for MLS ozone
!   2007-03-15       su - add reading conventional error table option
!   2007-06-05  treadon - restructure mpi_querybf section to improve efficiency
!   2007-10-03  todling - skip most of this in 4dvar inner loop
!   2008-03-28       wu - move random seed for perturb_obs from setuprhsall
!   2008-04-18  safford - rm unused vars and uses
!   2008-05-01    h.liu - add gome ozone
!   2008-06-20   derber - move destroy_sfc to this routine 
!   2008-09-08   lueken - merged ed''s cahnges into q1fy09 code
!   2008-12-30  todling - handle inquire for diff versions of fortran
!   2009-01-05  todling - need tendency alloc in observer mode
!   2009-01-23  todling - echo surface state info 
!   2009-03-18  meunier - add a if statement to read lagrangian data
!   2009-08-19  guo     - moved destroy_sfc_grid() to observer_finalize().
!   2009-12-20  gayno - modify argument lists so that fov-based surface
!                       calculation may be used.
!   2010-03-29  hu    - add code to read in cloud observations  including:
!                            prepbufr (metar, nesdis cloud product)
!                            radar reflectivity, lightning, NASA LaRC cloud
!   2010-04-01  treadon - move strip and reorder to gridmod
!   2010-04-08  hliu - add seviri
!
!   2010-04-05  huang   - add aero and modis for reading modis aod from satellite
!                         currently read BUFR file only
!   2010-04-22  tangborn - read for carbon monoxide
!   2010-08-23  tong    - add calcuation of hgtl_full used in read_radar.f90
!   2011-04-02  li       - add nst_gsi, getnst and destroy_nst
!   2011-05-20  mccarty  - add cris/atms handling
!   2011-05-26  todling  - add call to create_nst
!   2012-03-07  akella   - set NST variables; init & destroy in guess_grids 
!                          [see create_sfc_grids & destroy_sfc_grids] 
!   2012-05-16  todling  - protect call to prebufr when NST is on (should be mods)
!   2012-09-08  wargan   - add OMI with efficiency factors
!   2013-01-26  parrish - WCOSS debug compile fails--extra arguments in call read_aerosol.
!                         Commented out extra line of arguments not used.
!   2013-02-13  eliu     - turn off parallel I/O for SSMIS (due to the need to
!                          do spatial averaging for noise reduction) 
!   2013-06-01  zhu     - add mype_airobst to handle aircraft temperature bias correction 
!   2013-08-08  s.liu     - add read NASA_LaRC_cloud product
!   2013-10-25  todling - reposition ltosi and others to commvars
!   2014-01-01  xli     - add option to read NSST marine BUFR data file nsstbufr (on the
!                         top of prepbufr and modsbufr)
!   2014-02-03  guo     - Hid processing (read) of non-EMC ozone obstypes
!                         through module m_extOzone, separated from read_ozone.
!                       - Added some -do- and -if- construct names, for easier
!                         understanding of the code.
!   2014-06-19  carley/zhu - Add tcamt and lcbas
!   2014-11-12  carley  - Add call to read goes imager sky cover data for tcamt
!   2014-12-03  derber - modify for no radiance cases and read processor for
!                        surface fields
!   2015-01-16  ejones  - added saphir, gmi, and amsr2 handling
!   2015-03-23  zaizhong ma - add Himawari-8 ahi
!   2015-05-30  li     - modify for no radiance cases but sst (nsstbufr) and read processor for
!                        surface fields (use_sfc = .true. for data type of sst),
!                        to use deter_sfc in read_nsstbufr.f90)
!   2015-07-10  pondeca - add cloud ceiling height (cldch)
!   2015-08-12  pondeca - add capability to read min/maxT obs from ascii file
!   2015-08-20  zhu     - use centralized radiance info from radiance_mod to specify
!                         all-sky and aerosol usages in radiance assimilation
!   2015-09-04  J. Jung - Added mods for CrIS full spectral resolution (FSR)
!   2015-10-19  lippi   - Added logic to read l2rw or rw radial winds.
!   2016-03-02  s.liu/carley - remove use_reflectivity and use i_gsdcldanal_type
!   2016-04-28  J. Jung - added logic for RARS and direct broadcast data from NESDIS/UW.
!   2016-05-05  pondeca - add 10-m u-wind and v-wind (uwnd10m, vwnd10m)
!   2016-09-xx  CAPS(G. Zhao) - read mosaic dbz in BUFR (read_Radarref_directDA)
!   2016-09-19  Guo     - replaced open(obs_input_common) with "call unformatted_open(obs_input_common)"
!   2017-05-12  Y. Wang and X. Wang - add multi-interface to read in dBZ (nc) and radial velocity (ascii)
!   2016-12-14  lippi   - Fixed bug of using observations twice when both
!                         l2rwbufr and radarbufr are in the OBS_INPUT table.
!                         Changed the dsis entries for l2rwbufr and radarbufr to
!                         l2rw and l3rw respectively. Also make use of nml
!                         option vadwnd_l2rw_qc. 
!   2017-08-31  Li      - move gsi_nstcoupler_init & gsi_nstcoupler_set to getsfc in sathin.F90
!                       - move gsi_nstcoupler_final from create_sfc_grids to here
!   2017-12-05  Wargan  - added OMPS ozone
!   2018-01-23 Apodaca  - add GOES/GLM lightning data
!   2018-07-09 Todlng   - move gsi_nstcoupler_final to destroy_sfc (consistency)
!   2019-01-15  Li      - add to handle mbuoyb
!   2019-03-27  h. liu   - add abi
!   2022-05-06 Hoover   - add HU-3 ASCAT wind read via read_hu3ascat
!   
!
!   input argument list:
!     mype     - mpi task id
!
!   output argument list:
!     ndata(*,1)- number of prefiles retained for further processing
!     ndata(*,2)- number of observations read
!     ndata(*,3)- number of observations keep after read
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$  end documentation block
    use kinds, only: r_kind,i_kind,i_llong,r_double
    use gridmod, only: nlon,nlat,nsig,iglobal,ijn,itotsub,lat1,lon1,&
         displs_g,strip,reorder
    use general_commvars_mod, only: ltosi,ltosj
    use obsmod, only: iadate,ndat,time_window,dplat,dsfcalc,dfile,dthin, &
           dtype,dval,dmesh,obsfile_all,ref_obs,nprof_gps,dsis,ditype,&
           perturb_obs,lobserver,lread_obs_save,obs_input_common, &
           reduce_diag,nobs_sub,dval_use,hurricane_radar,l2rwthin 
    use gsi_nstcouplermod, only: nst_gsi
!   use gsi_nstcouplermod, only: gsi_nstcoupler_set
    use hdraobmod, only: read_hdraob,nhdt,nhdq,nhduv,nhdps,hdtlist,hdqlist,hduvlist,hdpslist,nodet,nodeq,nodeuv,nodeps
    use qcmod, only: njqc,vadwnd_l2rw_qc,nvqc
    use gsi_4dvar, only: l4dvar
    use satthin, only: super_val,super_val1,superp,makegvals,getsfc,destroy_sfc
    use mpimod, only: ierror,mpi_comm_world,mpi_sum,mpi_max,mpi_rtype,mpi_integer,npe,&
         setcomm
    use constants, only: one,zero,izero
    use converr, only: converr_read
    use converr_ps, only: converr_ps_read
    use converr_q, only: converr_q_read
    use converr_t, only: converr_t_read
    use converr_uv, only: converr_uv_read
    use converr_pw, only: converr_pw_read
    use convb_ps,only: convb_ps_read
    use convb_q,only:convb_q_read
    use convb_t,only:convb_t_read
    use convb_uv,only:convb_uv_read
    use pvqc,only: readvqcdatfile
    use guess_grids, only: ges_prsl,geop_hgtl,ntguessig
    use radinfo, only: nusis,iuse_rad,jpch_rad,diag_rad
    use insitu_info, only: mbuoy_info,mbuoyb_info,read_ship_info
    use aeroinfo, only: nusis_aero,iuse_aero,jpch_aero,diag_aero
    use ozinfo, only: nusis_oz,iuse_oz,jpch_oz,diag_ozone
    use pcpinfo, only: npcptype,nupcp,iusep,diag_pcp
    use convinfo, only: nconvtype,ioctype,icuse,diag_conv,ithin_conv
    use chemmod, only : oneobtest_chem,oneob_type_chem,oneobschem
    use lightinfo, only: nlighttype,iuse_light,diag_light
    use aircraftinfo, only: aircraft_t_bc,aircraft_t_bc_pof,aircraft_t_bc_ext,mype_airobst
    use gsi_io, only: mype_io
    use rapidrefresh_cldsurf_mod, only: i_gsdcldanal_type
    use radiance_mod, only: rad_obs_type,radiance_obstype_search

    use m_extOzone, only: is_extOzone
    use m_extOzone, only: extOzone_read
    use mpeu_util, only: warn
    use gsi_unformatted, only: unformatted_open

    use mrmsmod,only: l_mrms_sparse_netcdf
    use directDA_radaruse_mod, only: l_use_dbz_directDA

    implicit none

!   Declare passed variables
    integer(i_kind)                  ,intent(in   ) :: mype
    integer(i_kind),dimension(ndat,3),intent(  out) :: ndata

!   Declare local parameters
    integer(i_llong),parameter:: lenbuf=8388608_i_llong  ! lenbuf=8*1024*1024

!   Declare local variables
    logical :: lexist,ssmis,amsre,sndr,hirs,avhrr,lexistears,lexistdb,use_prsl_full,use_hgtl_full
    logical :: use_sfc,nuse,use_prsl_full_proc,use_hgtl_full_proc,seviri,mls,abi
    logical,dimension(ndat):: belong,parallel_read,ears_possible,db_possible
    logical :: modis,use_sfc_any
    logical :: acft_profl_file
    character(10):: obstype,platid
    character(22):: string
    character(120):: infile
    character(20):: sis
    integer(i_kind) i,j,k,ii,nmind,lunout,isfcalc,ithinx,ithin,nread,npuse,nouse
    integer(i_kind) nprof_gps1,npem1,krsize,len4file,npemax,ilarge,nlarge,npestart
    integer(i_llong) :: lenbytes
    integer(i_kind):: npetot,npeextra,mmdat,nodata
    integer(i_kind):: iworld,iworld_group,next_mype,mm1,iix
    integer(i_kind):: mype_root
    integer(i_kind),dimension(8):: nhd,nhd1
    integer(i_kind):: minuse,lunsave,maxproc,minproc
    integer(i_kind),dimension(ndat):: npe_sub,npe_sub3,mpi_comm_sub,mype_root_sub,npe_order
    integer(i_kind),dimension(ndat):: ntasks1,ntasks
    integer(i_kind),dimension(ndat):: read_rec1,read_rec
    integer(i_kind),dimension(ndat):: read_ears_rec1,read_ears_rec
    integer(i_kind),dimension(ndat):: read_db_rec1,read_db_rec
    integer(i_kind),dimension(ndat,3):: ndata1
    integer(i_kind),dimension(npe,ndat):: mype_work,nobs_sub1
    integer(i_kind),dimension(npe,ndat):: mype_sub
    integer(i_kind),allocatable,dimension(:):: nrnd
    integer(i_kind):: nmls_type,mype_io_sfc
    integer(i_kind):: iread,ipuse,iouse

    real(r_kind) gstime,val_dat,rmesh,twind,rseed
    real(r_kind),allocatable,dimension(:) :: prslsm,hgtlsm,work1
    real(r_kind),allocatable,dimension(:,:,:):: prsl_full,hgtl_full

    type(rad_obs_type) :: radmod

    data lunout / 81 /
    data lunsave  / 82 /

!*****************************************************************************

!   Set analysis time and allocate/initialize arrays and variables
    call w3fs21(iadate,nmind)
    gstime=real(nmind,r_kind)
    allocate(nobs_sub(npe,ndat))
    nobs_sub = 0
    nobs_sub1 = 0

    call makegvals
    do ii=1,ndat
       ndata1(ii,1)=0
       ndata1(ii,2)=0
       ndata1(ii,3)=0
       ntasks1(ii) =0
       parallel_read=.false.
    end do
    npem1=npe-1
    nprof_gps1=0

    if(njqc) then
       call converr_ps_read(mype)
       call converr_q_read(mype)
       call converr_t_read(mype)
       call converr_uv_read(mype)
       call converr_pw_read(mype)
       call convb_ps_read(mype)
       call convb_q_read(mype)
       call convb_t_read(mype)
       call convb_uv_read(mype)
    else
       call converr_read(mype)
    endif
    if(nvqc) call readvqcdatfile('vqctp001.dat',20,10,20,10,200,2)

!   Optionally set random seed to perturb observations
    if (perturb_obs) then
       rseed=iadate(4)+iadate(3)*100+iadate(2)*10000+iadate(1)*1000000+mype
       call random_seed(size=krsize)
       allocate(nrnd(krsize))
       do i=1,krsize
          nrnd(i)=rseed
       end do
       call random_seed(put=nrnd)
       deallocate(nrnd)
    endif

!   Set number of high definition stations to zero
    nhdt=izero
    nhdq=izero
    nhduv=izero
    nhdps=izero
    nodet=izero
    nodeq=izero
    nodeuv=izero
    nodeps=izero

!   Set data class and number of reader tasks.  Set logical flag to indicate 
!   type type of GPS data (if present)
    ii=0
    ref_obs = .false.    !.false. = assimilate GPS bending angle
    ears_possible = .false.
    db_possible = .false.
    nmls_type=0
    read_rec1 = 0
    read_ears_rec1=0
    read_db_rec1=0
    do i=1,ndat
       obstype=dtype(i)                   !     obstype  - observation types to process
       amsre= index(obstype,'amsre') /= 0
       ssmis= index(obstype,'ssmis') /= 0
       sndr = index(obstype,'sndr') /= 0
       hirs = index(obstype,'hirs') /= 0
       avhrr = index(obstype,'avhrr') /= 0
       modis = index(obstype,'modis') /= 0
       seviri = index(obstype,'seviri') /= 0
       abi = index(obstype,'abi') /= 0
       mls = index(obstype,'mls') /= 0
       if(obstype == 'mls20' ) nmls_type=nmls_type+1
       if(obstype == 'mls22' ) nmls_type=nmls_type+1
       if(obstype == 'mls30' ) nmls_type=nmls_type+1
       if(nmls_type>1) then
          write(6,*) '******ERROR***********: there is more than one MLS data type, not allowed, please check'
          call stop2(339)
       end if
       if (obstype == 't'  .or. obstype == 'uv' .or. &
           obstype == 'q'  .or. obstype == 'ps' .or. &
           obstype == 'pw' .or. obstype == 'spd'.or. &
           obstype == 'sst'.or. &
           obstype == 'tcp'.or. obstype == "lag".or. &
           obstype == 'dw' .or. obstype == 'rw' .or. &
           obstype == 'mta_cld' .or. obstype == 'gos_ctp' .or. &
           obstype == 'rad_ref' .or. obstype=='lghtn' .or. &
           obstype == 'larccld' .or. obstype == 'pm2_5' .or. obstype == 'pm10' .or. &
           obstype == 'gust' .or. obstype=='vis' .or. &
           obstype == 'pblh' .or. obstype=='wspd10m' .or. &
           obstype == 'td2m' .or. obstype=='mxtm' .or. &
           obstype == 'mitm' .or. obstype=='pmsl' .or. &
           obstype == 'howv' .or. obstype=='tcamt' .or. &
           obstype=='lcbas' .or. obstype=='cldch' .or. obstype == 'larcglb' .or. &
           obstype=='uwnd10m' .or. obstype=='vwnd10m' .or. obstype=='dbz' ) then
          ditype(i) = 'conv'
       else if (obstype == 'swcp' .or. obstype == 'lwcp') then
          ditype(i) = 'wcp'
       else if( hirs   .or. sndr      .or.  seviri .or. abi .or.        &
               obstype == 'airs'      .or. obstype == 'amsua'     .or.  &
               obstype == 'msu'       .or. obstype == 'iasi'      .or.  &
               obstype == 'amsub'     .or. obstype == 'mhs'       .or.  &
               obstype == 'hsb'       .or. obstype == 'goes_img'  .or.  &
               obstype == 'ahi'       .or. avhrr                  .or.  &
               amsre  .or. ssmis      .or. obstype == 'ssmi'      .or.  &
               obstype == 'ssu'       .or. obstype == 'atms'      .or.  &
               obstype == 'cris'      .or. obstype == 'cris-fsr'  .or.  &
               obstype == 'amsr2'     .or.  &
               obstype == 'gmi'       .or. obstype == 'saphir'   ) then
          ditype(i) = 'rad'
       else if (is_extOzone(dfile(i),obstype,dplat(i))) then
          ditype(i) = 'ozone'
       else if (obstype == 'sbuv2' &
           .or. obstype == 'omi' &
           .or. obstype == 'ompstc8' &
           .or. obstype == 'ompsnp' &
           .or. obstype == 'gome' &
           .or. index(obstype, 'omps') /= 0 &
           .or. mls &
           ) then
          ditype(i) = 'ozone'
       else if (obstype == 'mopitt') then
          ditype(i) = 'co'
       else if (index(obstype,'pcp')/=0 )then
          ditype(i) = 'pcp'
       else if (obstype == 'gps_ref' .or. obstype == 'gps_bnd') then
          ditype(i) = 'gps'
       else if ( index(obstype,'aod') /= 0 ) then
          ditype(i) = 'aero'
       else if (obstype == 'goes_glm') then
          ditype(i) = 'light'
       else
          write(6,*)'READ_OBS:  ***ERROR*** - unknown ob type ',trim(obstype)
       end if

!   Set data class and number of reader tasks.  Set logical flag to indicate 
!   type type of GPS data (if present)
       if (index(dtype(i),'gps_ref') /= 0) ref_obs = .true.

!   Check info files to see if data is read.

       nuse=.false.
       minuse=-1
       if(ditype(i) == 'conv')then
          if(diag_conv .and. .not. reduce_diag)minuse=-2
          do j=1,nconvtype
             if(trim(dtype(i)) == trim(ioctype(j)) .and. icuse(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'rad')then
          if(diag_rad .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_rad
             if(trim(dsis(i)) == trim(nusis(j)) .and. iuse_rad(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'ozone')then
          if(diag_ozone .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_oz
             if(trim(dsis(i)) == trim(nusis_oz(j)) .and. iuse_oz(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'pcp')then
          if(diag_pcp .and. .not. reduce_diag)minuse=-2
          do j=1,npcptype
             if(trim(dsis(i)) == trim(nupcp(j)) .and. iusep(j) > minuse)nuse=.true.
          end do
       else if(ditype(i) == 'aero')then
          if(diag_aero .and. .not. reduce_diag)minuse=-2
          do j=1,jpch_aero
             if(trim(dsis(i)) == trim(nusis_aero(j)) .and. iuse_aero(j) > minuse)nuse=.true.
          end do
        else if(ditype(i) == 'light')then
          if(diag_light .and. .not. reduce_diag)minuse=-2
          do j=1,nlighttype
             if(iuse_light(j) > minuse) nuse=.true.
          end do
       else
          nuse=.true.
       end if

       if(nuse)then

!     Control parallel read for each ob type (currently just rad obs).  
!     To remove parallel read comment out line.
          ithin=dthin(i)
          if(ithin > 0 )then
            if(dmesh(ithin) > one)then
             if(hirs)then
                parallel_read(i)= .true.
             else if(obstype == 'amsua')then
                parallel_read(i)= .true.
             else if(obstype == 'airs' )then
                parallel_read(i)= .true.
             else if(obstype == 'iasi')then
                parallel_read(i)= .true.
             else if(obstype == 'amsub')then
                parallel_read(i)= .true.
             else if(obstype == 'mhs' )then
                parallel_read(i)= .true.
             else if(sndr )then
                parallel_read(i)= .true.
! N.B. ATMS must be run on one processor for the filtering code to work.
             else if(obstype == 'atms')then
!                 parallel_read(i)= .true.
             else if(ssmis)then
!               parallel_read(i)= .true.  
             else if(seviri)then
                parallel_read(i)= .true.
             else if(abi)then
                parallel_read(i)= .true.
             else if(obstype == 'cris' .or. obstype == 'cris-fsr')then
                parallel_read(i)= .true.
             else if(avhrr)then
                parallel_read(i)= .true.
             else if(amsre)then
                parallel_read(i)= .true.
             else if(obstype == 'goes_img' )then
                parallel_read(i)= .true.
             else if(obstype == 'ahi' )then
                parallel_read(i)= .true.
             else if(obstype == 'hsb' )then
                parallel_read(i)= .true.
             else if(obstype == 'ssmi' )then
                parallel_read(i)= .true.
             else if(obstype == 'ssu' )then
                parallel_read(i)= .true.
             else if(obstype == 'amsr2')then    
!                parallel_read(i)= .true.     ! turn parallel read off for spatial averaging
             else if(obstype == 'gmi')then
!                parallel_read(i)= .true.     ! turn parallel read off for spatial averaging
!   Parallel read for SAPHIR not currently working. Leave parallel read off.
!             else if(obstype == 'saphir')then
!                parallel_read(i)= .true.

             end if
           end if
          end if
! direct broadcast from EUMETSAT (EARS)
          ears_possible(i) = ditype(i) == 'rad'  .and. & 
                  (obstype == 'amsua' .or. obstype == 'amsub' .or. & 
                   obstype == 'mhs'   .or. obstype == 'hirs3' .or. &
                   obstype == 'cris'  .or. obstype == 'cris-fsr' .or. &
                   obstype == 'iasi'  .or. obstype == 'atms') .and. &
                  (dplat(i) == 'n17' .or. dplat(i) == 'n18' .or. & 
                   dplat(i) == 'n19' .or. dplat(i) == 'npp' .or. &
                   dplat(i) == 'n20' .or. &
                   dplat(i) == 'metop-a' .or. dplat(i) == 'metop-b' .or. &
                   dplat(i) == 'metop-c') 
! direct broadcast from NESDIS/UW
          db_possible(i) = ditype(i) == 'rad'  .and.       & 
                  (obstype == 'amsua' .or.  obstype == 'amsub' .or.  & 
                   obstype == 'mhs' .or. obstype == 'atms' .or. &
                   obstype == 'cris' .or. obstype == 'cris-fsr' .or. &
                   obstype == 'iasi') .and. &
                  (dplat(i) == 'n17' .or. dplat(i) == 'n18' .or. & 
                   dplat(i) == 'n19' .or. dplat(i) == 'npp' .or. &
                   dplat(i) == 'n20' .or. &
                   dplat(i) == 'metop-a' .or. dplat(i) == 'metop-b' .or. &
                   dplat(i) == 'metop-c') 

!   Inquire data set to deterimine if input data available and size of dataset
          ii=ii+1
          if (ii>npem1) ii=0
          if(mype==ii)then
             call gsi_inquire(lenbytes,lexist,trim(dfile(i)),mype)
             call read_obs_check (lexist,trim(dfile(i)),dplat(i),dtype(i),minuse,read_rec1(i))
             
!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

             if(.not. lexist)read_rec1(i) = 999999
             len4file=lenbytes/4
             if (ears_possible(i))then

                call gsi_inquire(lenbytes,lexistears,trim(dfile(i))//'ears',mype)
                call read_obs_check (lexistears,trim(dfile(i))//'ears',dplat(i),dtype(i),minuse, &
                    read_ears_rec1(i))

!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

                if(.not. lexistears)read_ears_rec1(i) = 999999
                lexist=lexist .or. lexistears
                len4file=len4file+lenbytes/4
             else
               read_ears_rec1(i) = 999999
             end if
             if (db_possible(i))then

                call gsi_inquire(lenbytes,lexistdb,trim(dfile(i))//'_db',mype)
                call read_obs_check (lexistdb,trim(dfile(i))//'_db',dplat(i),dtype(i),minuse, &
                    read_db_rec1(i))

!   If no data set starting record to be 999999.  Note if this is not large
!   enough code should still work - just does a bit more work.

                if(.not. lexistdb)read_db_rec1(i) = 999999
                lexist=lexist .or. lexistdb
                len4file=len4file+lenbytes/4
             else
               read_db_rec1(i) = 999999
             end if

 
             if(lexist) then
!      Initialize number of reader tasks to 1.  For the time being
!      only allow number of reader tasks >= 1 for select obstype.

                ntasks1(i)=1
                if(parallel_read(i)) then

!  Allow up to 16 processors/file increase loop bounds to increase number of processors allowed
                   do j=1,4
                      if(len4file < lenbuf)exit
                      ntasks1(i)=2*ntasks1(i)
                      len4file=len4file/2
                   end do
!               if(ntasks1(i)*lenbuf < len4file) ntasks1(i)=ntasks1(i)+1
                end if
             end if
          end if
       else
          if(mype == 0)write(6,*) 'data type ',dsis(i), &
                'not used in info file -- do not read file ',trim(dfile(i))
       end if
    end do


!   Distribute optimal number of reader tasks to all mpi tasks
    call mpi_allreduce(ntasks1,ntasks,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror)
    call mpi_allreduce(read_rec1,read_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 
    call mpi_allreduce(read_ears_rec1,read_ears_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 
    call mpi_allreduce(read_db_rec1,read_db_rec,ndat,mpi_integer,mpi_sum,mpi_comm_world,ierror) 

!   Limit number of requested tasks per type to be <= total available tasks
    npemax=0
    npetot=0
    do i=1,ndat
       if (ntasks(i)>npe) then
          write(6,*)'read_obs:  ***WARNING*** i=',i,' dtype=',dtype(i),' dsis=',dsis(i),&
               ' requested ntasks=',ntasks(i),' > npe=',npe,' reset ntasks=',npe
          ntasks(i)=npe
       endif
       npe_sub(i)=ntasks(i)
       npetot=npetot+npe_sub(i)
       npemax=max(npemax,npe_sub(i))
    end do

    if(l4dvar.and.(.not.lobserver)) then
!_RTod use_sfc=.false.
!_RTod call getsfc(mype,use_sfc)
       return
    endif
    
    npeextra=0
    if(mod(npetot,npe) > 0) npeextra=npe-mod(npetot,npe)
    maxproc=32
    if(npeextra > 0)then
       if(mype == 0)write(6,*) ' number of extra processors ',npeextra
       extraloop: do j=1,npeextra
          npe_sub3=ntasks
          minproc=999999
          do i=1,ndat
            if(ntasks(i) > 0 .and.  parallel_read(i))minproc=min(minproc,ntasks(i))
          end do
          if(npeextra < minproc) exit extraloop
          iix=minproc
          do ii=1,6
             do i=1,ndat
                if(iix == npe_sub3(i) .and. parallel_read(i))then
                   if(ntasks(i) <= npeextra .and. ntasks(i) < maxproc)then
                      npeextra=npeextra-ntasks(i)
                      ntasks(i)=2*ntasks(i)
                      if(npeextra < iix)cycle extraloop
                   end if
                end if
             end do
             iix=2*iix
             if(iix >= maxproc) cycle extraloop
          end do
       end do extraloop
    end if

!   Set up locations of first processor

    ilarge=0
    npestart=0
    npe_sub3=npe_sub
    mype_root_sub=0
    mmdat=0
    loopx: do j=1,ndat
       nlarge=0
       do i=1,ndat
          if(npe_sub3(i) > nlarge .and. npe_sub3(i)+npestart <= npe)then
             ilarge=i
             nlarge=npe_sub3(i)
          end if
       end do
       if(nlarge == 0)exit loopx
       npe_order(j)=ilarge
       mype_root_sub(ilarge)=npestart
       npestart=npestart+npe_sub3(ilarge)
       mmdat=mmdat+1
       npe_sub3(ilarge)=0
       if(npestart + minval(npe_sub3, mask=npe_sub3>0)>= npe) npestart=0
    end do loopx

!   Define sub-communicators for each data file
    mm1=mype+1
    belong=.false.
    mype_sub=-999
    mype_root=0
    next_mype=0
    do ii=1,mmdat
       i=npe_order(ii)
       if(npe_sub(i) > 0)then
          next_mype=mype_root_sub(i)
          do k=1,npe_sub(i)
             mype_work(k,i) = next_mype
             mype_sub(mype_work(k,i)+1,i)=k-1
             if(next_mype == mype)belong(i) = .true.
             next_mype = next_mype + 1
             if (next_mype>npem1) next_mype=0
          end do               

          call setcomm(iworld,iworld_group,npe_sub(i),mype_work(1,i),&
                 mpi_comm_sub(i),ierror)
       end if

    end do
    mype_airobst = mype_root
    do ii=1,mmdat
       i=npe_order(ii)
       if(mype == 0 .and. npe_sub(i) > 0) write(6,'(1x,a,i4,1x,a,1x,2a,2i4,1x,i6,1x,i6,1x,i6)') &
        'READ_OBS:  read ',i,dtype(i),dsis(i),' using ntasks=',ntasks(i),mype_root_sub(i), & 
               read_rec(i),read_ears_rec(i),read_db_rec(i)

       acft_profl_file = index(dfile(i),'_profl')/=0
       if ((aircraft_t_bc_pof .or. aircraft_t_bc_ext .or. &
          (aircraft_t_bc .and. acft_profl_file)) .and. dtype(i) == 't') &
                   mype_airobst = mype_root_sub(i)

    end do


    use_prsl_full=.false.
    use_hgtl_full=.false.
    use_sfc=.false.
    use_prsl_full_proc=.false.
    use_hgtl_full_proc=.false.
    mype_io_sfc=mype_io
    do ii=1,mmdat
       i=npe_order(ii)
       if(ditype(i) =='conv')then
          obstype=dtype(i)
          if (obstype == 't' .or. obstype == 'q'  .or. &
              obstype == 'uv' .or. obstype == 'wspd10m' .or. &
              obstype == 'uwnd10m' .or. obstype == 'vwnd10m') then
              use_prsl_full=.true.
              if(belong(i))use_prsl_full_proc=.true.
          else
            do j=1,nconvtype
               if(obstype == trim(ioctype(j)) .and. ithin_conv(j) > 0)then
                  use_prsl_full=.true.
                  if(belong(i))use_prsl_full_proc=.true.
               end if
            end do
          end if
          if(dfile(i) == 'uprair')then
             use_prsl_full=.true.
             use_hgtl_full = .true.
             if(belong(i))use_hgtl_full_proc=.true.
             if(belong(i))use_prsl_full_proc=.true.
          else if(obstype == 'rw')then
             use_hgtl_full=.true.
             if(belong(i))use_hgtl_full_proc=.true.
          else if(obstype == 'dbz')then
             use_hgtl_full=.true.
             if(belong(i))use_hgtl_full_proc=.true.
          end if
          if(obstype == 'sst')then
            if(belong(i))use_sfc=.true.
          endif
       else if(ditype(i) == 'rad' )then
          if(belong(i)) use_sfc=.true.
       end if
    end do
    use_sfc_any=.false.
    loop: do ii=1,mmdat
       i=npe_order(ii)
       if(ditype(i) == 'rad' .or. ditype(i) == 'sst')then
          mype_io_sfc=mype_root_sub(i)
          use_sfc_any=.true.
          exit loop
       end if
    end do loop
    if(use_sfc_any .and. mype == mype_io)use_sfc=.true.

!   Create full horizontal surface fields from local fields in guess_grids
    call getsfc(mype,mype_io_sfc,use_sfc,use_sfc_any)

    if(mype == mype_io) call prt_guessfc2('sfcges2',use_sfc)

!   Get guess 3d pressure on full grid
    allocate(work1(max(iglobal,itotsub)),prslsm(lat1*lon1))
    if(use_prsl_full)then
       if(use_prsl_full_proc)then
          allocate(prsl_full(nlat,nlon,nsig))
       else
          allocate(prsl_full(1,1,1))
       end if
       do k=1,nsig
          call strip(ges_prsl(:,:,k,ntguessig),prslsm)
          call mpi_allgatherv(prslsm,ijn(mype+1),mpi_rtype,&
               work1,ijn,displs_g,mpi_rtype,mpi_comm_world,ierror)
          if(use_prsl_full_proc)then
             call reorder(work1,1,1)
             do ii=1,iglobal
                i=ltosi(ii)
                j=ltosj(ii)
                prsl_full(i,j,k)=work1(ii)
             end do
          end if
       end do
    else
       allocate(prsl_full(1,1,1))
    end if
!   Get guess 3d geopotential height on full grid
    if(use_hgtl_full)then
       allocate(hgtlsm(lat1*lon1))
       if(use_hgtl_full_proc)then
          allocate(hgtl_full(nlat,nlon,nsig))
       else
          allocate(hgtl_full(1,1,1))
       end if
       do k=1,nsig
          call strip(geop_hgtl(:,:,k,ntguessig),hgtlsm)
          call mpi_allgatherv(hgtlsm,ijn(mype+1),mpi_rtype,&
               work1,ijn,displs_g,mpi_rtype,mpi_comm_world,ierror)
          if(use_hgtl_full_proc)then
             call reorder(work1,1,1)
             do ii=1,iglobal
                i=ltosi(ii)
                j=ltosj(ii)
                hgtl_full(i,j,k)=work1(ii)
             end do
           end if
       end do
       deallocate(hgtlsm)
    else
      allocate(hgtl_full(1,1,1))
    end if
    deallocate(work1,prslsm)

!   Create moored buoy station ID
    call mbuoy_info(mype)

!   Create moored buoy station ID for mbuoyb with 7-digit station ID
    call mbuoyb_info(mype)

!   Create ships info(ID, Depth & Instrument)
    call read_ship_info(mype)

!   Loop over data files.  Each data file is read by a sub-communicator
    loop_of_obsdata_files: &
    do ii=1,mmdat

       i=npe_order(ii)
       task_belongs: &
       if (i > 0 .and. belong(i)) then

          platid=dplat(i)                    !     platid   - satellites to read
          obstype=dtype(i)                   !     obstype  - observation types to process
          infile=trim(dfile(i))              !     infile   - units from which to read data
          sis=dsis(i)                        !     sensor/instrument/satellite indicator
          val_dat=dval(i)                    !     weighting factors applied to super obs
          ithin=dthin(i)                     !     ithin    - flags to thin data
          ithinx=max(1,abs(ithin))
          rmesh=dmesh(ithinx)                !     rmesh    - thinning mesh sizes (km)
          twind=time_window(i)               !     time window (hours) for input group
          isfcalc=dsfcalc(i)                 !     method to calculate surface fields within fov
          nread=0
          nouse=0
          npuse=0

          if (mype_sub(mm1,i)==mype_root) then
             open(lunout,file=obsfile_all(i),form='unformatted')
             rewind(lunout)
          endif

!         Process conventional (prepbufr) data
          string="--"//trim(ditype(i))
          ditype_select: &
          if(ditype(i) == 'conv')then
             conv_obstype_select: &
             if (obstype == 't' .or. obstype == 'q'  .or. obstype == 'ps' .or. &
                 obstype == 'pw' .or. obstype == 'spd'.or. & 
                 obstype == 'gust' .or. obstype == 'vis'.or. &
                 obstype == 'td2m' .or. &
!                 obstype=='mxtm' .or. obstype == 'mitm' .or. &
!                 obstype=='howv' .or. obstype=='pmsl' .or. &    #howv #ww3 
                 obstype=='pmsl' .or. &
                 obstype == 'mta_cld' .or. obstype == 'gos_ctp' .or. &
                 obstype == 'lcbas' .or. obstype == 'cldch' ) then

!               Process flight-letel high-density data not included in prepbufr
                if ( index(infile,'hdobbufr') /=0 ) then
                  call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                                    prsl_full,nobs_sub1(1,i))
                  string='READ_FL_HDOB'
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
                else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'

                endif
             else if(obstype == 'howv') then
                 if ( index(infile,'satmar') /=0) then
                   
                    call read_satmar (nread, npuse, nouse                                  &
                                     , infile, obstype, lunout, gstime, twind, sis         &
                                     , nobs_sub1(1,i))
                    string='READ_SATMAR'
                 else 
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'

                 endif
             else if(obstype == 'mitm') then
                if ( index(infile,'mitmdat') /=0) then
                   call read_mitm_mxtm(nread,npuse,nouse,infile,obstype,lunout,gstime,sis, & 
                                       nobs_sub1(1,i))
                   string='READ_ASCII_MITM'
                 else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                 endif

             else if(obstype == 'mxtm') then
                if ( index(infile,'mxtmdat') /=0) then
                   call read_mitm_mxtm(nread,npuse,nouse,infile,obstype,lunout,gstime,sis, & 
                                       nobs_sub1(1,i))
                   string='READ_ASCII_MXTM'
                 else
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                 endif

!            Process total cloud amount (tcamt) in prepbufr -or- from goes imager sky cover products
             else if(obstype == 'tcamt') then
!             Process GOES Imager Sky Cover product separately from prepbufr-based sky cover obs
                if ( index(infile,'goessky') /=0 ) then
                   call read_goesimgr_skycover(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                        prsl_full,nobs_sub1(1,i))
                   string='READ_GOESIMGR_SKYCOVER'
                else
!              else read from prepbufr
                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,prsl_full, &
                         nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                end if

!             Process winds in the prepbufr
            else if(obstype == 'uv' .or. obstype == 'wspd10m' .or. &
                    obstype == 'uwnd10m' .or. obstype == 'vwnd10m') then
!             Process satellite winds which seperate from prepbufr
                if ( index(infile,'satwnd') /=0 ) then
                  call read_satwnd(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_SATWND'
!             Process high resolution radiosonde data
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
!             Process oscat winds which seperate from prepbufr
                elseif ( index(infile,'oscatbufr') /=0 ) then
                  call read_sfcwnd(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_SFCWND'
!             Process HU-3 ASCAT winds which are separate from prepbufr
                elseif ( index(infile,'hu3ascatbufr') /=0 ) then
                  call read_hu3ascat(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_HU3ASCAT'
!             Process rapidscat winds which seperate from prepbufr
                elseif ( index(infile,'rapidscatbufr') /=0 ) then
                  call read_rapidscat(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                     prsl_full,nobs_sub1(1,i))
                  string='READ_RAPIDSCAT'
                else if ( index(infile,'hdobbufr') /=0 ) then
                  call read_fl_hdob(nread,npuse,nouse,infile,obstype,lunout,gstime,twind,sis,&
                       prsl_full,nobs_sub1(1,i))
                  string='READ_FL_HDOB'
                else if (index(infile,'uprair') /=0)then
                   call read_hdraob(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,hgtl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_UPRAIR'
                else
                  call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                     prsl_full,nobs_sub1(1,i),read_rec(i))
                  string='READ_PREPBUFR'
                endif

!            Process conventional SST (nsstbufr, at this moment) data
             elseif ( obstype == 'sst' ) then
                string="--"//trim(ditype(i))//":sst:"//trim(platid)
                if ( platid == 'nsst') then
                   call read_nsstbufr(nread,npuse,nouse,gstime,infile,obstype, &
                        lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_NSSTBUFR'
                elseif ( platid == 'mods') then
                   call read_modsbufr(nread,npuse,nouse,gstime,infile,obstype, &
                        lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_MODSBUFR'
                else
                   if(nst_gsi>0)then
                      write(6,*)'read_obs: should not handle SST via read_prepbufr when NSST on'
                      call stop2(999)
                   endif

                   call read_prepbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis,&
                        prsl_full,nobs_sub1(1,i),read_rec(i))
                   string='READ_PREPBUFR'
                endif

!            Process radar reflectivity Mosaic
             else if (obstype == 'rad_ref' ) then
                call read_radarref_mosaic(nread,npuse,infile,obstype,lunout,twind,sis, &
                      nobs_sub1(1,i))
                string='READ_RADARREF_MOSAIC'

!            Process  lightning
             else if (obstype == 'lghtn' ) then
                if(i_gsdcldanal_type==2) then
                   call read_lightning(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                else if(i_gsdcldanal_type==1 .or. i_gsdcldanal_type==6 &
                        .or. i_gsdcldanal_type==3 .or. i_gsdcldanal_type==7) then
                   call read_lightning_grid(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                endif
                string='READ_LIGHTNING'

!            Process  NASA LaRC 
             ! for regional obs that are already mapped to analysis grid
             else if (obstype == 'larccld' ) then
                if(i_gsdcldanal_type==2) then
                   call read_NASA_LaRC_cloud(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                else if(i_gsdcldanal_type==1 .or. i_gsdcldanal_type==6 &
                        .or. i_gsdcldanal_type==3 .or. i_gsdcldanal_type==7) then
                   call read_nasa_larc(nread,npuse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                end if
                string='READ_NASA_LaRC'
             ! for global NASA LaRC obs 
             else if (obstype == 'larcglb' ) then
                call read_NASA_LaRC_cloud(nread,npuse,nouse,infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                string='READ_NASA_LaRC'

!            Process radar winds
             else if (obstype == 'rw') then
                if( trim(infile) == 'vr_vol' )then
                  call read_radar_wind_ascii(nread,npuse,nouse,infile,lunout,obstype,sis,&
                                  hgtl_full,nobs_sub1(1,i))
                  string='READ_RADAR_WIND'
                else if (hurricane_radar) then
                   if (sis == 'rw' ) then
                      write(6,*)'READ_OBS: radial wind,read_radar,dfile=',infile,',dsis=',sis
                      call read_radar(nread,npuse,nouse,infile,lunout,obstype,twind,sis,&
                                   hgtl_full,nobs_sub1(1,i))
                      string='READ_RADAR'
                   else if (sis == 'l2rw') then
                      if (l2rwthin)then 
                         call read_radar_l2rw(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i),hgtl_full) 
                         string='READ_RADAR_L2RW_NOVADQC'
                      else
                         write(6,*)'READ_OBS: radial wind,read_radar_l2rw_novadqc,dfile=',infile,',dsis=',sis
                         call read_radar_l2rw_novadqc(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i))
                         string='READ_RADAR_L2RW_NOVADQC'
                      end if
                   end if                  
                else
                   if (vadwnd_l2rw_qc) then
                      write(6,*)'READ_OBS: radial wind,read_radar,dfile=',infile,',dsis=',sis 
                     call read_radar(nread,npuse,nouse,infile,lunout,obstype,twind,sis,&
                                     hgtl_full,nobs_sub1(1,i))
                     string='READ_RADAR'
                   else if (sis == 'l2rw') then
                      write(6,*)'READ_OBS: radial wind,read_radar_l2rw_novadqc,dfile=',infile,',dsis=',sis
                     call read_radar_l2rw_novadqc(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i))
                     string='READ_RADAR_L2RW_NOVADQC'
                   end if
                end if
!            Process radar reflectivity from MRMS
             else if (obstype == 'dbz' ) then
                print *, "calling read_dbz"

                if(trim(infile)=='dbzobs.nc')then
                  call read_dbz_nc(nread,npuse,nouse,infile,lunout,obstype,sis,hgtl_full,nobs_sub1(1,i))
                  string='READ_dBZ'
                else if ( l_use_dbz_directDA ) then
                  call read_radarref_directDA(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                                           nobs_sub1(1,i))
                  string='READ_RADARREF_DIRECTDA'
                else
                  call read_dbz_mrms_detect_format(infile,l_mrms_sparse_netcdf)
                  if(l_mrms_sparse_netcdf) then
                     call read_dbz_mrms_sparse_netcdf(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                     string='READ_dbz_mrms_sparse_netcdf'
                  else
                     call read_dbz_mrms_netcdf(nread,npuse,nouse,infile,obstype,lunout,sis,nobs_sub1(1,i))
                     string='READ_dbz_mrms_netcdf'
                  endif
                end if

!            Process lagrangian data
             else if (obstype == 'lag') then
                call read_lag(nread,npuse,nouse,infile,lunout,obstype,&
                 &twind,gstime,sis)
                string='READ_LAG'

!            Process lidar winds
             else if (obstype == 'dw') then
                call read_lidar(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                     nobs_sub1(1,i))
                string='READ_LIDAR'

!            Process synthetic tc-mslp obs
             else if (obstype == 'tcp') then
                call read_tcps(nread,npuse,nouse,infile,obstype,lunout,sis, &
                     nobs_sub1(1,i))
                string='READ_TCPS'

             else if (obstype == 'pm2_5' .or. obstype == 'pm10') then

                if (oneobtest_chem .and. oneob_type_chem=='pm2_5') then
                   call oneobschem(nread,npuse,nouse,gstime,&
                        &infile,obstype,lunout,sis,nobs_sub1(1,i))
                   string='ONEOBSCHEM'
                else
                   call read_anowbufr(nread,npuse,nouse,gstime,&
                        &infile,obstype,lunout,twind,sis,nobs_sub1(1,i))
                   string='READ_ANOWBUFR'
                endif

!            Process pblh
             else if (obstype == 'pblh') then
                call read_pblh(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                    nobs_sub1(1,i))
                string='READ_PBLH'
             end if conv_obstype_select
!            Process swcp and lwcp
          else if (ditype(i) == 'wcp') then
             if ( obstype == 'swcp' .or. obstype == 'lwcp' ) then
                call read_wcpbufr(nread,npuse,nouse,infile,obstype,lunout,twind,sis, &
                   prsl_full,nobs_sub1(1,i),read_rec(i))
                string='READ_WCPBUFR'
             end if
          else if (ditype(i) == 'rad')then

             call radiance_obstype_search(obstype,radmod)

!            Process TOVS 1b data
             rad_obstype_select: &
             if (platid /= 'aqua' .and. (obstype == 'amsua' .or. &
                  obstype == 'amsub' .or. obstype == 'msu'   .or.  &
                  obstype == 'mhs'   .or. obstype == 'hirs4' .or.  &
                  obstype == 'hirs3' .or. obstype == 'hirs2' .or.  &
                  obstype == 'ssu' )) then
                call read_bufrtovs(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use,radmod)
                string='READ_BUFRTOVS'

!            Process atms data
             else if (obstype == 'atms') then
                call read_atms(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i),&
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use,radmod)
                string='READ_ATMS'

!            Process saphir data
             else if (obstype == 'saphir') then
                call read_saphir(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),dval_use)
                string='READ_SAPHIR'


!            Process airs data        
             else if(platid == 'aqua' .and. (obstype == 'airs' .or.   &
                  obstype == 'amsua'  .or.  obstype == 'hsb' ))then
                call read_airs(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AIRS'

!            Process iasi data
             else if(obstype == 'iasi')then
                call read_iasi(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use)
                string='READ_IASI'

!            Process cris data
             else if(obstype == 'cris' .or. obstype =='cris-fsr' )then
                call read_cris(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),nobs_sub1(1,i), &
                     read_rec(i),read_ears_rec(i),read_db_rec(i),dval_use)
                string='READ_CRIS'

!            Process GOES sounder data
!            Process raw or prepbufr files (1x1 or 5x5)
             else if (obstype == 'sndr' .or.                            &
                      obstype == 'sndrd1' .or. obstype == 'sndrd2' .or. &
                      obstype == 'sndrd3' .or. obstype == 'sndrd4') then
                call read_goesndr(mype,val_dat,ithin,rmesh,platid,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,gstime,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_GOESNDR'

!            Process ssmi data
             else if (obstype == 'ssmi' ) then
                call read_ssmi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SSMI'

!            Process amsre data
             else if ( obstype == 'amsre_low' .or. obstype == 'amsre_mid' .or. &
                       obstype == 'amsre_hig' ) then
                call read_amsre(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AMSRE'
                
!            Process ssmis data
             else if (obstype == 'ssmis'     .or. &
                      obstype == 'ssmis_las' .or. obstype == 'ssmis_uas' .or. &
                      obstype == 'ssmis_img' .or. obstype == 'ssmis_env' ) then
                call read_ssmis(mype,val_dat,ithin,isfcalc,rmesh,platid,gstime,&
                      infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                      mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                      nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SSMIS'

!            Process AMSR2 data
             else if(obstype == 'amsr2')then
                call read_amsr2(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i))
                string='READ_AMSR2'

!            Process GOES IMAGER RADIANCE  data
             else if(obstype == 'goes_img') then
                call read_goesimg(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_GOESMIMG'

!            Process GMI data
             else if (obstype == 'gmi') then
                call read_gmi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis,&
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),dval_use)
                string='READ_GMI'

!            Process Meteosat SEVIRI RADIANCE  data
             else if(obstype == 'seviri') then
                 call read_seviri(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_SEVIRI'
!            Process GOES-R ABI RADIANCE  data
             else if(obstype == 'abi') then
                call read_abi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_ABI'

        !    Process Himawari-8 AHI RADIANCE  data
             else if(obstype == 'ahi') then
                call read_ahi(mype,val_dat,ithin,rmesh,platid,gstime,&
                     infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                     mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i),  &
                     nobs_sub1(1,i),read_rec(i),dval_use)
                string='READ_AHI'


!            Process NAVY AVHRR RADIANCE  data
               else if(obstype == 'avhrr_navy') then
                  call read_avhrr_navy(mype,val_dat,ithin,rmesh,platid,gstime,&
                       infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                       mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                       nobs_sub1(1,i),read_rec(i),dval_use)
                  string='READ_AVH_NAVY'

  !            Process NESDIS AVHRR RADIANCE  data
               else if(obstype == 'avhrr') then
                  call read_avhrr(mype,val_dat,ithin,rmesh,platid,gstime,&
                       infile,lunout,obstype,nread,npuse,nouse,twind,sis, &
                       mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                       nobs_sub1(1,i),read_rec(i),dval_use)
                  string='READ_AVHRR'
               end if rad_obstype_select

!         Process ozone data
          else if (ditype(i) == 'ozone')then
             ozone_obstype_select: &
             if (is_extOzone(infile,obstype,dplat(i))) then

                call extOzone_read(infile,obstype,dplat(i),dsis(i), &
                   iread,ipuse,iouse, platid,gstime,lunout,twind,ithin,rmesh, &
                   nobs_sub1(:,i))
                string='extOzone_read'

                nread=nread+iread
                npuse=npuse+ipuse
                nouse=nouse+iouse

             else
                call read_ozone(nread,npuse,nouse,&
                   platid,infile,gstime,lunout,obstype,twind,sis,ithin,rmesh, &
                   nobs_sub1(1,i))
                string='READ_OZONE'
             endif ozone_obstype_select

!         Process co data
          else if (ditype(i) =='co')then 
             call read_co(nread,npuse,nouse,infile,gstime,lunout,obstype,sis, &
                  nobs_sub1(1,i))
             string='READ_CO'

!         Process precipitation             
          else if (ditype(i) == 'pcp')then
             call read_pcp(nread,npuse,nouse,gstime,infile,lunout,obstype,twind,sis, &
                  nobs_sub1(1,i))
             string='READ_PCP'

!         Process gps observations
          else if (ditype(i) == 'gps')then
             call read_gps(nread,npuse,nouse,infile,lunout,obstype,twind, &
                  nprof_gps1,sis,nobs_sub1(1,i))
             string='READ_GPS'

!         Process aerosol data
          else if (ditype(i) == 'aero' )then
             call read_aerosol(nread,npuse,nouse,&
                  platid,infile,gstime,lunout,obstype,twind,sis,ithin,rmesh, &
                  mype_root,mype_sub(mm1,i),npe_sub(i),mpi_comm_sub(i), &
                  nobs_sub1(1,i))
             string='READ_AEROSOL'

!         Process satellite lightning observations (e.g. GOES/GLM)                     
          else if(ditype(i) == 'light')then
               if (obstype == 'goes_glm' ) then
             call read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twind,sis)
             string='READ_GOESGLM'
               endif

          end if ditype_select

!         Accumulate data counts on "root" task
          if (mype_sub(mm1,i)==mype_root) then
             close(lunout)
             ndata1(i,1)=ndata1(i,1)+npuse
             ndata1(i,2)=ndata1(i,2)+nread
             ndata1(i,3)=ndata1(i,3)+nouse

             if(string(1:2)=='--') then
               call warn('read_obs','task without reader, i =',i)
               call warn('read_obs','                infile =',trim(infile))
               call warn('read_obs','             ditype(i) =',trim(ditype(i)))
               call warn('read_obs','               obstype =',trim(obstype))
               call warn('read_obs','                platid =',trim(platid))
               call warn('read_obs','                string =',trim(string))
             endif

             write(6, '(a,'': file='',a,'' type='',a,'' sis='',a,'' nread='',i10,&
                  '' ithin='',i2,'' rmesh='',f11.6,'' isfcalc='',i2,'' nkeep='',i10,&
                  '' ntask='',i3)')

          endif
       endif task_belongs

    end do loop_of_obsdata_files
    deallocate(prsl_full)
    deallocate(hgtl_full)

!   Broadcast aircraft new tail numbers for aircraft
!   temperature bias correction
!   if (aircraft_t_bc) then
!      call mpi_barrier(mpi_comm_world,ierror)
!      call mpi_bcast(ntail_update,1,mpi_itype,mype_airobst,mpi_comm_world,ierror)
!      call mpi_bcast(idx_tail,max_tail,mpi_itype,mype_airobst,mpi_comm_world,ierror)
!      call mpi_bcast(taillist,max_tail,MPI_CHARACTER,mype_airobst,mpi_comm_world,ierror)
!   end if

!   Deallocate arrays containing full horizontal surface fields
    call destroy_sfc
!   Sum and distribute number of obs read and used for each input ob group
    call mpi_allreduce(ndata1,ndata,ndat*3,mpi_integer,mpi_sum,mpi_comm_world,&
       ierror)

!   Collect super obs factors
    if(mype == 0)write(6,*) ' dval_use = ',dval_use
    if(dval_use)then
       call mpi_allreduce(super_val,super_val1,superp+1,mpi_rtype,&
            mpi_sum,mpi_comm_world,ierror)
    else
       super_val1=zero
    end if
    super_val1(0)=one
    deallocate(super_val)
    nhd(1)=nhdt
    nhd(2)=nhdq
    nhd(3)=nhduv
    nhd(4)=nhdps
    nhd(5)=nodet
    nhd(6)=nodeq
    nhd(7)=nodeuv
    nhd(8)=nodeps
!   get number of high resolution stations on every processor
    call mpi_allreduce(nhd,nhd1,8,mpi_integer,mpi_max,mpi_comm_world,ierror)
    nhdt=nhd1(1)
    nhdq=nhd1(2)
    nhduv=nhd1(3)
    nhdps=nhd1(4)
    nodet=nhd1(5)
    nodeq=nhd1(6)
    nodeuv=nhd1(7)
    nodeps=nhd1(8)
    if(nhdt > 0)then
      if(.not. allocated(hdtlist))allocate(hdtlist(nhdt))
      call mpi_bcast(hdtlist,nhdt,mpi_integer,nodet,mpi_comm_world,ierror)
    end if
    if(nhdq > 0) then
      if(.not. allocated(hdqlist))allocate(hdqlist(nhdq))
      call mpi_bcast(hdqlist,nhdq,mpi_integer,nodeq,mpi_comm_world,ierror)
    end if
    if(nhduv > 0) then
      if(.not. allocated(hduvlist))allocate(hduvlist(nhduv))
      call mpi_bcast(hduvlist,nhduv,mpi_integer,nodeuv,mpi_comm_world,ierror)
    end if
    if(nhdps > 0)then
      if(.not. allocated(hdpslist))allocate(hdpslist(nhduv))
      call mpi_bcast(hdpslist,nhdps,mpi_integer,nodeps,mpi_comm_world,ierror)
    end if
    
    if(mype == 0)write(6,*)'number of HD stations',nhdt,nhdq,nhduv,nhdps
    if(mype == 0)write(6,*)'processors           ',nodet,nodeq,nodeuv,nodeps

!   Collect number of gps profiles (needed later for qc)
    call mpi_allreduce(nprof_gps1,nprof_gps,1,mpi_integer,mpi_sum,mpi_comm_world,ierror)
    call mpi_allreduce(nobs_sub1,nobs_sub,npe*ndat,mpi_integer,mpi_sum,mpi_comm_world,& 
         ierror)

!   Write collective obs selection information to scratch file.
    if (lread_obs_save .and. mype==0) then
       write(6,*)'READ_OBS:  write collective obs selection info to ',trim(obs_input_common)
       call unformatted_open(lunsave,file=obs_input_common,class=".obs_input.")
       write(lunsave) ndata,ndat,npe,superp,nprof_gps,ditype
       write(lunsave) super_val1
       write(lunsave) nobs_sub
       close(lunsave)
    endif

!   End of routine
    return
end subroutine read_obs


end module read_obsmod
production/gsi.fd/src/gsi/read_hu3ascat.f900000640002177400414130000007007114237550767021121 0ustar  bhooverdras-aidasubroutine read_hu3ascat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis,&
     prsl_full,nobs)
!$$$  subprogram documentation block
! subroutine based primarily on read_sfcwnd.f90: documentation block for that
! routine follows the history log.
! program history log:
!   2022-05-12: Hoover - HU-3 (AI-derived) ASCAT processed as ASCAT winds
!                      - Optimal uob, vob determined from max likelihood of
!                        ambiguities
!                .      .    .                                       .
! subprogram:    read_sfcwnd                    read scatterometer winds
!   prgmmr: Li Bi                               date: 2012-08-20
!
! abstract:  This routine reads OSCAT scatterometer winds from dump.        
!            it also has options to thin the data by using conventional 
!            thinning programs 
!            When running the gsi in regional mode, the code only
!            retains those observations that fall within the regional
!            domain
!
! program history log:
!   2012-08-20 Li Bi      
!   2014-04-15 Su -  new error table
!   2015-02-23  Rancic/Thomas - add thin4d to time window logical
!   2015-03-23  Su      -fix array size with maximum message and subset number from fixed number to
!                        dynamic allocated array
!   2015-10-01  guo     - consolidate use of ob location (in deg)
!   2016-03-15  Su      - modified the code so that the program won't stop when
!                         no subtype is found in non linear qc error table and b table
!   2020-05-04  wu   - no rotate_wind for fv3_regional
!
!   input argument list:
!     ithin    - flag to thin data
!     rmesh    - thinning mesh size (km)
!     gstime   - analysis time in minutes from reference date
!     infile   - unit from which to read BUFR data
!     lunout   - unit to which to write data for further processing
!     obstype  - observation type to process
!     twind    - input group time window (hours)
!     sis      - satellite/instrument/sensor indicator
!
!   output argument list:
!     nread    - number of satellite winds read 
!     ndata    - number of satellite winds retained for further processing
!     nodata   - number of satellite winds retained for further processing
!     nobs     - array of observations on each subdomain for each processor
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
! Changes relative to read_sfcwnd
! 
!$$$
  use kinds, only: r_kind,r_double,i_kind,r_single
  use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,&
       tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,&
       rlats,rlons,fv3_regional
  use qcmod, only: errormod,noiqc,njqc

  use convthin, only: make3grids,map3grids,del3grids,use_all
  use constants, only: deg2rad,zero,rad2deg,one_tenth,&
        tiny_r_kind,huge_r_kind,r60inv,one_tenth,&
        one,two,three,four,five,half,quarter,r60inv,r10,r100,r2000
  use converr,only: etabl
  use converr_uv,only: etabl_uv,isuble_uv,maxsub_uv
  use convb_uv,only: btabl_uv
  use obsmod, only: ran01dom,bmiss
  use convinfo, only: nconvtype, &
       icuse,ictype,icsubtype,ioctype, &
       ithin_conv,rmesh_conv,pmesh_conv
  use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen,time_4dvar,thin4d
  use deter_sfc_mod, only: deter_sfc_type,deter_sfc2
  use mpimod, only: npe
  implicit none

! Declare passed variables
  character(len=*)                      ,intent(in   ) :: infile,obstype
  character(len=20)                     ,intent(in   ) :: sis
  integer(i_kind)                       ,intent(in   ) :: lunout
  integer(i_kind)                       ,intent(inout) :: nread,ndata,nodata
  integer(i_kind),dimension(npe)        ,intent(inout) :: nobs
  real(r_kind)                          ,intent(in   ) :: twind
  real(r_kind),dimension(nlat,nlon,nsig),intent(in   ) :: prsl_full

! Declare local parameters

  real(r_kind),parameter:: r6= 6.0_r_kind
  real(r_kind),parameter:: r90= 90.0_r_kind
  real(r_kind),parameter:: r110= 110.0_r_kind
  real(r_kind),parameter:: r360 = 360.0_r_kind
  real(r_kind),parameter:: r421=421.0_r_kind
  real(r_kind),parameter:: r1200= 1200.0_r_kind
  
  

! Declare local variables
  logical outside
  logical luse,ithinp
  logical,allocatable,dimension(:,:):: lmsg     ! set true when convinfo entry id found in a message

  character(70) obstr,hdrtr,wndstr
  character(8) subset
  character(8) c_prvstg,c_sprvstg

  integer(i_kind) ireadmg,ireadsb,iuse,mxtb,nmsgmax
  integer(i_kind) i,maxobs,idomsfc,nsattype,j,ncount
  integer(i_kind) nc,nx,isflg,itx,nchanl
  integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread
  integer(i_kind) kk,klon1,klat1,klonp1,klatp1
  integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k
  integer(i_kind) nreal,ithin,iout,ntmp,icount,iiout,ii
  integer(i_kind) itype,iosub,ixsub,isubsub,iobsub 
  integer(i_kind) lim_qm
  integer(i_kind) nlevp         ! vertical level for thinning
  integer(i_kind) pflag
  integer(i_kind) ntest,nvtest
  integer(i_kind) kl,k1,k2
  integer(i_kind) nmsg                ! message index
  integer(i_kind) qc1,qc2,qc3,ierr
  
  
 
  integer(i_kind),dimension(nconvtype) :: ntxall 
  integer(i_kind),dimension(nconvtype+1) :: ntx  
  
  integer(i_kind),dimension(5):: idate5 
  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
  integer(i_kind),allocatable,dimension(:,:)::tab

! integer(i_kind) itypex,lcount,iflag,m
  integer(i_kind),dimension(1):: opt_idx
  integer(i_kind) itypey
  real(r_kind) toff,t4dv
  real(r_kind) rmesh,ediff,usage,tdiff
  real(r_kind) u0,v0,uob,vob,dx,dy,dx1,dy1,w00,w10,w01,w11
  real(r_kind) dlnpob,ppb,ppb2,qifn,qify,ee,var_jb
  real(r_kind) woe,dlat,dlon,dlat_earth,dlon_earth,oelev
  real(r_kind) dlat_earth_deg,dlon_earth_deg
  real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
  real(r_kind) vdisterrmax,u00,v00,uob1,vob1
  real(r_kind) del,werrmin,obserr,ppb1,wjbmin
  real(r_kind) tsavg,ff10,sfcr,sstime,gstime,zz
  real(r_kind) crit1,timedif,xmesh,pmesh
  real(r_kind),dimension(nsig):: presl
  real(r_kind) uob_1,uob_2,uob_3,uob_4,vob_1,vob_2,vob_3,vob_4
  real(r_kind) lkcs_1,lkcs_2,lkcs_3,lkcs_4
  real(r_kind),dimension(4):: lkcs_vec
  real(r_kind),dimension(4):: uob_vec
  real(r_kind),dimension(4):: vob_vec

  real(r_double),dimension(8):: hdrdat
  real(r_double),dimension(2):: satqc
  real(r_double),dimension(3):: obsdat
  real(r_double),dimension(3,4):: wnddat
  real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
  real(r_kind),allocatable,dimension(:):: presl_thin
  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out

! equivalence to handle character names
  equivalence(r_prvstg(1,1),c_prvstg)
  equivalence(r_sprvstg(1,1),c_sprvstg)


!******** Modify below from the bufrtable: 
  data hdrtr /'SAID CLATH CLONH YEAR MNTH DAYS HOUR MINU'/ 
  data obstr/'WVCQ NWVA ISWV'/ 
  data wndstr/'WS10 WD10 LKCS'/ 
  
  
  data ithin / -9 /
  data lunin / 11 /
  data rmesh / -99.999_r_kind /

!**************************************************************************

write(6,*) ' READ_HU3ASCAT: entering routine'

! Set lower limits for observation errors
! ** keep this way for now
! nreal keep the dimension of cdata_all 
  werrmin=one
  nsattype=0
  nreal=24
  if (noiqc) then
     lim_qm=8
  else
     lim_qm=4
  endif

! ** read convtype from convinfo file 
! ** only read in ASCAT 290 for now ** 
  ntread=1
  ntmatch=0
  ntx(ntread)=0
  ntxall=0
  do nc=1,nconvtype
     if(trim(ioctype(nc)) == 'uv' .and. ictype(nc) == 290) then
        ntmatch=ntmatch+1
        ntxall(ntmatch)=nc
        ithin=ithin_conv(nc)
        if(ithin > 0)then
           ntread=ntread+1
           ntx(ntread)=nc
        end if
     end if
  end do
  if(ntmatch == 0)then
     write(6,*) ' READ_HU3ASCAT: no matching obstype found in convinfo ',obstype
     return
  end if
      
!!  go through the satedump to find out how many subset to process
!** Open and read data from bufr data file

  open(lunin,file=trim(infile),form='unformatted')
  call openbf(lunin,'IN',lunin)
  call datelen(10)

!! get message and subset counts

  call getcount_bufr(infile,nmsgmax,mxtb)

  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))

  lmsg = .false.
  maxobs=0
  tab=0
  nmsg=0
  nrep=0
  ntb =0
  ncount=0
  msg_report: do while (ireadmg(lunin,subset,idate) == 0)

!    Time offset
     if(nmsg == 0) call time_4dvar(idate,toff)
     nmsg=nmsg+1
     if (nmsg>nmsgmax) then
        write(6,*)'READ_HU3ASCAT: messages exceed maximum ',nmsgmax
        call stop2(49)
     endif
     loop_report: do while (ireadsb(lunin) == 0)
        ntb = ntb+1
        maxobs=maxobs+1
        nrep(nmsg)=nrep(nmsg)+1
        if (ntb>mxtb) then
           write(6,*)'READ_HU3ASCAT: reports exceed maximum ',mxtb   
           call stop2(49)
        endif
!** Extract sat ID information from BUFR and assign type 
!   This part will extract information from the bufrtable
!   iobsub is the prepbufr subtype, still part of the convinfo file
!********* iobsub= 3 or 4 for existing ASCAT winds
!********* we will use iobsub=6 to distinguish HU-3 ASCAT winds
!********* NOTE: Max subtype=7 for uv obs

        call ufbint(lunin,hdrdat,8,1,iret,hdrtr)
!       determine the satellite wind type 
!       BTH: Spoofing with HU3ASCAT: subset=NC012122, hdrdat(1)=5.0                                       
        iobsub=6
        itype=-1
        if(trim(subset) == 'NC012122') then
           if( hdrdat(1) < r6 ) then           !    HU3ASCAT data == 5.0
             itype=290
           endif
        endif
!  Match ob to proper convinfo type
        ncsave=0
        matchloop:do ncx=1,ntmatch
           nc=ntxall(ncx)
           if (itype /= ictype(nc)) cycle matchloop
        write(6,*) 'BTH: nc=',nc
!  Find convtype which match ob type and subtype
           if(icsubtype(nc) == iobsub) then
              ncsave=nc
              exit matchloop
           else
!  Find convtype which match ob type and subtype group (isubtype == ?*)
!       where ? specifies the group and icsubtype = ?6)
              ixsub=icsubtype(nc)/10
              iosub=iobsub/10
              isubsub=icsubtype(nc)-ixsub*10
              if(ixsub == iosub .and. isubsub == 0) then
                 ncsave=nc
!  Find convtype which match ob type and subtype is all remaining
!       (icsubtype(nc) = 6)
              else if (ncsave == 0 .and. icsubtype(nc) == 6) then
                 ncsave=nc
              end if
           end if
        end do matchloop
!  Save information for next read
        if(ncsave /= 0) then
           maxobs=maxobs+1
           nx=1
           if(ithin_conv(ncsave) > 0)then
              do ii=2,ntread
                 if(ntx(ii) == ncsave)nx=ii
              end do
           end if
           tab(ntb,1)=ncsave
           tab(ntb,2)=nx
           tab(ntb,3)=1
           lmsg(nmsg,nx) = .true.
        end if
     enddo loop_report
  enddo msg_report

! Loop over convinfo file entries; operate on matches
  write(6,*) 'BTH: maxobs final=',maxobs
  allocate(cdata_all(nreal,maxobs),isort(maxobs))
  isort = 0
  cdata_all=zero
  nread=0
  ntest=0
  nvtest=0
  nchanl=0
  ilon=2
  ilat=3

!!  read satellite winds one type a time
!   same as in the read_prepbufr.f90 file

  loop_convinfo: do nx=1,ntread 
     use_all = .true.
     ithin=0
     if(nx >1) then
        nc=ntx(nx)
        ithin=ithin_conv(nc)
        if (ithin > 0 ) then
           rmesh=rmesh_conv(nc)
           pmesh=pmesh_conv(nc)
           use_all = .false.
           if(pmesh > zero) then
              pflag=1
              nlevp=r1200/pmesh
           else
              pflag=0
              nlevp=nsig
           endif
           xmesh=rmesh

           call make3grids(xmesh,nlevp)

           if (.not.use_all) then
              allocate(presl_thin(nlevp))
              if (pflag==1) then
                 do k=1,nlevp
                    presl_thin(k)=(r1200-(k-1)*pmesh)*one_tenth
                 enddo
              endif
           endif

           write(6,*)'READ_HU3ASCAT: ictype(nc),rmesh,pflag,nlevp,pmesh,nc ',&
                   ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc
        endif
     endif

     call closbf(lunin)
     close(lunin)
     open(lunin,file=trim(infile),form='unformatted')
     call openbf(lunin,'IN',lunin)
     call datelen(10)

! Big loop over BUFR file

     ntb = 0
     nmsg = 0
     loop_msg:  do while(ireadmg(lunin,subset,idate) == 0)
        nmsg = nmsg+1
        if(.not.lmsg(nmsg,nx)) then
           ntb=ntb+nrep(nmsg)
           write(6,*) 'BTH: nmsg no useable reports, skip ahead',nmsg
           cycle loop_msg ! no useable reports this mesage, skip ahead report count
        end if

        loop_readsb: do while(ireadsb(lunin) == 0)
!          use msg lookup table to decide which messages to skip
!          use report id lookup table to only process matching reports
           ntb = ntb+1
           nc=tab(ntb,1)
           if(nc <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb

           hdrdat=bmiss
           obsdat=bmiss
           wnddat=bmiss
           satqc=bmiss
           iobsub=6
           itype=-1
           uob=bmiss
           vob=bmiss
           ppb=bmiss
           ppb1=bmiss
           ppb2=bmiss
           uob1=bmiss
           vob1=bmiss
           ee=r110
           qifn=r110
           qify=r110
           uob_1=bmiss
           vob_1=bmiss
           uob_2=bmiss
           vob_2=bmiss
           uob_3=bmiss
           vob_3=bmiss
           uob_4=bmiss
           vob_4=bmiss
           lkcs_1=bmiss
           lkcs_2=bmiss
           lkcs_3=bmiss
           lkcs_4=bmiss
 
! Extract type, date, and location information
           call ufbint(lunin,hdrdat,8,1,iret,hdrtr) 
           call ufbint(lunin,obsdat,3,1,iret,obstr)
           call ufbrep(lunin,wnddat,3,4,iret,wndstr)


!** potential can reject bad cell, etc, place holder for now
!   reject the data with bad quality mark from SDM
!** cycle loop means skip to the next record     

           if(hdrdat(1) >= r6) cycle loop_readsb
!       Compare relative obs time with window.  If obs 
!       falls outside of window, don't use this obs
           idate5(1) = hdrdat(4)     ! year
           idate5(2) = hdrdat(5)     ! month
           idate5(3) = hdrdat(6)     ! day
           idate5(4) = hdrdat(7)     ! hours
           idate5(5) = hdrdat(8)     ! minutes
           call w3fs21(idate5,nmind)
           t4dv = real((nmind-iwinbgn),r_kind)*r60inv
           if (l4dvar.or.l4densvar) then
              if (t4dv<zero .OR. t4dv>winlen) cycle loop_readsb 
           else
              sstime = real(nmind,r_kind) 
              tdiff=(sstime-gstime)*r60inv
              if (abs(tdiff)>twind) cycle loop_readsb 
           endif


!       determine the satellite wind type as in prepbufr
!       290: ASCAT winds                              
           iosub=6
           if(abs(hdrdat(2)) >r90 ) cycle loop_readsb 
           if(hdrdat(3) <zero) hdrdat(3)=hdrdat(3)+r360
           if(hdrdat(3) == r360) hdrdat(3)=hdrdat(3)-r360
           if(hdrdat(3) >r360) cycle loop_readsb 
           !if(abs(obsdat(2)) >= 100) cycle loop_readsb
             ! applied to wind direction, move to lower bloc
             ! when optimal wind vector has been selected
           if(obsdat(1) >=1) cycle loop_readsb

           if(trim(subset) == 'NC012122') then    ! HU3ASCAT wind
              if( hdrdat(1) < r6) then          
                   itype=290
              endif
           endif

           nread=nread+2
           dlon_earth_deg=hdrdat(3)
           dlat_earth_deg=hdrdat(2)
           dlon_earth=hdrdat(3)*deg2rad
           dlat_earth=hdrdat(2)*deg2rad
                              
!       If regional, map obs lat,lon to rotated grid.
           if(regional)then
              call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)
              if(diagnostic_reg) then
                 call txy2ll(dlon,dlat,rlon00,rlat00)
                 ntest=ntest+1
                 cdist=sin(dlat_earth)*sin(rlat00)+cos(dlat_earth)*cos(rlat00)* &
                       (sin(dlon_earth)*sin(rlon00)+cos(dlon_earth)*cos(rlon00))
                 cdist=max(-one,min(cdist,one))
                 disterr=acos(cdist)*rad2deg
                 disterrmax=max(disterrmax,disterr)
              end if
              if(outside) cycle loop_readsb ! check to see if outside regional 
           else
              dlon=dlon_earth
              dlat=dlat_earth
              call grdcrd1(dlat,rlats,nlat,1)
              call grdcrd1(dlon,rlons,nlon,1)
           endif

!     If ASCAT data, determine primary surface type.  If not open sea,
!     skip this observation.  This check must be done before thinning.
!     isflg    - surface flag 0:sea 1:land 2:sea ice 3:snow 4:mixed

           if (itype==290) then                              
              call deter_sfc_type(dlat_earth,dlon_earth,t4dv,isflg,tsavg)
              if (isflg /= 0) cycle loop_readsb
              if (tsavg <= 273.0_r_kind) cycle loop_readsb
           endif

       
!!    convert from wind direction and speed to u,v component
           !uob=-obsdat(2)*sin(obsdat(1)*deg2rad)
           !vob=-obsdat(2)*cos(obsdat(1)*deg2rad)
               ! no optimal wind vector in hu3_ascat BUFR file,
               ! we will select one from the available ambiguities
               ! based on assigned likelihood, below

           qc1=obsdat(1) ! WVCQ: wind vector cell quality
           qc2=obsdat(2) ! NWVA: number of wind vector ambiguities
           qc3=obsdat(3) ! ISWV: index of selected wind vector

           uob_1=-wnddat(1,1)*sin(wnddat(2,1)*deg2rad)
           vob_1=-wnddat(1,1)*cos(wnddat(2,1)*deg2rad)
           uob_2=-wnddat(1,2)*sin(wnddat(2,2)*deg2rad)
           vob_2=-wnddat(1,2)*cos(wnddat(2,2)*deg2rad)
           uob_3=-wnddat(1,3)*sin(wnddat(2,3)*deg2rad)
           vob_3=-wnddat(1,3)*cos(wnddat(2,3)*deg2rad)
           uob_4=-wnddat(1,4)*sin(wnddat(2,4)*deg2rad)
           vob_4=-wnddat(1,4)*cos(wnddat(2,4)*deg2rad)
           ! load uob, vob values into vectors
           uob_vec(1)=uob_1
           uob_vec(2)=uob_2
           uob_vec(3)=uob_3
           uob_vec(4)=uob_4
           vob_vec(1)=vob_1
           vob_vec(2)=vob_2
           vob_vec(3)=vob_3
           vob_vec(4)=vob_4
           lkcs_1=wnddat(3,1)
           lkcs_2=wnddat(3,2)
           lkcs_3=wnddat(3,3)
           lkcs_4=wnddat(3,4)
           ! missing-value lkcs will be represented by a very large number
           ! (>>r110): Reverse the sign of these members so they are not
           ! selected by maxloc() as the optimal wind vector
           if(lkcs_1 > r110) lkcs_1 = -lkcs_1
           if(lkcs_2 > r110) lkcs_2 = -lkcs_2
           if(lkcs_3 > r110) lkcs_3 = -lkcs_3
           if(lkcs_4 > r110) lkcs_4 = -lkcs_4
           ! load LKCS values into vector
           lkcs_vec(1)=lkcs_1
           lkcs_vec(2)=lkcs_2
           lkcs_vec(3)=lkcs_3
           lkcs_vec(4)=lkcs_4
           ! select optimal wind vector based on maxloc(lkcs_vec)
           opt_idx=maxloc(lkcs_vec)
           write(6,*) 'BTH: abs(wnddat),lkcs=',abs(wnddat(1,opt_idx(1))),lkcs_vec(opt_idx(1))
           ! insert wind speed threshold criteria from above
           if(abs(wnddat(1,opt_idx(1))) >= r100) cycle loop_readsb
           ! reject any optimal wind vector with likelihood > 1 or less than 0
           if(lkcs_vec(opt_idx(1))>1.) cycle loop_readsb
           if(lkcs_vec(opt_idx(1))<0.) cycle loop_readsb
           ! define wind vector from optimal wnddat index
           uob=uob_vec(opt_idx(1))
           vob=vob_vec(opt_idx(1))
           write(6,*) 'BTH: selected wind uob,vob,lkcs=',uob,vob,lkcs_vec(opt_idx(1))           
!!  Get observation error from PREPBUFR observation error table
!   only need read the 4th column for type 290 from the right
 
           ppb=max(zero,min(ppb,r2000))
           itypey=itype
           if(njqc) then
              ierr=0
              do i =1,maxsub_uv
                 if( icsubtype(nc) == isuble_uv(itypey,i) ) then
                    ierr=i+1
                    exit
                 else if( i == maxsub_uv .and. icsubtype(nc) /= isuble_uv(itypey,i)) then
                    ncount=ncount+1
                    do j=1,maxsub_uv
                       if(isuble_uv(itypey,j) ==0 ) then
                          ierr=j+1
                          exit
                       endif
                    enddo
                    if (ncount ==1) then
                       write(6,*) 'READ_HU3ASCAT,WARNING!! cannot find subtyep in the error table,&
                                   itype,iobsub=',itypey,icsubtype
                       write(6,*) 'read error table at colomn subtype as 0,error table column=',j
                    endif
                 endif
              enddo
              if(ppb>=etabl_uv(itypey,1,1)) k1=1
              do kl=1,32
                 if(ppb>=etabl_uv(itypey,kl+1,1).and.ppb<=etabl_uv(itypey,kl,1)) k1=kl
              end do
              if(ppb<=etabl_uv(itypey,33,1)) k1=5
              k2=k1+1
              ediff = etabl_uv(itypey,k2,1)-etabl_uv(itypey,k1,1)
              if (abs(ediff) > tiny_r_kind) then
                 del = (ppb-etabl_uv(itypey,k1,1))/ediff
              else
                 del = huge_r_kind
              endif
              del=max(zero,min(del,one))
              obserr=(one-del)*etabl_uv(itypey,k1,ierr)+del*etabl_uv(itypey,k2,ierr)
              obserr=max(obserr,werrmin)
! get non linear qc parameter from b table
              var_jb=(one-del)*btabl_uv(itypey,k1,ierr)+del*btabl_uv(itypey,k2,ierr)
              var_jb=max(var_jb,wjbmin)
              if (var_jb >= 10.0_r_kind) var_jb=zero
          else
             if(ppb>=etabl(itype,1,1)) k1=1
              do kl=1,32
                 if(ppb>=etabl(itype,kl+1,1).and.ppb<=etabl(itype,kl,1)) k1=kl
              end do
              if(ppb<=etabl(itype,33,1)) k1=5
              k2=k1+1
              ediff = etabl(itype,k2,1)-etabl(itype,k1,1)
              if (abs(ediff) > tiny_r_kind) then
                 del = (ppb-etabl(itype,k1,1))/ediff
              else
                 del = huge_r_kind
              endif
              del=max(zero,min(del,one))
              obserr=(one-del)*etabl(itype,k1,4)+del*etabl(itype,k2,4)
              obserr=max(obserr,werrmin)
           endif

!         Set usage variable
           usage = 0 
           iuse=icuse(nc)
           if(iuse <= 0)usage=r100

! Get information from surface file necessary for conventional data here
! This is different from the previous sfc_type call
           call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz)
 
!!    process the thining procedure
                
           ithin=ithin_conv(nc)
           ithinp = ithin > 0 .and. pflag /= 0
           if(ithinp   )then
!          Interpolate guess pressure profile to observation location
              klon1= int(dlon);  klat1= int(dlat)
              dx   = dlon-klon1; dy   = dlat-klat1
              dx1  = one-dx;     dy1  = one-dy
              w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy

              klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
              if (klon1==0) klon1=nlon
              klatp1=min(nlat,klat1+1); klonp1=klon1+1
              if (klonp1==nlon+1) klonp1=1
              do kk=1,nsig
                 presl(kk)=w00*prsl_full(klat1 ,klon1 ,kk) +  &
                           w10*prsl_full(klatp1,klon1 ,kk) + &
                           w01*prsl_full(klat1 ,klonp1,kk) + &
                           w11*prsl_full(klatp1,klonp1,kk)
              end do
           end if

! The following two lines are new in SATWND:
           dlnpob=log(one_tenth*ppb)  ! ln(pressure in cb)
           ppb=one_tenth*ppb         ! from mb to cb

 !         Special block for data thinning - if requested
           if (ithin > 0 .and. iuse >=0) then
              ntmp=ndata  ! counting moved to map3gridS

 !         Set data quality index for thinning
              if (thin4d) then
                 timedif = zero
              else
                 timedif=abs(t4dv-toff)
              endif

              crit1 = timedif/r6+half

              if (pflag==0) then
                 do kk=1,nsig
                    presl_thin(kk)=presl(kk)
                 end do
              endif
 
              call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
                              ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)

              if (.not. luse) cycle loop_readsb
              if(iiout > 0) isort(iiout)=0
              if (ndata > ntmp) then
                 nodata=nodata+2
              endif
              isort(ntb)=iout

           else
              ndata=ndata+1
              nodata=nodata+2
              iout=ndata
              isort(ntb)=iout
           endif

           woe=obserr
           oelev=r10

           if(regional .and. .not. fv3_regional)then
              u0=uob
              v0=vob
              call rotate_wind_ll2xy(u0,v0,uob,vob,dlon_earth,dlon,dlat)
              if(diagnostic_reg) then
                 call rotate_wind_xy2ll(uob,vob,u00,v00,dlon_earth,dlon,dlat)
                 nvtest=nvtest+1
                 disterr=sqrt((u0-u00)**2+(v0-v00)**2)
                 vdisterrmax=max(vdisterrmax,disterr)
              end if
           endif
           write(6,*) 'BTH: Getting to cdata_all write-out'
! Output result to array, need restruct from here. 


           cdata_all(1,iout)=woe                  ! wind error
           cdata_all(2,iout)=dlon                 ! grid relative longitude
           cdata_all(3,iout)=dlat                 ! grid relative latitude
           cdata_all(4,iout)=dlnpob               ! ln(pressure in cb)
           cdata_all(5,iout)=oelev                 ! index of height         
           cdata_all(6,iout)=uob                  ! u obs
           cdata_all(7,iout)=vob                  ! v obs 
           cdata_all(8,iout)=ndata                ! station id 
           cdata_all(9,iout)=t4dv                 ! time
           cdata_all(10,iout)=nc                  ! index of type in convinfo file
           cdata_all(11,iout)=0                   ! index of station elevation
           cdata_all(12,iout)=qc1                 ! index of quality mark
           cdata_all(13,iout)=obserr              ! original obs error
           cdata_all(14,iout)=usage               ! usage parameter
           cdata_all(15,iout)=idomsfc             ! dominate surface type
           cdata_all(16,iout)=tsavg               ! skin temperature
           cdata_all(17,iout)=ff10                ! 10 meter wind factor
           cdata_all(18,iout)=sfcr                ! surface roughness
           cdata_all(19,iout)=dlon_earth_deg      ! earth relative longitude (degrees)
           cdata_all(20,iout)=dlat_earth_deg      ! earth relative latitude (degrees)
           cdata_all(21,iout)=zz                  ! terrain height at ob location
           cdata_all(22,iout)=r_prvstg(1,1)       ! provider name
           cdata_all(23,iout)=r_sprvstg(1,1)      ! subprovider name
           cdata_all(24,iout)=var_jb              ! non linear qc parameter

        enddo  loop_readsb

     enddo loop_msg

!    Close unit to bufr file
!    Deallocate arrays used for thinning data
     if (.not.use_all) then
        deallocate(presl_thin)
        call del3grids
     endif
! Normal exit

  enddo loop_convinfo! loops over convinfo entry matches
  call closbf(lunin)
  deallocate(lmsg,nrep,tab)
 

  ! Write header record and data to output file for further processing
  allocate(iloc(ndata))
  icount=0
  do i=1,maxobs
     if(isort(i) > 0)then
        icount=icount+1
        iloc(icount)=isort(i)
     end if
  end do
  if(ndata /= icount)then
     write(6,*) ' READ_HU3ASCAT: mix up in read_hu3ascat ,ndata,icount ',ndata,icount
     call stop2(49)
  end if

  allocate(cdata_out(nreal,ndata))
  do i=1,ndata
     itx=iloc(i)
     do k=1,nreal
        cdata_out(k,i)=cdata_all(k,itx)
     end do
  end do
  deallocate(iloc,isort,cdata_all)
!  deallocate(etabl)
  
  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
  write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
  write(lunout) cdata_out

  deallocate(cdata_out)
900 continue
  if(diagnostic_reg .and. ntest>0) write(6,*)'READ_HU3ASCAT:  ',&
       'ntest,disterrmax=',ntest,disterrmax
  if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_HU3ASCAT:  ',&
       'nvtest,vdisterrmax=',ntest,vdisterrmax

  if (ndata == 0) then
     write(6,*)'READ_HU3ASCAT:  closbf(',lunin,') no data'
  endif
  
  write(6,*) 'READ_HU3ASCAT,nread,ndata,nreal,nodata=',nread,ndata,nreal,nodata

  close(lunin)

! End of routine
  return



end subroutine read_hu3ascat
README.txt0000640002177400414130000000274414237552527012656 0ustar  bhooverdras-aidaRepositories:

./production
This repository contains the code-changes necessary to read the HU3-ASCAT BUFR file, select
an optimal wind from the available ambiguities (if present), and send appropriate data to
cdata_all for further processing in setupw with HU3-ASCAT winds defined as Type=290 and
Subtype=6 as a monitored wind:

read_obs --> read_hu3ascat --> setupw
* Requires hard-wiring the global_convinfo.txt file found in production/fix/in config.anal

./lkcs_diag
This repository achieves the monitoring of HU3-ASCAT winds that is achieved in ./production,
but in addition:
 - HU3-ASCAT optimal wind likelihood (LKCS) is retained for the diag_conv_uv*.nc4 file by
   being passed to setupw through the slot reserved for station elevation. The station
   elevation MUST be set to zero for proper handling in setupw, so an if-trap is introduced
   in setupw to identify when cdata(ielev,i) comes from an HU3-ASCAT wind, at which point
   the local station elevation variable (dstn) is reassigned to zero. This will allow for
   proper handling of the HU3-ASCAT winds in setupw while letting the LKCS value still pass
   through as cdata(ielev,i) to the diag file under the Station_Elevation variable.

read_obs --> read_hu3ascat --> setupw
* Requires hard-wiring the global_convinfo.txt file found in production/fix/in config.anal
* Diag file contains HU3-ASCAT wind likelihood in Station_Elevation variable for HU3-ASCAT
  winds only, with the understanding that the *real* station elevation is zero.