wrfv2_fire/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
  20
  21 END SUBROUTINE med_initialdata_input_ptr
  22
  23 SUBROUTINE med_initialdata_input ( grid , config_flags )
  24   ! Driver layer
  25    USE module_domain
  26    USE module_io_domain
  27    USE module_timing
  28 use module_io
  29   ! Model layer
  30    USE module_configure
  31    USE module_bc_time_utilities
  32    USE module_utility
  33
  34    IMPLICIT NONE
  35
  36   ! Interface
  37    INTERFACE
  38      SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
  39        USE module_domain
  40        TYPE (domain) grid
  41        LOGICAL, INTENT(IN) :: allowed_to_read
  42      END SUBROUTINE start_domain
  43    END INTERFACE
  44
  45   ! Arguments
  46    TYPE(domain)                               :: grid
  47    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
  48   ! Local
  49    INTEGER                :: fid , ierr , myproc
  50    CHARACTER (LEN=80)     :: inpname , rstname, timestr
  51    CHARACTER (LEN=80)     :: message
  52    LOGICAL                :: restart
  53
  54    CALL nl_get_restart( 1, restart )
  55    IF ( .NOT. restart ) THEN
  56      !  Initialize the mother domain.
  57      grid%input_from_file = .true.
  58      IF ( grid%input_from_file ) THEN
  59
  60         CALL       wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
  61
  62 ! typically <date> will not be part of input_inname but allow for it
  63         CALL domain_clock_get( grid, current_timestr=timestr )
  64         CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
  65
  66         CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
  67         IF ( ierr .NE. 0 ) THEN
  68           WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
  69           CALL WRF_ERROR_FATAL ( wrf_err_message )
  70         ENDIF
  71         IF      ( ( grid%id .EQ. 1 ) .OR. ( config_flags%fine_input_stream .EQ. 0 ) ) THEN
  72            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_model_input' )
  73            CALL input_model_input      ( fid ,  grid , config_flags , ierr )
  74            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_model_input' )
  75         ELSE IF   ( config_flags%fine_input_stream .EQ. 1 ) THEN
  76            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input1' )
  77            CALL input_aux_model_input1 ( fid ,   grid , config_flags , ierr )
  78            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input1' )
  79         ELSE IF   ( config_flags%fine_input_stream .EQ. 2 ) THEN
  80            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input2' )
  81            CALL input_aux_model_input2 ( fid ,   grid , config_flags , ierr )
  82            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input2' )
  83         ELSE IF   ( config_flags%fine_input_stream .EQ. 3 ) THEN
  84            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input3' )
  85            CALL input_aux_model_input3 ( fid ,   grid , config_flags , ierr )
  86            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input3' )
  87         ELSE IF   ( config_flags%fine_input_stream .EQ. 4 ) THEN
  88            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input4' )
  89            CALL input_aux_model_input4 ( fid ,   grid , config_flags , ierr )
  90            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input4' )
  91         ELSE IF   ( config_flags%fine_input_stream .EQ. 5 ) THEN
  92            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input5' )
  93            CALL input_aux_model_input5 ( fid ,   grid , config_flags , ierr )
  94            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input5' )
  95         ELSE IF   ( config_flags%fine_input_stream .EQ. 6 ) THEN
  96            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input6' )
  97            CALL input_aux_model_input6 ( fid ,   grid , config_flags , ierr )
  98            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input6' )
  99         ELSE IF   ( config_flags%fine_input_stream .EQ. 7 ) THEN
 100            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input7' )
 101            CALL input_aux_model_input7 ( fid ,   grid , config_flags , ierr )
 102            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input7' )
 103         ELSE IF   ( config_flags%fine_input_stream .EQ. 8 ) THEN
 104            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input8' )
 105            CALL input_aux_model_input8 ( fid ,   grid , config_flags , ierr )
 106            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input8' )
 107         ELSE IF   ( config_flags%fine_input_stream .EQ. 9 ) THEN
 108            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input9' )
 109            CALL input_aux_model_input9 ( fid ,   grid , config_flags , ierr )
 110            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input9' )
 111         ELSE IF   ( config_flags%fine_input_stream .EQ. 10 ) THEN
 112            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input10' )
 113            CALL input_aux_model_input10 ( fid ,   grid , config_flags , ierr )
 114            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input10' )
 115         ELSE IF   ( config_flags%fine_input_stream .EQ. 11 ) THEN
 116            CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input11' )
 117            CALL input_aux_model_input11 ( fid ,   grid , config_flags , ierr )
 118            CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input11' )
 119         ELSE
 120            WRITE( message , '("med_initialdata_input: bad fine_input_stream = ",I4)') config_flags%fine_input_stream
 121            CALL WRF_ERROR_FATAL ( message )
 122         END IF
 123         CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
 124 #ifdef MOVE_NESTS
 125         grid%nest_pos = grid%ht
 126         where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500.  ! make a cliff
 127 #endif
 128      ENDIF
 129      grid%imask_nostag = 1
 130      grid%imask_xstag = 1
 131      grid%imask_ystag = 1
 132      grid%imask_xystag = 1
 133 #if (EM_CORE == 1)
 134      grid%press_adj = .FALSE.
 135 #endif
 136      CALL start_domain ( grid , .TRUE. )
 137    ELSE
 138      CALL domain_clock_get( grid, current_timestr=timestr )
 139      CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
 140
 141      WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
 142      CALL wrf_message (  message )
 143      CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
 144      IF ( ierr .NE. 0 ) THEN
 145        WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
 146        CALL WRF_ERROR_FATAL ( message )
 147      ENDIF
 148      CALL input_restart ( fid,   grid , config_flags , ierr )
 149      CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
 150      grid%imask_nostag = 1
 151      grid%imask_xstag = 1
 152      grid%imask_ystag = 1
 153      grid%imask_xystag = 1
 154 #if (EM_CORE == 1)
 155      grid%press_adj = .FALSE.
 156 #endif
 157      CALL start_domain ( grid , .TRUE. )
 158    ENDIF
 159
 160    RETURN
 161 END SUBROUTINE med_initialdata_input
 162
 163 SUBROUTINE med_shutdown_io ( grid , config_flags )
 164   ! Driver layer
 165    USE module_domain
 166    USE module_io_domain
 167   ! Model layer
 168    USE module_configure
 169
 170    IMPLICIT NONE
 171
 172   ! Arguments
 173    TYPE(domain)                               :: grid
 174    TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
 175   ! Local
 176    CHARACTER (LEN=80)      :: message
 177    INTEGER                 :: ierr
 178
 179    IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
 180    IF ( grid%auxhist1_oid > 0 ) CALL close_dataset ( grid%auxhist1_oid , config_flags , "DATASET=AUXHIST1" )
 181    IF ( grid%auxhist2_oid > 0 ) CALL close_dataset ( grid%auxhist2_oid , config_flags , "DATASET=AUXHIST2" )
 182    IF ( grid%auxhist3_oid > 0 ) CALL close_dataset ( grid%auxhist3_oid , config_flags , "DATASET=AUXHIST3" )
 183    IF ( grid%auxhist4_oid > 0 ) CALL close_dataset ( grid%auxhist4_oid , config_flags , "DATASET=AUXHIST4" )
 184    IF ( grid%auxhist5_oid > 0 ) CALL close_dataset ( grid%auxhist5_oid , config_flags , "DATASET=AUXHIST5" )
 185 #if 0
 186    IF ( grid%auxhist6_oid > 0 ) CALL close_dataset ( grid%auxhist6_oid , config_flags , "DATASET=AUXHIST6" )
 187    IF ( grid%auxhist7_oid > 0 ) CALL close_dataset ( grid%auxhist7_oid , config_flags , "DATASET=AUXHIST7" )
 188    IF ( grid%auxhist8_oid > 0 ) CALL close_dataset ( grid%auxhist8_oid , config_flags , "DATASET=AUXHIST8" )
 189    IF ( grid%auxhist9_oid > 0 ) CALL close_dataset ( grid%auxhist9_oid , config_flags , "DATASET=AUXHIST9" )
 190    IF ( grid%auxhist10_oid > 0 ) CALL close_dataset ( grid%auxhist10_oid , config_flags , "DATASET=AUXHIST10" )
 191    IF ( grid%auxhist11_oid > 0 ) CALL close_dataset ( grid%auxhist11_oid , config_flags , "DATASET=AUXHIST11" )
 192 #endif
 193
 194    IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
 195
 196    CALL wrf_ioexit( ierr )    ! shut down the quilt I/O
 197
 198    RETURN
 199
 200 END SUBROUTINE med_shutdown_io
 201
 202 SUBROUTINE med_add_config_info_to_grid ( grid )
 203
 204    USE module_domain
 205    USE module_configure
 206
 207    IMPLICIT NONE
 208
 209    !  Input data.
 210
 211    TYPE(domain) , TARGET          :: grid
 212
 213 #define SOURCE_RECORD model_config_rec %
 214 #define SOURCE_REC_DEX (grid%id)
 215 #define DEST_RECORD   grid %
 216 #include <config_assigns.inc>
 217
 218    RETURN
 219
 220 END SUBROUTINE med_add_config_info_to_grid
 221