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          if (use_error_factor_rad) then
  42             deallocate (satinfo(i) % error_factor)
  43          endif
  44
  45          deallocate (ob%instid(i) % ichan)
  46          deallocate (iv%instid(i) % ichan)
  47
  48          if (iv%instid(i)%num_rad > 0) then
  49
  50             deallocate (iv%instid(i)%info%date_char)
  51             deallocate (iv%instid(i)%info%name)
  52             deallocate (iv%instid(i)%info%platform)
  53             deallocate (iv%instid(i)%info%id)
  54             deallocate (iv%instid(i)%info%levels)
  55             deallocate (iv%instid(i)%info%lat)
  56             deallocate (iv%instid(i)%info%lon)
  57             deallocate (iv%instid(i)%info%elv)
  58
  59             deallocate (iv%instid(i)%info%pstar)
  60             deallocate (iv%instid(i)%info%i)
  61             deallocate (iv%instid(i)%info%j)
  62             deallocate (iv%instid(i)%info%k)
  63             deallocate (iv%instid(i)%info%zk)
  64             deallocate (iv%instid(i)%info%dx)
  65             deallocate (iv%instid(i)%info%dy)
  66             deallocate (iv%instid(i)%info%dz)
  67             deallocate (iv%instid(i)%info%dxm)
  68             deallocate (iv%instid(i)%info%dym)
  69             deallocate (iv%instid(i)%info%dzm)
  70             deallocate (iv%instid(i)%info%proc_domain)
  71
  72             deallocate (iv%instid(i)%t)
  73             deallocate (iv%instid(i)%mr)
  74             deallocate (iv%instid(i)%tm)
  75             deallocate (iv%instid(i)%qm)
  76             deallocate (iv%instid(i)%qrn)
  77             deallocate (iv%instid(i)%qcw)
  78             if ( crtm_cloud ) then
  79                deallocate (iv%instid(i)%qci)
  80                deallocate (iv%instid(i)%qsn)
  81                deallocate (iv%instid(i)%qgr)
  82                deallocate (iv%instid(i)%qhl)
  83                deallocate (iv%instid(i)%rcw)
  84                deallocate (iv%instid(i)%rci)
  85                deallocate (iv%instid(i)%rrn)
  86                deallocate (iv%instid(i)%rsn)
  87                deallocate (iv%instid(i)%rgr)
  88                deallocate (iv%instid(i)%rhl)
  89             end if
  90             deallocate (iv%instid(i)%pm)
  91             deallocate (iv%instid(i)%pf)
  92             deallocate (iv%instid(i)%u10)
  93             deallocate (iv%instid(i)%v10)
  94             deallocate (iv%instid(i)%t2m)
  95             deallocate (iv%instid(i)%q2m)
  96             deallocate (iv%instid(i)%mr2m)
  97             deallocate (iv%instid(i)%psfc)
  98             deallocate (iv%instid(i)%ts)
  99             deallocate (iv%instid(i)%smois)
 100             deallocate (iv%instid(i)%tslb)
 101             deallocate (iv%instid(i)%snowh)
 102             deallocate (iv%instid(i)%isflg)
 103             deallocate (iv%instid(i)%soiltyp)
 104             deallocate (iv%instid(i)%landsea_mask)
 105             if (rtm_option == rtm_option_rttov) then
 106                deallocate (iv%instid(i)%surftype)
 107                deallocate (iv%instid(i)%snow_frac)
 108             end if
 109             deallocate (iv%instid(i)%elevation)
 110             deallocate (iv%instid(i)%vegfra)
 111             deallocate (iv%instid(i)%vegtyp)
 112             deallocate (iv%instid(i)%clwp)
 113             if ( index(iv%instid(i)%rttovid_string,'amsr2') > 0 ) then
 114                deallocate (iv%instid(i)%clw)
 115             end if
 116             if ( index(iv%instid(i)%rttovid_string, 'ahi') > 0 ) then
 117                deallocate (iv%instid(i)%cloudflag)
 118             end if
 119             if ( index(iv%instid(i)%rttovid_string,'gmi') > 0 ) then
 120                deallocate (iv%instid(i)%clw)
 121             end if
 122             deallocate (iv%instid(i)%ps)
 123             deallocate (iv%instid(i)%tb_xb)
 124             if ( crtm_cloud ) then
 125                deallocate (iv%instid(i)%tb_xb_clr)
 126                deallocate (iv%instid(i)%cip)
 127             end if
 128             deallocate (iv%instid(i)%tb_qc)
 129             deallocate (iv%instid(i)%tb_inv)
 130             deallocate (iv%instid(i)%tb_error)
 131             deallocate (iv%instid(i)%tb_sens)
 132             deallocate (iv%instid(i)%tb_imp)
 133             deallocate (iv%instid(i)%rad_xb)
 134             deallocate (iv%instid(i)%rad_obs)
 135             deallocate (iv%instid(i)%rad_ovc)
 136             deallocate (iv%instid(i)%emiss)
 137             deallocate (iv%instid(i)%scanpos)
 138             deallocate (iv%instid(i)%scanline)
 139             deallocate (iv%instid(i)%ifgat)
 140             deallocate (iv%instid(i)%cloud_flag)
 141             deallocate (iv%instid(i)%rain_flag)
 142             deallocate (iv%instid(i)%satzen)
 143             deallocate (iv%instid(i)%satazi)
 144             deallocate (iv%instid(i)%solzen)
 145             deallocate (iv%instid(i)%solazi)
 146             deallocate (iv%instid(i)%tropt)
 147             deallocate (iv%instid(i)%gamma_jacobian)
 148             deallocate(iv%instid(i)%cloud_frac)
 149             if ( use_clddet_zz ) then
 150                do iy = 1, iv%instid(i)%superob_width
 151                do ix = 1, iv%instid(i)%superob_width
 152                   deallocate (iv%instid(i)%superob(ix,iy)%cld_qc)
 153                   deallocate (iv%instid(i)%superob(ix,iy)%tb_obs)
 154                end do
 155                end do
 156                deallocate (iv%instid(i)%superob)
 157            end if
 158            if (ANY(use_satcv)) then
 159               if (use_satcv(2)) then
 160                  do n = 1,iv%instid(i)%num_rad
 161                     deallocate (iv%instid(i)%cv_index(n)%cc)
 162                     deallocate (iv%instid(i)%cv_index(n)%vtox)
 163                  end do
 164               end if
 165               deallocate (iv%instid(i)%cv_index)
 166            end if
 167
 168            if ( use_rttov_kmatrix .or. use_crtm_kmatrix ) then
 169               deallocate(iv%instid(i)%ts_jacobian)
 170               deallocate(iv%instid(i)%ps_jacobian)
 171               deallocate(iv%instid(i)%emiss_jacobian)
 172               deallocate(iv%instid(i)%windspeed_jacobian)
 173               deallocate(iv%instid(i)%t_jacobian)
 174               deallocate(iv%instid(i)%q_jacobian)
 175            end if
 176             if (rtm_option == rtm_option_crtm) then
 177                deallocate(iv%instid(i)%crtm_climat)
 178                deallocate(iv%instid(i)%water_coverage)
 179                deallocate(iv%instid(i)%land_coverage)
 180                deallocate(iv%instid(i)%ice_coverage)
 181                deallocate(iv%instid(i)%snow_coverage)
 182                if (use_crtm_kmatrix) then
 183                  if ( crtm_cloud ) then
 184                      deallocate(iv%instid(i)%water_jacobian)
 185                      deallocate(iv%instid(i)%ice_jacobian)
 186                      deallocate(iv%instid(i)%rain_jacobian)
 187                      deallocate(iv%instid(i)%snow_jacobian)
 188                      deallocate(iv%instid(i)%graupel_jacobian)
 189                      deallocate(iv%instid(i)%hail_jacobian)
 190                      deallocate(iv%instid(i)%water_r_jacobian)
 191                      deallocate(iv%instid(i)%ice_r_jacobian)
 192                      deallocate(iv%instid(i)%rain_r_jacobian)
 193                      deallocate(iv%instid(i)%snow_r_jacobian)
 194                      deallocate(iv%instid(i)%graupel_r_jacobian)
 195                      deallocate(iv%instid(i)%hail_r_jacobian)
 196                  end if
 197                  if ( calc_weightfunc ) then
 198                     deallocate(iv%instid(i)%lod)
 199                     deallocate(iv%instid(i)%lod_jacobian)
 200                     deallocate(iv%instid(i)%trans)
 201                     deallocate(iv%instid(i)%trans_jacobian)
 202                     deallocate(iv%instid(i)%der_trans)
 203                  end if
 204               end if
 205             end if
 206
 207          end if
 208
 209           if ( use_rad .and. (use_varbc.or.freeze_varbc) ) then
 210              if (iv%instid(i)%varbc_info%npredmax > 0) then
 211                 deallocate (iv%instid(i)%varbc_info%pred)
 212                 deallocate (iv%instid(i)%varbc_info%pred_mean)
 213                 deallocate (iv%instid(i)%varbc_info%pred_std)
 214                 deallocate (iv%instid(i)%varbc_info%nbgerr)
 215              end if
 216              do ichan = 1, iv%instid(i)%nchan
 217                 if (iv%instid(i)%varbc(ichan)%npred <= 0) cycle
 218                 deallocate (iv%instid(i)%varbc(ichan)%pred_use)
 219                 deallocate (iv%instid(i)%varbc(ichan)%ipred)
 220                 deallocate (iv%instid(i)%varbc(ichan)%index)
 221                 deallocate (iv%instid(i)%varbc(ichan)%param)
 222                 deallocate (iv%instid(i)%varbc(ichan)%bgerr)
 223                 deallocate (iv%instid(i)%varbc(ichan)%vtox)
 224              end do
 225              deallocate (iv%instid(i)%varbc)
 226           end if
 227 #ifdef RTTOV
 228          if (rtm_option == rtm_option_rttov) then
 229             call rttov_dealloc_coefs (ierr,coefs(i))
 230             if ( ierr /= 0 ) then
 231                call da_error(__FILE__,__LINE__,(/'failure in rttov_dealloc_coefs'/))
 232             end if
 233          end if
 234 #endif
 235       end do
 236       deallocate (iv%instid)
 237       deallocate (j % jo % rad)
 238       deallocate (satinfo)
 239
 240    if (trace_use) call da_trace_exit ("da_deallocate_radiance")
 241
 242 end subroutine da_deallocate_radiance
 243