var/da/da_main/da_med_initialdata_input.inc

   1 subroutine da_med_initialdata_input (grid, config_flags, filename, in_date)
   2
   3    !-----------------------------------------------------------------------
   4    ! Purpose: TBD
   5    !-----------------------------------------------------------------------
   6
   7    implicit none
   8
   9    type(domain), intent(inout)                :: grid
  10    type (grid_config_rec_type), intent(inout) :: config_flags
  11
  12    character(*),  intent (in)                 :: filename
  13    character(*),  intent (in),  optional      :: in_date
  14
  15    integer                 :: fid , status, n, nsave
  16
  17    integer :: julyr, julday
  18    real    :: gmt
  19    integer :: icnt
  20
  21    if (trace_use) call da_trace_entry("da_med_initialdata_input")
  22    if (trace_use) call da_trace("da_med_initialdata_input", &
  23       Message="Reading "//trim(filename))
  24
  25    ! Initialize the mother domain.
  26
  27    grid%input_from_file = .true.
  28    ! Initialize the array grid%pb (YRG, 08/26/2010) for use of wrftoxb:
  29    grid%pb = 0.0
  30
  31    call ext_ncd_open_for_read(trim(filename), 0, 0, "", fid, ierr)
  32
  33    if (ierr /= 0) then
  34       write(unit=message(1), fmt='(2a)') &
  35          'Netcdf error opening file:', trim(filename)
  36       call da_error(__FILE__,__LINE__,message(1:1))
  37    end if
  38
  39    call ext_ncd_get_next_time(fid, current_date, Status)
  40
  41    if (present(in_date)) then
  42       ! Set start_date to current_date.
  43       read(in_date(1:19), fmt='(i4, 5(1x, i2))') &
  44          grid%start_year,   &
  45          grid%start_month,  &
  46          grid%start_day,    &
  47          grid%start_hour,   &
  48          grid%start_minute, &
  49          grid%start_second
  50
  51       nsave = -1
  52       do n=1, 1000
  53          if (current_date(1:19) == in_date(1:19)) then
  54             nsave = n - 1
  55             exit
  56          end if
  57          call ext_ncd_get_next_time(fid, current_date, Status)
  58       end do
  59
  60       if (nsave < 0) then
  61          call da_error(__FILE__,__LINE__,(/"Cannot find the needed time"/))
  62       end if
  63    else
  64       ! Set start_date to current_date.
  65       read(current_date(1:19), fmt='(i4, 5(1x, i2))') &
  66            grid%start_year,  &
  67            grid%start_month, &
  68            grid%start_day,   &
  69            grid%start_hour,  &
  70            grid%start_minute,&
  71            grid%start_second
  72    end if
  73
  74    call geth_julgmt(julyr, julday, gmt)
  75    call nl_set_gmt (grid%id, gmt)
  76    call nl_set_julyr (grid%id, julyr)
  77    call nl_set_julday (grid%id, julday)
  78
  79    call nl_set_iswater (grid%id, grid%iswater)
  80    call nl_set_cen_lat (grid%id , grid%cen_lat)
  81    call nl_set_cen_lon (grid%id , grid%cen_lon)
  82    call nl_set_truelat1 (grid%id , grid%truelat1)
  83    call nl_set_truelat2 (grid%id , grid%truelat2)
  84    call nl_set_moad_cen_lat (grid%id , grid%moad_cen_lat)
  85    call nl_set_stand_lon (grid%id , grid%stand_lon)
  86    call nl_set_pole_lat (grid%id , grid%pole_lat)
  87    call nl_set_map_proj (grid%id , grid%map_proj)
  88    start_date=current_date
  89
  90    call geth_julgmt(julyr, julday, gmt)
  91    config_flags%gmt = gmt
  92    config_flags%julyr = julyr
  93    config_flags%julday = julday
  94
  95    call ext_ncd_ioclose(fid, ierr)
  96
  97    call da_trace("da_med_initialdata_input", &
  98        message="open_r_dataset for "//trim(filename))
  99    call open_r_dataset (fid, trim(filename), grid , config_flags , &
 100       "DATASET=INPUT", ierr)
 101
 102    if (ierr .NE. 0) then
 103       write(unit=message(1),fmt='(A,A,A,I5)') 'Error opening ', &
 104         trim(filename),' for reading ierr=',ierr
 105       call da_error(__FILE__,__LINE__,message(1:1))
 106    end if
 107
 108    if (present(in_date)) then
 109       do n=1, nsave
 110          call da_message((/"current_date="//current_date// &
 111             ', in_date='//in_date/))
 112          call ext_ncd_get_next_time(fid, current_date, Status)
 113       end do
 114    end if
 115
 116    call input_input (fid ,   grid , config_flags , ierr)
 117
 118    call nl_get_mminlu (grid%id , grid%mminlu)
 119
 120    ! Check if this is a restart file; quit if it is.
 121    ! Restart files can be successfully read and used but will result in garbage data, so we should quit now.
 122    call wrf_get_dom_ti_integer (fid, 'FLAG_RESTART', status, 1, icnt, ierr)
 123    if (ierr == 0) then
 124       if (status == 1) then
 125          write(unit=message(1),fmt='(A,A)') trim(filename), ' appears to be a WRF restart file'
 126          write(unit=message(2),fmt='(A)')'WRFDA can only work with wrfinput or wrfout format files'
 127          call da_error(__FILE__,__LINE__,message(1:2))
 128       end if
 129    end if
 130
 131
 132    ! mp_physics is used in da_transfer_wrftoxb.inc
 133    ! get the setting from the input file
 134    call wrf_get_dom_ti_integer (fid, 'MP_PHYSICS', grid%mp_physics, 1, icnt, ierr)
 135
 136    ! sf_surface_physics is used in da_transfer_xatowrf.inc
 137    ! get the setting from the input file
 138    call wrf_get_dom_ti_integer (fid, 'SF_SURFACE_PHYSICS', grid%sf_surface_physics, 1, icnt, ierr)
 139
 140    !global attribute HYBRID_OPT exists in WRF V3.9 and later
 141    call wrf_get_dom_ti_integer (fid, 'HYBRID_OPT', grid%hybrid_opt, 1, icnt, ierr)
 142    if ( ierr /= 0 ) then
 143       grid%hybrid_opt = 0
 144       write(unit=message(1),fmt='(A,A)') trim(filename), ' appears to be from earlier than WRF V3.9'
 145       write(unit=message(2),fmt='(A)')   'Setting hybrid_opt = 0'
 146       call da_message(message(1:2))
 147    else
 148       ! when input file contains HYBRID_OPT, stop 4DVAR if not terrain-following.
 149       if ( var4d ) then
 150          if ( grid%hybrid_opt > 0 ) then
 151             write(unit=message(1),fmt='(A,I2,A,A)') 'HYBRID_OPT = ', grid%hybrid_opt, ' in ', trim(filename)
 152             write(unit=message(2),fmt='(A)') '4DVAR does not work with hybrid vertical coordinate'
 153             call da_error(__FILE__,__LINE__,message(1:2))
 154          end if
 155       end if
 156    end if
 157
 158    write(unit=message(1),fmt='(A,I2)') 'hybrid_opt = ', grid%hybrid_opt
 159    call da_message(message(1:1))
 160
 161    !global attribute USE_THETA_M exists in WRF V3.7? and later
 162    call wrf_get_dom_ti_integer (fid, 'USE_THETA_M', grid%use_theta_m, 1, icnt, ierr)
 163    if ( ierr /= 0 ) then
 164       grid%use_theta_m = 0
 165       write(unit=message(1),fmt='(A,A)') trim(filename), ' appears to be from earlier than WRF V3.7'
 166       write(unit=message(2),fmt='(A)')   'Setting use_theta_m = 0'
 167       call da_message(message(1:2))
 168    else
 169       ! when input file contains USE_THETA_M, stop 4DVAR (wrfplus not work with thetam yet).
 170       if ( var4d ) then
 171          if ( grid%use_theta_m > 0 ) then
 172             write(unit=message(1),fmt='(A,I2,A,A)') 'USE_THETA_M = ', grid%use_theta_m, ' in ', trim(filename)
 173             write(unit=message(2),fmt='(A)') '4DVAR does not work with moist potential T'
 174             call da_error(__FILE__,__LINE__,message(1:2))
 175          end if
 176       end if
 177    end if
 178
 179    write(unit=message(1),fmt='(A,I2)') 'use_theta_m = ', grid%use_theta_m
 180    call da_message(message(1:1))
 181
 182
 183    call close_dataset (fid , config_flags , "DATASET=INPUT")
 184
 185    if (trace_use) call da_trace_exit("da_med_initialdata_input")
 186
 187 end subroutine da_med_initialdata_input
 188
 189