share/mediation_wrfmain.F

   1 !WRF:MEDIATION_LAYER:
   2 !
   3
   4 SUBROUTINE med_initialdata_input_ptr ( grid , config_flags )
   5    USE module_domain
   6    USE module_configure
   7    IMPLICIT NONE
   8    TYPE (domain) , POINTER :: grid
   9    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  10    INTERFACE
  11       SUBROUTINE med_initialdata_input ( grid , config_flags )
  12          USE module_domain
  13          USE module_configure
  14          TYPE (domain) :: grid
  15          TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
  16       END SUBROUTINE med_initialdata_input
  17    END INTERFACE
  18    CALL  med_initialdata_input ( grid , config_flags )
  19 END SUBROUTINE med_initialdata_input_ptr
  20
  21 SUBROUTINE med_initialdata_input ( grid , config_flags )
  22   ! Driver layer
  23    USE module_domain
  24    USE module_io_domain
  25    USE module_timing
  26 use module_io
  27   ! Model layer
  28    USE module_configure
  29    USE module_bc_time_utilities
  30    USE module_utility
  31
  32    IMPLICIT NONE
  33
  34   ! Interface
  35    INTERFACE
  36      SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
  37        USE module_domain
  38        TYPE (domain) grid
  39        LOGICAL, INTENT(IN) :: allowed_to_read
  40      END SUBROUTINE start_domain
  41    END INTERFACE
  42
  43   ! Arguments
  44    TYPE(domain)                               :: grid
  45    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  46   ! Local
  47    INTEGER                :: fid , ierr , myproc
  48    CHARACTER (LEN=256)    :: inpname , rstname, timestr
  49    CHARACTER (LEN=80)     :: message
  50    LOGICAL                :: restart
  51    LOGICAL, EXTERNAL      :: wrf_dm_on_monitor
  52 #if (WRFPLUS == 1)
  53    INTEGER                :: save_dyn_opt
  54 #endif
  55
  56    CALL nl_get_restart( 1, restart )
  57    IF ( .NOT. restart ) THEN
  58      !  Initialize the mother domain.
  59      grid%input_from_file = .true.
  60      IF ( grid%input_from_file ) THEN
  61
  62         CALL       wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
  63
  64         IF ( wrf_dm_on_monitor() ) CALL start_timing
  65
  66 ! typically <date> will not be part of input_inname but allow for it
  67         CALL domain_clock_get( grid, current_timestr=timestr )
  68         CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
  69
  70         CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
  71         IF ( ierr .NE. 0 ) THEN
  72           WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
  73           CALL WRF_ERROR_FATAL ( wrf_err_message )
  74         ENDIF
  75 ! registry-generated code that reads the variable set defined on a given stream
  76 #include "fine_stream_input.inc"
  77
  78         CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
  79         IF ( wrf_dm_on_monitor() ) THEN
  80           WRITE ( message , FMT = '("processing wrfinput file (stream 0) for domain ",I8)' ) grid%id
  81           CALL end_timing ( TRIM(message) )
  82         ENDIF
  83
  84 !gmm add input for noamp hydro model here
  85      IF ( config_flags%opt_run.eq.5 ) THEN
  86
  87         CALL construct_filename2a ( inpname , config_flags%auxinput7_inname &
  88                                  ,grid%id , 2 , timestr)
  89
  90      if( grid%auxinput7_oid .NE. 0 ) then
  91        CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
  92      endif
  93
  94         CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags , "DATASET=AUXINPUT7", ierr )
  95
  96 !        call set_first_operation(grid%auxinput6_oid)
  97
  98
  99         IF ( ierr .NE. 0 ) THEN
 100           WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
 101           CALL WRF_ERROR_FATAL ( wrf_err_message )
 102         ENDIF
 103
 104            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input7' )
 105            CALL input_auxinput7 ( grid%auxinput7_oid ,   grid , config_flags , ierr )
 106            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input7' )
 107
 108         CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
 109
 110        ENDIF
 111 !gmm
 112
 113 #ifdef MOVE_NESTS
 114 #if ( EM_CORE == 1 )
 115         grid%nest_pos = grid%ht
 116         where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500.  ! make a cliff
 117 #endif
 118 #endif
 119      ENDIF
 120      grid%imask_nostag = 1
 121      grid%imask_xstag = 1
 122      grid%imask_ystag = 1
 123      grid%imask_xystag = 1
 124 #if (EM_CORE == 1)
 125      grid%press_adj = .FALSE.
 126 #endif
 127 #if (WRFPLUS == 1)
 128      ! if calling start_domain here, we always want it be called as NLM
 129      save_dyn_opt = model_config_rec%dyn_opt
 130      model_config_rec%dyn_opt = dyn_em
 131      IF ( model_config_rec%dyn_opt .NE. dyn_em_check ) &
 132 #endif
 133      CALL start_domain ( grid , .TRUE. )
 134 #if (WRFPLUS == 1)
 135      model_config_rec%dyn_opt = save_dyn_opt
 136 #endif
 137    ELSE
 138
 139      IF ( wrf_dm_on_monitor() ) CALL start_timing
 140
 141      CALL domain_clock_get( grid, current_timestr=timestr )
 142      CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
 143
 144      WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
 145      CALL wrf_message (  message )
 146      CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
 147      IF ( ierr .NE. 0 ) THEN
 148        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
 149        CALL WRF_ERROR_FATAL ( message )
 150      ENDIF
 151      CALL input_restart ( fid,   grid , config_flags , ierr )
 152      CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
 153
 154      IF ( wrf_dm_on_monitor() ) THEN
 155        WRITE ( message , FMT = '("processing restart file for domain ",I8)' ) grid%id
 156        CALL end_timing ( TRIM(message) )
 157      ENDIF
 158
 159      grid%imask_nostag = 1
 160      grid%imask_xstag = 1
 161      grid%imask_ystag = 1
 162      grid%imask_xystag = 1
 163 #if (EM_CORE == 1)
 164      grid%press_adj = .FALSE.
 165 #endif
 166      CALL start_domain ( grid , .TRUE. )
 167    ENDIF
 168
 169    RETURN
 170 END SUBROUTINE med_initialdata_input
 171
 172 SUBROUTINE med_shutdown_io ( grid , config_flags )
 173   ! Driver layer
 174    USE module_domain
 175    USE module_io_domain
 176   ! Model layer
 177    USE module_configure
 178    USE module_dm, ONLY : domain_active_this_task
 179
 180    IMPLICIT NONE
 181    INTERFACE
 182      RECURSIVE SUBROUTINE med_shutdown_io_recurse ( grid , config_flags )
 183        USE module_domain
 184        USE module_configure
 185        TYPE (domain) , POINTER :: grid
 186        TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
 187      END SUBROUTINE med_shutdown_io_recurse
 188    END INTERFACE
 189
 190   ! Arguments
 191    TYPE(domain), TARGET                       :: grid
 192    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 193   ! Local
 194    TYPE(domain),POINTER                       :: grid_ptr
 195    CHARACTER (LEN=80)      :: message
 196    INTEGER                 :: id, ierr
 197
 198    IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
 199
 200    grid_ptr => grid
 201    CALL med_shutdown_io_recurse ( grid_ptr , config_flags )
 202
 203    CALL wrf_ioexit( ierr )    ! shut down the quilt I/O
 204
 205    RETURN
 206
 207 END SUBROUTINE med_shutdown_io
 208
 209 RECURSIVE SUBROUTINE med_shutdown_io_recurse ( grid , config_flags )
 210   ! Driver layer
 211    USE module_domain
 212    USE module_io_domain
 213   ! Model layer
 214    USE module_configure
 215
 216    IMPLICIT NONE
 217
 218   ! Arguments
 219    TYPE(domain), POINTER                      :: grid
 220    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 221   ! Local
 222    TYPE(domain), POINTER                      :: grid_ptr
 223    CHARACTER (LEN=80)      :: message
 224    INTEGER                 :: kid
 225    INTEGER                 :: ierr
 226
 227    IF ( ASSOCIATED( grid ) ) THEN
 228      CALL push_communicators_for_domain(grid%id)
 229      IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
 230 ! registry generated closes for auxhist streams
 231 #    include "shutdown_closes.inc"
 232      grid_ptr => grid
 233      DO WHILE ( ASSOCIATED( grid_ptr ) )
 234        DO kid = 1, max_nests
 235          IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
 236            CALL med_shutdown_io_recurse ( grid_ptr%nests(kid)%ptr, config_flags )
 237          ENDIF
 238        ENDDO
 239        grid_ptr => grid_ptr%sibling
 240      ENDDO
 241      CALL pop_communicators_for_domain
 242    ENDIF
 243    RETURN
 244 END SUBROUTINE med_shutdown_io_recurse
 245
 246
 247 SUBROUTINE med_add_config_info_to_grid ( grid )
 248
 249    USE module_domain
 250    USE module_configure
 251
 252    IMPLICIT NONE
 253
 254    !  Input data.
 255
 256    TYPE(domain) , TARGET          :: grid
 257
 258 #define SOURCE_RECORD model_config_rec %
 259 #define SOURCE_REC_DEX (grid%id)
 260 #define DEST_RECORD   grid %
 261 #include "config_assigns.inc"
 262
 263    RETURN
 264
 265 END SUBROUTINE med_add_config_info_to_grid
 266