forked from wrf-model/WRF
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathmodule_alloc_space.h
154 lines (128 loc) · 8.78 KB
/
module_alloc_space.h
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
SUBROUTINE ROUTINENAME ( grid, id, setinitval_in , tl_in , inter_domain_in , okay_to_alloc_in, num_bytes_allocated , &
sd31, ed31, sd32, ed32, sd33, ed33, &
sm31 , em31 , sm32 , em32 , sm33 , em33 , &
sp31 , ep31 , sp32 , ep32 , sp33 , ep33 , &
sp31x, ep31x, sp32x, ep32x, sp33x, ep33x, &
sp31y, ep31y, sp32y, ep32y, sp33y, ep33y, &
sm31x, em31x, sm32x, em32x, sm33x, em33x, &
sm31y, em31y, sm32y, em32y, sm33y, em33y )
USE module_domain_type
USE module_configure, ONLY : model_config_rec, grid_config_rec_type, in_use_for_config, model_to_grid_config_rec
! USE module_state_description
USE module_scalar_tables ! this includes module_state_description too
IMPLICIT NONE
! Input data.
TYPE(domain) , POINTER :: grid
INTEGER , INTENT(IN) :: id
INTEGER , INTENT(IN) :: setinitval_in ! 3 = everything, 1 = arrays only, 0 = none
INTEGER , INTENT(IN) :: sd31, ed31, sd32, ed32, sd33, ed33
INTEGER , INTENT(IN) :: sm31, em31, sm32, em32, sm33, em33
INTEGER , INTENT(IN) :: sp31, ep31, sp32, ep32, sp33, ep33
INTEGER , INTENT(IN) :: sp31x, ep31x, sp32x, ep32x, sp33x, ep33x
INTEGER , INTENT(IN) :: sp31y, ep31y, sp32y, ep32y, sp33y, ep33y
INTEGER , INTENT(IN) :: sm31x, em31x, sm32x, em32x, sm33x, em33x
INTEGER , INTENT(IN) :: sm31y, em31y, sm32y, em32y, sm33y, em33y
! this argument is a bitmask. First bit is time level 1, second is time level 2, and so on.
! e.g. to set both 1st and second time level, use 3
! to set only 1st use 1
! to set only 2st use 2
INTEGER , INTENT(IN) :: tl_in
! true if the allocation is for an intermediate domain (for nesting); only certain fields allocated
! false otherwise (all allocated, modulo tl above)
LOGICAL , INTENT(IN) :: inter_domain_in, okay_to_alloc_in
INTEGER(KIND=8) , INTENT(INOUT) :: num_bytes_allocated
! Local data.
INTEGER idum1, idum2, spec_bdy_width
REAL initial_data_value
CHARACTER (LEN=256) message
INTEGER tl
LOGICAL inter_domain, okay_to_alloc
INTEGER setinitval
INTEGER sr_x, sr_y
!declare ierr variable for error checking ALLOCATE calls
INTEGER ierr
INTEGER :: loop
INTEGER(KIND=8) :: nba ! number of bytes allocated per variable
CHARACTER(LEN=256) :: message_string
! Local data
TYPE ( grid_config_rec_type ) :: config_flags
INTEGER :: k_start , k_end, its, ite, jts, jte
INTEGER :: ids , ide , jds , jde , kds , kde , &
ims , ime , jms , jme , kms , kme , &
ips , ipe , jps , jpe , kps , kpe
INTEGER :: sids , side , sjds , sjde , skds , skde , &
sims , sime , sjms , sjme , skms , skme , &
sips , sipe , sjps , sjpe , skps , skpe
INTEGER :: imsx, imex, jmsx, jmex, kmsx, kmex, &
ipsx, ipex, jpsx, jpex, kpsx, kpex, &
imsy, imey, jmsy, jmey, kmsy, kmey, &
ipsy, ipey, jpsy, jpey, kpsy, kpey
data_ordering : SELECT CASE ( model_data_order )
CASE ( DATA_ORDER_XYZ )
ids = sd31 ; ide = ed31 ; jds = sd32 ; jde = ed32 ; kds = sd33 ; kde = ed33 ;
ims = sm31 ; ime = em31 ; jms = sm32 ; jme = em32 ; kms = sm33 ; kme = em33 ;
ips = sp31 ; ipe = ep31 ; jps = sp32 ; jpe = ep32 ; kps = sp33 ; kpe = ep33 ;
imsx = sm31x ; imex = em31x ; jmsx = sm32x ; jmex = em32x ; kmsx = sm33x ; kmex = em33x ;
ipsx = sp31x ; ipex = ep31x ; jpsx = sp32x ; jpex = ep32x ; kpsx = sp33x ; kpex = ep33x ;
imsy = sm31y ; imey = em31y ; jmsy = sm32y ; jmey = em32y ; kmsy = sm33y ; kmey = em33y ;
ipsy = sp31y ; ipey = ep31y ; jpsy = sp32y ; jpey = ep32y ; kpsy = sp33y ; kpey = ep33y ;
CASE ( DATA_ORDER_YXZ )
ids = sd32 ; ide = ed32 ; jds = sd31 ; jde = ed31 ; kds = sd33 ; kde = ed33 ;
ims = sm32 ; ime = em32 ; jms = sm31 ; jme = em31 ; kms = sm33 ; kme = em33 ;
ips = sp32 ; ipe = ep32 ; jps = sp31 ; jpe = ep31 ; kps = sp33 ; kpe = ep33 ;
imsx = sm32x ; imex = em32x ; jmsx = sm31x ; jmex = em31x ; kmsx = sm33x ; kmex = em33x ;
ipsx = sp32x ; ipex = ep32x ; jpsx = sp31x ; jpex = ep31x ; kpsx = sp33x ; kpex = ep33x ;
imsy = sm32y ; imey = em32y ; jmsy = sm31y ; jmey = em31y ; kmsy = sm33y ; kmey = em33y ;
ipsy = sp32y ; ipey = ep32y ; jpsy = sp31y ; jpey = ep31y ; kpsy = sp33y ; kpey = ep33y ;
CASE ( DATA_ORDER_ZXY )
ids = sd32 ; ide = ed32 ; jds = sd33 ; jde = ed33 ; kds = sd31 ; kde = ed31 ;
ims = sm32 ; ime = em32 ; jms = sm33 ; jme = em33 ; kms = sm31 ; kme = em31 ;
ips = sp32 ; ipe = ep32 ; jps = sp33 ; jpe = ep33 ; kps = sp31 ; kpe = ep31 ;
imsx = sm32x ; imex = em32x ; jmsx = sm33x ; jmex = em33x ; kmsx = sm31x ; kmex = em31x ;
ipsx = sp32x ; ipex = ep32x ; jpsx = sp33x ; jpex = ep33x ; kpsx = sp31x ; kpex = ep31x ;
imsy = sm32y ; imey = em32y ; jmsy = sm33y ; jmey = em33y ; kmsy = sm31y ; kmey = em31y ;
ipsy = sp32y ; ipey = ep32y ; jpsy = sp33y ; jpey = ep33y ; kpsy = sp31y ; kpey = ep31y ;
CASE ( DATA_ORDER_ZYX )
ids = sd33 ; ide = ed33 ; jds = sd32 ; jde = ed32 ; kds = sd31 ; kde = ed31 ;
ims = sm33 ; ime = em33 ; jms = sm32 ; jme = em32 ; kms = sm31 ; kme = em31 ;
ips = sp33 ; ipe = ep33 ; jps = sp32 ; jpe = ep32 ; kps = sp31 ; kpe = ep31 ;
imsx = sm33x ; imex = em33x ; jmsx = sm32x ; jmex = em32x ; kmsx = sm31x ; kmex = em31x ;
ipsx = sp33x ; ipex = ep33x ; jpsx = sp32x ; jpex = ep32x ; kpsx = sp31x ; kpex = ep31x ;
imsy = sm33y ; imey = em33y ; jmsy = sm32y ; jmey = em32y ; kmsy = sm31y ; kmey = em31y ;
ipsy = sp33y ; ipey = ep33y ; jpsy = sp32y ; jpey = ep32y ; kpsy = sp31y ; kpey = ep31y ;
CASE ( DATA_ORDER_XZY )
ids = sd31 ; ide = ed31 ; jds = sd33 ; jde = ed33 ; kds = sd32 ; kde = ed32 ;
ims = sm31 ; ime = em31 ; jms = sm33 ; jme = em33 ; kms = sm32 ; kme = em32 ;
ips = sp31 ; ipe = ep31 ; jps = sp33 ; jpe = ep33 ; kps = sp32 ; kpe = ep32 ;
imsx = sm31x ; imex = em31x ; jmsx = sm33x ; jmex = em33x ; kmsx = sm32x ; kmex = em32x ;
ipsx = sp31x ; ipex = ep31x ; jpsx = sp33x ; jpex = ep33x ; kpsx = sp32x ; kpex = ep32x ;
imsy = sm31y ; imey = em31y ; jmsy = sm33y ; jmey = em33y ; kmsy = sm32y ; kmey = em32y ;
ipsy = sp31y ; ipey = ep31y ; jpsy = sp33y ; jpey = ep33y ; kpsy = sp32y ; kpey = ep32y ;
CASE ( DATA_ORDER_YZX )
ids = sd33 ; ide = ed33 ; jds = sd31 ; jde = ed31 ; kds = sd32 ; kde = ed32 ;
ims = sm33 ; ime = em33 ; jms = sm31 ; jme = em31 ; kms = sm32 ; kme = em32 ;
ips = sp33 ; ipe = ep33 ; jps = sp31 ; jpe = ep31 ; kps = sp32 ; kpe = ep32 ;
imsx = sm33x ; imex = em33x ; jmsx = sm31x ; jmex = em31x ; kmsx = sm32x ; kmex = em32x ;
ipsx = sp33x ; ipex = ep33x ; jpsx = sp31x ; jpex = ep31x ; kpsx = sp32x ; kpex = ep32x ;
imsy = sm33y ; imey = em33y ; jmsy = sm31y ; jmey = em31y ; kmsy = sm32y ; kmey = em32y ;
ipsy = sp33y ; ipey = ep33y ; jpsy = sp31y ; jpey = ep31y ; kpsy = sp32y ; kpey = ep32y ;
END SELECT data_ordering
CALL model_to_grid_config_rec ( id , model_config_rec , config_flags )
CALL nl_get_sr_x( id , sr_x )
CALL nl_get_sr_y( id , sr_y )
tl = tl_in
inter_domain = inter_domain_in
okay_to_alloc = okay_to_alloc_in
#if ( RWORDSIZE == 8 )
initial_data_value = 0.
#else
CALL get_initial_data_value ( initial_data_value )
#endif
#ifdef NO_INITIAL_DATA_VALUE
setinitval = 0
#else
setinitval = setinitval_in
#endif
CALL nl_get_spec_bdy_width( 1, spec_bdy_width )
# include "allocs.inc"
END SUBROUTINE ROUTINENAME