wrfv2_fire/var/obsproc/src/module_err_afwa.F90

   1 MODULE module_err_afwa
   2
   3 !-----------------------------------------------------------------------------!
   4 ! Assign observational error at every level from input error profiles read
   5 ! in file "filein".
   6 !
   7 ! Error profiles actually used are written out in files:
   8 ! PRES.txt: pressure
   9 ! RH.txt:   relative humidity
  10 ! TEMP.txt: temperature and dew point
  11 ! WIND.txt: wind speed
  12 !------------------------------------------------------------------------------
  13 !  HISTORY:
  14 !
  15 ! F. VANDENBERGHE, March 2001
  16 !
  17 !         01/13/2003 - Updated for Profiler obs.           S. R. H. Rizvi
  18 !
  19 !         02/04/2003 - Updated for Buoy     obs.           S. R. H. Rizvi
  20 !
  21 !         02/10/2003 - Reviewed and modified for Profiler
  22 !                      and Buoy obs.                       Y.-R. Guo
  23 !         06/30/2006 -   Updated for AIRS retrievals       Syed  RH  Rizvi
  24 !         11/09/2006 -   Updated for GPS RO                Y.-R. Guo
  25 !
  26 !------------------------------------------------------------------------------
  27    TYPE field_type
  28         REAL :: height
  29         REAL :: wind
  30         REAL :: temp
  31         REAL :: rh
  32         REAL :: pres
  33    END TYPE field_type
  34
  35    TYPE obs_type
  36         REAL              :: level
  37         TYPE (field_type) :: synop
  38         TYPE (field_type) :: ships
  39         TYPE (field_type) :: buoys
  40         TYPE (field_type) :: metar
  41         TYPE (field_type) :: airep
  42         TYPE (field_type) :: tamdar
  43         TYPE (field_type) :: pilot
  44         TYPE (field_type) :: profl
  45         TYPE (field_type) :: sound
  46         TYPE (field_type) :: satem
  47         TYPE (field_type) :: satob
  48         TYPE (field_type) :: gpspw
  49         TYPE (field_type) :: ssmt1
  50         TYPE (field_type) :: ssmt2
  51         TYPE (field_type) :: ssmi
  52         TYPE (field_type) :: tovs
  53         TYPE (field_type) :: airs
  54         TYPE (field_type) :: other
  55    END TYPE obs_type
  56
  57 CONTAINS
  58
  59 SUBROUTINE obs_err_afwa (filein,iunit,nobs_max, obs, number_of_obs)
  60
  61 !-------------------------------------------------------------------------------
  62
  63   USE module_type
  64   USE module_func
  65   USE module_err_ncep
  66   USE module_intp
  67 ! USE module_rh
  68
  69   IMPLICIT NONE
  70
  71   CHARACTER (LEN=80)                                :: filein
  72   INTEGER                                          :: iunit
  73   INTEGER, INTENT (in)                             :: nobs_max
  74   TYPE (report), INTENT (inout), DIMENSION (nobs_max) :: obs
  75   TYPE (measurement ) , POINTER                    :: current
  76   INTEGER, INTENT (in)                             :: number_of_obs
  77
  78   INTEGER                                          :: loop_index, is_sound
  79   INTEGER                                          :: nvalids, nsoundings
  80   INTEGER                                          :: nsurfaces, nlevels
  81   REAL                                             :: pres, temp, error_rh
  82   REAL                                             :: t9,  p9, rh9, qv9
  83   REAL                                             :: t,   p,  rh,  qv
  84   REAL                                             :: es9, qs9
  85   REAL                                             :: es,  qs
  86
  87   real                                             :: latt, rr
  88   CHARACTER (LEN=40)  :: platform
  89   INTEGER             :: i,fm
  90   CHARACTER (LEN=80)  :: keyword
  91   CHARACTER (LEN=80)  :: endword
  92   CHARACTER (LEN=80)  :: fmt_err
  93
  94   CHARACTER (LEN= 5)  :: bogus_type
  95
  96   TYPE (obs_type), DIMENSION (15) :: err
  97   TYPE (obs_type), DIMENSION (26) :: err_wind
  98
  99   INCLUDE 'platform_interface.inc'
 100   INCLUDE 'missing.inc'
 101   INCLUDE 'constants.inc'
 102
 103 !------------------------------------------------------------------------------!
 104   WRITE (UNIT = 0, FMT = '(A)')  &
 105 '------------------------------------------------------------------------------'
 106   WRITE ( UNIT = 0, FMT = '(/,A,/)') '<AFWA> OBSERVATIONAL ERRORS PER TYPE:'
 107
 108 ! 1. LOAD OBSERVATIONAL ERROR FROM INPUT FILE
 109 ! ===========================================
 110
 111 ! 1.1 INITIALISE PRESSURE LEVELS FOR HEIGHT, PRESSURE, TEMPERATURE AND RH
 112 !     -------------------------------------------------------------------
 113
 114       !  Pressure levels in Pa
 115
 116       err ( 1) % level =  1000. * 100.
 117       err ( 2) % level =   850. * 100.
 118       err ( 3) % level =   700. * 100.
 119       err ( 4) % level =   500. * 100.
 120       err ( 5) % level =   400. * 100.
 121       err ( 6) % level =   300. * 100.
 122       err ( 7) % level =   250. * 100.
 123       err ( 8) % level =   200. * 100.
 124       err ( 9) % level =   150. * 100.
 125       err (10) % level =   100. * 100.
 126       err (11) % level =    70. * 100.
 127       err (12) % level =    50. * 100.
 128       err (13) % level =    30. * 100.
 129       err (14) % level =    20. * 100.
 130       err (15) % level =    10. * 100.
 131
 132 ! 1.2 INITIALISE PRESSURE LEVELS FOR WIND
 133 !     -----------------------------------
 134
 135       !  Pressure levels in Pa
 136
 137       err_wind ( 1) % level =  1100. * 100.
 138       err_wind ( 2) % level =  1050. * 100.
 139       err_wind ( 3) % level =  1000. * 100.
 140       err_wind ( 4) % level =   950. * 100.
 141       err_wind ( 5) % level =   900. * 100.
 142       err_wind ( 6) % level =   850. * 100.
 143       err_wind ( 7) % level =   800. * 100.
 144       err_wind ( 8) % level =   750. * 100.
 145       err_wind ( 9) % level =   700. * 100.
 146       err_wind (10) % level =   650. * 100.
 147       err_wind (11) % level =   600. * 100.
 148       err_wind (12) % level =   550. * 100.
 149       err_wind (13) % level =   500. * 100.
 150       err_wind (14) % level =   450. * 100.
 151       err_wind (15) % level =   400. * 100.
 152       err_wind (16) % level =   350. * 100.
 153       err_wind (17) % level =   300. * 100.
 154       err_wind (18) % level =   250. * 100.
 155       err_wind (19) % level =   200. * 100.
 156       err_wind (20) % level =   150. * 100.
 157       err_wind (21) % level =   100. * 100.
 158       err_wind (22) % level =    50. * 100.
 159       err_wind (23) % level =    40. * 100.
 160       err_wind (24) % level =    30. * 100.
 161       err_wind (25) % level =    20. * 100.
 162       err_wind (26) % level =    10. * 100.
 163
 164 ! 1.3 INITIALISE ERRORS TO NCEP VALUES FOR PRESSURE, TEMPERATURE AND RH
 165 !     -----------------------------------------------------------------
 166
 167       DO i = 1, 15
 168
 169          !  Height error
 170
 171          err (i) % synop % height = intplin (err (i) % level, err_k (1:JPERR),&
 172                                                               err_h (1:JPERR))
 173          err (i) % metar % height = intplin (err (i) % level, err_k (1:JPERR),&
 174                                                               err_h (1:JPERR))
 175          err (i) % ships % height = intplin (err (i) % level, err_k (1:JPERR),&
 176                                                               err_h (1:JPERR))
 177          err (i) % buoys % height = intplin (err (i) % level, err_k (1:JPERR),&
 178                                                               err_h (1:JPERR))
 179          err (i) % sound % height = intplin (err (i) % level, err_k (1:JPERR),&
 180                                                               err_h (1:JPERR))
 181          err (i) % pilot % height = intplin (err (i) % level, err_k (1:JPERR),&
 182                                                               err_h (1:JPERR))
 183          err (i) % profl % height = intplin (err (i) % level, err_k (1:JPERR),&
 184                                                               err_h (1:JPERR))
 185          err (i) % satem % height = intplin (err (i) % level, err_k (1:JPERR),&
 186                                                               err_h (1:JPERR))
 187          err (i) % satob % height = intplin (err (i) % level, err_k (1:JPERR),&
 188                                                               err_h (1:JPERR))
 189          err (i) % airep % height = intplin (err (i) % level, err_k (1:JPERR),&
 190                                                               err_h (1:JPERR))
 191          err (i) % ssmt1 % height = intplin (err (i) % level, err_k (1:JPERR),&
 192                                                               err_h (1:JPERR))
 193          err (i) % ssmt2 % height = intplin (err (i) % level, err_k (1:JPERR),&
 194                                                               err_h (1:JPERR))
 195          err (i) % ssmi  % height = intplin (err (i) % level, err_k (1:JPERR),&
 196                                                               err_h (1:JPERR))
 197          err (i) % tovs  % height = intplin (err (i) % level, err_k (1:JPERR),&
 198                                                               err_h (1:JPERR))
 199          err (i) % airs  % height = intplin (err (i) % level, err_k (1:JPERR),&
 200                                                               err_h (1:JPERR))
 201          err (i) % other % height = intplin (err (i) % level, err_k (1:JPERR),&
 202                                                               err_h (1:JPERR))
 203          !  Pressure error
 204
 205          err (i) % synop % pres = intplin (err (i) % level, err_k (1:JPERR),&
 206                                                             err_p (1:JPERR))
 207          err (i) % metar % pres = intplin (err (i) % level, err_k (1:JPERR),&
 208                                                             err_p (1:JPERR))
 209          err (i) % ships % pres = intplin (err (i) % level, err_k (1:JPERR),&
 210                                                             err_p (1:JPERR))
 211          err (i) % buoys % pres = intplin (err (i) % level, err_k (1:JPERR),&
 212                                                             err_p (1:JPERR))
 213          err (i) % sound % pres = intplin (err (i) % level, err_k (1:JPERR),&
 214                                                             err_p (1:JPERR))
 215          err (i) % pilot % pres = intplin (err (i) % level, err_k (1:JPERR),&
 216                                                             err_p (1:JPERR))
 217          err (i) % profl % pres = intplin (err (i) % level, err_k (1:JPERR),&
 218                                                             err_p (1:JPERR))
 219          err (i) % satem % pres = intplin (err (i) % level, err_k (1:JPERR),&
 220                                                             err_p (1:JPERR))
 221          err (i) % satob % pres = intplin (err (i) % level, err_k (1:JPERR),&
 222                                                             err_p (1:JPERR))
 223          err (i) % airep % pres = intplin (err (i) % level, err_k (1:JPERR),&
 224                                                             err_p (1:JPERR))
 225          err (i) % ssmt1 % pres = intplin (err (i) % level, err_k (1:JPERR),&
 226                                                             err_p (1:JPERR))
 227          err (i) % ssmt2 % pres = intplin (err (i) % level, err_k (1:JPERR),&
 228                                                             err_p (1:JPERR))
 229          err (i) % ssmi  % pres = intplin (err (i) % level, err_k (1:JPERR),&
 230                                                             err_p (1:JPERR))
 231          err (i) % tovs  % pres = intplin (err (i) % level, err_k (1:JPERR),&
 232                                                             err_p (1:JPERR))
 233          err (i) % airs  % pres = intplin (err (i) % level, err_k (1:JPERR),&
 234                                                             err_p (1:JPERR))
 235          err (i) % other % pres = intplin (err (i) % level, err_k (1:JPERR),&
 236                                                             err_p (1:JPERR))
 237
 238          !  Temperature error
 239
 240          err (i) % synop % temp = intplog (err (i) % level, err_k (1:JPERR), &
 241                                                             err_t (1:JPERR))
 242          err (i) % metar % temp = intplog (err (i) % level, err_k (1:JPERR), &
 243                                                             err_t (1:JPERR))
 244          err (i) % ships % temp = intplog (err (i) % level, err_k (1:JPERR), &
 245                                                             err_t (1:JPERR))
 246          err (i) % buoys % temp = intplog (err (i) % level, err_k (1:JPERR), &
 247                                                             err_t (1:JPERR))
 248          err (i) % sound % temp = intplog (err (i) % level, err_k (1:JPERR), &
 249                                                             err_t (1:JPERR))
 250          err (i) % pilot % temp = intplog (err (i) % level, err_k (1:JPERR), &
 251                                                             err_t (1:JPERR))
 252          err (i) % profl % temp = intplog (err (i) % level, err_k (1:JPERR), &
 253                                                             err_t (1:JPERR))
 254          err (i) % satem % temp = intplog (err (i) % level, err_k (1:JPERR), &
 255                                                             err_t (1:JPERR))
 256          err (i) % satob % temp = intplog (err (i) % level, err_k (1:JPERR), &
 257                                                             err_t (1:JPERR))
 258          err (i) % airep % temp = intplog (err (i) % level, err_k (1:JPERR), &
 259                                                             err_t (1:JPERR))
 260          err (i) % ssmt1 % temp = intplog (err (i) % level, err_k (1:JPERR), &
 261                                                             err_t (1:JPERR))
 262          err (i) % ssmt2 % temp = intplog (err (i) % level, err_k (1:JPERR), &
 263                                                             err_t (1:JPERR))
 264          err (i) % ssmi  % temp = intplog (err (i) % level, err_k (1:JPERR), &
 265                                                             err_t (1:JPERR))
 266          err (i) % tovs  % temp = intplog (err (i) % level, err_k (1:JPERR), &
 267                                                             err_t (1:JPERR))
 268          err (i) % airs  % temp = intplog (err (i) % level, err_k (1:JPERR), &
 269                                                             err_t (1:JPERR))
 270          err (i) % other % temp = intplog (err (i) % level, err_k (1:JPERR), &
 271                                                             err_t (1:JPERR))
 272          !  Relative humidity error
 273
 274          err (i) % synop % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 275                                                           err_rh (1:JPERR))
 276          err (i) % metar % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 277                                                           err_rh (1:JPERR))
 278          err (i) % ships % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 279                                                           err_rh (1:JPERR))
 280          err (i) % buoys % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 281                                                           err_rh (1:JPERR))
 282          err (i) % sound % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 283                                                           err_rh (1:JPERR))
 284          err (i) % pilot % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 285                                                           err_rh (1:JPERR))
 286          err (i) % profl % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 287                                                           err_rh (1:JPERR))
 288          err (i) % satem % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 289                                                           err_rh (1:JPERR))
 290          err (i) % satob % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 291                                                           err_rh (1:JPERR))
 292          err (i) % airep % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 293                                                           err_rh (1:JPERR))
 294          err (i) % ssmt1 % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 295                                                           err_rh (1:JPERR))
 296          err (i) % ssmt2 % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 297                                                           err_rh (1:JPERR))
 298          err (i) % ssmi  % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 299                                                           err_rh (1:JPERR))
 300          err (i) % tovs  % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 301                                                           err_rh (1:JPERR))
 302          err (i) % airs  % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 303                                                           err_rh (1:JPERR))
 304          err (i) % other % rh = intplog (err (i) % level, err_k  (1:JPERR), &
 305                                                           err_rh (1:JPERR))
 306
 307       ENDDO
 308
 309 ! 1.4 INITIALISE ERRORS TO NCEP VALUES FOR WIND
 310 !     -----------------------------------------
 311
 312       DO i = 1, 26
 313
 314          !  Wind error
 315
 316          err_wind (i) % synop % wind = intplin (err_wind (i) % level, &
 317                                                 err_k (1:JPERR),err_u (1:JPERR))
 318          err_wind (i) % metar % wind = intplin (err_wind (i) % level, &
 319                                                 err_k (1:JPERR),err_u (1:JPERR))
 320          err_wind (i) % ships % wind = intplin (err_wind (i) % level, &
 321                                                 err_k (1:JPERR),err_u (1:JPERR))
 322          err_wind (i) % buoys % wind = intplin (err_wind (i) % level, &
 323                                                 err_k (1:JPERR),err_u (1:JPERR))
 324          err_wind (i) % sound % wind = intplin (err_wind (i) % level, &
 325                                                 err_k (1:JPERR),err_u (1:JPERR))
 326          err_wind (i) % pilot % wind = intplin (err_wind (i) % level, &
 327                                                 err_k (1:JPERR),err_u (1:JPERR))
 328          err_wind (i) % profl % wind = intplin (err_wind (i) % level, &
 329                                                 err_k (1:JPERR),err_u (1:JPERR))
 330          err_wind (i) % satem % wind = intplin (err_wind (i) % level, &
 331                                                 err_k (1:JPERR),err_u (1:JPERR))
 332          err_wind (i) % satob % wind = intplin (err_wind (i) % level, &
 333                                                 err_k (1:JPERR),err_u (1:JPERR))
 334          err_wind (i) % airep % wind = intplin (err_wind (i) % level, &
 335                                                 err_k (1:JPERR),err_u (1:JPERR))
 336          err_wind (i) % ssmt1 % wind = intplin (err_wind (i) % level, &
 337                                                 err_k (1:JPERR),err_u (1:JPERR))
 338          err_wind (i) % ssmt2 % wind = intplin (err_wind (i) % level, &
 339                                                 err_k (1:JPERR),err_u (1:JPERR))
 340          err_wind (i) % ssmi  % wind = intplin (err_wind (i) % level, &
 341                                                 err_k (1:JPERR),err_u (1:JPERR))
 342          err_wind (i) % tovs  % wind = intplin (err_wind (i) % level, &
 343                                                 err_k (1:JPERR),err_u (1:JPERR))
 344          err_wind (i) % other % wind = intplin (err_wind (i) % level, &
 345                                                 err_k (1:JPERR),err_u (1:JPERR))
 346       ENDDO
 347
 348 ! 1.5 HEIGHT OBSERVATIONAL ERROR
 349 !     --------------------------
 350
 351       keyword = 'HEIGHT SENSOR ERRORS'
 352       endword = 'WIND SENSOR ERRORS'
 353       fmt_err = '(7(1X,F5.1))'
 354
 355       CALL read_obserr_height (iunit, filein, keyword, endword, fmt_err, err)
 356
 357 ! 1.6 WIND OBSERVATIONAL ERROR
 358 !     ------------------------
 359
 360       keyword = 'WIND SENSOR ERRORS'
 361       endword = 'TEMP SENSOR ERRORS'
 362       fmt_err = '(7(1X,F5.1))'
 363       CALL read_obserr_wind (iunit, filein, keyword, endword, fmt_err, err_wind)
 364
 365 ! 1.7 TEMPERATURE OBSERVATIONAL ERROR
 366 !     -------------------------------
 367
 368       keyword = 'TEMP SENSOR ERRORS'
 369       endword = 'RH SENSOR ERRORS ( % )'
 370       fmt_err = '(5(1X,F5.1))'
 371
 372       CALL read_obserr_temp (iunit, filein, keyword, endword, fmt_err, err)
 373
 374 ! 1.8 RH OBSERVATIONAL ERROR
 375 !     -------------------
 376
 377       keyword = 'RH SENSOR ERRORS ( % )'
 378       endword = 'PRESSURE SENSOR ERRORS'
 379       fmt_err = '(1X,5(1X,F5.2))'
 380
 381       CALL read_obserr_rh (iunit, filein, keyword, endword, fmt_err, err)
 382
 383 ! 1.9 PRESSURE OBSERVATIONAL ERROR
 384 !     ----------------------------
 385
 386       keyword = 'PRESSURE SENSOR ERRORS'
 387       endword = '*.'
 388       fmt_err = '(5(1X,F5.1))'
 389
 390       CALL read_obserr_pres (iunit, filein, keyword, endword, fmt_err, err)
 391
 392
 393
 394 ! 2. LOOP OVER STATIONS
 395 ! =====================
 396
 397       nvalids    = 0
 398       nsoundings = 0
 399       nsurfaces  = 0
 400       nlevels    = 0
 401
 402
 403 record: DO loop_index = 1, number_of_obs
 404
 405
 406 ! 2.1 Check if record valid
 407 !     ---------------------
 408
 409 record_valid: IF (obs(loop_index)%info%discard) THEN
 410
 411       CYCLE  record
 412
 413       ELSE record_valid
 414
 415 ! 2.2 Count valid record
 416 !     ------------------
 417
 418       nvalids = nvalids + 1
 419
 420 ! 2.2 Type of observation
 421 !     ------------------
 422
 423       ! Platform code xx
 424
 425        READ (obs (loop_index) % info % platform (4:6), '(I3)') fm
 426
 427 ! 2.2 interpret code
 428 !     ---------------
 429
 430        CALL  fm_decoder (fm, platform)
 431        if (fm == 135) bogus_type = obs (loop_index) % info % platform (8:12)
 432
 433 ! 2.3 2D fields observational error
 434 !     -----------------------------
 435
 436       obs (loop_index) % ground  % slp % error = 200. ! 2hPa
 437 ! For TC bogus, slp error is obtained from psfc%data, name:"BOGUS" is not TC bogus:
 438       IF (fm == 135 .and. bogus_type /= 'BOGUS') &
 439         obs (loop_index) % ground  % slp % error = obs (loop_index) % ground  % psfc % data
 440
 441 !     Some PW or ZTD data are read with their errors, don't modify them
 442
 443       IF (obs (loop_index) % ground  % pw  % error .LE. 0.) THEN
 444         obs (loop_index) % ground  % pw  % error = 0.2   ! 2. mm for GPSPW
 445         IF (fm == 114) THEN
 446 ! the unit of ZTD is also cm, so the default error is 0.5 cm (YRG, 05/09/2008):
 447           obs (loop_index) % ground  % pw  % error = 0.5 ! .5 cm for GP{SZTD
 448         ENDIF
 449         if (eps_equal(obs(loop_index)%ground %pw %data,missing_r,1.)) THEN
 450           obs (loop_index) % ground  % pw  % qc = missing
 451         else
 452           if (fm == 125) then
 453             obs (loop_index) % ground  % pw  % qc = 0 ! error assigned for SSMI
 454           else
 455             obs (loop_index) % ground  % pw  % qc = 1 ! error assigned.
 456           endif
 457         endif
 458       ENDIF
 459
 460       obs (loop_index) % ground  % tb19v % error = err (1) % ssmi % temp
 461       obs (loop_index) % ground  % tb19h % error = err (1) % ssmi % temp
 462       obs (loop_index) % ground  % tb22v % error = err (1) % ssmi % temp
 463       obs (loop_index) % ground  % tb37v % error = err (1) % ssmi % temp
 464       obs (loop_index) % ground  % tb37h % error = err (1) % ssmi % temp
 465       obs (loop_index) % ground  % tb85v % error = err (1) % ssmi % temp
 466       obs (loop_index) % ground  % tb85h % error = err (1) % ssmi % temp
 467
 468       ! SSMI Tb varies from 2 to 5 K from channel 19 to 85
 469
 470       obs (loop_index) % ground  % tb19v % error = 1.00
 471       obs (loop_index) % ground  % tb19h % error = 1.00
 472       obs (loop_index) % ground  % tb22v % error = 2.33
 473       obs (loop_index) % ground  % tb37v % error = 3.66
 474       obs (loop_index) % ground  % tb37h % error = 3.66
 475       obs (loop_index) % ground  % tb85v % error = 5.00
 476       obs (loop_index) % ground  % tb85h % error = 5.00
 477
 478
 479 ! 2.4 Initialise upper level pointer to surface level
 480 !     -----------------------------------------------
 481
 482       current => obs (loop_index) % surface
 483
 484 ! 3. LOOP ON UPPER-AIR LEVELS (FIRST LEVEL IS SURFACE)
 485 ! ====================================================
 486
 487       is_sound   = -1
 488
 489 upper_level: DO WHILE (ASSOCIATED (current))
 490
 491
 492 ! 3.1 Turn on the sounding flag and count the number of level
 493 !     -------------------------------------------------------
 494
 495       is_sound = is_sound + 1
 496       nlevels  = nlevels  + 1
 497
 498 ! 3.2 Pressure
 499 !     --------
 500
 501       pres = current%meas%pressure%data
 502
 503       hh   = current%meas%height%data
 504
 505 ! 3.3 Check if pressure is present
 506 !     ----------------------------
 507
 508       IF ((eps_equal (pres, missing_r, 1.))  .OR. &
 509           (eps_equal (pres, 0.,        1.))) THEN
 510
 511            WRITE (0,'(A,A,1X,A)') 'Internal error obs ', &
 512                                    TRIM (obs (loop_index) % location % id), &
 513                                    TRIM (obs (loop_index) % location % name)
 514            WRITE (0,'(A,F12.3)')  'Pressure = ', pres
 515            STOP                   'in obs_err_afwa.F90.F'
 516
 517       ENDIF
 518
 519
 520 ! 4.  VERTICAL INTERPOLATION OF OBSERVATIONAL ERROR UPON OBSERVATION TYPE
 521 ! =======================================================================
 522
 523       SELECT CASE (TRIM (platform))
 524
 525 ! 4.1 Synoptic obs
 526 !     ------------
 527
 528 !     CASE  ('SYNOP','SYNOP MOBIL')
 529       CASE  ('SYNOP')
 530
 531           !  Wind
 532
 533           current % meas % direction % error = 5. ! 5 degree
 534
 535           current % meas % speed % error = intplin (pres, err_wind % level,&
 536                                                     err_wind % synop % wind)
 537           current % meas % u % error = intplin (pres, err_wind % level,  &
 538                                                 err_wind % synop % wind)
 539           current % meas % v % error = intplin (pres, err_wind % level,  &
 540                                                 err_wind % synop % wind)
 541
 542           !  Pressure
 543
 544           current % meas % pressure % error = intplin  (pres,err % level,    &
 545                                                         err % synop % pres)
 546
 547           !  Height
 548
 549           current % meas % height % error = intplin  (pres,err % level,    &
 550                                                       err % synop % height)
 551           !  Temperature
 552
 553           current % meas % temperature % error = intplog (pres, err % level, &
 554                                                           err % synop % temp)
 555           !  Dew point as temperature
 556
 557           current % meas % dew_point % error = &
 558           current % meas % temperature % error
 559
 560           !  Relative humidity
 561
 562           current % meas % rh % error = intplog (pres, err % level, &
 563                                                  err % synop % rh)
 564
 565 ! 4.2 Ships obs
 566 !     ---------
 567
 568       CASE  ('SHIP')
 569
 570           !  Wind
 571           current % meas % direction % error = 5. ! 5 degree
 572           current % meas % speed     % error = intplin (pres, err_wind % level,&
 573                                                         err_wind % ships % wind)
 574           current % meas % u % error = intplin (pres, err_wind % level,  &
 575                                                 err_wind % ships % wind)
 576           current % meas % v % error = intplin (pres, err_wind % level,  &
 577                                                 err_wind % ships % wind)
 578
 579           !  Pressure
 580
 581           current % meas % pressure % error = intplin  (pres,err % level,    &
 582                                                         err % ships % pres)
 583
 584           !  Height
 585
 586           current % meas % height % error = intplog (pres, err % level, &
 587                                                      err % ships % height)
 588
 589           !  Temperature
 590
 591           current % meas % temperature % error = intplog (pres, err % level, &
 592                                                           err % ships % temp)
 593
 594           !  Dew point as temperature
 595
 596           current % meas % dew_point % error = &
 597           current % meas % temperature % error
 598
 599           !  Relative humidity
 600
 601           current % meas % rh % error = intplog (pres, err % level, &
 602                                                  err % ships % rh)
 603
 604 ! 4.2.1 Buoys obs
 605 !     ---------
 606
 607       CASE  ('BUOY')
 608
 609           !  Wind
 610
 611           current % meas % direction % error = 5. ! 5 degree
 612           current % meas % speed     % error = intplin (pres, err_wind % level,&
 613                                                         err_wind % buoys % wind)
 614           current % meas % u % error = intplin (pres, err_wind % level,  &
 615                                                 err_wind % buoys % wind)
 616           current % meas % v % error = intplin (pres, err_wind % level,  &
 617                                                 err_wind % buoys % wind)
 618
 619           !  Pressure
 620
 621           current % meas % pressure % error = intplin  (pres,err % level,    &
 622                                                         err % buoys % pres)
 623
 624           !  Height
 625
 626           current % meas % height % error = intplog (pres, err % level, &
 627                                                      err % buoys % height)
 628
 629           !  Temperature
 630
 631           current % meas % temperature % error = intplog (pres, err % level, &
 632                                                           err % buoys % temp)
 633
 634           !  Dew point as temperature
 635
 636           current % meas % dew_point % error = &
 637           current % meas % temperature % error
 638
 639           !  Relative humidity
 640
 641           current % meas % rh % error = intplog (pres, err % level, &
 642                                                  err % buoys % rh)
 643
 644 ! 4.3 Metar obs
 645 !     ---------
 646
 647 !     CASE  ('METAR','SPECI')
 648       CASE  ('METAR')
 649
 650           !  Wind
 651
 652           current % meas % direction % error = 5. ! 5 degree
 653           current % meas % speed     % error = intplin (pres, err_wind % level,&
 654                                                         err_wind % metar % wind)
 655           current % meas % u % error = intplin (pres, err_wind % level,  &
 656                                                 err_wind% metar % wind)
 657           current % meas % v % error = intplin (pres, err_wind % level,  &
 658                                                 err_wind % metar % wind)
 659
 660           !  Pressure
 661
 662           current % meas % pressure % error = intplin  (pres,err % level,    &
 663                                                         err % metar % pres)
 664
 665           !  Height
 666
 667           current % meas % height % error = intplog (pres, err % level, &
 668                                                      err % metar % height)
 669
 670           !  Temperature
 671
 672           current % meas % temperature % error = intplog (pres, err % level, &
 673                                                           err % metar % temp)
 674           !  Dew point as temperature
 675
 676           current % meas % dew_point % error = &
 677           current % meas % temperature % error
 678
 679
 680           !  Relative humidity
 681
 682           current % meas % rh % error = intplog (pres, err % level, &
 683                                                  err % metar % rh)
 684
 685 ! 4.4 Pilot
 686 !     -----
 687
 688 !     CASE  ('PILOT','PILOT SHIP','PILOT MOBIL')
 689       CASE  ('PILOT')
 690
 691           !  Wind
 692
 693           current % meas % direction % error = 5. ! 5 degree
 694           current % meas % speed     % error = intplin (pres, err_wind % level,&
 695                                                         err_wind % pilot % wind)
 696           current % meas % u % error = intplin (pres, err_wind % level,  &
 697                                                 err_wind % pilot % wind)
 698           current % meas % v % error = intplin (pres, err_wind % level,  &
 699                                                 err_wind % pilot % wind)
 700           !  Pressure
 701
 702           current % meas % pressure % error = intplin (pres, err % level,   &
 703                                                        err % pilot % pres)
 704
 705           !  height
 706
 707           current % meas % height % error = intplog (pres, err % level, &
 708                                                      err % pilot % height)
 709
 710           !  Temperature
 711
 712           current % meas % temperature % error = intplog (pres,err % level, &
 713                                                           err % pilot % temp)
 714           !  Dew point as temperature
 715
 716           current % meas % dew_point % error = &
 717           current % meas % temperature % error
 718
 719
 720           !  Relative humidity
 721
 722           current % meas % rh % error = intplog (pres, err % level, &
 723                                                  err % pilot % rh)
 724
 725 ! 4.4.1 Profilers
 726 !     -----
 727
 728       CASE  ('PROFL')
 729
 730           !  Wind
 731
 732           current % meas % direction % error = 5. ! 5 degree
 733           current % meas % speed     % error = intplin (pres, err_wind % level,&
 734                                                         err_wind % profl % wind)
 735           current % meas % u % error = intplin (pres, err_wind % level,  &
 736                                                 err_wind % profl % wind)
 737           current % meas % v % error = intplin (pres, err_wind % level,  &
 738                                                 err_wind % profl % wind)
 739           !  Pressure
 740
 741           current % meas % pressure % error = intplin (pres, err % level,   &
 742                                                        err % profl % pres)
 743
 744           !  height
 745
 746           current % meas % height % error = intplog (pres, err % level, &
 747                                                      err % profl % height)
 748
 749           !  Temperature
 750
 751           current % meas % temperature % error = intplog (pres,err % level, &
 752                                                           err % profl % temp)
 753           !  Dew point as temperature
 754
 755           current % meas % dew_point % error = &
 756           current % meas % temperature % error
 757
 758
 759           !  Relative humidity
 760
 761           current % meas % rh % error = intplog (pres, err % level, &
 762                                                  err % profl % rh)
 763 ! 4.5 Sounding obs
 764 !     ------------
 765
 766 !     CASE  ('TEMP','TEMP SHIP','TEMP DROP','TEMP MOBIL')
 767       CASE  ('SOUND')
 768
 769           !  Wind
 770
 771           current % meas % direction % error = 5. ! 5 degree
 772           current % meas % speed     % error = intplin (pres, err_wind % level,&
 773                                                         err_wind % sound % wind)
 774           current % meas % u % error = intplin (pres, err_wind % level, &
 775                                                 err_wind % sound % wind)
 776           current % meas % v % error = intplin (pres, err_wind % level, &
 777                                                 err_wind % sound % wind)
 778
 779           !  Pressure
 780
 781           current % meas % pressure % error = intplin (pres, err % level, &
 782                                                        err % sound % pres)
 783
 784           !  Height
 785
 786           current % meas % height % error = intplog (pres, err % level, &
 787                                                      err % sound % height)
 788           !  Temperature
 789
 790           current % meas % temperature % error = intplog (pres,err % level, &
 791                                                           err % sound % temp)
 792           !  Dew point as temperature
 793
 794           current % meas % dew_point % error = &
 795           current % meas % temperature % error
 796
 797           !  Relative humidity
 798
 799           current % meas % rh % error = intplog (pres, err % level, &
 800                                                  err % sound % rh)
 801
 802
 803 ! 4.5.1 Bogus Sounding
 804 !     ----------------
 805
 806 !     CASE  ('BOGUS')
 807       CASE  ('BOGUS')
 808
 809           !  Wind
 810
 811           current % meas % direction % error = 5. ! 5 degree
 812
 813           IF (bogus_type /= 'BOGUS') then
 814
 815             current % meas % speed     % error = current % meas % u % data
 816
 817             current % meas % u % error = current % meas % u % data
 818
 819             current % meas % v % error = current % meas % v % data
 820
 821             current % meas % temperature % error = current % meas % dew_point % data
 822
 823             current % meas % dew_point % error = current % meas % temperature % error
 824
 825             current % meas % rh % error = current % meas % thickness % data
 826
 827 !            current % meas % pressure % error = intplin (pres, err % level, &
 828 !                                                       err % sound % pres)
 829 !
 830 !            current % meas % height % error = intplog (pres, err % level, &
 831 !                                                     err % sound % height)
 832           else
 833
 834             current % meas % speed     % error = intplin (pres, err_wind % level,&
 835                                                         err_wind % sound % wind)
 836             current % meas % u % error = intplin (pres, err_wind % level, &
 837                                                 err_wind % sound % wind)
 838             current % meas % v % error = intplin (pres, err_wind % level, &
 839                                                 err_wind % sound % wind)
 840
 841           !  Pressure
 842
 843           current % meas % pressure % error = intplin (pres, err % level, &
 844                                                        err % sound % pres)
 845
 846           !  Height
 847
 848           current % meas % height % error = intplog (pres, err % level, &
 849                                                      err % sound % height)
 850           !  Temperature
 851
 852           current % meas % temperature % error = intplog (pres,err % level, &
 853                                                           err % sound % temp)
 854           !  Dew point as temperature
 855
 856           current % meas % dew_point % error = &
 857           current % meas % temperature % error
 858
 859           !  Relative humidity
 860
 861           current % meas % rh % error = intplog (pres, err % level, &
 862                                                  err % sound % rh)
 863
 864           endif
 865
 866 ! 4.6 Satem obs
 867 !     ---------
 868
 869       CASE  ('SATEM')
 870
 871           !  Wind
 872
 873           current % meas % direction % error = 5. ! 5 degree
 874           current % meas % speed     % error = intplin (pres, err_wind % level,&
 875                                                         err_wind % satem % wind)
 876           current % meas % u % error = intplin (pres, err_wind % level, &
 877                                                 err_wind % satem % wind)
 878           current % meas % v % error = intplin (pres, err_wind % level, &
 879                                                 err_wind % satem % wind)
 880           !  Pressure
 881
 882           current % meas % pressure % error = intplin (pres, err % level, &
 883                                                        err % satem % pres)
 884
 885           !  Height
 886
 887           current % meas % height % error = intplog (pres, err % level, &
 888                                                      err % satem % height)
 889
 890           current % meas % thickness % error = intplog (pres, err % level, &
 891                                                      err % satem % height)
 892
 893           obs (loop_index) % ground % pw  % error = intplog (  &
 894                          obs(loop_index)%ground%ref_pres%data,     &
 895                          err % level, err % satem % height)
 896
 897           !  Temperature
 898
 899           current % meas % temperature % error = intplog (pres, err % level, &
 900                                                           err % satem % temp)
 901
 902           !  Dew point as temperature
 903
 904           current % meas % dew_point % error = &
 905           current % meas % temperature % error
 906
 907           !  Relative humidity
 908
 909           current % meas % rh % error = intplog (pres, err % level, &
 910                                                  err % satem % rh)
 911
 912
 913
 914 ! 4.8 Satobs obs
 915 !     ----------
 916
 917       CASE  ('SATOB')
 918
 919           !  Wind
 920
 921           current % meas % direction % error = 5. ! 5 degree
 922           current % meas % speed     % error = intplin (pres, err_wind % level,&
 923                                                         err_wind % satob % wind)
 924           current % meas % u % error = intplin (pres, err_wind % level, &
 925                                                 err_wind % satob % wind)
 926           current % meas % v % error = intplin (pres, err_wind % level, &
 927                                                 err_wind % satob % wind)
 928
 929           !  Pressure
 930
 931           current % meas % pressure % error = intplin (pres, err % level, &
 932                                                        err % satob % pres)
 933
 934           !  height
 935
 936           current % meas % height % error = intplog (pres, err % level, &
 937                                                      err % satob % height)
 938
 939           !  Temperature
 940
 941           current % meas % temperature % error = intplog (pres, err % level, &
 942                                                           err % satob % temp)
 943
 944           !  Dew point as temperature
 945
 946           current % meas % dew_point % error = &
 947           current % meas % temperature % error
 948
 949           !  Relative humidity
 950
 951           current % meas % rh % error = intplog (pres, err % level, &
 952                                                  err % satob % rh)
 953
 954
 955 ! 4.9 Airep
 956 !     -----
 957
 958       CASE  ('AIREP','AMDAR','TAMDAR')
 959
 960           !  Wind
 961
 962           current % meas % direction % error = 5. ! 5 degree
 963           current % meas % speed     % error = intplin (pres, err_wind % level,&
 964                                                         err_wind % airep % wind)
 965           current % meas % u % error = intplin (pres, err_wind % level, &
 966                                                 err_wind % airep % wind)
 967           current % meas % v % error = intplin (pres, err_wind % level, &
 968                                                 err_wind % airep % wind)
 969
 970           !  Pressure
 971
 972           current % meas % pressure % error = intplin (pres, err % level, &
 973                                                        err % airep % pres)
 974
 975           !  Height
 976
 977           current % meas % height % error = intplog (pres, err % level, &
 978                                                      err % airep % height)
 979
 980           !  Temperature
 981
 982           current % meas % temperature % error = intplog (pres, err % level, &
 983                                                           err % airep % temp)
 984           !  Dew point as temperature
 985
 986           current % meas % dew_point % error = &
 987           current % meas % temperature % error
 988
 989           !  Relative humidity
 990
 991           current % meas % rh % error = intplog (pres, err % level, &
 992                                                  err % airep % rh)
 993
 994
 995 ! 4.9 SSMT1
 996 !     -----
 997
 998       CASE  ('SSMT1')
 999
1000           !  Wind
1001
1002           current % meas % direction % error = 5. ! 5 degree
1003           current % meas % speed     % error = intplin (pres, err_wind % level,&
1004                                                         err_wind % ssmt1 % wind)
1005           current % meas % u % error = intplin (pres, err_wind % level, &
1006                                                 err_wind % ssmt1 % wind)
1007           current % meas % v % error = intplin (pres, err_wind % level, &
1008                                                 err_wind % ssmt1 % wind)
1009
1010           !  Pressure
1011
1012           current % meas % pressure % error = intplin (pres, err % level, &
1013                                                        err % ssmt1 % pres)
1014
1015           !  height
1016
1017           current % meas % rh % error = intplog (pres, err % level, &
1018                                                  err % ssmt1 % height)
1019
1020           !  Temperature
1021
1022           current % meas % temperature % error = intplog (pres, err % level, &
1023                                                           err % ssmt1 % temp)
1024           !  Dew point as temperature
1025
1026           current % meas % dew_point % error = &
1027           current % meas % temperature % error
1028
1029           !  Relative humidity
1030
1031           current % meas % rh % error = intplog (pres, err % level, &
1032                                                  err % ssmt1 % rh)
1033
1034
1035
1036 ! 4.10 SSMT2
1037 !      -----
1038
1039       CASE  ('SSMT2')
1040
1041           !  Wind
1042
1043           current % meas % direction % error = 5. ! 5 degree
1044           current % meas % speed     % error = intplin (pres, err_wind % level,&
1045                                                         err_wind % ssmt2 % wind)
1046           current % meas % u % error = intplin (pres, err_wind % level, &
1047                                                 err_wind % ssmt2 % wind)
1048           current % meas % v % error = intplin (pres, err_wind % level, &
1049                                                 err_wind % ssmt2 % wind)
1050
1051           !  Pressure
1052
1053           current % meas % pressure % error = intplin (pres, err % level, &
1054                                                        err % ssmt2 % pres)
1055
1056           !  height
1057
1058           current % meas % rh % error = intplog (pres, err % level, &
1059                                                  err % ssmt2 % height)
1060
1061           !  Temperature
1062
1063           current % meas % temperature % error = intplog (pres, err % level, &
1064                                                           err % ssmt2 % temp)
1065           !  Dew point as temperature
1066
1067           current % meas % dew_point % error = &
1068           current % meas % temperature % error
1069
1070           !  Relative humidity
1071
1072           current % meas % rh % error = intplog (pres, err % level, &
1073                                                  err % ssmt2 % rh)
1074
1075
1076
1077 ! 4.11 SSMI
1078 !      -----
1079
1080       CASE  ('SSMI')
1081
1082           !  Wind
1083
1084           current % meas % direction % error = 5. ! 5 degree
1085
1086           ! SSMI wind speed can come with its own error
1087
1088           IF (current % meas % speed % error .LE. 0.) &
1089           current % meas % speed % error = intplin (pres, err_wind % level,&
1090                                                     err_wind % ssmi % wind)
1091           current % meas % u % error = intplin (pres, err_wind  % level, &
1092                                                 err_wind % ssmi % wind)
1093           current % meas % v % error = intplin (pres, err_wind  % level, &
1094                                                 err_wind % ssmi % wind)
1095
1096           !  Pressure
1097
1098           current % meas % pressure % error = intplin (pres, err  % level, &
1099                                                        err % ssmi % pres)
1100
1101           !  Height
1102
1103           current % meas % height % error = intplog (pres, err  % level, &
1104                                                      err % ssmi % height)
1105
1106           !  Temperature
1107
1108           current % meas % temperature % error = intplog (pres, err  % level, &
1109                                                           err % ssmi % temp)
1110           !  Dew point as temperature
1111
1112           current % meas % dew_point % error = &
1113           current % meas % temperature % error
1114
1115           !  Relative humidity
1116
1117           current % meas % rh % error = intplog (pres, err  % level, &
1118                                                  err % ssmi % rh)
1119
1120
1121
1122 ! 4.12 TOVS
1123 !      -----
1124
1125       CASE  ('TOVS')
1126
1127           !  Wind
1128
1129           current % meas % direction % error = 5. ! 5 degree
1130           current % meas % speed     % error = intplin (pres, err_wind % level,&
1131                                                         err_wind % tovs % wind)
1132           current % meas % u % error = intplin (pres, err_wind  % level, &
1133                                                 err_wind % tovs % wind)
1134           current % meas % v % error = intplin (pres, err_wind  % level, &
1135                                                 err_wind % tovs % wind)
1136
1137           !  Pressure
1138
1139           current % meas % pressure % error = intplin (pres, err  % level, &
1140                                                        err % tovs % pres)
1141
1142           !  Height
1143
1144           current % meas % height % error = intplog (pres, err  % level, &
1145                                                  err % tovs % height)
1146
1147           !  Temperature
1148
1149           current % meas % temperature % error = intplog (pres, err  % level, &
1150                                                           err % tovs % temp)
1151           !  Dew point as temperature
1152
1153           current % meas % dew_point % error = &
1154           current % meas % temperature % error
1155
1156           !  Relative humidity
1157
1158           current % meas % rh % error = intplog (pres, err  % level, &
1159                                                  err % tovs % rh)
1160
1161
1162 ! 4.13 QSCAT
1163 !      -----
1164
1165       CASE  ('QSCAT')
1166
1167           !  Wind
1168
1169           current % meas % direction % error = current % meas % v % data
1170           current % meas % speed     % error = current % meas % u % data
1171
1172           current % meas % u % error = intplin (pres, err_wind  % level, &
1173                                                 err_wind % tovs % wind)
1174           current % meas % v % error = intplin (pres, err_wind  % level, &
1175                                                 err_wind % tovs % wind)
1176
1177           !  Pressure
1178
1179           current % meas % pressure % error = intplin (pres, err  % level, &
1180                                                        err % tovs % pres)
1181
1182           !  Height
1183
1184           current % meas % height % error = intplog (pres, err  % level, &
1185                                                  err % tovs % height)
1186
1187           !  Temperature
1188
1189           current % meas % temperature % error = intplog (pres, err  % level, &
1190                                                           err % tovs % temp)
1191           !  Dew point as temperature
1192
1193           current % meas % dew_point % error = &
1194           current % meas % temperature % error
1195
1196           !  Relative humidity
1197
1198           current % meas % rh % error = intplog (pres, err  % level, &
1199                                                  err % tovs % rh)
1200
1201 ! 4.14 GPSRF, GPSEP (like SSMT/1)
1202 !      -----
1203
1204      CASE  ('GPSRF', 'GPSEP')
1205
1206          !  Wind
1207
1208           current % meas % direction % error = 5. ! 5 degree
1209           current % meas % speed     % error = intplin (pres,err_wind % level,&
1210                                                         err_wind % ssmt1 % wind)
1211           current % meas % u % error = intplin (pres, err_wind % level, &
1212                                                 err_wind % ssmt1 % wind)
1213           current % meas % v % error = intplin (pres, err_wind % level, &
1214                                                 err_wind % ssmt1 % wind)
1215
1216           !  Pressure
1217
1218           current % meas % pressure % error = intplin (pres, err % level, &
1219                                                        err % ssmt1 % pres)
1220
1221           !  height
1222
1223           current % meas % height % error = intplog (pres, err % level, &
1224                                                      err % ssmt1 % height)
1225
1226           !  Temperature
1227
1228           current % meas % temperature % error = intplog (pres, err % level, &
1229                                                           err % ssmt1 % temp)
1230
1231           ! Refractivity (the 'dew point' is used to store the refractivity)
1232
1233           latt = abs(current % meas % u % data)
1234
1235  !         Refractivity (the 'dew point' is used to store the ref_obs)
1236           rr   =(current % meas % dew_point % data) *0.01
1237
1238           if ( hh >= ha ) then
1239             current % meas % dew_point % error =rr*ea
1240           else
1241             erh90 = (ea-ed)*(hh-ha)/(ha-hd)+ea
1242             if (hh >= hb) then
1243               erh0 = (ea-eb)*(hh-ha)/(ha-hb)+ea
1244             else if (hh >=hc) then
1245               erh0 = (eb-ec)*(hh-hb)/(hb-hc)+eb
1246             else
1247               erh0 =2.5
1248             endif
1249
1250             err90=rr*erh90
1251             err0 =rr*erh0
1252
1253             current % meas % dew_point % error =err90-(1-(abs(latt))/90)*(err90-err0)
1254           endif
1255
1256           !  Relative humidity
1257
1258           current % meas % rh % error = intplog (pres, err % level, &
1259                                                  err % ssmt1 % rh)
1260
1261 ! 4.15 AIRS (like SSMT/1)
1262 !      -----
1263
1264      CASE  ('AIRSRET')
1265
1266           !  Pressure
1267
1268           current % meas % pressure % error = intplin (pres, err % level, &
1269                                                        err % airs  % pres)
1270
1271           !  height
1272
1273           current % meas % height % error = intplog (pres, err % level, &
1274                                                      err % airs  % height)
1275
1276           !  Temperature
1277
1278           current % meas % temperature % error = intplog (pres, err % level, &
1279                                                           err % airs  % temp)
1280
1281           !  Relative humidity
1282
1283           current % meas % rh % error = intplog (pres, err % level, &
1284                                                  err % airs  % rh)
1285
1286       CASE  ('GPSPW')
1287
1288
1289 ! 4.13 Others, use ncep values
1290 !      -----------------------
1291
1292       CASE DEFAULT
1293
1294       WRITE (UNIT = 0, FMT = '(A,A,A)') &
1295      'Unknown platform:',TRIM (platform),' use NCEP observational errors.'
1296
1297
1298       !  wind
1299
1300       current % meas % direction % error = 5. ! 5 degree
1301       current % meas % speed     % error = intplin (pres, err_k (1:JPERR), &
1302                                                           err_u (1:JPERR))
1303       current % meas % u % error = intplin (pres, err_k (1:JPERR), &
1304                                                   err_u (1:JPERR))
1305       current % meas % v % error = intplin (pres, err_k (1:JPERR), &
1306                                                   err_u (1:JPERR))
1307       !  Pressure
1308
1309       current % meas % pressure % error = intplin (pres, err_k (1:JPERR), &
1310                                                          err_p (1:JPERR))
1311
1312       !  Relative humidity
1313
1314       current % meas % rh % error = intplog (pres, err_k  (1:JPERR), &
1315                                                    err_rh (1:JPERR))
1316
1317       !  Height
1318
1319       current % meas % height   % error = intplin (pres, err_k (1:JPERR), &
1320                                                          err_h (1:JPERR))
1321
1322       !  Temperature
1323
1324       current % meas % temperature % error = intplog (pres, err_k (1:JPERR),&
1325                                                             err_t (1:JPERR))
1326
1327       !  Dew point as temperature
1328
1329       current % meas % dew_point % error = current % meas % temperature % error
1330
1331
1332
1333       END SELECT
1334
1335
1336 ! 5.  MIXING RATIO ERROR DERIVED FROM RELATIVE HUMIDITY, TEMPERATURE, AND
1337 !     PRESSURE
1338 ! =====================================================
1339
1340    IF ((.NOT.eps_equal (current % meas % pressure % data,missing_r,1.))   .AND.&
1341        (.NOT.eps_equal (current % meas % temperature % data,missing_r,1.)).AND.&
1342        (.NOT.eps_equal (current % meas % rh % data, missing_r, 1.))) THEN
1343
1344 !       current % meas % qv % error = E_QV_FROM_RH (current % meas % rh % error, &
1345 !                                       current % meas % temperature % error, &
1346 !                                       current % meas % pressure % error, &
1347 !                                       current % meas % rh % data, &
1348 !                                       current % meas % temperature % data, &
1349 !                                       current % meas % pressure % data)
1350
1351 !       current % meas % qv % error = MAX (current % meas % qv % error, 0.001)
1352
1353         p9  = current % meas % pressure % data  / 100
1354         p   = current % meas % pressure % error / 100
1355         t9  = current % meas % temperature % data
1356         t   = current % meas % temperature % error
1357         rh9 = current % meas % rh % data
1358         rh  = current % meas % rh % error
1359
1360         es9 = 6.112 * EXP (17.67*(t9-273.15) &
1361                                 /(t9-273.15+243.5))
1362         es = 6.112 &
1363            * EXP ( 17.67*(t9-273.15) /  (t9-273.15+243.5) ) &
1364            *     (+17.67* t          /  (t9-273.15+243.5)  &
1365                   -17.67*(t9-273.15) / ((t9-273.15+243.5)*(t9-273.15+243.5)))
1366
1367         qs9 = 0.622 * es9 / (p9-es9)
1368         qs  = 0.622 * es  / (p9-es9) &
1369             - 0.622 * es9 * (p -es ) / ((p9-es9)*(p9-es9))
1370
1371         qv9 = 0.01*rh9*qs9
1372         qv  = 0.01*rh *qs9 + 0.01*rh9 *qs
1373
1374         !  Error should not be lower than 1g/kg
1375
1376         current % meas % qv % error = MAX (qv, 0.001)
1377
1378    ELSE
1379
1380         current % meas % qv % error = missing_r
1381
1382    ENDIF
1383
1384
1385 !  IF (eps_equal (current % meas % temperature % data,missing_r,1.))
1386 !      temp = t_from_p_icao (p)
1387 !  ELSE
1388 !      temp = current % meas % temperature % data
1389 !  ENDIF
1390
1391 !  current % meas % qv % error = F_QV_FROM_RH  &
1392 !                               (current % meas % rh % error, temp,&
1393 !                                current % meas % pressure % data)
1394
1395 ! 6.  GO TOP NEXT LEVEL
1396 ! =====================
1397
1398       current => current%next
1399
1400       ENDDO upper_level
1401
1402
1403 ! 7.  GO TO NEXT STATIONS
1404 ! =======================
1405
1406 ! 7.1 Increment the surface or sounding counter
1407 !     -----------------------------------------
1408
1409       if (is_sound .gt. 0) then
1410           nsoundings = nsoundings + 1
1411       else
1412           nsurfaces  = nsurfaces + 1
1413       endif
1414
1415 ! 7.2 Go to next valid record
1416 !     -----------------------
1417
1418       ENDIF  record_valid
1419
1420 ! 7.3 Go to next record
1421 !     -----------------
1422       ENDDO  record
1423
1424
1425 ! 8.  PRINT DIAGNOSTIC
1426 ! ====================
1427
1428       WRITE (UNIT = 0 , FMT = '(A)' ) ' '
1429       WRITE (UNIT = 0 , FMT = '(A,I6,A,I6,A)' ) &
1430      "Number of processed stations:           ",nvalids,&
1431      " = ",nlevels," levels."
1432       WRITE (UNIT = 0 , FMT = '(A,I6,A,I6,A)' ) &
1433      "Number of processed surface stations:   ",nsurfaces,&
1434      " = ",nsurfaces," surface levels."
1435       WRITE (UNIT = 0 , FMT = '(A,I6,A,I6,A,/)' ) &
1436      "Number of processed upper-air stations: ",nsoundings,&
1437      " = ",nlevels-nsurfaces," upper-air levels."
1438
1439 ! 9.  END
1440 ! =======
1441       RETURN
1442
1443       END SUBROUTINE obs_err_afwa
1444
1445 SUBROUTINE READ_OBSERR_HEIGHT (iunit, filein, keyword, endword, fmt_err, err)
1446 !------------------------------------------------------------------------------!
1447 !
1448 ! Read height observational error defined on the following 15 levels (in hPa):
1449 !
1450 !  1000,  850,  700,  500,  400,
1451 !   300,  250,  200,  150,  100,
1452 !    70,   50,   30,   20,   10
1453 !
1454 !------------------------------------------------------------------------------!
1455    IMPLICIT NONE
1456 !------------------------------------------------------------------------------!
1457
1458    INTEGER             :: iunit   != 99
1459    CHARACTER (LEN=80)  :: filein  != 'obserr.txt'
1460    CHARACTER (LEN=80)  :: keyword != 'HEIGHT SENSOR ERRORS'
1461    CHARACTER (LEN=80)  :: endword != 'WIND SENSOR ERRORS'
1462    CHARACTER (LEN=80)  :: fmt_err != '(5(1X,F5.1))'
1463    TYPE (obs_type), DIMENSION (15) :: err
1464
1465    INTEGER             :: io_error, i
1466    CHARACTER (LEN=80)  :: line1, line2, line3, line4
1467    LOGICAL             :: found, wind
1468    CHARACTER (LEN=80)  :: fileout
1469
1470 !------------------------------------------------------------------------------!
1471
1472 ! 1.  OPEN INPUT FILE
1473 ! ===================
1474
1475       OPEN (UNIT = iunit , FILE = filein , FORM = 'FORMATTED'  , &
1476             ACTION = 'READ' , STATUS = 'OLD', IOSTAT = io_error)
1477
1478       IF (io_error .NE. 0) THEN
1479           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
1480          'Unable to open input observational error file ',TRIM (filein)
1481           STOP
1482       ENDIF
1483
1484
1485 ! 2.  READ DATA
1486 ! =============
1487
1488 !     Read file until keyword is found
1489
1490       found   = .FALSE.
1491       wind    = .FALSE.
1492       io_error= 0
1493
1494       DO WHILE (io_error .EQ. 0.)
1495
1496          !  Read 1 line
1497
1498          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line1
1499
1500          !  Exit when error or at end of file
1501
1502          IF (io_error .NE. 0) EXIT
1503
1504          !  Winds are given over 4 lines, any other data are given over 3 lines
1505
1506          IF (TRIM (obstype (line1)) .EQ. 'WIND SENSOR ERRORS') THEN
1507
1508              wind = .TRUE.
1509
1510          !  Winds ends at temperature,
1511
1512          ELSE IF (TRIM (obstype (line1)) .EQ. 'TEMP SENSOR ERRORS') THEN
1513
1514              wind = .false.
1515
1516          ENDIF
1517
1518          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line2
1519          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line3
1520          IF (wind) &
1521          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line4
1522
1523          !  If temp obstype is found, read error data
1524
1525          IF (TRIM (obstype (line1)) .EQ. TRIM (keyword)) THEN
1526
1527              found = .TRUE.
1528              WRITE (UNIT = 0, FMT = '(A,A)',ADVANCE='no') &
1529                     TRIM (obstype (line1)),': '
1530
1531          ELSE IF (((TRIM (obstype (line1)) .EQ. TRIM (endword)) .OR. &
1532                    (line1 (1:2) .EQ. '*.'))) THEN
1533
1534              EXIT
1535
1536          ENDIF
1537
1538          !  If temp obstype is not found, keep on reading
1539
1540          IF (.NOT. found) CYCLE
1541
1542          !  Keyword has been found, Error at mandatory pressure levels follow
1543          !  Break down data upon obs type
1544
1545
1546          SELECT CASE (TRIM (sensor (line1)))
1547
1548
1549          CASE ('RAOBS')  ! Sound
1550
1551                 WRITE (UNIT = 0, FMT = '(1X,2A)', ADVANCE='no') &
1552                        TRIM (sensor (line1)),','
1553
1554                 READ (line1, fmt_err) (err (i) % sound % height, i =  1,  5)
1555                 READ (line2, fmt_err) (err (i) % sound % height, i =  6, 10)
1556                 READ (line3, fmt_err) (err (i) % sound % height, i = 11, 15)
1557
1558          CASE ('PIBALS')  ! Pilot
1559
1560                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1561                        TRIM (sensor (line1)),','
1562
1563                 READ (line1, fmt_err) (err (i) % pilot % height, i =  1,  5)
1564                 READ (line2, fmt_err) (err (i) % pilot % height, i =  6, 10)
1565                 READ (line3, fmt_err) (err (i) % pilot % height, i = 11, 15)
1566
1567          CASE ('AIREPS')  ! AIREPS
1568
1569                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1570                        TRIM (sensor (line1)),','
1571
1572                 READ (line1, fmt_err) (err (i) % airep % height, i =  1,  5)
1573                 READ (line2, fmt_err) (err (i) % airep % height, i =  6, 10)
1574                 READ (line3, fmt_err) (err (i) % airep % height, i = 11, 15)
1575
1576          CASE ('AIRSRET')  ! AIRS retrievals
1577
1578                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1579                        TRIM (sensor (line1)),','
1580
1581                 READ (line1, fmt_err) (err (i) % airs  % height, i =  1,  5)
1582                 READ (line2, fmt_err) (err (i) % airs  % height, i =  6, 10)
1583                 READ (line3, fmt_err) (err (i) % airs  % height, i = 11, 15)
1584
1585          CASE ('SURFACE LAND')  ! synop and metar
1586
1587                 READ (line1, fmt_err) (err (i) % synop % height, i =  1,  5)
1588                 READ (line2, fmt_err) (err (i) % synop % height, i =  6, 10)
1589                 READ (line3, fmt_err) (err (i) % synop % height, i = 11, 15)
1590
1591                 READ (line1, fmt_err) (err (i) % metar % height, i =  1,  5)
1592                 READ (line2, fmt_err) (err (i) % metar % height, i =  6, 10)
1593                 READ (line3, fmt_err) (err (i) % metar % height, i = 11, 15)
1594
1595          CASE ('SURFACE SHIP')  ! ships
1596
1597                 WRITE (UNIT = 0, FMT = '(1X,2A)', ADVANCE='no') &
1598                        TRIM (sensor (line1)),','
1599
1600                 READ (line1, fmt_err) (err (i) % ships % height, i =  1,  5)
1601                 READ (line2, fmt_err) (err (i) % ships % height, i =  6, 10)
1602                 READ (line3, fmt_err) (err (i) % ships % height, i = 11, 15)
1603
1604          CASE ('BUOY')  ! BUOY
1605
1606                 WRITE (UNIT = 0, FMT = '(1X,2A)', ADVANCE='no') &
1607                        TRIM (sensor (line1)),','
1608
1609                 READ (line1, fmt_err) (err (i) % buoys % height, i =  1,  5)
1610                 READ (line2, fmt_err) (err (i) % buoys % height, i =  6, 10)
1611                 READ (line3, fmt_err) (err (i) % buoys % height, i = 11, 15)
1612
1613          CASE ('NOAA - A RETRIEVAL')   ! Satob and Satem
1614
1615                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1616                        TRIM (sensor (line1)),','
1617
1618                 READ (line1, fmt_err) (err (i) % satob % height, i =  1,  5)
1619                 READ (line2, fmt_err) (err (i) % satob % height, i =  6, 10)
1620                 READ (line3, fmt_err) (err (i) % satob % height, i = 11, 15)
1621
1622 !               READ (line1, fmt_err) (err (i) % satem % height, i =  1,  5)
1623 !               READ (line2, fmt_err) (err (i) % satem % height, i =  6, 10)
1624 !               READ (line3, fmt_err) (err (i) % satem % height, i = 11, 15)
1625
1626          CASE ('NOAA - CLEAR PATH RETRIEVAL')   ! Satem clear path
1627
1628 !                WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1629                 WRITE (UNIT = 0, FMT = '(1X,2A)') &
1630                        TRIM (sensor (line1)),','
1631
1632                 READ (line1, fmt_err) (err (i) % satem % height, i =  1,  5)
1633                 READ (line2, fmt_err) (err (i) % satem % height, i =  6, 10)
1634                 READ (line3, fmt_err) (err (i) % satem % height, i = 11, 15)
1635
1636          CASE ('DMSP - A RETRIEVAL')   ! ssmt1, ssmt2, ssmi and tovs
1637
1638 !                WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1639                 WRITE (UNIT = 0, FMT = '(1X,2A)') &
1640                        TRIM (sensor (line1)),','
1641
1642                 READ (line1, fmt_err) (err (i) % ssmt1 % height, i =  1,  5)
1643                 READ (line2, fmt_err) (err (i) % ssmt1 % height, i =  6, 10)
1644                 READ (line3, fmt_err) (err (i) % ssmt1 % height, i = 11, 15)
1645
1646                 READ (line1, fmt_err) (err (i) % ssmt2 % height, i =  1,  5)
1647                 READ (line2, fmt_err) (err (i) % ssmt2 % height, i =  6, 10)
1648                 READ (line3, fmt_err) (err (i) % ssmt2 % height, i = 11, 15)
1649
1650                 READ (line1, fmt_err) (err (i) % ssmi  % height, i =  1,  5)
1651                 READ (line2, fmt_err) (err (i) % ssmi  % height, i =  6, 10)
1652                 READ (line3, fmt_err) (err (i) % ssmi  % height, i = 11, 15)
1653
1654                 READ (line1, fmt_err) (err (i) % tovs  % height, i =  1,  5)
1655                 READ (line2, fmt_err) (err (i) % tovs  % height, i =  6, 10)
1656                 READ (line3, fmt_err) (err (i) % tovs  % height, i = 11, 15)
1657
1658          CASE ('PROFL')  ! Profilers
1659
1660                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1661                        TRIM (sensor (line1)),','
1662
1663                 READ (line1, fmt_err) (err (i) % profl % height, i =  1,  5)
1664                 READ (line2, fmt_err) (err (i) % profl % height, i =  6, 10)
1665                 READ (line3, fmt_err) (err (i) % profl % height, i = 11, 15)
1666
1667
1668          CASE DEFAULT  ! Other
1669
1670 !               WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1671 !                      TRIM (sensor (line1)),','
1672
1673                 READ (line1, fmt_err) (err (i) % other % height, i =  1,  5)
1674                 READ (line2, fmt_err) (err (i) % other % height, i =  6, 10)
1675                 READ (line3, fmt_err) (err (i) % other % height, i = 11, 15)
1676
1677          END SELECT
1678
1679       ENDDO
1680
1681       WRITE (UNIT = 0, FMT = '(A)') ' '
1682
1683       !  If obs type is not found, print it
1684
1685       IF (.NOT. found) THEN
1686           WRITE (UNIT = 0, FMT = '(/,A,A)') &
1687         ' Observational errors for ',TRIM (keyword)
1688           WRITE (UNIT = 0, FMT = '(A,A,/)') &
1689         ' were not found in file ',  TRIM (filein)
1690
1691       ENDIF
1692
1693 ! 3.  CLOSE INPUT FILE
1694 ! ====================
1695
1696       CLOSE (UNIT = iunit)
1697
1698 ! 4.  WRITE VALUES
1699 ! ================
1700
1701       fileout = keyword (1:6)//'.txt'
1702
1703       OPEN (UNIT = iunit , FILE = fileout , FORM = 'FORMATTED'  , &
1704             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error)
1705
1706       IF (io_error .NE. 0) THEN
1707           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
1708          'Unable to open output observational error file ',TRIM (fileout)
1709           STOP
1710       ENDIF
1711
1712
1713       WRITE (UNIT = iunit, FMT = '(20X,A)') TRIM (keyword)
1714
1715       WRITE (UNIT = iunit, FMT = '(1X,16A)') ' level',&
1716     ' synop ','  ship ','  buoy ',' metar ',' pilot ',' profl ',&
1717     ' sound ',' satem ',' satob ',' airep ',&
1718     ' ssmt1 ',' ssmt2 ','  tovs ','  ssmi ',' airsret',&
1719     ' other '
1720
1721       DO i = 15, 1, -1
1722          WRITE (UNIT = iunit, FMT = '(F6.0,15(2X,F5.1))') &
1723                 err (i) % level / 100., &
1724                 err (i) % synop % height, &
1725                 err (i) % ships % height, &
1726                 err (i) % buoys % height, &
1727                 err (i) % metar % height, &
1728                 err (i) % pilot % height, &
1729                 err (i) % profl % height, &
1730                 err (i) % sound % height, &
1731                 err (i) % satem % height, &
1732                 err (i) % satob % height, &
1733                 err (i) % airep % height, &
1734                 err (i) % ssmt1 % height, &
1735                 err (i) % ssmt2 % height, &
1736                 err (i) % tovs  % height, &
1737                 err (i) % ssmi  % height, &
1738                 err (i) % airs  % height, &
1739                 err (i) % other % height
1740
1741       ENDDO
1742
1743       CLOSE (UNIT = iunit)
1744
1745 END SUBROUTINE READ_OBSERR_HEIGHT
1746
1747 SUBROUTINE READ_OBSERR_WIND (iunit, filein, keyword, endword, fmt_err, err)
1748 !------------------------------------------------------------------------------!
1749 !
1750 ! Read wind obsevational error defined on the following 26 pressure levels
1751 ! (in hPa):
1752 !
1753 !   10,   20,   30,   40,   50,  100,  150,
1754 !  200,  250,  300,  350,  400,  450,  500,
1755 !  550,  600,  650,  700,  750,  800,  850,
1756 !  900,  950, 1000, 1050, 1100, xxxx, yyyy
1757 !
1758 ! The last two values are place holders.
1759 !
1760 !------------------------------------------------------------------------------!
1761    IMPLICIT NONE
1762 !------------------------------------------------------------------------------!
1763
1764    INTEGER             :: iunit   != 99
1765    CHARACTER (LEN=80)  :: filein  != 'obserr.txt'
1766    CHARACTER (LEN=80)  :: keyword != 'WIND SENSOR ERRORS'
1767    CHARACTER (LEN=80)  :: endword != 'TEMP SENSOR ERRORS'
1768    CHARACTER (LEN=80)  :: fmt_err != '(7(1X,F5.1))'
1769    TYPE (obs_type), DIMENSION (26) :: err
1770
1771    INTEGER             :: io_error, i
1772    CHARACTER (LEN=80)  :: line1, line2, line3, line4
1773    LOGICAL             :: found, wind
1774    CHARACTER (LEN=80)  :: fileout
1775    REAL                :: xxxx, yyyy
1776
1777 !------------------------------------------------------------------------------!
1778
1779 ! 1.  OPEN INPUT FILE
1780 ! ===================
1781
1782       OPEN (UNIT = iunit , FILE = filein , FORM = 'FORMATTED'  , &
1783             ACTION = 'READ' , STATUS = 'OLD', IOSTAT = io_error)
1784
1785       IF (io_error .NE. 0) THEN
1786           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
1787          'Unable to open input observational error file ',TRIM (filein)
1788           STOP
1789       ENDIF
1790
1791
1792 ! 2.  READ DATA
1793 ! =============
1794
1795 !     Read file until keyword is found
1796       found   = .FALSE.
1797       wind    = .FALSE.
1798       io_error= 0
1799
1800       DO WHILE (io_error .EQ. 0.)
1801
1802          !  Read 4 line record
1803
1804          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line1
1805          !  Exit when error or at end of file
1806
1807          IF (io_error .NE. 0) EXIT
1808
1809          !  Winds are given over 4 lines, any other data are given over 3 lines
1810
1811          IF (TRIM (obstype (line1)) .EQ. 'WIND SENSOR ERRORS') THEN
1812
1813              wind = .TRUE.
1814
1815          !  Winds ends at temperature,
1816
1817          ELSE IF (TRIM (obstype (line1)) .EQ. 'TEMP SENSOR ERRORS') THEN
1818
1819              wind = .false.
1820
1821          ENDIF
1822
1823          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line2
1824          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line3
1825          IF (wind) &
1826          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line4
1827
1828          !  If wind obstype is found, read error data
1829
1830          IF (TRIM (obstype (line1)) .EQ. TRIM (keyword)) THEN
1831
1832              found = .TRUE.
1833
1834              WRITE (UNIT = 0, FMT = '(/,A,A)', ADVANCE = 'no') &
1835                     TRIM (obstype (line1)),': '
1836
1837          ELSE IF (((TRIM (obstype (line1)) .EQ. TRIM (endword)) .OR. &
1838                    (line1 (1:2) .EQ. '*.'))) THEN
1839
1840              EXIT
1841
1842          ENDIF
1843
1844          !  If wind obstype is not found, keep on reading
1845
1846          IF (.NOT. found) CYCLE
1847
1848          !  Keyword has been found, Error at mandatory pressure levels follow
1849          !  Break down data upon obs type
1850
1851          SELECT CASE (TRIM (sensor (line1)))
1852
1853          CASE ('RAOBS')              ! Sound, synop, metar and ships
1854
1855          WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1856                 TRIM (sensor (line1)),','
1857
1858                 READ (line1, fmt_err) (err (i) % sound % wind, i = 26, 20,-1)
1859                 READ (line2, fmt_err) (err (i) % sound % wind, i = 19, 13,-1)
1860                 READ (line3, fmt_err) (err (i) % sound % wind, i = 12,  6,-1)
1861                 READ (line4, fmt_err) (err (i) % sound % wind, i =  5,  1,-1), &
1862                                        xxxx,yyyy
1863
1864                 READ (line1, fmt_err) (err (i) % synop % wind, i = 26, 20,-1)
1865                 READ (line2, fmt_err) (err (i) % synop % wind, i = 19, 13,-1)
1866                 READ (line3, fmt_err) (err (i) % synop % wind, i = 12,  6,-1)
1867                 READ (line4, fmt_err) (err (i) % synop % wind, i =  5,  1,-1), &
1868                                        xxxx,yyyy
1869
1870                 READ (line1, fmt_err) (err (i) % ships % wind, i = 26, 20,-1)
1871                 READ (line2, fmt_err) (err (i) % ships % wind, i = 19, 13,-1)
1872                 READ (line3, fmt_err) (err (i) % ships % wind, i = 12,  6,-1)
1873                 READ (line4, fmt_err) (err (i) % ships % wind, i =  5,  1,-1), &
1874                                        xxxx,yyyy
1875
1876                 READ (line1, fmt_err) (err (i) % metar % wind, i = 26, 20,-1)
1877                 READ (line2, fmt_err) (err (i) % metar % wind, i = 19, 13,-1)
1878                 READ (line3, fmt_err) (err (i) % metar % wind, i = 12,  6,-1)
1879                 READ (line4, fmt_err) (err (i) % metar % wind, i =  5,  1,-1), &
1880                                        xxxx,yyyy
1881
1882
1883          CASE ('PIBALS')  ! Pilot
1884
1885                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1886                        TRIM (sensor (line1)),','
1887
1888                 READ (line1, fmt_err) (err (i) % pilot % wind, i = 26, 20,-1)
1889                 READ (line2, fmt_err) (err (i) % pilot % wind, i = 19, 13,-1)
1890                 READ (line3, fmt_err) (err (i) % pilot % wind, i = 12,  6,-1)
1891                 READ (line4, fmt_err) (err (i) % pilot % wind, i =  5,  1,-1), &
1892                                        xxxx,yyyy
1893
1894
1895          CASE ('PROFL')  ! Profilers
1896
1897                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1898                        TRIM (sensor (line1)),','
1899
1900                 READ (line1, fmt_err) (err (i) % profl % wind, i = 26, 20,-1)
1901                 READ (line2, fmt_err) (err (i) % profl % wind, i = 19, 13,-1)
1902                 READ (line3, fmt_err) (err (i) % profl % wind, i = 12,  6,-1)
1903                 READ (line4, fmt_err) (err (i) % profl % wind, i =  5,  1,-1), &
1904                                        xxxx,yyyy
1905
1906
1907          CASE ('BUOY')  ! BUOY
1908
1909                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1910                        TRIM (sensor (line1)),','
1911
1912                 READ (line1, fmt_err) (err (i) % buoys % wind, i = 26, 20,-1)
1913                 READ (line2, fmt_err) (err (i) % buoys % wind, i = 19, 13,-1)
1914                 READ (line3, fmt_err) (err (i) % buoys % wind, i = 12,  6,-1)
1915                 READ (line4, fmt_err) (err (i) % buoys % wind, i =  5,  1,-1), &
1916                                        xxxx,yyyy
1917
1918          CASE ('US LOW LEVEL WINDS')  ! Satobs and Satem ssmt1, ssmt2, ssmi, tovs
1919
1920                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1921                        TRIM (sensor (line1)),','
1922
1923                 READ (line1, fmt_err) (err (i) % satob % wind, i = 26, 20,-1)
1924                 READ (line2, fmt_err) (err (i) % satob % wind, i = 19, 13,-1)
1925                 READ (line3, fmt_err) (err (i) % satob % wind, i = 12,  6,-1)
1926                 READ (line4, fmt_err) (err (i) % satob % wind, i =  5,  1,-1), &
1927                                        xxxx,yyyy
1928
1929                 READ (line1, fmt_err) (err (i) % satem % wind, i = 26, 20,-1)
1930                 READ (line2, fmt_err) (err (i) % satem % wind, i = 19, 13,-1)
1931                 READ (line3, fmt_err) (err (i) % satem % wind, i = 12,  6,-1)
1932                 READ (line4, fmt_err) (err (i) % satem % wind, i =  5,  1,-1), &
1933                                        xxxx,yyyy
1934
1935                 READ (line1, fmt_err) (err (i) % ssmt1 % wind, i = 26, 20,-1)
1936                 READ (line2, fmt_err) (err (i) % ssmt1 % wind, i = 19, 13,-1)
1937                 READ (line3, fmt_err) (err (i) % ssmt1 % wind, i = 12,  6,-1)
1938                 READ (line4, fmt_err) (err (i) % ssmt1 % wind, i =  5,  1,-1), &
1939                                        xxxx,yyyy
1940
1941                 READ (line1, fmt_err) (err (i) % ssmt2 % wind, i = 26, 20,-1)
1942                 READ (line2, fmt_err) (err (i) % ssmt2 % wind, i = 19, 13,-1)
1943                 READ (line3, fmt_err) (err (i) % ssmt2 % wind, i = 12,  6,-1)
1944                 READ (line4, fmt_err) (err (i) % ssmt2 % wind, i =  5,  1,-1), &
1945                                        xxxx,yyyy
1946
1947                 READ (line1, fmt_err) (err (i) % ssmi  % wind, i = 26, 20,-1)
1948                 READ (line2, fmt_err) (err (i) % ssmi  % wind, i = 19, 13,-1)
1949                 READ (line3, fmt_err) (err (i) % ssmi  % wind, i = 12,  6,-1)
1950                 READ (line4, fmt_err) (err (i) % ssmi  % wind, i =  5,  1,-1), &
1951                                        xxxx,yyyy
1952
1953                 READ (line1, fmt_err) (err (i) % tovs  % wind, i = 26, 20,-1)
1954                 READ (line2, fmt_err) (err (i) % tovs  % wind, i = 19, 13,-1)
1955                 READ (line3, fmt_err) (err (i) % tovs  % wind, i = 12,  6,-1)
1956                 READ (line4, fmt_err) (err (i) % tovs  % wind, i =  5,  1,-1), &
1957                                        xxxx,yyyy
1958
1959          CASE ('AIREPS')  ! Airep
1960
1961                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1962                        TRIM (sensor (line1)),','
1963
1964                 READ (line1, fmt_err) (err (i) % airep % wind, i = 26, 20,-1)
1965                 READ (line2, fmt_err) (err (i) % airep % wind, i = 19, 13,-1)
1966                 READ (line3, fmt_err) (err (i) % airep % wind, i = 12,  6,-1)
1967                 READ (line4, fmt_err) (err (i) % airep % wind, i =  5,  1,-1), &
1968                                        xxxx,yyyy
1969
1970
1971          CASE DEFAULT  ! Other
1972
1973 !               WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
1974 !                      TRIM (sensor (line1)),','
1975
1976                 READ (line1, fmt_err) (err (i) % other % wind, i = 26, 20,-1)
1977                 READ (line2, fmt_err) (err (i) % other % wind, i = 19, 13,-1)
1978                 READ (line3, fmt_err) (err (i) % other % wind, i = 12,  6,-1)
1979                 READ (line4, fmt_err) (err (i) % other % wind, i =  5,  1,-1), &
1980                                        xxxx,yyyy
1981
1982
1983          END SELECT
1984
1985       ENDDO
1986
1987       WRITE (UNIT = 0, FMT = '(A)') ' '
1988
1989       IF (.NOT. found) THEN
1990
1991           WRITE (UNIT = 0, FMT = '(/,A,A)') &
1992         ' Observational errors for ',TRIM (keyword)
1993           WRITE (UNIT = 0, FMT = '(A,A,/)') &
1994         ' were not found in file ',  TRIM (filein)
1995
1996       ENDIF
1997
1998
1999 ! 3.  CLOSE INPUT FILE
2000 ! ====================
2001
2002       CLOSE (UNIT = iunit)
2003
2004
2005 ! 4.  WRITE VALUES
2006 ! ================
2007
2008       fileout = keyword (1:4)//'.txt'
2009
2010       OPEN (UNIT = iunit , FILE = fileout , FORM = 'FORMATTED'  , &
2011             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error)
2012
2013       IF (io_error .NE. 0) THEN
2014           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2015          'Unable to open output observational error file ',TRIM (fileout)
2016           STOP
2017       ENDIF
2018
2019
2020       WRITE (UNIT = iunit, FMT = '(20X,A)') TRIM (keyword)
2021
2022       WRITE (UNIT = iunit, FMT = '(1X,16A)') ' level',&
2023     ' synop ','  ship ','  buoy ',' metar ',' pilot ',' profl ',&
2024     ' sound ',' satem ',' satob ',' airep ',&
2025     ' ssmt1 ',' ssmt2 ','  ssmi ','  tovs ',&
2026     ' other '
2027
2028       DO i = 26, 1, -1
2029          WRITE (UNIT = iunit, FMT = '(F6.0,15(2X,F5.1))') &
2030                 err (i) % level / 100., &
2031                 err (i) % synop % wind, &
2032                 err (i) % ships % wind, &
2033                 err (i) % buoys % wind, &
2034                 err (i) % metar % wind, &
2035                 err (i) % pilot % wind, &
2036                 err (i) % profl % wind, &
2037                 err (i) % sound % wind, &
2038                 err (i) % satem % wind, &
2039                 err (i) % satob % wind, &
2040                 err (i) % airep % wind, &
2041                 err (i) % ssmt1 % wind, &
2042                 err (i) % ssmt2 % wind, &
2043                 err (i) % ssmi  % wind, &
2044                 err (i) % tovs  % wind, &
2045                 err (i) % other % wind
2046
2047
2048       ENDDO
2049
2050       CLOSE (UNIT = iunit)
2051
2052 END SUBROUTINE READ_OBSERR_WIND
2053
2054 SUBROUTINE READ_OBSERR_TEMP (iunit, filein, keyword, endword, fmt_err, err)
2055 !------------------------------------------------------------------------------!
2056 !
2057 ! Read temp observational error defined on the following 15 levels (in hPa):
2058 !
2059 !  1000,  850,  700,  500,  400,
2060 !   300,  250,  200,  150,  100,
2061 !    70,   50,   30,   20,   10
2062 !
2063 !------------------------------------------------------------------------------!
2064    IMPLICIT NONE
2065 !------------------------------------------------------------------------------!
2066
2067    INTEGER             :: iunit   != 99
2068    CHARACTER (LEN=80)  :: filein  != 'obserr.txt'
2069    CHARACTER (LEN=80)  :: keyword != 'TEMP SENSOR ERRORS'
2070    CHARACTER (LEN=80)  :: endword != 'RH SENSOR ERRORS'
2071    CHARACTER (LEN=80)  :: fmt_err != '(5(1X,F5.1))'
2072    TYPE (obs_type), DIMENSION (15) :: err
2073
2074    INTEGER             :: io_error, i
2075    CHARACTER (LEN=80)  :: line1, line2, line3, line4
2076    LOGICAL             :: found, wind
2077    CHARACTER (LEN=80)  :: fileout
2078
2079 !------------------------------------------------------------------------------!
2080
2081 ! 1.  OPEN INPUT FILE
2082 ! ===================
2083
2084       OPEN (UNIT = iunit , FILE = filein , FORM = 'FORMATTED'  , &
2085             ACTION = 'READ' , STATUS = 'OLD', IOSTAT = io_error)
2086
2087       IF (io_error .NE. 0) THEN
2088           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2089          'Unable to open input observational error file ',TRIM (filein)
2090           STOP
2091       ENDIF
2092
2093
2094 ! 2.  READ DATA
2095 ! =============
2096
2097 !     Read file until keyword is found
2098
2099       found   = .FALSE.
2100       wind    = .FALSE.
2101       io_error= 0
2102
2103       DO WHILE (io_error .EQ. 0.)
2104
2105          !  Read 1 line
2106
2107          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line1
2108
2109          !  Exit when error or at end of file
2110
2111          IF (io_error .NE. 0) EXIT
2112
2113          !  Winds are given over 4 lines, any other data are given over 3 lines
2114
2115          IF (TRIM (obstype (line1)) .EQ. 'WIND SENSOR ERRORS') THEN
2116
2117              wind = .TRUE.
2118
2119          !  Winds ends at temperature,
2120
2121          ELSE IF (TRIM (obstype (line1)) .EQ. 'TEMP SENSOR ERRORS') THEN
2122
2123              wind = .false.
2124
2125          ENDIF
2126
2127          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line2
2128          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line3
2129          IF (wind) &
2130          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line4
2131
2132          !  If temp obstype is found, read error data
2133
2134          IF (TRIM (obstype (line1)) .EQ. TRIM (keyword)) THEN
2135
2136              found = .TRUE.
2137
2138              WRITE (UNIT = 0, FMT = '(/,A,A)', ADVANCE = 'no' ) &
2139                     TRIM (obstype (line1)),': '
2140
2141          ELSE IF (((TRIM (obstype (line1)) .EQ. TRIM (endword)) .OR. &
2142                    (line1 (1:2) .EQ. '*.'))) THEN
2143
2144              EXIT
2145
2146          ENDIF
2147
2148          !  If temp obstype is not found, keep on reading
2149
2150          IF (.NOT. found) CYCLE
2151
2152          !  Keyword has been found, Error at mandatory pressure levels follow
2153          !  Break down data upon obs type
2154
2155
2156          SELECT CASE (TRIM (sensor (line1)))
2157
2158          CASE ('SURFACE LAND') ! synop and metar
2159
2160                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2161                        TRIM (sensor (line1)),','
2162
2163                 READ (line1, fmt_err) (err (i) % synop % temp, i =  1,  5)
2164                 READ (line2, fmt_err) (err (i) % synop % temp, i =  6, 10)
2165                 READ (line3, fmt_err) (err (i) % synop % temp, i = 11, 15)
2166
2167                 READ (line1, fmt_err) (err (i) % metar % temp, i =  1,  5)
2168                 READ (line2, fmt_err) (err (i) % metar % temp, i =  6, 10)
2169                 READ (line3, fmt_err) (err (i) % metar % temp, i = 11, 15)
2170
2171          CASE ('SURFACE SHIP') ! ships
2172
2173                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2174                        TRIM (sensor (line1)),','
2175
2176                 READ (line1, fmt_err) (err (i) % ships % temp, i =  1,  5)
2177                 READ (line2, fmt_err) (err (i) % ships % temp, i =  6, 10)
2178                 READ (line3, fmt_err) (err (i) % ships % temp, i = 11, 15)
2179
2180          CASE ('BUOY') ! BUOY
2181
2182                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2183                        TRIM (sensor (line1)),','
2184
2185                 READ (line1, fmt_err) (err (i) % buoys % temp, i =  1,  5)
2186                 READ (line2, fmt_err) (err (i) % buoys % temp, i =  6, 10)
2187                 READ (line3, fmt_err) (err (i) % buoys % temp, i = 11, 15)
2188
2189          CASE ('RAOBS')              ! Sound
2190
2191                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2192                        TRIM (sensor (line1)),','
2193
2194                 READ (line1, fmt_err) (err (i) % sound % temp, i =  1,  5)
2195                 READ (line2, fmt_err) (err (i) % sound % temp, i =  6, 10)
2196                 READ (line3, fmt_err) (err (i) % sound % temp, i = 11, 15)
2197
2198          CASE ('PIBALS','PROFL')  ! Pilot
2199
2200                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2201                        TRIM (sensor (line1)),','
2202
2203                 READ (line1, fmt_err) (err (i) % pilot % temp, i =  1,  5)
2204                 READ (line2, fmt_err) (err (i) % pilot % temp, i =  6, 10)
2205                 READ (line3, fmt_err) (err (i) % pilot % temp, i = 11, 15)
2206
2207                 READ (line1, fmt_err) (err (i) % profl % temp, i =  1,  5)
2208                 READ (line2, fmt_err) (err (i) % profl % temp, i =  6, 10)
2209                 READ (line3, fmt_err) (err (i) % profl % temp, i = 11, 15)
2210
2211          CASE ('NOAA - A RETRIEVAL')  ! Satobs and Satem
2212
2213                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2214                        TRIM (sensor (line1)),','
2215
2216                 READ (line1, fmt_err) (err (i) % satob % temp, i =  1,  5)
2217                 READ (line2, fmt_err) (err (i) % satob % temp, i =  6, 10)
2218                 READ (line3, fmt_err) (err (i) % satob % temp, i = 11, 15)
2219
2220                 READ (line1, fmt_err) (err (i) % satem % temp, i =  1,  5)
2221                 READ (line2, fmt_err) (err (i) % satem % temp, i =  6, 10)
2222                 READ (line3, fmt_err) (err (i) % satem % temp, i = 11, 15)
2223
2224          CASE ('AIREPS')  ! Airep
2225
2226                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2227                        TRIM (sensor (line1)),','
2228
2229                 READ (line1, fmt_err) (err (i) % airep % temp, i =  1,  5)
2230                 READ (line2, fmt_err) (err (i) % airep % temp, i =  6, 10)
2231                 READ (line3, fmt_err) (err (i) % airep % temp, i = 11, 15)
2232          CASE ('AIRSRET')  ! AIRS retrievals
2233
2234                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2235                        TRIM (sensor (line1)),','
2236
2237                 READ (line1, fmt_err) (err (i) % airs  % temp, i =  1,  5)
2238                 READ (line2, fmt_err) (err (i) % airs  % temp, i =  6, 10)
2239                 READ (line3, fmt_err) (err (i) % airs  % temp, i = 11, 15)
2240
2241          CASE ('DMSP - A RETRIEVAL')  ! ssmt1, ssmt2, ssmi and ttovs
2242
2243                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2244                        TRIM (sensor (line1)),','
2245
2246                 READ (line1, fmt_err) (err (i) % ssmt1 % temp, i =  1,  5)
2247                 READ (line2, fmt_err) (err (i) % ssmt1 % temp, i =  6, 10)
2248                 READ (line3, fmt_err) (err (i) % ssmt1 % temp, i = 11, 15)
2249
2250                 READ (line1, fmt_err) (err (i) % ssmt2 % temp, i =  1,  5)
2251                 READ (line2, fmt_err) (err (i) % ssmt2 % temp, i =  6, 10)
2252                 READ (line3, fmt_err) (err (i) % ssmt2 % temp, i = 11, 15)
2253
2254                 READ (line1, fmt_err) (err (i) % ssmi  % temp, i =  1,  5)
2255                 READ (line2, fmt_err) (err (i) % ssmi  % temp, i =  6, 10)
2256                 READ (line3, fmt_err) (err (i) % ssmi  % temp, i = 11, 15)
2257
2258                 READ (line1, fmt_err) (err (i) % tovs  % temp, i =  1,  5)
2259                 READ (line2, fmt_err) (err (i) % tovs  % temp, i =  6, 10)
2260                 READ (line3, fmt_err) (err (i) % tovs  % temp, i = 11, 15)
2261
2262          CASE DEFAULT  ! Other
2263
2264 !               WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2265 !                      TRIM (sensor (line1)),','
2266
2267                 READ (line1, fmt_err) (err (i) % other % temp, i =  1,  5)
2268                 READ (line2, fmt_err) (err (i) % other % temp, i =  6, 10)
2269                 READ (line3, fmt_err) (err (i) % other % temp, i = 11, 15)
2270
2271          END SELECT
2272
2273       ENDDO
2274
2275       WRITE (UNIT = 0, FMT = '(A)')  ' '
2276
2277       !  If obs type is not found, print it
2278
2279       IF (.NOT. found) THEN
2280           WRITE (UNIT = 0, FMT = '(/,A,A)') &
2281         ' Observational errors for ',TRIM (keyword)
2282           WRITE (UNIT = 0, FMT = '(A,A,/)') &
2283         ' were not found in file ',  TRIM (filein)
2284       ENDIF
2285
2286
2287 ! 3.  CLOSE INPUT FILE
2288 ! ====================
2289
2290       CLOSE (UNIT = iunit)
2291
2292 ! 4.  WRITE VALUES
2293 ! ================
2294
2295       fileout = keyword (1:4)//'.txt'
2296
2297       OPEN (UNIT = iunit , FILE = fileout , FORM = 'FORMATTED'  , &
2298             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error)
2299
2300       IF (io_error .NE. 0) THEN
2301           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2302          'Unable to open output observational error file ',TRIM (fileout)
2303           STOP
2304       ENDIF
2305
2306
2307       WRITE (UNIT = iunit, FMT = '(20X,A)') TRIM (keyword)
2308
2309       WRITE (UNIT = iunit, FMT = '(1X,16A)') ' level',&
2310     ' synop ','  ship ','  buoy ',' metar ',' pilot ',' profl ',&
2311     ' sound ',' satem ',' satob ',' airep ',&
2312     ' ssmt1 ',' ssmt2 ','  tovs ','  ssmi ',' airsret', &
2313     ' other '
2314
2315
2316       DO i = 15, 1, -1
2317          WRITE (UNIT = iunit, FMT = '(F6.0,15(2X,F5.1))') &
2318                 err (i) % level / 100., &
2319                 err (i) % synop % temp, &
2320                 err (i) % ships % temp, &
2321                 err (i) % buoys % temp, &
2322                 err (i) % metar % temp, &
2323                 err (i) % pilot % temp, &
2324                 err (i) % profl % temp, &
2325                 err (i) % sound % temp, &
2326                 err (i) % satem % temp, &
2327                 err (i) % satob % temp, &
2328                 err (i) % airep % temp, &
2329                 err (i) % ssmt1 % temp, &
2330                 err (i) % ssmt2 % temp, &
2331                 err (i) % tovs  % temp, &
2332                 err (i) % ssmi  % temp, &
2333                 err (i) % airs  % temp, &
2334                 err (i) % other % temp
2335
2336       ENDDO
2337
2338       CLOSE (UNIT = iunit)
2339
2340 END SUBROUTINE READ_OBSERR_TEMP
2341
2342 SUBROUTINE READ_OBSERR_RH (iunit, filein, keyword, endword, fmt_err, err)
2343 !------------------------------------------------------------------------------!
2344 !
2345 ! Read rh observational error defined on the following 15 levels (in hPa):
2346 !
2347 !  1000,  850,  700,  500,  400,
2348 !   300,  250,  200,  150,  100,
2349 !    70,   50,   30,   20,   10
2350 !
2351 !------------------------------------------------------------------------------!
2352    IMPLICIT NONE
2353 !------------------------------------------------------------------------------!
2354
2355    INTEGER             :: iunit   != 99
2356    CHARACTER (LEN=80)  :: filein  != 'obserr.txt'
2357    CHARACTER (LEN=80)  :: keyword != 'RH SENSOR ERRORS'
2358    CHARACTER (LEN=80)  :: endword != 'PRESSURE SENSOR ERRORS'
2359    CHARACTER (LEN=80)  :: fmt_err != '(5(1X,F5.2))'
2360    TYPE (obs_type), DIMENSION (15) :: err
2361
2362    INTEGER             :: io_error, i
2363    CHARACTER (LEN=80)  :: line1, line2, line3, line4
2364    LOGICAL             :: found, wind
2365    CHARACTER (LEN=80)  :: fileout
2366
2367 !------------------------------------------------------------------------------!
2368
2369 ! 1.  OPEN INPUT FILE
2370 ! ===================
2371
2372       OPEN (UNIT = iunit , FILE = filein , FORM = 'FORMATTED'  , &
2373             ACTION = 'READ' , STATUS = 'OLD', IOSTAT = io_error)
2374
2375       IF (io_error .NE. 0) THEN
2376           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2377          'Unable to open input observational error file ',TRIM (filein)
2378           STOP
2379       ENDIF
2380
2381
2382 ! 2.  READ DATA
2383 ! =============
2384
2385 !     Read file until keyword is found
2386
2387       found   = .FALSE.
2388       wind    = .FALSE.
2389       io_error= 0
2390
2391       DO WHILE (io_error .EQ. 0)
2392
2393          !  Read 3 line record
2394
2395          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line1
2396
2397          !  Winds are given over 4 lines, any other data are given over 3 lines
2398
2399          IF (TRIM (obstype (line1)) .EQ. 'WIND SENSOR ERRORS') THEN
2400
2401              wind = .TRUE.
2402
2403          !  Winds ends at temperature,
2404
2405          ELSE IF (TRIM (obstype (line1)) .EQ. 'TEMP SENSOR ERRORS') THEN
2406
2407              wind = .false.
2408
2409          ENDIF
2410
2411          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line2
2412          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line3
2413          IF (wind) &
2414          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line4
2415
2416          !  Exit when error or at end of file
2417
2418          IF (io_error .NE. 0) EXIT
2419
2420          !  If rh obstype is found, read error data
2421
2422          IF (TRIM (obstype (line1)) .EQ. TRIM (keyword)) THEN
2423
2424              found = .TRUE.
2425
2426              WRITE (UNIT = 0, FMT = '(/,A,A)', ADVANCE = 'no' ) &
2427                     TRIM (obstype (line1)),': '
2428
2429          ELSE IF (((TRIM (obstype (line1)) .EQ. TRIM (endword)) .OR. &
2430                    (line1 (1:2) .EQ. '*.'))) THEN
2431
2432              EXIT
2433
2434          ENDIF
2435
2436
2437          !  If rh obstype is not found, keep on reading
2438
2439          IF (.NOT. found) CYCLE
2440
2441          !  Keyword has been found, Error at mandatory pressure levels follow
2442          !  Break down data upon obs type
2443
2444          SELECT CASE (TRIM (sensor (line1)))
2445
2446          CASE ('SURFACE LAND')  ! synop, ships, buoys and metar
2447
2448                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2449                        TRIM (sensor (line1)),','
2450
2451                 READ (line1, fmt_err) (err (i) % synop % rh, i =  1,  5)
2452                 READ (line2, fmt_err) (err (i) % synop % rh, i =  6, 10)
2453                 READ (line3, fmt_err) (err (i) % synop % rh, i = 11, 15)
2454
2455                 READ (line1, fmt_err) (err (i) % ships % rh, i =  1,  5)
2456                 READ (line2, fmt_err) (err (i) % ships % rh, i =  6, 10)
2457                 READ (line3, fmt_err) (err (i) % ships % rh, i = 11, 15)
2458
2459                 READ (line1, fmt_err) (err (i) % buoys % rh, i =  1,  5)
2460                 READ (line2, fmt_err) (err (i) % buoys % rh, i =  6, 10)
2461                 READ (line3, fmt_err) (err (i) % buoys % rh, i = 11, 15)
2462
2463                 READ (line1, fmt_err) (err (i) % metar % rh, i =  1,  5)
2464                 READ (line2, fmt_err) (err (i) % metar % rh, i =  6, 10)
2465                 READ (line3, fmt_err) (err (i) % metar % rh, i = 11, 15)
2466
2467          CASE ('RAOBS')  ! Sound
2468
2469                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2470                        TRIM (sensor (line1)),','
2471
2472                 READ (line1, fmt_err) (err (i) % sound % rh, i =  1,  5)
2473                 READ (line2, fmt_err) (err (i) % sound % rh, i =  6, 10)
2474                 READ (line3, fmt_err) (err (i) % sound % rh, i = 11, 15)
2475
2476          CASE ('PIBALS','PROFL')  ! Pilot
2477
2478                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2479                        TRIM (sensor (line1)),','
2480
2481                 READ (line1, fmt_err) (err (i) % pilot % rh, i =  1,  5)
2482                 READ (line2, fmt_err) (err (i) % pilot % rh, i =  6, 10)
2483                 READ (line3, fmt_err) (err (i) % pilot % rh, i = 11, 15)
2484
2485                 READ (line1, fmt_err) (err (i) % profl % rh, i =  1,  5)
2486                 READ (line2, fmt_err) (err (i) % profl % rh, i =  6, 10)
2487                 READ (line3, fmt_err) (err (i) % profl % rh, i = 11, 15)
2488
2489
2490          CASE ('NOAA - A RETRIEVAL')  ! Satobs and Satem
2491
2492                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2493                        TRIM (sensor (line1)),','
2494
2495                 READ (line1, fmt_err) (err (i) % satob % rh, i =  1,  5)
2496                 READ (line2, fmt_err) (err (i) % satob % rh, i =  6, 10)
2497                 READ (line3, fmt_err) (err (i) % satob % rh, i = 11, 15)
2498
2499                 READ (line1, fmt_err) (err (i) % satem % rh, i =  1,  5)
2500                 READ (line2, fmt_err) (err (i) % satem % rh, i =  6, 10)
2501                 READ (line3, fmt_err) (err (i) % satem % rh, i = 11, 15)
2502
2503          CASE ('AIREPS')  ! Airep
2504
2505                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2506                        TRIM (sensor (line1)),','
2507
2508                 READ (line1, fmt_err) (err (i) % airep % rh, i =  1,  5)
2509                 READ (line2, fmt_err) (err (i) % airep % rh, i =  6, 10)
2510                 READ (line3, fmt_err) (err (i) % airep % rh, i = 11, 15)
2511          CASE ('AIRSRET')  ! AIRS retrievals
2512
2513                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2514                        TRIM (sensor (line1)),','
2515
2516                 READ (line1, fmt_err) (err (i) % airs % rh, i =  1,  5)
2517                 READ (line2, fmt_err) (err (i) % airs % rh, i =  6, 10)
2518                 READ (line3, fmt_err) (err (i) % airs % rh, i = 11, 15)
2519
2520          CASE ('DMSP - A RETRIEVAL')  ! ssmt1, ssmt2, ssmi and ttovs
2521
2522                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2523                        TRIM (sensor (line1)),','
2524
2525                 READ (line1, fmt_err) (err (i) % ssmt1 % rh, i =  1,  5)
2526                 READ (line2, fmt_err) (err (i) % ssmt1 % rh, i =  6, 10)
2527                 READ (line3, fmt_err) (err (i) % ssmt1 % rh, i = 11, 15)
2528
2529                 READ (line1, fmt_err) (err (i) % ssmt2 % rh, i =  1,  5)
2530                 READ (line2, fmt_err) (err (i) % ssmt2 % rh, i =  6, 10)
2531                 READ (line3, fmt_err) (err (i) % ssmt2 % rh, i = 11, 15)
2532
2533                 READ (line1, fmt_err) (err (i) % ssmi  % rh, i =  1,  5)
2534                 READ (line2, fmt_err) (err (i) % ssmi  % rh, i =  6, 10)
2535                 READ (line3, fmt_err) (err (i) % ssmi  % rh, i = 11, 15)
2536
2537                 READ (line1, fmt_err) (err (i) % tovs  % rh, i =  1,  5)
2538                 READ (line2, fmt_err) (err (i) % tovs  % rh, i =  6, 10)
2539                 READ (line3, fmt_err) (err (i) % tovs  % rh, i = 11, 15)
2540
2541          CASE DEFAULT  ! Other
2542
2543                 READ (line1, fmt_err) (err (i) % other % rh, i =  1,  5)
2544                 READ (line2, fmt_err) (err (i) % other % rh, i =  6, 10)
2545                 READ (line3, fmt_err) (err (i) % other % rh, i = 11, 15)
2546
2547          END SELECT
2548
2549       ENDDO
2550
2551       WRITE (0,'(A)') ' '
2552
2553       !  If obs type is not found, print it
2554
2555       IF (.NOT. found) THEN
2556           WRITE (UNIT = 0, FMT = '(/,A,A)') &
2557         ' Observational errors for ',TRIM (keyword)
2558           WRITE (UNIT = 0, FMT = '(A,A,/)') &
2559         ' were not found in file ',  TRIM (filein)
2560       ENDIF
2561
2562
2563 ! 3.  CLOSE INPUT FILE
2564 ! ====================
2565
2566       CLOSE (UNIT = iunit)
2567
2568
2569 ! 4.  WRITE VALUES
2570 ! ================
2571
2572       fileout = keyword (1:2)//'.txt'
2573
2574       OPEN (UNIT = iunit , FILE = fileout , FORM = 'FORMATTED'  , &
2575             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error)
2576
2577       IF (io_error .NE. 0) THEN
2578           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2579          'Unable to open output observational error file ',TRIM (fileout)
2580           STOP
2581       ENDIF
2582
2583
2584       WRITE (UNIT = iunit, FMT = '(20X,A)') TRIM (keyword)
2585
2586       WRITE (UNIT = iunit, FMT = '(1X,16A)') ' level',&
2587     ' synop ','  ship ','  buoy ',' metar ',' pilot ',' profl ',&
2588     ' sound ',' satem ',' satob ',' airep ',&
2589     ' ssmt1 ',' ssmt2 ','  tovs ','  ssmi ',' airsret',&
2590     ' other '
2591
2592       DO i = 15, 1, -1
2593          WRITE (UNIT = iunit, FMT = '(F6.0,15(2X,F5.1))') &
2594                 err (i) % level / 100., &
2595                 err (i) % synop % rh, &
2596                 err (i) % ships % rh, &
2597                 err (i) % buoys % rh, &
2598                 err (i) % metar % rh, &
2599                 err (i) % pilot % rh, &
2600                 err (i) % profl % rh, &
2601                 err (i) % sound % rh, &
2602                 err (i) % satem % rh, &
2603                 err (i) % satob % rh, &
2604                 err (i) % airep % rh, &
2605                 err (i) % ssmt1 % rh, &
2606                 err (i) % ssmt2 % rh, &
2607                 err (i) % tovs  % rh, &
2608                 err (i) % ssmi  % rh, &
2609                 err (i) % airs  % rh, &
2610                 err (i) % other % rh
2611
2612       ENDDO
2613
2614       CLOSE (UNIT = iunit)
2615
2616 END SUBROUTINE READ_OBSERR_RH
2617
2618 SUBROUTINE READ_OBSERR_PRES (iunit, filein, keyword, endword, fmt_err, err)
2619 !------------------------------------------------------------------------------!
2620 !
2621 ! Read pressure observational error defined on the following 15 levels (in hPa):
2622 !
2623 !  1000,  850,  700,  500,  400,
2624 !   300,  250,  200,  150,  100,
2625 !    70,   50,   30,   20,   10
2626 !
2627 !------------------------------------------------------------------------------!
2628    IMPLICIT NONE
2629 !------------------------------------------------------------------------------!
2630
2631    INTEGER             :: iunit   != 99
2632    CHARACTER (LEN=80)  :: filein  != 'obserr.txt'
2633    CHARACTER (LEN=80)  :: keyword != 'PRESSURE SENSOR ERRORS'
2634    CHARACTER (LEN=80)  :: endword != '*.'
2635    CHARACTER (LEN=80)  :: fmt_err != '(5(1X,F5.1))'
2636    TYPE (obs_type), DIMENSION (15) :: err
2637
2638    INTEGER             :: io_error, i
2639    CHARACTER (LEN=80)  :: line1, line2, line3, line4
2640    LOGICAL             :: found, wind
2641    CHARACTER (LEN=80)  :: fileout
2642
2643 !------------------------------------------------------------------------------!
2644
2645 ! 1.  OPEN INPUT FILE
2646 ! ===================
2647
2648       OPEN (UNIT = iunit , FILE = filein , FORM = 'FORMATTED'  , &
2649             ACTION = 'READ' , STATUS = 'OLD', IOSTAT = io_error)
2650
2651       IF (io_error .NE. 0) THEN
2652           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2653          'Unable to open input observational error file ',TRIM (filein)
2654           STOP
2655       ENDIF
2656
2657
2658 ! 2.  READ DATA
2659 ! =============
2660
2661 !     Read file until keyword is found
2662
2663       found   = .FALSE.
2664       wind    = .FALSE.
2665       io_error= 0
2666
2667       DO WHILE (io_error .EQ. 0.)
2668
2669          !  Read 1 line
2670
2671          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line1
2672
2673          !  Exit when error or at end of file
2674
2675          IF (io_error .NE. 0) EXIT
2676
2677          !  Winds are given over 4 lines, any other data are given over 3 lines
2678
2679          IF (TRIM (obstype (line1)) .EQ. 'WIND SENSOR ERRORS') THEN
2680
2681              wind = .TRUE.
2682
2683          !  Winds ends at temperature,
2684
2685          ELSE IF (TRIM (obstype (line1)) .EQ. 'TEMP SENSOR ERRORS') THEN
2686
2687              wind = .false.
2688
2689          ENDIF
2690
2691          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line2
2692          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line3
2693          IF (wind) &
2694          READ (UNIT = iunit, IOSTAT = io_error, FMT = '(A)') line4
2695
2696          !  If temp obstype is found, read error data
2697
2698          IF (TRIM (obstype (line1)) .EQ. TRIM (keyword)) THEN
2699
2700              found = .TRUE.
2701
2702              WRITE (UNIT = 0, FMT = '(/,A,A)', ADVANCE = 'no' ) &
2703                     TRIM (obstype (line1)),': '
2704
2705          ELSE IF (((TRIM (obstype (line1)) .EQ. TRIM (endword)) .OR. &
2706                    (line1 (1:2) .EQ. '*.'))) THEN
2707
2708              EXIT
2709
2710          ENDIF
2711
2712          !  If temp obstype is not found, keep on reading
2713
2714          IF (.NOT. found) CYCLE
2715
2716          !  Keyword has been found, Error at mandatory pressure levels follow
2717          !  Break down data upon obs type
2718
2719
2720          SELECT CASE (TRIM (sensor (line1)))
2721
2722          CASE ('SURFACE LAND') ! synop and metar
2723
2724                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2725                        TRIM (sensor (line1)),','
2726
2727                 READ (line1, fmt_err) (err (i) % synop % pres, i =  1,  5)
2728                 READ (line2, fmt_err) (err (i) % synop % pres, i =  6, 10)
2729                 READ (line3, fmt_err) (err (i) % synop % pres, i = 11, 15)
2730
2731                 READ (line1, fmt_err) (err (i) % metar % pres, i =  1,  5)
2732                 READ (line2, fmt_err) (err (i) % metar % pres, i =  6, 10)
2733                 READ (line3, fmt_err) (err (i) % metar % pres, i = 11, 15)
2734
2735          CASE ('SURFACE SHIP') ! ships
2736
2737                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2738                        TRIM (sensor (line1)),','
2739
2740                 READ (line1, fmt_err) (err (i) % ships % pres, i =  1,  5)
2741                 READ (line2, fmt_err) (err (i) % ships % pres, i =  6, 10)
2742                 READ (line3, fmt_err) (err (i) % ships % pres, i = 11, 15)
2743
2744          CASE ('RAOBS') ! Sounding
2745
2746                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2747                        TRIM (sensor (line1)),','
2748
2749                 READ (line1, fmt_err) (err (i) % sound % pres, i =  1,  5)
2750                 READ (line2, fmt_err) (err (i) % sound % pres, i =  6, 10)
2751                 READ (line3, fmt_err) (err (i) % sound % pres, i = 11, 15)
2752
2753          CASE ('PIBALS','PROFL')  ! Pilot
2754
2755                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2756                        TRIM (sensor (line1)),','
2757
2758                 READ (line1, fmt_err) (err (i) % pilot % pres, i =  1,  5)
2759                 READ (line2, fmt_err) (err (i) % pilot % pres, i =  6, 10)
2760                 READ (line3, fmt_err) (err (i) % pilot % pres, i = 11, 15)
2761
2762                 READ (line1, fmt_err) (err (i) % profl % pres, i =  1,  5)
2763                 READ (line2, fmt_err) (err (i) % profl % pres, i =  6, 10)
2764                 READ (line3, fmt_err) (err (i) % profl % pres, i = 11, 15)
2765
2766          CASE ('NOAA - A RETRIEVAL')  !  Satobs and Satem
2767
2768                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2769                        TRIM (sensor (line1)),','
2770
2771                 READ (line1, fmt_err) (err (i) % satob % pres, i =  1,  5)
2772                 READ (line2, fmt_err) (err (i) % satob % pres, i =  6, 10)
2773                 READ (line3, fmt_err) (err (i) % satob % pres, i = 11, 15)
2774
2775                 READ (line1, fmt_err) (err (i) % satem % pres, i =  1,  5)
2776                 READ (line2, fmt_err) (err (i) % satem % pres, i =  6, 10)
2777                 READ (line3, fmt_err) (err (i) % satem % pres, i = 11, 15)
2778
2779          CASE ('AIREPS')  ! Airep
2780
2781                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2782                        TRIM (sensor (line1)),','
2783
2784                 READ (line1, fmt_err) (err (i) % airep % pres, i =  1,  5)
2785                 READ (line2, fmt_err) (err (i) % airep % pres, i =  6, 10)
2786                 READ (line3, fmt_err) (err (i) % airep % pres, i = 11, 15)
2787
2788          CASE ('AIRSRET')  ! AIRS retrievals
2789
2790                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2791                        TRIM (sensor (line1)),','
2792
2793                 READ (line1, fmt_err) (err (i) % airs % pres, i =  1,  5)
2794                 READ (line2, fmt_err) (err (i) % airs % pres, i =  6, 10)
2795                 READ (line3, fmt_err) (err (i) % airs % pres, i = 11, 15)
2796
2797          CASE ('DMSP - A RETRIEVAL')  !  ssmt1, ssmt2, ssmi and ttovs
2798
2799                 WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2800                        TRIM (sensor (line1)),','
2801
2802                 READ (line1, fmt_err) (err (i) % ssmt1 % pres, i =  1,  5)
2803                 READ (line2, fmt_err) (err (i) % ssmt1 % pres, i =  6, 10)
2804                 READ (line3, fmt_err) (err (i) % ssmt1 % pres, i = 11, 15)
2805
2806                 READ (line1, fmt_err) (err (i) % ssmt2 % pres, i =  1,  5)
2807                 READ (line2, fmt_err) (err (i) % ssmt2 % pres, i =  6, 10)
2808                 READ (line3, fmt_err) (err (i) % ssmt2 % pres, i = 11, 15)
2809
2810                 READ (line1, fmt_err) (err (i) % ssmi  % pres, i =  1,  5)
2811                 READ (line2, fmt_err) (err (i) % ssmi  % pres, i =  6, 10)
2812                 READ (line3, fmt_err) (err (i) % ssmi  % pres, i = 11, 15)
2813
2814                 READ (line1, fmt_err) (err (i) % tovs  % pres, i =  1,  5)
2815                 READ (line2, fmt_err) (err (i) % tovs  % pres, i =  6, 10)
2816                 READ (line3, fmt_err) (err (i) % tovs  % pres, i = 11, 15)
2817
2818          CASE DEFAULT  ! Other
2819
2820 !               WRITE (UNIT = 0, FMT = '(1X,2A)',ADVANCE='no') &
2821 !                      TRIM (sensor (line1)),','
2822
2823                 READ (line1, fmt_err) (err (i) % other % pres, i =  1,  5)
2824                 READ (line2, fmt_err) (err (i) % other % pres, i =  6, 10)
2825                 READ (line3, fmt_err) (err (i) % other % pres, i = 11, 15)
2826
2827          END SELECT
2828
2829       ENDDO
2830
2831       WRITE (0,'(A)') ' '
2832
2833       !  If obs type is not found, print it
2834
2835       IF (.NOT. found) THEN
2836           WRITE (UNIT = 0, FMT = '(/,A,A)') &
2837         ' Observational errors for ',TRIM (keyword)
2838           WRITE (UNIT = 0, FMT = '(A,A,/)') &
2839         ' were not found in file ',  TRIM (filein)
2840       ENDIF
2841
2842 ! 3.  CLOSE INPUT FILE
2843 ! ====================
2844
2845       CLOSE (UNIT = iunit)
2846
2847 ! 4.  WRITE VALUES
2848 ! ================
2849
2850       fileout = keyword (1:4)//'.txt'
2851
2852       OPEN (UNIT = iunit , FILE = fileout , FORM = 'FORMATTED'  , &
2853             ACTION = 'WRITE' , STATUS = 'REPLACE', IOSTAT = io_error)
2854
2855       IF (io_error .NE. 0) THEN
2856           WRITE (UNIT = 0, FMT = '(/,A,A,/)') &
2857          'Unable to open output observational error file ',TRIM (fileout)
2858           STOP
2859       ENDIF
2860
2861
2862       WRITE (UNIT = iunit, FMT = '(20X,A)') TRIM (keyword)
2863
2864       WRITE (UNIT = iunit, FMT = '(1X,16A)') ' level',&
2865     ' synop ','  ship ','  buoy ',' metar ',' pilot ',' profl ',&
2866     ' sound ',' satem ',' satob ',' airep ',&
2867     ' ssmt1 ',' ssmt2 ','  tovs ','  ssmi ', 'airsret', &
2868     ' other '
2869
2870       DO i = 15, 1, -1
2871          WRITE (UNIT = iunit, FMT = '(F6.0,15(2X,F5.1))') &
2872                 err (i) % level / 100., &
2873                 err (i) % synop % pres / 100., &
2874                 err (i) % ships % pres / 100., &
2875                 err (i) % buoys % pres / 100., &
2876                 err (i) % metar % pres / 100., &
2877                 err (i) % pilot % pres / 100., &
2878                 err (i) % profl % pres / 100., &
2879                 err (i) % sound % pres / 100., &
2880                 err (i) % satem % pres / 100., &
2881                 err (i) % satob % pres / 100., &
2882                 err (i) % airep % pres / 100., &
2883                 err (i) % ssmt1 % pres / 100., &
2884                 err (i) % ssmt2 % pres / 100., &
2885                 err (i) % tovs  % pres / 100., &
2886                 err (i) % ssmi  % pres / 100., &
2887                 err (i) % airs  % pres / 100., &
2888                 err (i) % other % pres / 100.
2889
2890       ENDDO
2891
2892       CLOSE (UNIT = iunit)
2893
2894 END SUBROUTINE READ_OBSERR_PRES
2895
2896 FUNCTION obstype (line) RESULT (f_obstype)
2897 !------------------------------------------------------------------------------!
2898
2899       ! Read in a line the string present after keyword 'BOGUS'
2900
2901 !------------------------------------------------------------------------------!
2902       IMPLICIT NONE
2903       CHARACTER (LEN= 80) :: line, f_obstype
2904       INTEGER            :: b,c
2905 !------------------------------------------------------------------------------!
2906
2907 !  Find keyword bogus
2908
2909         DO c = 1, LEN_TRIM (line) - 5
2910            IF (line (c:c+4) .EQ. 'BOGUS') EXIT
2911         ENDDO
2912
2913         c = c + 5
2914
2915 !  Skip blank until next word
2916
2917         DO b = c, LEN_TRIM (line)
2918            IF (line (b:b) .NE. ' ') EXIT
2919         ENDDO
2920
2921 !  String follows
2922
2923         f_obstype = TRIM (line (b:LEN_TRIM (line)))
2924
2925 END FUNCTION obstype
2926
2927 !------------------------------------------------------------------------------!
2928 FUNCTION sensor (line) RESULT (f_sensor)
2929
2930       ! Read first in a string after numbers
2931
2932 !------------------------------------------------------------------------------!
2933       IMPLICIT NONE
2934       CHARACTER (LEN= 80) :: line, f_sensor
2935       INTEGER             :: b,c
2936 !------------------------------------------------------------------------------!
2937
2938 !  Find the first non-blank, non point and non-number character
2939
2940        DO c = 1, LEN_TRIM (line)
2941        IF (((iachar (line(c:c)) .NE. 32)  .AND. &
2942             (iachar (line(c:c)) .NE. 46)) .AND. &
2943            ((iachar (line(c:c)) .LT. 48)  .OR.  &
2944             (iachar (line(c:c)) .GT. 57)))      &
2945              EXIT
2946        ENDDO
2947
2948 !  String is start after blank untill end of line
2949
2950         f_sensor = line (c:LEN_TRIM (line))
2951
2952 END FUNCTION sensor
2953
2954 END MODULE MODULE_ERR_AFWA