var/da/da_radiance/da_deallocate_radiance.inc

   1   subroutine da_deallocate_radiance ( ob, iv, j)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: deallocate radiance related structures/arrays
   5    ! Extracted from da_solve.inc
   6    !-----------------------------------------------------------------------
   7
   8    implicit none
   9
  10    type (y_type),        intent(inout)  :: ob        ! Observation structure.
  11    type (iv_type),       intent(inout)  :: iv        ! Obs. increment structure.
  12    type (j_type),        intent(inout)  :: j         ! Cost function.
  13
  14    integer                        :: i,n,ichan,ix,iy
  15
  16    if (trace_use) call da_trace_entry("da_deallocate_radiance")
  17
  18       do i =1, iv%num_inst
  19          deallocate (j % jo % rad(i) % jo_ichan)
  20          deallocate (j % jo % rad(i) % num_ichan)
  21          deallocate (satinfo(i) % ichan)
  22          deallocate (satinfo(i) % iuse)
  23          deallocate (satinfo(i) % error)
  24          deallocate (satinfo(i) % error_cld)
  25          deallocate (satinfo(i) % polar)
  26
  27          deallocate (satinfo(i) % scanbias)
  28          deallocate (satinfo(i) % scanbias_b)
  29          deallocate (satinfo(i) % bcoef)
  30          deallocate (satinfo(i) % bcoef0)
  31          deallocate (satinfo(i) % error_std)
  32
  33          ! Deallocate extra variables for AHI
  34          if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then
  35             deallocate ( satinfo(i) % BTLim)
  36             deallocate ( satinfo(i) % ca1)
  37             deallocate ( satinfo(i) % ca2)
  38             deallocate ( satinfo(i) % clearSkyBias)
  39          endif
  40
  41          ! Deallocate extra variables for ABI
  42          if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then
  43             deallocate (satinfo(i) % error_cld_y)
  44             deallocate (satinfo(i) % error_cld_x)
  45          endif
  46
  47
  48          if (use_error_factor_rad) then
  49             deallocate (satinfo(i) % error_factor)
  50          endif
  51
  52          deallocate (ob%instid(i) % ichan)
  53          deallocate (iv%instid(i) % ichan)
  54
  55          if (iv%instid(i)%num_rad > 0) then
  56
  57             deallocate (iv%instid(i)%info%date_char)
  58             deallocate (iv%instid(i)%info%name)
  59             deallocate (iv%instid(i)%info%platform)
  60             deallocate (iv%instid(i)%info%id)
  61             deallocate (iv%instid(i)%info%levels)
  62             deallocate (iv%instid(i)%info%lat)
  63             deallocate (iv%instid(i)%info%lon)
  64             deallocate (iv%instid(i)%info%elv)
  65
  66             deallocate (iv%instid(i)%info%pstar)
  67             deallocate (iv%instid(i)%info%i)
  68             deallocate (iv%instid(i)%info%j)
  69             deallocate (iv%instid(i)%info%k)
  70             deallocate (iv%instid(i)%info%zk)
  71             deallocate (iv%instid(i)%info%dx)
  72             deallocate (iv%instid(i)%info%dy)
  73             deallocate (iv%instid(i)%info%dz)
  74             deallocate (iv%instid(i)%info%dxm)
  75             deallocate (iv%instid(i)%info%dym)
  76             deallocate (iv%instid(i)%info%dzm)
  77             deallocate (iv%instid(i)%info%proc_domain)
  78
  79             deallocate (iv%instid(i)%t)
  80             deallocate (iv%instid(i)%mr)
  81             deallocate (iv%instid(i)%tm)
  82             deallocate (iv%instid(i)%qm)
  83             deallocate (iv%instid(i)%qrn)
  84             deallocate (iv%instid(i)%qcw)
  85             if ( crtm_cloud ) then
  86                deallocate (iv%instid(i)%qci)
  87                deallocate (iv%instid(i)%qsn)
  88                deallocate (iv%instid(i)%qgr)
  89                deallocate (iv%instid(i)%qhl)
  90                deallocate (iv%instid(i)%rcw)
  91                deallocate (iv%instid(i)%rci)
  92                deallocate (iv%instid(i)%rrn)
  93                deallocate (iv%instid(i)%rsn)
  94                deallocate (iv%instid(i)%rgr)
  95                deallocate (iv%instid(i)%rhl)
  96             end if
  97             deallocate (iv%instid(i)%pm)
  98             deallocate (iv%instid(i)%pf)
  99             deallocate (iv%instid(i)%u10)
 100             deallocate (iv%instid(i)%v10)
 101             deallocate (iv%instid(i)%t2m)
 102             deallocate (iv%instid(i)%q2m)
 103             deallocate (iv%instid(i)%mr2m)
 104             deallocate (iv%instid(i)%psfc)
 105             deallocate (iv%instid(i)%ts)
 106             deallocate (iv%instid(i)%smois)
 107             deallocate (iv%instid(i)%tslb)
 108             deallocate (iv%instid(i)%snowh)
 109             deallocate (iv%instid(i)%isflg)
 110             deallocate (iv%instid(i)%soiltyp)
 111             deallocate (iv%instid(i)%landsea_mask)
 112             if (rtm_option == rtm_option_rttov) then
 113                deallocate (iv%instid(i)%surftype)
 114                deallocate (iv%instid(i)%snow_frac)
 115             end if
 116             deallocate (iv%instid(i)%elevation)
 117             deallocate (iv%instid(i)%vegfra)
 118             deallocate (iv%instid(i)%vegtyp)
 119             deallocate (iv%instid(i)%clwp)
 120             if ( index(iv%instid(i)%rttovid_string,'amsr2') > 0 ) then
 121                deallocate (iv%instid(i)%clw)
 122             end if
 123             if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then
 124                deallocate (iv%instid(i)%cloudflag)
 125             end if
 126             if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then
 127                deallocate (iv%instid(i)%cloud_mod)
 128                deallocate (iv%instid(i)%cloud_obs)
 129             end if
 130             if ( index(iv%instid(i)%rttovid_string,'gmi') > 0 ) then
 131                deallocate (iv%instid(i)%clw)
 132             end if
 133             deallocate (iv%instid(i)%ps)
 134             deallocate (iv%instid(i)%tb_xb)
 135             if ( crtm_cloud ) then
 136                deallocate (iv%instid(i)%tb_xb_clr)
 137                deallocate (iv%instid(i)%cip)
 138             end if
 139             deallocate (iv%instid(i)%tb_qc)
 140             deallocate (iv%instid(i)%tb_inv)
 141             deallocate (iv%instid(i)%tb_error)
 142             deallocate (iv%instid(i)%tb_sens)
 143             deallocate (iv%instid(i)%tb_imp)
 144             deallocate (iv%instid(i)%rad_xb)
 145             deallocate (iv%instid(i)%rad_obs)
 146             deallocate (iv%instid(i)%rad_ovc)
 147             deallocate (iv%instid(i)%emiss)
 148             deallocate (iv%instid(i)%scanpos)
 149             deallocate (iv%instid(i)%scanline)
 150             deallocate (iv%instid(i)%ifgat)
 151             deallocate (iv%instid(i)%cloud_flag)
 152             deallocate (iv%instid(i)%rain_flag)
 153             deallocate (iv%instid(i)%satzen)
 154             deallocate (iv%instid(i)%satazi)
 155             deallocate (iv%instid(i)%solzen)
 156             deallocate (iv%instid(i)%solazi)
 157             deallocate (iv%instid(i)%tropt)
 158             deallocate (iv%instid(i)%gamma_jacobian)
 159             deallocate(iv%instid(i)%cloud_frac)
 160             if ( use_clddet_zz ) then
 161                do iy = 1, iv%instid(i)%superob_width
 162                do ix = 1, iv%instid(i)%superob_width
 163                  if ( index(iv%instid(i)%rttovid_string, 'abi') > 0 ) then
 164                   do n = 1,iv%instid(i)%num_rad
 165                      if ( allocated (iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3) ) &
 166                         deallocate (iv%instid(i)%superob(ix,iy)%cld_qc(n)%tb_stddev_3x3)
 167                      if ( allocated (iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O_abi) ) &
 168                         deallocate (iv%instid(i)%superob(ix,iy)%cld_qc(n)%CIRH2O_abi)
 169                   end do
 170                  end if
 171                  deallocate (iv%instid(i)%superob(ix,iy)%cld_qc)
 172                  deallocate (iv%instid(i)%superob(ix,iy)%tb_obs)
 173                end do
 174                end do
 175                deallocate (iv%instid(i)%superob)
 176            end if
 177            if (ANY(use_satcv)) then
 178               if (use_satcv(2)) then
 179                  do n = 1,iv%instid(i)%num_rad
 180                     deallocate (iv%instid(i)%cv_index(n)%cc)
 181                     deallocate (iv%instid(i)%cv_index(n)%vtox)
 182                  end do
 183               end if
 184               deallocate (iv%instid(i)%cv_index)
 185            end if
 186
 187            if ( use_rttov_kmatrix .or. use_crtm_kmatrix ) then
 188               deallocate(iv%instid(i)%ts_jacobian)
 189               deallocate(iv%instid(i)%ps_jacobian)
 190               deallocate(iv%instid(i)%emiss_jacobian)
 191               deallocate(iv%instid(i)%windspeed_jacobian)
 192               deallocate(iv%instid(i)%t_jacobian)
 193               deallocate(iv%instid(i)%q_jacobian)
 194            end if
 195             if (rtm_option == rtm_option_crtm) then
 196                deallocate(iv%instid(i)%crtm_climat)
 197                deallocate(iv%instid(i)%water_coverage)
 198                deallocate(iv%instid(i)%land_coverage)
 199                deallocate(iv%instid(i)%ice_coverage)
 200                deallocate(iv%instid(i)%snow_coverage)
 201                if (use_crtm_kmatrix) then
 202                  if ( crtm_cloud ) then
 203                      deallocate(iv%instid(i)%water_jacobian)
 204                      deallocate(iv%instid(i)%ice_jacobian)
 205                      deallocate(iv%instid(i)%rain_jacobian)
 206                      deallocate(iv%instid(i)%snow_jacobian)
 207                      deallocate(iv%instid(i)%graupel_jacobian)
 208                      deallocate(iv%instid(i)%hail_jacobian)
 209                      deallocate(iv%instid(i)%water_r_jacobian)
 210                      deallocate(iv%instid(i)%ice_r_jacobian)
 211                      deallocate(iv%instid(i)%rain_r_jacobian)
 212                      deallocate(iv%instid(i)%snow_r_jacobian)
 213                      deallocate(iv%instid(i)%graupel_r_jacobian)
 214                      deallocate(iv%instid(i)%hail_r_jacobian)
 215                  end if
 216                  if ( calc_weightfunc ) then
 217                     deallocate(iv%instid(i)%lod)
 218                     deallocate(iv%instid(i)%lod_jacobian)
 219                     deallocate(iv%instid(i)%trans)
 220                     deallocate(iv%instid(i)%trans_jacobian)
 221                     deallocate(iv%instid(i)%der_trans)
 222                  end if
 223               end if
 224             end if
 225
 226          end if
 227
 228           if ( use_rad .and. (use_varbc.or.freeze_varbc) ) then
 229              if (iv%instid(i)%varbc_info%npredmax > 0) then
 230                 deallocate (iv%instid(i)%varbc_info%pred)
 231                 deallocate (iv%instid(i)%varbc_info%pred_mean)
 232                 deallocate (iv%instid(i)%varbc_info%pred_std)
 233                 deallocate (iv%instid(i)%varbc_info%nbgerr)
 234              end if
 235              do ichan = 1, iv%instid(i)%nchan
 236                 if (iv%instid(i)%varbc(ichan)%npred <= 0) cycle
 237                 deallocate (iv%instid(i)%varbc(ichan)%pred_use)
 238                 deallocate (iv%instid(i)%varbc(ichan)%ipred)
 239                 deallocate (iv%instid(i)%varbc(ichan)%index)
 240                 deallocate (iv%instid(i)%varbc(ichan)%param)
 241                 deallocate (iv%instid(i)%varbc(ichan)%bgerr)
 242                 deallocate (iv%instid(i)%varbc(ichan)%vtox)
 243              end do
 244              deallocate (iv%instid(i)%varbc)
 245           end if
 246 #ifdef RTTOV
 247          if (rtm_option == rtm_option_rttov) then
 248             call rttov_dealloc_coefs (ierr,coefs(i))
 249             if ( ierr /= 0 ) then
 250                call da_error(__FILE__,__LINE__,(/'failure in rttov_dealloc_coefs'/))
 251             end if
 252          end if
 253 #endif
 254       end do
 255       deallocate (iv%instid)
 256       deallocate (j % jo % rad)
 257       deallocate (satinfo)
 258
 259    if (trace_use) call da_trace_exit ("da_deallocate_radiance")
 260
 261 end subroutine da_deallocate_radiance
 262