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