wrfv2_fire/frame/module_alloc_space.F

   1 MODULE module_alloc_space
   2 CONTAINS
   3    SUBROUTINE alloc_space_field_core ( grid,   id, setinitval_in ,  tl_in , inter_domain_in ,   &
   4                                   sd31, ed31, sd32, ed32, sd33, ed33, &
   5                                   sm31 , em31 , sm32 , em32 , sm33 , em33 , &
   6                                   sm31x, em31x, sm32x, em32x, sm33x, em33x, &
   7                                   sm31y, em31y, sm32y, em32y, sm33y, em33y )
   8
   9       USE module_domain_type
  10       USE module_configure, ONLY : model_config_rec, in_use_for_config
  11       USE module_state_description
  12
  13       IMPLICIT NONE
  14
  15       !  Input data.
  16
  17       TYPE(domain)               , POINTER          :: grid
  18       INTEGER , INTENT(IN)            :: id
  19       INTEGER , INTENT(IN)            :: setinitval_in   ! 3 = everything, 1 = arrays only, 0 = none
  20       INTEGER , INTENT(IN)            :: sd31, ed31, sd32, ed32, sd33, ed33
  21       INTEGER , INTENT(IN)            :: sm31, em31, sm32, em32, sm33, em33
  22       INTEGER , INTENT(IN)            :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  23       INTEGER , INTENT(IN)            :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  24
  25       ! this argument is a bitmask. First bit is time level 1, second is time level 2, and so on.
  26       ! e.g. to set both 1st and second time level, use 3
  27       !      to set only 1st                        use 1
  28       !      to set only 2st                        use 2
  29       INTEGER , INTENT(IN)            :: tl_in
  30
  31       ! true if the allocation is for an intermediate domain (for nesting); only certain fields allocated
  32       ! false otherwise (all allocated, modulo tl above)
  33       LOGICAL , INTENT(IN)            :: inter_domain_in
  34
  35       !  Local data.
  36       INTEGER idum1, idum2, spec_bdy_width
  37       INTEGER num_bytes_allocated
  38       REAL    initial_data_value
  39       CHARACTER (LEN=256) message
  40       INTEGER tl
  41       LOGICAL inter_domain
  42       INTEGER setinitval
  43       INTEGER sr_x, sr_y
  44
  45       !declare ierr variable for error checking ALLOCATE calls
  46       INTEGER ierr
  47
  48       INTEGER                              :: loop
  49
  50       CALL nl_get_sr_x( id , sr_x )
  51       CALL nl_get_sr_x( id , sr_y )
  52
  53       tl = tl_in
  54       inter_domain = inter_domain_in
  55
  56 #if ( RWORDSIZE == 8 )
  57       initial_data_value = 0.
  58 #else
  59       CALL get_initial_data_value ( initial_data_value )
  60 #endif
  61
  62 #ifdef NO_INITIAL_DATA_VALUE
  63       setinitval = 0
  64 #else
  65       setinitval = setinitval_in
  66 #endif
  67
  68       CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
  69
  70       CALL set_scalar_indices_from_config( id , idum1 , idum2 )
  71
  72       num_bytes_allocated = 0
  73
  74 #if (EM_CORE == 1)
  75       IF ( grid%id .EQ. 1 ) CALL wrf_message ( &
  76           'DYNAMICS OPTION: Eulerian Mass Coordinate ')
  77 #endif
  78 #if (NMM_CORE == 1)
  79       IF ( grid%id .EQ. 1 ) &
  80           CALL wrf_message ( 'DYNAMICS OPTION: nmm dyncore' )
  81 #endif
  82 #if (COAMPS_CORE == 1)
  83         IF ( grid%id .EQ. 1 ) &
  84           CALL wrf_message ( 'DYNAMICS OPTION: coamps dyncore' )
  85 #endif
  86
  87 # include <allocs.inc>
  88
  89       WRITE(message,*)&
  90           'alloc_space_field: domain ',id,', ',num_bytes_allocated,' bytes allocated'
  91       CALL  wrf_debug( 1, message )
  92
  93    END SUBROUTINE alloc_space_field_core
  94 END MODULE module_alloc_space
  95