var/da/da_obs_io/da_final_write_obs_gas_sfc.inc

   1 subroutine da_final_write_obs_gas_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    !local
  19    character(len=4) :: typestr
  20    typestr = 'gas'
  21
  22    if (trace_use) call da_trace_entry("da_final_write_obs_gas_sfc")
  23
  24 #ifdef DM_PARALLEL
  25    ! Wait to ensure all temporary files have been written
  26    call mpi_barrier(comm, ierr)
  27 #endif
  28
  29    if (rootproc) then
  30       call da_get_unit(iunit)
  31       allocate (filename(0:num_procs-1))
  32       do k = 0,num_procs-1
  33          write(unit=filename(k),fmt ='(a,i2.2,a,i4.4)')'gas_omb_oma_',it,'.',k
  34       end do
  35       call da_get_unit(omb_unit)
  36        write(unit=file,fmt ='(a,i2.2)')'gas_omb_oma_',it
  37       open(unit=omb_unit,file=trim(file),form='formatted', status='replace', iostat=ios)
  38       if (ios /= 0) call da_error(__FILE__,__LINE__, &
  39          (/"Cannot open file "//file/))
  40    end if
  41
  42    num_obs = 0
  43    if (iv%info(chemic_surf)%nlocal > 0) then
  44       do n = 1, iv%info(chemic_surf)%nlocal
  45          if(iv%info(chemic_surf)%proc_domain(1,n)) num_obs = num_obs + 1
  46       end do
  47    end if
  48    call da_proc_sum_int(num_obs)
  49    if (num_obs > 0 .and. rootproc) then
  50       write(omb_unit,'(a20,i8)') typestr, num_obs
  51       num_obs = 0
  52       do k = 0,num_procs-1
  53          call da_read_omb_tmp(filename(k),iunit,num_obs,typestr,3,if_wind_sd)
  54       end do
  55    end if
  56
  57
  58    if (rootproc) then
  59       close(iunit)
  60       close(omb_unit)
  61       call da_free_unit(iunit)
  62       call da_free_unit(omb_unit)
  63       deallocate (filename)
  64    end if
  65
  66    if (trace_use) call da_trace_exit("da_final_write_obs_gas_sfc")
  67
  68 end subroutine da_final_write_obs_gas_sfc
  69
  70