var/da/da_define_structures/da_zero_y.inc

   1 subroutine da_zero_y( iv, y, value )
   2
   3    !---------------------------------------------------------------------------
   4    ! Purpose: Initialises the Y-array
   5    !---------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type (iv_type), intent(in)            :: iv      ! Ob type input.
  10    type (y_type),  intent(inout)         :: y       ! Residual type structure.
  11    real, optional, intent(inout)         :: value
  12
  13    integer                               :: n       ! Loop counter.
  14    integer                               :: nlevels ! Number of levels.
  15
  16    if (trace_use_dull) call da_trace_entry("da_zero_y")
  17
  18    if (.not.(present(value))) value = 0.0
  19    !---------------------------------------------------------------------------
  20    ! [1.0] Copy number of observations:
  21    !---------------------------------------------------------------------------
  22
  23    y % nlocal(:) = iv % info(:) % nlocal
  24
  25    !---------------------------------------------------------------------------
  26    ! [2.0] Allocate:
  27    !---------------------------------------------------------------------------
  28
  29    ! Initialize synops:
  30
  31    if ( y % nlocal(synop) > 0 ) then
  32       y % synop(1:y % nlocal(synop)) % u = value
  33       y % synop(1:y % nlocal(synop)) % v = value
  34       y % synop(1:y % nlocal(synop)) % t = value
  35       y % synop(1:y % nlocal(synop)) % p = value
  36       y % synop(1:y % nlocal(synop)) % q = value
  37    end if
  38
  39    ! Initialize ships:
  40
  41    if ( y % nlocal(ships) > 0 ) then
  42       y % ships(1:y % nlocal(ships)) % u = value
  43       y % ships(1:y % nlocal(ships)) % v = value
  44       y % ships(1:y % nlocal(ships)) % t = value
  45       y % ships(1:y % nlocal(ships)) % p = value
  46       y % ships(1:y % nlocal(ships)) % q = value
  47    end if
  48
  49    ! Initialize metars:
  50
  51    if ( y % nlocal(metar) > 0 ) then
  52       y % metar(1:y % nlocal(metar)) % u = value
  53       y % metar(1:y % nlocal(metar)) % v = value
  54       y % metar(1:y % nlocal(metar)) % t = value
  55       y % metar(1:y % nlocal(metar)) % p = value
  56       y % metar(1:y % nlocal(metar)) % q = value
  57    end if
  58
  59    ! Initialize Geo. AMV's:
  60
  61    if ( y % nlocal(geoamv) > 0 ) then
  62       do n = 1, y % nlocal(geoamv)
  63        nlevels = iv%info(geoamv)%levels(n)
  64        y % geoamv(n) % u(1:nlevels) = value
  65        y % geoamv(n) % v(1:nlevels) = value
  66       end do
  67    end if
  68
  69    ! Initialize Polat AMVs:
  70
  71    if ( y % nlocal(polaramv) > 0 ) then
  72       do n = 1, y % nlocal(polaramv)
  73        nlevels = iv%info(polaramv)%levels(n)
  74        y % polaramv(n) % u(1:nlevels) = value
  75        y % polaramv(n) % v(1:nlevels) = value
  76       end do
  77    end if
  78
  79    ! Initialize GPS TPW:
  80
  81    if ( y % nlocal(gpspw) > 0 ) then
  82       y % gpspw(1:y % nlocal(gpspw)) % tpw = value
  83    end if
  84
  85    ! Initialize GPS REFRACTIVITY:
  86
  87    if ( y % nlocal(gpsref) > 0 ) then
  88       do n = 1, y % nlocal(gpsref)
  89          nlevels = iv % info(gpsref) % levels(n)
  90          y % gpsref(n) % ref(1:nlevels) = value
  91          y % gpsref(n) %   p(1:nlevels) = value
  92          y % gpsref(n) %   t(1:nlevels) = value
  93          y % gpsref(n) %   q(1:nlevels) = value
  94       end do
  95    end if
  96
  97    ! Initialize GPS EXCESS PHASE:
  98
  99    if ( y % nlocal(gpseph) > 0 ) then
 100       do n = 1, y % nlocal(gpseph)
 101          nlevels = iv % info(gpseph) % levels(n)
 102          if ( nlevels > 0 ) then
 103             y % gpseph(n) % eph(1:nlevels) = value
 104          end if
 105       end do
 106    end if
 107
 108    ! Initialize sondes:
 109
 110    if ( y % nlocal(sound) > 0 ) then
 111       do n = 1, y % nlocal(sound)
 112          nlevels = iv%info(sound)%levels(n)
 113
 114          y % sound(n) % u(1:nlevels) = value
 115          y % sound(n) % v(1:nlevels) = value
 116          y % sound(n) % t(1:nlevels) = value
 117          y % sound(n) % q(1:nlevels) = value
 118       end do
 119    end if
 120
 121    ! Initialize sonde_sfc
 122    if ( y % nlocal(sonde_sfc) > 0 ) then
 123       do n = 1, y % nlocal(sonde_sfc)
 124          y % sonde_sfc(n) % u = value
 125          y % sonde_sfc(n) % v = value
 126          y % sonde_sfc(n) % t = value
 127          y % sonde_sfc(n) % p = value
 128          y % sonde_sfc(n) % q = value
 129       end do
 130    end if
 131
 132    if ( y % nlocal(mtgirs) > 0 ) then
 133       do n = 1, y % nlocal(mtgirs)
 134          nlevels = iv%info(mtgirs)%levels(n)
 135
 136          y % mtgirs(n) % u(1:nlevels) = value
 137          y % mtgirs(n) % v(1:nlevels) = value
 138          y % mtgirs(n) % t(1:nlevels) = value
 139          y % mtgirs(n) % q(1:nlevels) = value
 140
 141       end do
 142    end if
 143
 144    if ( y % nlocal(tamdar) > 0 ) then
 145       do n = 1, y % nlocal(tamdar)
 146          nlevels = iv%info(tamdar)%levels(n)
 147
 148          y % tamdar(n) % u(1:nlevels) = 0.0
 149          y % tamdar(n) % v(1:nlevels) = 0.0
 150          y % tamdar(n) % t(1:nlevels) = 0.0
 151          y % tamdar(n) % q(1:nlevels) = 0.0
 152
 153       end do
 154    end if
 155
 156 ! Initialize tamdar_sfc
 157    if ( y % nlocal(tamdar_sfc) > 0 ) then
 158
 159          y % tamdar_sfc(n) % u = 0.0
 160          y % tamdar_sfc(n) % v = 0.0
 161          y % tamdar_sfc(n) % t = 0.0
 162          y % tamdar_sfc(n) % p = 0.0
 163          y % tamdar_sfc(n) % q = 0.0
 164    end if
 165
 166    if ( y % nlocal(bogus) > 0 ) then
 167       do n = 1, y % nlocal(bogus)
 168          nlevels = iv % info(bogus) % levels(n)
 169
 170          y % bogus(n) % u(1:nlevels) = value
 171          y % bogus(n) % v(1:nlevels) = value
 172          y % bogus(n) % t(1:nlevels) = value
 173          y % bogus(n) % q(1:nlevels) = value
 174          y % bogus(n) % slp          = value
 175       end do
 176    end if
 177
 178    ! Initialize pilots:
 179
 180    if ( y % nlocal(pilot) > 0 ) then
 181       do n = 1, y % nlocal(pilot)
 182          nlevels = iv % info(pilot) % levels(n)
 183
 184          y % pilot(n) % u(1:nlevels) = value
 185          y % pilot(n) % v(1:nlevels) = value
 186       end do
 187    end if
 188
 189    ! Initialize AIREPs:
 190
 191    if ( y % nlocal(airep) > 0 ) then
 192       do n = 1, y % nlocal(airep)
 193          nlevels = iv%info(airep)%levels(n)
 194
 195          y % airep(n) % u(1:nlevels) = value
 196          y % airep(n) % v(1:nlevels) = value
 197          y % airep(n) % t(1:nlevels) = value
 198          y % airep(n) % q(1:nlevels) = value
 199       end do
 200    end if
 201
 202    ! Initialize satem:
 203
 204    if ( y % nlocal(satem) > 0 ) then
 205       do n = 1, y % nlocal(satem)
 206          nlevels = iv % info(satem) % levels(n)
 207
 208          y % satem(n) % thickness(1:nlevels) = value
 209       end do
 210    end if
 211
 212    if ( y % nlocal(ssmi_tb) > 0 ) then
 213       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb19v = value
 214       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb19h = value
 215       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb22v = value
 216       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb37v = value
 217       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb37h = value
 218       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb85v = value
 219       y % ssmi_tb(1:y % nlocal(ssmi_tb)) % tb85h = value
 220    end if
 221
 222    if ( y % nlocal(ssmi_rv) > 0 ) then
 223         y % ssmi_rv(1:y % nlocal(ssmi_rv)) % tpw = value
 224         y % ssmi_rv(1:y % nlocal(ssmi_rv)) % Speed = value
 225    end if
 226
 227    if ( y % nlocal(ssmt1) > 0 ) then
 228       do n = 1, y % nlocal(ssmt1)
 229          nlevels = iv % info(ssmt1) % levels(n)
 230          y % ssmt1(n) % t(1:nlevels) = value
 231       end do
 232    end if
 233
 234    if ( y % nlocal(ssmt2) > 0 ) then
 235       do n = 1, y % nlocal(ssmt2)
 236          nlevels = iv % info(ssmt2) % levels(n)
 237          y % ssmt2(n) % rh(1:nlevels) = value
 238       end do
 239    end if
 240
 241    if ( pseudo_uvtpq ) then
 242         y % pseudo(1:num_pseudo) % u = value
 243         y % pseudo(1:num_pseudo) % v = value
 244         y % pseudo(1:num_pseudo) % t = value
 245         y % pseudo(1:num_pseudo) % p = value
 246         y % pseudo(1:num_pseudo) % q = value
 247    end if
 248
 249    !  Initialize Quikscat:
 250
 251    if ( y % nlocal(qscat) > 0 ) then
 252       y % qscat(1:y % nlocal(qscat)) % u = value
 253       y % qscat(1:y % nlocal(qscat)) % v = value
 254    end if
 255
 256    ! Initialize profilers:
 257
 258    if ( y % nlocal(profiler) > 0 ) then
 259       do n = 1, y % nlocal(profiler)
 260          nlevels = iv % info(profiler) % levels(n)
 261
 262          y % profiler(n) % u(1:nlevels) = value
 263          y % profiler(n) % v(1:nlevels) = value
 264       end do
 265    end if
 266
 267    ! Initialize buoy:
 268
 269    if ( y % nlocal(buoy) > 0 ) then
 270       y % buoy(1:y % nlocal(buoy)) % u = value
 271       y % buoy(1:y % nlocal(buoy)) % v = value
 272       y % buoy(1:y % nlocal(buoy)) % t = value
 273       y % buoy(1:y % nlocal(buoy)) % p = value
 274       y % buoy(1:y % nlocal(buoy)) % q = value
 275    end if
 276
 277    ! Initialize radar:
 278    if ( y % nlocal(radar) > 0 ) then
 279       do n = 1, y % nlocal(radar)
 280          nlevels = iv % info(radar) % levels(n)
 281
 282          y % radar(n) % rv(1:nlevels) = value
 283          y % radar(n) % rf(1:nlevels) = value
 284       end do
 285    end if
 286
 287    ! Initialize rain:
 288    if ( y % nlocal(rain) > 0 ) then
 289           y % rain(1:y % nlocal(rain)) % rain = value
 290    end if
 291
 292    ! Initialize AIRS retrievals:
 293
 294    if ( y % nlocal(airsr) > 0 ) then
 295       do n = 1, y % nlocal(airsr)
 296          nlevels = iv % info(airsr) % levels(n)
 297
 298          y % airsr(n) % t(1:nlevels) = value
 299          y % airsr(n) % q(1:nlevels) = value
 300       end do
 301    end if
 302
 303
 304    if (trace_use_dull) call da_trace_exit("da_zero_y")
 305
 306 end subroutine da_zero_y
 307
 308