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
  13    IMPLICIT NONE
  14
  15    REAL    :: time
  16
  17    INTEGER :: loop , &
  18               levels_to_process
  19
  20
  21    TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid
  22    TYPE(domain)           :: dummy
  23    TYPE (grid_config_rec_type)              :: config_flags
  24    TYPE (WRFU_Time) startTime, stopTime, currentTime
  25    TYPE (WRFU_TimeInterval) stepTime
  26
  27    INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr
  28    INTEGER :: debug_level, rc
  29    LOGICAL :: input_from_file
  30
  31    INTERFACE
  32      SUBROUTINE med_initialdata_output ( grid , config_flags )
  33        USE module_domain , ONLY : domain
  34        USE module_configure , ONLY : grid_config_rec_type
  35        TYPE (domain) , POINTER :: grid
  36        TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  37      END SUBROUTINE med_initialdata_output
  38    END INTERFACE
  39
  40 #include "version_decl"
  41
  42
  43 #ifdef DM_PARALLEL
  44    INTEGER                 :: nbytes
  45    INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
  46    INTEGER                 :: configbuf( configbuflen )
  47    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  48 #endif
  49
  50    CHARACTER (LEN=80)     :: message
  51
  52    !  Define the name of this program (program_name defined in module_domain)
  53
  54    program_name = "IDEAL " // TRIM(release_version) // " PREPROCESSOR"
  55
  56    !  Get the NAMELIST data for input.
  57
  58    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
  59    CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
  60    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
  61
  62 #ifdef DM_PARALLEL
  63    IF ( wrf_dm_on_monitor() ) THEN
  64      CALL initial_config
  65    ENDIF
  66    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  67    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  68    CALL set_config_as_buffer( configbuf, configbuflen )
  69    CALL wrf_dm_initialize
  70 #else
  71    CALL initial_config
  72 #endif
  73    CALL nl_get_debug_level ( 1, debug_level )
  74    CALL set_wrf_debug_level ( debug_level )
  75
  76    CALL  wrf_message ( program_name )
  77
  78
  79    ! allocated and configure the mother domain
  80
  81    NULLIFY( null_domain )
  82
  83    CALL alloc_and_configure_domain ( domain_id  = 1 ,                  &
  84                                      grid       = head_grid ,          &
  85                                      parent     = null_domain ,        &
  86                                      kid        = -1                   )
  87
  88    grid => head_grid
  89    ! TBH:  Note that historically, IDEAL did not set up clocks.  These
  90    ! TBH:  are explicit replacements for old default initializations...  They
  91    ! TBH:  are needed to ensure that time manager calls do not fail due to
  92    ! TBH:  uninitialized clock.  Clean this up later...
  93    CALL WRFU_TimeSet(startTime, YY=1, MM=1, DD=1, H=0, M=0, S=0, rc=rc)
  94    stopTime = startTime
  95    currentTime = startTime
  96    ! TBH:  Bogus time step value -- clock is never advanced...
  97    CALL WRFU_TimeIntervalSet(stepTime, S=180, rc=rc)
  98    grid%domain_clock = WRFU_ClockCreate( TimeStep= stepTime,  &
  99                                          StartTime=startTime, &
 100                                          StopTime= stopTime,  &
 101                                          rc=rc )
 102    CALL wrf_check_error( WRFU_SUCCESS, rc, &
 103                          'grid%domain_clock = WRFU_ClockCreate() FAILED', &
 104                          __FILE__ , &
 105                          __LINE__  )
 106    CALL       wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
 107    CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags )
 108    CALL       wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
 109    CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 )
 110
 111 #ifdef PLANET
 112    WRITE ( current_date , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) &
 113            config_flags%start_year, &
 114            config_flags%start_day, &
 115            config_flags%start_hour, &
 116            config_flags%start_minute, &
 117            config_flags%start_second
 118 #else
 119    WRITE ( current_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) &
 120            config_flags%start_year, &
 121            config_flags%start_month, &
 122            config_flags%start_day, &
 123            config_flags%start_hour, &
 124            config_flags%start_minute, &
 125            config_flags%start_second
 126 #endif
 127    CALL domain_clockprint ( 150, grid, &
 128           'DEBUG assemble_output:  clock before 1st currTime set,' )
 129    WRITE (wrf_err_message,*) &
 130         'DEBUG assemble_output:  before 1st currTime set, current_date = ',TRIM(current_date)
 131    CALL wrf_debug ( 150 , wrf_err_message )
 132    CALL domain_clock_set( grid, current_timestr=current_date(1:19) )
 133    CALL domain_clockprint ( 150, grid, &
 134           'DEBUG assemble_output:  clock after 1st currTime set,' )
 135
 136    CALL       wrf_debug ( 100 , 'wrf: calling init_wrfio' )
 137    CALL init_wrfio
 138
 139 #ifdef DM_PARALLEL
 140    CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 141    CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 142    CALL set_config_as_buffer( configbuf, configbuflen )
 143 #endif
 144
 145    CALL med_initialdata_output( head_grid , config_flags )
 146
 147    CALL       wrf_debug (   0 , 'wrf: SUCCESS COMPLETE IDEAL INIT' )
 148    CALL med_shutdown_io ( head_grid , config_flags )
 149    CALL wrf_shutdown
 150
 151    CALL WRFU_Finalize( rc=rc )
 152
 153 END PROGRAM ideal
 154
 155 SUBROUTINE med_initialdata_output ( grid , config_flags )
 156   ! Driver layer
 157    USE module_domain
 158    USE module_io_domain
 159    USE module_initialize_ideal
 160   ! Model layer
 161    USE module_configure
 162
 163    IMPLICIT NONE
 164
 165   ! Arguments
 166    TYPE(domain)  , POINTER                    :: grid
 167    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 168   ! Local
 169    INTEGER                :: time_step_begin_restart
 170    INTEGER                :: fid , ierr , id
 171    CHARACTER (LEN=80)      :: rstname
 172    CHARACTER (LEN=80)      :: message
 173    CHARACTER (LEN=80)      :: inpname , bdyname
 174
 175    !  Initialize the mother domain.
 176
 177    grid%input_from_file = .false.
 178    CALL init_domain (  grid )
 179    CALL calc_current_date ( grid%id, 0.)
 180
 181    CALL construct_filename1 ( inpname , 'wrfinput' , grid%id , 2 )
 182    CALL open_w_dataset ( id, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
 183    IF ( ierr .NE. 0 ) THEN
 184      WRITE (wrf_err_message,*)'ideal: error opening wrfinput for writing ',ierr
 185      CALL wrf_error_fatal( wrf_err_message )
 186    ENDIF
 187    CALL output_model_input ( id, grid , config_flags , ierr )
 188    CALL close_dataset ( id , config_flags, "DATASET=INPUT" )
 189
 190
 191    IF ( config_flags%specified ) THEN
 192
 193      CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 )
 194      CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
 195      IF ( ierr .NE. 0 ) THEN
 196        WRITE (wrf_err_message,*)'ideal: error opening wrfbdy for writing ',ierr
 197        CALL wrf_error_fatal( wrf_err_message )
 198      ENDIF
 199      CALL output_boundary ( id, grid , config_flags , ierr )
 200      CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
 201
 202    ENDIF
 203
 204    RETURN
 205 END SUBROUTINE med_initialdata_output
 206