| 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 | |
|---|
