var/convertor/convert_nmm.F

   1 ! This is a program that converts NMM data into WRF input data.
   2 ! No boundary data yet.
   3 !
   4 PROGRAM convert_nmm
   5
   6    USE module_machine
   7    USE module_domain
   8    USE module_io_domain
   9    USE module_driver_constants
  10    USE module_bc
  11    USE module_configure
  12    USE module_timing
  13    USE module_utility
  14 #ifdef DM_PARALLEL
  15    USE module_dm
  16 #endif
  17
  18    IMPLICIT NONE
  19
  20    TYPE(WRFU_TimeInterval) :: time_interval
  21
  22    INTERFACE
  23      SUBROUTINE Setup_Timekeeping( grid )
  24       USE module_domain
  25       TYPE(domain), POINTER :: grid
  26      END SUBROUTINE Setup_Timekeeping
  27    END INTERFACE
  28
  29    REAL    :: time , bdyfrq
  30
  31    INTEGER :: loop , levels_to_process
  32    INTEGER :: rc
  33
  34
  35    TYPE(domain) , POINTER      :: keep_grid, grid_ptr, null_domain, grid
  36    TYPE (grid_config_rec_type) :: config_flags
  37    INTEGER                     :: number_at_same_level
  38
  39    INTEGER :: max_dom, domain_id
  40    INTEGER :: id1 , id , ierr
  41    INTEGER :: idum1, idum2
  42 #ifdef DM_PARALLEL
  43    INTEGER                 :: nbytes
  44    INTEGER, PARAMETER      :: configbuflen = 4* CONFIG_BUF_LEN
  45    INTEGER                 :: configbuf( configbuflen )
  46    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
  47 #endif
  48
  49    REAL    :: dt_from_file, tstart_from_file, tend_from_file
  50    INTEGER :: ids , ide , jds , jde , kds , kde
  51    INTEGER :: ims , ime , jms , jme , kms , kme
  52    INTEGER :: i , j , k , idts, ntsd, bdy_frame, nbdy_frames
  53    INTEGER :: debug_level
  54
  55    CHARACTER (LEN=80)     :: message
  56
  57    REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
  58    REAL , DIMENSION(:,:  ) , ALLOCATABLE :: mbdy2dtemp1
  59    REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
  60    REAL , DIMENSION(:,:  ) , ALLOCATABLE :: mbdy2dtemp2
  61
  62    CHARACTER(LEN=24) :: previous_date , this_date , next_date
  63    CHARACTER(LEN=19) :: start_date_char , end_date_char , current_date_char , next_date_char
  64    CHARACTER(LEN= 4) :: loop_char
  65
  66    INTEGER :: start_year , start_month , start_day , start_hour , start_minute , start_second
  67    INTEGER ::   end_year ,   end_month ,   end_day ,   end_hour ,   end_minute ,   end_second
  68    INTEGER :: interval_seconds , real_data_init_type
  69    INTEGER :: time_loop_max , time_loop
  70
  71    CHARACTER (LEN=80) :: inpname , bdyname
  72
  73 ! these are needed on some compilers, eg compaq/alpha, to
  74 ! permit pass by reference through the registry generated
  75 ! interface to med_read_nmm, below
  76 #ifdef DEREF_KLUDGE
  77 !  see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  78    INTEGER     :: sm31 , em31 , sm32 , em32 , sm33 , em33
  79    INTEGER     :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  80    INTEGER     :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  81 #endif
  82
  83    !  Get the NAMELIST data for input.
  84
  85    !  Define the name of this program (program_name defined in module_domain)
  86
  87    program_name = "REAL_EM V1.2 PREPROCESSOR"
  88
  89 #ifdef DM_PARALLEL
  90    CALL disable_quilting
  91 #endif
  92
  93    CALL init_modules(1)   ! Phase 1 returns after MPI_INIT() (if it is called)
  94    CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
  95    CALL init_modules(2)   ! Phase 2 resumes after MPI_INIT() (if it is called)
  96
  97 #ifdef DM_PARALLEL
  98    IF ( wrf_dm_on_monitor() ) THEN
  99      CALL initial_config
 100      CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
 101      CALL wrf_dm_bcast_bytes( configbuf, nbytes )
 102      CALL set_config_as_buffer( configbuf, configbuflen )
 103    ENDIF
 104    CALL wrf_dm_initialize
 105 #else
 106    CALL initial_config
 107 #endif
 108
 109    CALL nl_get_debug_level ( 1, debug_level )
 110    CALL set_wrf_debug_level ( debug_level )
 111
 112    CALL  wrf_message ( program_name )
 113
 114    !  An available simple timer from the timing module.
 115
 116    NULLIFY( null_domain )
 117    CALL alloc_and_configure_domain ( domain_id  = 1           , &
 118                                      grid       = head_grid   , &
 119                                      parent     = null_domain , &
 120                                      kid        = -1            )
 121
 122    grid => head_grid
 123    CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
 124
 125    CALL Setup_Timekeeping ( grid )
 126    CALL WRFU_TimeIntervalSet ( time_interval , S=model_config_rec%interval_seconds, rc=rc )
 127    CALL WRFU_ClockSet ( grid%domain_clock , timeStep=time_interval , rc=rc )
 128    CALL WRFU_ClockGet ( grid%domain_clock, currTime=grid%current_time , rc=rc )
 129    CALL wrf_timetoa ( grid%current_time, message )
 130    write(0,*)Trim(message)
 131
 132    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 133
 134
 135 print *,'start date=',model_config_rec%start_year(grid%id),model_config_rec%start_month(grid%id),&
 136 model_config_rec%start_day(grid%id),model_config_rec%start_hour(grid%id)
 137 print *,'end   date=',model_config_rec%end_year(grid%id),model_config_rec%end_month(grid%id),&
 138 model_config_rec%end_day(grid%id),model_config_rec%end_hour(grid%id)
 139 print *,'interval  =',model_config_rec%interval_seconds
 140 print *,'init_typ  =',model_config_rec%real_data_init_type
 141
 142    !  Figure out the starting and ending dates in a character format.
 143
 144    start_year   = model_config_rec%start_year  (grid%id)
 145    start_month  = model_config_rec%start_month (grid%id)
 146    start_day    = model_config_rec%start_day   (grid%id)
 147    start_hour   = model_config_rec%start_hour  (grid%id)
 148    start_minute = model_config_rec%start_minute(grid%id)
 149    start_second = model_config_rec%start_second(grid%id)
 150
 151    end_year   = model_config_rec%  end_year  (grid%id)
 152    end_month  = model_config_rec%  end_month (grid%id)
 153    end_day    = model_config_rec%  end_day   (grid%id)
 154    end_hour   = model_config_rec%  end_hour  (grid%id)
 155    end_minute = model_config_rec%  end_minute(grid%id)
 156    end_second = model_config_rec%  end_second(grid%id)
 157
 158    interval_seconds    = model_config_rec%interval_seconds
 159    real_data_init_type = model_config_rec%real_data_init_type
 160
 161    WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 162            start_year,start_month,start_day,start_hour,start_minute,start_second
 163    WRITE (   end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
 164              end_year,  end_month,  end_day,  end_hour,  end_minute,  end_second
 165
 166    !  Override stop time with value computed above.
 167    CALL wrf_atotime( end_date_char, grid%stop_time )
 168    CALL WRFU_ClockSet ( grid%domain_clock , StopTime=grid%stop_time, rc=rc )
 169    CALL wrf_check_error( WRFU_SUCCESS, rc, &
 170                          'WRFU_ClockSet(grid%domain_clock) FAILED', &
 171                          __FILE__ , &
 172                          __LINE__  )
 173
 174    !  Figure out our loop count for the processing times.
 175
 176    time_loop = 1
 177    PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',start_date_char,'.'
 178    current_date_char = start_date_char
 179    loop_count : DO
 180       CALL geth_newdate ( next_date_char , current_date_char , interval_seconds )
 181       IF      ( next_date_char .LT. end_date_char ) THEN
 182          time_loop = time_loop + 1
 183          PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
 184          current_date_char = next_date_char
 185       ELSE IF ( next_date_char .EQ. end_date_char ) THEN
 186          time_loop = time_loop + 1
 187          PRINT '(A,I4,A,A,A)','Time period #',time_loop,' to process = ',next_date_char,'.'
 188          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 189          time_loop_max = time_loop
 190          EXIT loop_count
 191       ELSE IF ( next_date_char .GT. end_date_char ) THEN
 192          PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
 193          time_loop_max = time_loop
 194          EXIT loop_count
 195       END IF
 196    END DO loop_count
 197
 198    !  Here we define the initial time to process, for later use by the code.
 199
 200    current_date_char = start_date_char
 201    start_date = start_date_char // '.0000'
 202    current_date = start_date
 203    bdyfrq = interval_seconds
 204    CALL nl_set_bdyfrq ( grid%id , bdyfrq )
 205    CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
 206
 207
 208 ! these are needed on some compilers, eg compaq/alpha, to
 209 ! permit pass by reference through the registry generated
 210 ! interface to med_read_nmm, below
 211 #include "deref_kludge.h"
 212
 213    ntsd = 0
 214    CALL med_read_nmm ( grid, config_flags, ntsd, dt_from_file, tstart_from_file, tend_from_file, &
 215 !
 216 #include "nmm_actual_args.inc"
 217 !
 218                      )
 219
 220    CALL init_wrfio
 221
 222    grid%input_from_file = .false.
 223
 224    CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
 225    CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
 226    IF ( ierr .NE. 0 ) THEN
 227      CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
 228    ENDIF
 229
 230 !   CALL calc_current_date ( grid%id , 0. )
 231
 232    CALL geth_newdate ( current_date_char, current_date, 3600 )
 233    current_date = current_date_char // '.0000'
 234    CALL output_model_input ( id1, grid , config_flags , ierr )
 235
 236    CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
 237
 238    current_date = current_date_char
 239    current_date = current_date_char // '.0000'
 240
 241    CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
 242    CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr )
 243
 244    nbdy_frames = NINT(( tend_from_file - tstart_from_file) )
 245    DO bdy_frame = 2,nbdy_frames
 246
 247      write(0,*)'BDY FRAME ', BDY_FRAME
 248      write(*,*)'BDY FRAME ', BDY_FRAME
 249      CALL wrf_timetoa ( grid%current_time, message )
 250      write(0,*)Trim(message)
 251      bdyfrq = interval_seconds
 252      CALL nl_set_bdyfrq ( grid%id , bdyfrq )
 253
 254      IF ( ierr .NE. 0 ) THEN
 255        CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
 256      ENDIF
 257
 258      CALL WRFU_ClockGet ( grid%domain_clock, currTime=grid%current_time , rc=rc )
 259
 260      current_date_char = current_date(1:19)
 261      CALL geth_newdate ( next_date_char, current_date_char, 3600 )
 262      current_date = next_date_char // '.0000'
 263
 264      CALL output_boundary ( id, grid , config_flags , ierr )
 265      IF ( .NOT. WRFU_ClockIsStopTime(grid%domain_clock ,rc=rc) ) THEN
 266         CALL WRFU_ClockAdvance( grid%domain_clock, rc=rc )
 267      ENDIF
 268
 269      ntsd = (bdy_frame-1)*(3600./dt_from_file)
 270      CALL med_read_nmm_bdy ( grid, config_flags, ntsd, dt_from_file, tstart_from_file, tend_from_file, &
 271 !
 272 #include "nmm_actual_args.inc"
 273 !
 274                      )
 275    END DO
 276
 277    CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" )
 278
 279
 280
 281    CALL wrf_shutdown
 282
 283    CALL WRFU_Finalize( rc=rc )
 284
 285 END PROGRAM convert_nmm