main/ideal_em.F

   1 !IDEAL:DRIVER_LAYER
   2 !
   3 ! create an initial data set for the WRF model based on an ideal condition
   4 PROGRAM ideal
   5
   6    USE module_domain , ONLY : domain
   7    USE module_initialize_ideal
   8    USE module_configure , ONLY : grid_config_rec_type
   9    USE module_check_a_mundo
  10
  11    USE module_timing
  12    USE module_wrf_error
  13 #if ( WRF_CHEM == 1 )
  14    USE module_input_chem_data
  15    USE module_input_chem_bioemiss
  16 #endif
  17
  18    IMPLICIT NONE
  19 #if ( WRF_CHEM == 1 )
  20   ! interface
  21    INTERFACE
  22      ! mediation-supplied
  23      SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
  24        USE module_domain
  25        TYPE (domain) grid
  26        TYPE (grid_config_rec_type) config_flags
  27      END SUBROUTINE med_read_wrf_chem_bioemiss
  28    END INTERFACE
  29 #endif
  30
  31    REAL    :: time
  32
  33    INTEGER :: loop , &
  34               levels_to_process
  35
  36
  37    TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid
  38    TYPE(domain)           :: dummy
  39    TYPE (grid_config_rec_type)              :: config_flags
  40    TYPE (WRFU_Time) startTime, stopTime, currentTime
  41    TYPE (WRFU_TimeInterval) stepTime
  42
  43    INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr
  44    INTEGER :: debug_level, rc
  45    LOGICAL :: input_from_file
  46
  47    INTERFACE
  48      SUBROUTINE med_initialdata_output ( grid , config_flags )
  49        USE module_domain , ONLY : domain
  50        USE module_configure , ONLY : grid_config_rec_type
  51        TYPE (domain) , POINTER :: grid
  52        TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  53      END SUBROUTINE med_initialdata_output
  54    END INTERFACE
  55
  56 #include "version_decl"
  57 #include "commit_decl"
  58
  59
  60 #ifdef DM_PARALLEL
  61    INTEGER                 :: nbytes
  62    INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
  63    INTEGER                 :: configbuf( configbuflen )
  64    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  65 #endif
  66
  67    CHARACTER (LEN=80)     :: message
  68
  69    !  Define the name of this program (program_name defined in module_domain)
  70
  71    program_name = "IDEAL " // TRIM(release_version) // " PREPROCESSOR"
  72
  73    !  Get the NAMELIST data for input.
  74
  75    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
  76 #ifdef NO_LEAP_CALENDAR
  77    CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_NOLEAP, rc=rc )
  78 #else
  79    CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_GREGORIAN, rc=rc )
  80 #endif
  81    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
  82
  83 #ifdef DM_PARALLEL
  84    IF ( wrf_dm_on_monitor() ) THEN
  85      CALL initial_config
  86    ENDIF
  87    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  88    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  89    CALL set_config_as_buffer( configbuf, configbuflen )
  90    CALL wrf_dm_initialize
  91 #else
  92    CALL initial_config
  93 #endif
  94    CALL nl_get_debug_level ( 1, debug_level )
  95    CALL set_wrf_debug_level ( debug_level )
  96
  97    CALL  wrf_message ( program_name )
  98    CALL  wrf_message ( commit_version )
  99    CALL  set_physics_rconfigs
 100    CALL  check_nml_consistency
 101
 102
 103    ! allocated and configure the mother domain
 104
 105    NULLIFY( null_domain )
 106
 107    CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
 108                                      grid       = head_grid ,          &
 109                                      parent     = null_domain ,        &
 110                                      kid        = -1                   )
 111
 112    grid => head_grid
 113    ! TBH:  Note that historically, IDEAL did not set up clocks.  These
 114    ! TBH:  are explicit replacements for old default initializations...  They
 115    ! TBH:  are needed to ensure that time manager calls do not fail due to
 116    ! TBH:  uninitialized clock.  Clean this up later...
 117    CALL WRFU_TimeSet(startTime, YY=1, MM=1, DD=1, H=0, M=0, S=0, rc=rc)
 118    stopTime = startTime
 119    currentTime = startTime
 120    ! TBH:  Bogus time step value -- clock is never advanced...
 121    CALL WRFU_TimeIntervalSet(stepTime, S=180, rc=rc)
 122    grid%domain_clock = WRFU_ClockCreate( TimeStep= stepTime,  &
 123                                          StartTime=startTime, &
 124                                          StopTime= stopTime,  &
 125                                          rc=rc )
 126    CALL wrf_check_error( WRFU_SUCCESS, rc, &
 127                          'grid%domain_clock = WRFU_ClockCreate() FAILED', &
 128                          __FILE__ , &
 129                          __LINE__  )
 130    CALL       wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
 131    CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags )
 132    CALL       wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
 133    CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
 134
 135 #ifdef PLANET
 136    WRITE ( current_date , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) &
 137            config_flags%start_year, &
 138            config_flags%start_day, &
 139            config_flags%start_hour, &
 140            config_flags%start_minute, &
 141            config_flags%start_second
 142 #else
 143    WRITE ( current_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) &
 144            config_flags%start_year, &
 145            config_flags%start_month, &
 146            config_flags%start_day, &
 147            config_flags%start_hour, &
 148            config_flags%start_minute, &
 149            config_flags%start_second
 150 #endif
 151    CALL domain_clockprint ( 150, grid, &
 152           'DEBUG assemble_output:  clock before 1st currTime set,' )
 153    WRITE (wrf_err_message,*) &
 154         'DEBUG assemble_output:  before 1st currTime set, current_date = ',TRIM(current_date)
 155    CALL wrf_debug ( 150 , wrf_err_message )
 156    CALL domain_clock_set( grid, current_timestr=current_date(1:19) )
 157    CALL domain_clockprint ( 150, grid, &
 158           'DEBUG assemble_output:  clock after 1st currTime set,' )
 159
 160    CALL       wrf_debug ( 100 , 'wrf: calling init_wrfio' )
 161    CALL init_wrfio
 162
 163 #ifdef DM_PARALLEL
 164    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 165    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 166    CALL set_config_as_buffer( configbuf, configbuflen )
 167 #endif
 168
 169 #if ( WRF_CHEM == 1 )
 170          IF( grid%chem_opt > 0 ) then
 171            ! Read the chemistry data from a previous wrf forecast (wrfout file)
 172            IF(grid%chem_in_opt == 1 ) THEN
 173               message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
 174               CALL  wrf_message ( message )
 175
 176               CALL med_read_wrf_chem_input ( grid , config_flags)
 177               IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC   &
 178                                          .or. grid%biomass_burn_opt == BIOMASSB) THEN
 179                  message = 'READING EMISSIONS DATA OPT 3'
 180                  CALL  wrf_message ( message )
 181 !                CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
 182                  CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
 183               END IF
 184
 185               IF(grid%bio_emiss_opt == 2 ) THEN
 186                  message = 'READING BEIS3.11 EMISSIONS DATA'
 187                  CALL  wrf_message ( message )
 188                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 189               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 190                  message = 'READING MEGAN 2 EMISSIONS DATA'
 191                  CALL  wrf_message ( message )
 192                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 193               END IF
 194
 195               IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
 196                  message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
 197                  CALL  wrf_message ( message )
 198                  CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
 199               END IF
 200
 201            ELSEIF(grid%chem_in_opt == 0)then
 202               ! Generate chemistry data from a idealized vertical profile
 203               message = 'STARTING WITH BACKGROUND CHEMISTRY '
 204               CALL  wrf_message ( message )
 205
 206               CALL input_chem_profile ( grid )
 207
 208               IF(grid%bio_emiss_opt == 2 ) THEN
 209                  message = 'READING BEIS3.11 EMISSIONS DATA'
 210                  CALL  wrf_message ( message )
 211                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 212               else IF(grid%bio_emiss_opt == 3 ) THEN !shc
 213                  message = 'READING MEGAN 2 EMISSIONS DATA'
 214                  CALL  wrf_message ( message )
 215                  CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
 216               END IF
 217               IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC   &
 218                                          .or. grid%biomass_burn_opt == BIOMASSB) THEN
 219                  message = 'READING EMISSIONS DATA OPT 3'
 220                  CALL  wrf_message ( message )
 221 !                CALL med_read_bin_chem_emissopt3 ( grid , config_flags)
 222                  CALL med_read_wrf_chem_emissopt3 ( grid , config_flags)
 223               END IF
 224
 225               IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc
 226                  message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
 227                  CALL  wrf_message ( message )
 228                  CALL med_read_wrf_chem_gocart_bg ( grid , config_flags)
 229               END IF
 230
 231            ELSE
 232              message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
 233              CALL  wrf_message ( message )
 234            END IF
 235          END IF
 236 #endif
 237
 238    grid%this_is_an_ideal_run = .TRUE.
 239    CALL med_initialdata_output( head_grid , config_flags )
 240
 241    CALL       wrf_debug (   0 , 'wrf: SUCCESS COMPLETE IDEAL INIT' )
 242    CALL med_shutdown_io ( head_grid , config_flags )
 243    CALL wrf_shutdown
 244
 245    CALL WRFU_Finalize( rc=rc )
 246
 247 END PROGRAM ideal
 248
 249 SUBROUTINE med_initialdata_output ( grid , config_flags )
 250   ! Driver layer
 251    USE module_domain
 252    USE module_io_domain
 253    USE module_initialize_ideal
 254   ! Model layer
 255    USE module_configure
 256
 257    IMPLICIT NONE
 258
 259   ! Arguments
 260    TYPE(domain)  , POINTER                    :: grid
 261    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 262   ! Local
 263    INTEGER                :: time_step_begin_restart
 264    INTEGER                :: fid , ierr , id
 265    CHARACTER (LEN=80)      :: rstname
 266    CHARACTER (LEN=80)      :: message
 267    CHARACTER (LEN=80)      :: inpname , bdyname
 268
 269    !  Initialize the mother domain.
 270
 271    grid%input_from_file = .false.
 272    CALL init_domain (  grid )
 273    CALL calc_current_date ( grid%id, 0.)
 274
 275    CALL construct_filename1 ( inpname , 'wrfinput' , grid%id , 2 )
 276    CALL open_w_dataset ( id, TRIM(inpname) , grid , config_flags , output_input , "DATASET=INPUT", ierr )
 277    IF ( ierr .NE. 0 ) THEN
 278      WRITE (wrf_err_message,*)'ideal: error opening wrfinput for writing ',ierr
 279      CALL wrf_error_fatal( wrf_err_message )
 280    ENDIF
 281    CALL output_input ( id, grid , config_flags , ierr )
 282    CALL close_dataset ( id , config_flags, "DATASET=INPUT" )
 283
 284
 285    IF ( config_flags%specified ) THEN
 286
 287      CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 )
 288      CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
 289      IF ( ierr .NE. 0 ) THEN
 290        WRITE (wrf_err_message,*)'ideal: error opening wrfbdy for writing ',ierr
 291        CALL wrf_error_fatal( wrf_err_message )
 292      ENDIF
 293      CALL output_boundary ( id, grid , config_flags , ierr )
 294      CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
 295
 296    ENDIF
 297
 298    RETURN
 299 END SUBROUTINE med_initialdata_output
 300