var/da/da_obs_io/da_final_write_obs_chem_sfc.inc

   1 subroutine da_final_write_obs_chem_sfc(it,iv)
   2
   3    !-------------------------------------------------------------------------
   4    ! Purpose: Writes full diagnostics for O, (O-B) & OMA together
   5    !-------------------------------------------------------------------------
   6
   7    implicit none
   8
   9    integer,        intent(in)    :: it
  10    type (iv_type), intent(in)    :: iv      ! O-B structure.
  11    integer                       :: n, k, iunit
  12    integer                       :: ios  ! Error code from MPI routines.
  13    integer                       :: num_obs
  14    logical                       :: if_wind_sd
  15    character(len=filename_len), allocatable     :: filename(:)
  16    character(len=filename_len)                  :: file
  17
  18
  19    if (trace_use) call da_trace_entry("da_final_write_obs_chem_sfc")
  20
  21 #ifdef DM_PARALLEL
  22    ! Wait to ensure all temporary files have been written
  23    call mpi_barrier(comm, ierr)
  24 #endif
  25
  26    if (rootproc) then
  27       call da_get_unit(iunit)
  28       allocate (filename(0:num_procs-1))
  29       do k = 0,num_procs-1
  30          write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'chem_omb_oma_',it,'.',k
  31       end do
  32       call da_get_unit(omb_unit)
  33        write(unit=file,fmt ='(a,i2.2)')'chem_omb_oma_',it
  34       open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios)
  35       if (ios /= 0) call da_error(__FILE__,__LINE__, &
  36          (/"Cannot open file "//file/))
  37    end if
  38
  39    num_obs = 0
  40    if (iv%info(chemic_surf)%nlocal > 0) then
  41       do n = 1, iv%info(chemic_surf)%nlocal
  42          if(iv%info(chemic_surf)%proc_domain(1,n)) num_obs = num_obs + 1
  43       end do
  44    end if
  45    call da_proc_sum_int(num_obs)
  46    if (num_obs > 0 .and. rootproc) then
  47       write(omb_unit,'(a20,i8)')'chem', num_obs
  48       num_obs = 0
  49       do k = 0,num_procs-1
  50          call da_read_omb_tmp(filename(k),iunit,num_obs,'chem',4,if_wind_sd)
  51       end do
  52    end if
  53
  54
  55    if (rootproc) then
  56       close(iunit)
  57       close(omb_unit)
  58       call da_free_unit(iunit)
  59       call da_free_unit(omb_unit)
  60       deallocate (filename)
  61    end if
  62
  63    if (trace_use) call da_trace_exit("da_final_write_obs_chem_sfc")
  64
  65 end subroutine da_final_write_obs_chem_sfc
  66
  67