Changeset 3235 for palm/trunk/SOURCE/multi_agent_system_mod.f90
- Timestamp:
- Sep 7, 2018 2:06:15 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/multi_agent_system_mod.f90 (modified) (41 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/multi_agent_system_mod.f90
r3201 r3235 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix in output, added agent-number dimension and related messages and 28 ! input parameters, updated cpu logging, added mas_last_actions 29 ! 30 ! 3201 2018-08-20 11:45:01Z sward 27 31 ! Bugfix, missing pre-processor directive. Set default 28 32 ! read_agents_from_restartfile = .FALSE. restarts not yet implemented. … … 87 91 CHARACTER(LEN=15) :: bc_mas_ns = 'absorb' !< north/south boundary condition 88 92 89 INTEGER(iwp) :: deleted_agents = 0 !< number of deleted agents per time step 90 INTEGER(iwp) :: heap_count !< number of items in binary heap (for pathfinding) 91 INTEGER(iwp) :: ibc_mas_lr !< agent left/right boundary condition dummy 92 INTEGER(iwp) :: ibc_mas_ns !< agent north/south boundary condition dummy 93 INTEGER(iwp) :: ind_pm10 = -9 !< chemical species index of PM10 94 INTEGER(iwp) :: ind_pm25 = -9 !< chemical species index of PM2.5 95 INTEGER(iwp) :: iran_agent = -1234567 !< number for random generator 96 INTEGER(iwp) :: min_nr_agent = 2 !< namelist parameter (see documentation) 97 INTEGER(iwp) :: ghla_count_recv !< number of agents in left ghost layer 98 INTEGER(iwp) :: ghna_count_recv !< number of agents in north ghost layer 99 INTEGER(iwp) :: ghra_count_recv !< number of agents in right ghost layer 100 INTEGER(iwp) :: ghsa_count_recv !< number of agents in south ghost layer 101 INTEGER(iwp) :: nr_move_north !< number of agts to move north during exchange_horiz 102 INTEGER(iwp) :: nr_move_south !< number of agts to move south during exchange_horiz 103 INTEGER(iwp) :: number_of_agents = 0 !< number of agents for each grid box (3d array is saved on agt_count) 104 INTEGER(iwp) :: number_of_agent_groups = 1 !< namelist parameter (see documentation) 105 INTEGER(iwp) :: sort_count_mas = 0 !< counter for sorting agents 106 INTEGER(iwp) :: agt_path_size = 15 !< size of agent path array 107 INTEGER(iwp) :: step_dealloc_mas = 100 !< namelist parameter (see documentation) 108 INTEGER(iwp) :: total_number_of_agents !< total number of agents in the whole model domain 93 INTEGER(iwp) :: deleted_agents = 0 !< number of deleted agents per time step 94 INTEGER(iwp) :: dim_size_agtnum_manual = 9999999 !< namelist parameter (see documentation) 95 INTEGER(iwp) :: heap_count !< number of items in binary heap (for pathfinding) 96 INTEGER(iwp) :: ibc_mas_lr !< agent left/right boundary condition dummy 97 INTEGER(iwp) :: ibc_mas_ns !< agent north/south boundary condition dummy 98 INTEGER(iwp) :: ind_pm10 = -9 !< chemical species index of PM10 99 INTEGER(iwp) :: ind_pm25 = -9 !< chemical species index of PM2.5 100 INTEGER(iwp) :: iran_agent = -1234567 !< number for random generator 101 INTEGER(iwp) :: min_nr_agent = 2 !< namelist parameter (see documentation) 102 INTEGER(iwp) :: ghla_count_recv !< number of agents in left ghost layer 103 INTEGER(iwp) :: ghna_count_recv !< number of agents in north ghost layer 104 INTEGER(iwp) :: ghra_count_recv !< number of agents in right ghost layer 105 INTEGER(iwp) :: ghsa_count_recv !< number of agents in south ghost layer 106 INTEGER(iwp) :: maximum_number_of_agents = 0 !< maximum number of agents during run 107 INTEGER(iwp) :: nr_move_north !< number of agts to move north during exchange_horiz 108 INTEGER(iwp) :: nr_move_south !< number of agts to move south during exchange_horiz 109 INTEGER(iwp) :: number_of_agents = 0 !< number of agents for each grid box (3d array is saved on agt_count) 110 INTEGER(iwp) :: number_of_agent_groups = 1 !< namelist parameter (see documentation) 111 INTEGER(iwp) :: sort_count_mas = 0 !< counter for sorting agents 112 INTEGER(iwp) :: agt_path_size = 15 !< size of agent path array 113 INTEGER(iwp) :: step_dealloc_mas = 100 !< namelist parameter (see documentation) 114 INTEGER(iwp) :: total_number_of_agents !< total number of agents in the whole model domain 109 115 110 116 INTEGER(iwp), PARAMETER :: NR_2_direction_move = 10000 !< parameter for agent exchange … … 114 120 INTEGER(iwp), PARAMETER :: max_number_of_agent_groups = 100 !< maximum allowed number of agent groups 115 121 116 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: agt_count !< 3d array of number of agents of every grid box122 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: agt_count !< 3d array of number of agents of every grid box 117 123 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: s_measure_height !< k-index(s-grid) for measurement 118 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: top_top_s !< k-index of first s-gridpoint above topography119 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: top_top_w !< k-index of first v-gridpoint above topography120 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: obstacle_flags !< flags to identify corners and edges of topography that cannot be crossed by agents121 122 LOGICAL :: deallocate_memory_mas = .TRUE. !< namelist parameter (see documentation)123 LOGICAL :: dt_3d_reached_mas !< flag: agent timestep has reached model timestep124 LOGICAL :: dt_3d_reached_l_mas !< flag: agent timestep has reached model timestep125 LOGICAL :: agents_active = .FALSE. !< flag for agent system126 LOGICAL :: random_start_position_agents = .TRUE. !< namelist parameter (see documentation)124 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: top_top_s !< k-index of first s-gridpoint above topography 125 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: top_top_w !< k-index of first v-gridpoint above topography 126 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: obstacle_flags !< flags to identify corners and edges of topography that cannot be crossed by agents 127 128 LOGICAL :: deallocate_memory_mas = .TRUE. !< namelist parameter (see documentation) 129 LOGICAL :: dt_3d_reached_mas !< flag: agent timestep has reached model timestep 130 LOGICAL :: dt_3d_reached_l_mas !< flag: agent timestep has reached model timestep 131 LOGICAL :: agents_active = .FALSE. !< flag for agent system 132 LOGICAL :: random_start_position_agents = .TRUE. !< namelist parameter (see documentation) 127 133 LOGICAL :: read_agents_from_restartfile = .FALSE. !< namelist parameter (see documentation) 128 LOGICAL :: agent_own_timestep = .FALSE. !< namelist parameter (see documentation)134 LOGICAL :: agent_own_timestep = .FALSE. !< namelist parameter (see documentation) 129 135 130 136 LOGICAL, DIMENSION(max_number_of_agent_groups) :: a_rand_target = .FALSE. !< namelist parameter (see documentation) … … 134 140 REAL(wp) :: coll_t_0 = 3. !< namelist parameter (see documentation) 135 141 REAL(wp) :: corner_gate_start = 0.5_wp !< namelist parameter (see documentation) 136 REAL(wp) :: corner_gate_width = 1.0_wp !< namelist parameter (see documentation) 142 REAL(wp) :: corner_gate_width = 1.0_wp !< namelist parameter (see documentation) 143 REAL(wp) :: dim_size_factor_agtnum = 1.0_wp !< namelist parameter (see documentation) 137 144 REAL(wp) :: d_sigma_rep_agent !< inverse of sigma_rep_agent 138 145 REAL(wp) :: d_sigma_rep_wall !< inverse of sigma_rep_wall … … 174 181 !-- Type for the definition of an agent 175 182 TYPE agent_type 176 INTEGER(iwp) :: block_nr !< number for sorting177 INTEGER(iwp) :: group !< number of agent group178 INTEGER(idp) :: id !< particle ID (64 bit integer)179 INTEGER(iwp) :: path_counter !< current target along path (path_x/y)180 LOGICAL :: agent_mask !< if this parameter is set to false the agent will be deleted181 REAL(wp) :: age !< age of agent182 REAL(wp) :: age_m !< age of agent183 REAL(wp) :: dt_sum !< sum of agents subtimesteps184 REAL(wp) :: clo !< clothing index185 REAL(wp) :: energy_storage !< energy stored by agent186 REAL(wp) :: force_x !< force term x-direction187 REAL(wp) :: force_y !< force term y-direction188 REAL(wp) :: origin_x !< origin x-position of agent189 REAL(wp) :: origin_y !< origin y-position of agent190 REAL(wp) :: pm10 !< PM10 concentration at agent position191 REAL(wp) :: pm25 !< PM25 concentration at agent position192 REAL(wp) :: speed_abs !< absolute value of agent speed193 REAL(wp) :: speed_e_x !< normalized speed of agent in x194 REAL(wp) :: speed_e_y !< normalized speed of agent in y195 REAL(wp) :: speed_des !< agent's desired speed196 REAL(wp) :: speed_x !< speed of agent in x197 REAL(wp) :: speed_y !< speed of agent in y198 REAL(wp) :: thermal_index !< the dynamic thermal index199 REAL(wp) :: windspeed !< absolute value of windspeed at agent position200 REAL(wp) :: x !< x-position201 REAL(wp) :: y !< y-position202 REAL(wp) :: t !< temperature203 REAL(wp) :: t_x !< x-position204 REAL(wp) :: t_y !< y-position205 REAL(wp), DIMENSION(0:15) :: path_x !< agent path to target (x)206 REAL(wp), DIMENSION(0:15) :: path_y !< agent path to target (y)183 INTEGER(iwp) :: block_nr !< number for sorting 184 INTEGER(iwp) :: group !< number of agent group 185 INTEGER(idp) :: id !< particle ID (64 bit integer) 186 INTEGER(iwp) :: path_counter !< current target along path (path_x/y) 187 LOGICAL :: agent_mask !< if this parameter is set to false the agent will be deleted 188 REAL(wp) :: age !< age of agent 189 REAL(wp) :: age_m !< age of agent 190 REAL(wp) :: dt_sum !< sum of agents subtimesteps 191 REAL(wp) :: clo !< clothing index 192 REAL(wp) :: energy_storage !< energy stored by agent 193 REAL(wp) :: force_x !< force term x-direction 194 REAL(wp) :: force_y !< force term y-direction 195 REAL(wp) :: origin_x !< origin x-position of agent 196 REAL(wp) :: origin_y !< origin y-position of agent 197 REAL(wp) :: pm10 !< PM10 concentration at agent position 198 REAL(wp) :: pm25 !< PM25 concentration at agent position 199 REAL(wp) :: speed_abs !< absolute value of agent speed 200 REAL(wp) :: speed_e_x !< normalized speed of agent in x 201 REAL(wp) :: speed_e_y !< normalized speed of agent in y 202 REAL(wp) :: speed_des !< agent's desired speed 203 REAL(wp) :: speed_x !< speed of agent in x 204 REAL(wp) :: speed_y !< speed of agent in y 205 REAL(wp) :: thermal_index !< the dynamic thermal index 206 REAL(wp) :: windspeed !< absolute value of windspeed at agent position 207 REAL(wp) :: x !< x-position 208 REAL(wp) :: y !< y-position 209 REAL(wp) :: t !< temperature 210 REAL(wp) :: t_x !< x-position 211 REAL(wp) :: t_y !< y-position 212 REAL(wp), DIMENSION(0:15) :: path_x !< agent path to target (x) 213 REAL(wp), DIMENSION(0:15) :: path_y !< agent path to target (y) 207 214 END TYPE agent_type 208 215 209 TYPE(agent_type), DIMENSION(:), POINTER :: agents !< Agent array for this grid cell210 TYPE(agent_type) :: zero_agent !< zero agent to avoid weird thing211 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: move_also_north !< for agent exchange between PEs212 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: move_also_south !< for agent exchange between PEs213 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_l !< ghost layer left of pe domain214 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_n !< ghost layer north of pe domain215 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_r !< ghost layer right of pe domain216 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_s !< ghost layer south of pe domain216 TYPE(agent_type), DIMENSION(:), POINTER :: agents !< Agent array for this grid cell 217 TYPE(agent_type) :: zero_agent !< zero agent to avoid weird thing 218 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: move_also_north !< for agent exchange between PEs 219 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: move_also_south !< for agent exchange between PEs 220 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_l !< ghost layer left of pe domain 221 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_n !< ghost layer north of pe domain 222 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_r !< ghost layer right of pe domain 223 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: agt_gh_s !< ghost layer south of pe domain 217 224 ! 218 225 !-- Type for 2D grid on which agents are stored … … 222 229 INTEGER(iwp) :: id_counter !< agent id counter (removeable?) 223 230 LOGICAL :: time_loop_done !< timestep loop for agent advection 224 TYPE(agent_type), POINTER, DIMENSION(:) :: agents !< Particle array for this grid cell231 TYPE(agent_type), POINTER, DIMENSION(:) :: agents !< Particle array for this grid cell 225 232 END TYPE grid_agent_def 226 233 … … 273 280 ! 274 281 !-- Public functions 275 PUBLIC mas_init, mas_ parin, multi_agent_system282 PUBLIC mas_init, mas_last_actions, mas_parin, multi_agent_system 276 283 277 284 ! … … 286 293 MODULE PROCEDURE mas_init 287 294 END INTERFACE mas_init 295 296 INTERFACE mas_last_actions 297 MODULE PROCEDURE mas_last_actions 298 END INTERFACE mas_last_actions 288 299 289 300 INTERFACE multi_agent_system … … 316 327 INTEGER(iwp), SAVE :: mas_count = 0 !< counts the mas-calls 317 328 318 LOGICAL :: first_loop_stride !< flag for first loop stride of agent sub-timesteps319 LOGICAL :: first_call = .TRUE. !< first call of mas flag for output329 LOGICAL :: first_loop_stride !< flag for first loop stride of agent sub-timesteps 330 LOGICAL, SAVE :: first_call = .TRUE. !< first call of mas flag for output 320 331 321 332 CALL cpu_log( log_point(9), 'mas', 'start' ) … … 363 374 ENDIF 364 375 ! 365 !-- Start logging366 CALL cpu_log( log_point_s(9), 'mas_transport', 'start' )367 CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )368 CALL cpu_log( log_point_s(16), 'mas_other_agents', 'start' )369 CALL cpu_log( log_point_s(16), 'mas_other_agents', 'pause' )370 !371 376 !-- Flag is true by default, will be set to false if an agent has not yet 372 377 !-- reached the model timestep … … 376 381 !-- First part of agent transport: 377 382 !-- Evaluate social forces for all agents at current positions 383 CALL cpu_log( log_point_s(9), 'mas_social_forces', 'start' ) 378 384 DO i = nxl, nxr 379 385 DO j = nys, nyn … … 391 397 ENDDO 392 398 ENDDO 399 CALL cpu_log( log_point_s(9), 'mas_social_forces', 'stop' ) 393 400 ! 394 401 !-- Second part of agent transport: 395 402 !-- timestep 403 CALL cpu_log( log_point_s(16), 'mas_timestep', 'start' ) 396 404 DO i = nxl, nxr 397 405 DO j = nys, nyn … … 444 452 ENDDO 445 453 ENDDO 454 CALL cpu_log( log_point_s(16), 'mas_timestep', 'stop' ) 446 455 447 456 ! … … 457 466 #endif 458 467 459 CALL cpu_log( log_point_s(9), 'mas_transport', 'stop' )460 CALL cpu_log( log_point_s(16), 'mas_other_agents', 'stop' )461 468 ! 462 469 !-- Increment time since last release … … 465 472 ! 466 473 !-- Move Agents local to PE to a different grid cell 474 CALL cpu_log( log_point_s(18), 'mas_move_exch_sort', 'start' ) 467 475 CALL mas_eh_move_agent 468 476 ! … … 473 481 !-- determine new number of agents 474 482 CALL mas_ps_sort_in_subboxes 483 CALL cpu_log( log_point_s(18), 'mas_move_exch_sort', 'stop' ) 475 484 ! 476 485 !-- Initialize variables for the next (sub-) timestep, i.e., for marking … … 540 549 REAL(wp) :: speed_round_y !< rounding influence expressed as x speed component 541 550 542 CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )543 551 ! 544 552 !-- loop over all agents in the current grid box … … 608 616 ENDDO 609 617 610 CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )611 618 ! 612 619 !-- corner rounding; to be added … … 1119 1126 1120 1127 USE control_parameters, & 1121 ONLY: agt_time_count 1128 ONLY: agt_time_count, end_time, message_string, & 1129 multi_agent_system_end, multi_agent_system_start 1122 1130 1123 1131 USE netcdf_interface, & … … 1130 1138 USE NETCDF 1131 1139 #endif 1140 USE mas_global_attributes, & 1141 ONLY: dim_size_agtnum 1132 1142 1133 1143 IMPLICIT NONE … … 1135 1145 INTEGER(iwp) :: agt_size !< Agent size in bytes 1136 1146 INTEGER(iwp) :: dummy !< dummy 1147 INTEGER(iwp) :: ii !< counter (x) 1137 1148 INTEGER(iwp) :: ip !< counter (x) 1138 1149 INTEGER(iwp) :: jp !< counter (y) … … 1141 1152 INTEGER(iwp) :: noa_rcv !< received number of agents 1142 1153 INTEGER(iwp) :: out_noa !< number of agents for output 1143 1154 1144 1155 INTEGER(iwp), DIMENSION(0:numprocs-1) :: noa_arr !< number of agents on each PE 1145 1156 1146 1157 TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET :: trf_agents !< all agents on current PE 1147 1158 TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET :: out_agents !< all agents in entire domain 1159 1148 1160 LOGICAL, INTENT (INOUT) :: ftest 1161 1162 LOGICAL, SAVE :: agt_dimension_exceeded = .FALSE. 1149 1163 1150 1164 CALL cpu_log( log_point_s(17), 'mas_data_output', 'start' ) … … 1172 1186 ! 1173 1187 !-- Gather all agents on PE0 for output 1174 CALL MPI_BARRIER( comm2d, ierr )1175 1188 IF ( myid == 0 ) THEN 1176 1189 noa_arr(0) = noa … … 1228 1241 1229 1242 #if defined( __netcdf ) 1230 1231 !-- Output in netCDF format 1232 IF ( ftest ) CALL check_open( 118 ) 1233 1234 ! 1235 !-- Update the NetCDF time axis 1243 ! 1244 !-- Update maximum number of agents 1245 maximum_number_of_agents = MAX(maximum_number_of_agents, out_noa) 1246 ! 1247 !-- Output in netCDF format 1248 IF ( ftest ) THEN 1249 ! 1250 !-- First, define size of agent number dimension from amount of agents 1251 !-- released, release interval, time of agent simulation and max 1252 !-- age of agents 1253 dim_size_agtnum = MIN( MIN( multi_agent_system_end, end_time ) & 1254 - multi_agent_system_start, & 1255 agent_maximum_age) 1256 1257 DO ii = 1, number_of_agent_groups 1258 dim_size_agtnum = dim_size_agtnum & 1259 + (FLOOR( ( asr(ii)-asl(ii) ) / adx(ii) ) + 1) & 1260 * (FLOOR( ( asn(ii)-ass(ii) ) / ady(ii) ) + 1) & 1261 * (FLOOR( dim_size_agtnum / dt_arel ) + 1) & 1262 * dim_size_factor_agtnum 1263 dim_size_agtnum = MIN( dim_size_agtnum, dim_size_agtnum_manual ) 1264 ENDDO 1265 CALL check_open( 118 ) 1266 ENDIF 1267 1268 ! 1269 !-- Update the NetCDF time axis 1236 1270 agt_time_count = agt_time_count + 1 1237 1271 1238 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_time_agt, & 1239 (/ time_since_reference_point /), & 1240 start = (/ agt_time_count /), count = (/ 1 /) ) 1272 IF ( .NOT. agt_dimension_exceeded ) THEN 1273 ! 1274 !-- if number of agents to be output exceeds dimension, set flag and 1275 !-- print warning 1276 IF ( out_noa > dim_size_agtnum ) THEN 1277 1278 agt_dimension_exceeded = .TRUE. 1279 WRITE(message_string,'(A,F11.1,2(A,I8))') & 1280 'Number of agents exceeds agent dimension.' // & 1281 '&Starting at time_since_reference_point = ', & 1282 time_since_reference_point, & 1283 ' s, &data may be missing.'// & 1284 '&Number of agents: ', out_noa, & 1285 '&Agent dimension size: ', dim_size_agtnum 1286 1287 CALL message( 'mas_data_output_agents', & 1288 'PA0420', 0, 1, 0, 6, 0 ) 1289 1290 ENDIF 1291 ENDIF 1292 1293 ! 1294 !-- reduce number of output agents to dimension size, if necessary 1295 IF ( agt_dimension_exceeded ) THEN 1296 1297 out_noa = MIN( out_noa, dim_size_agtnum ) 1298 1299 ENDIF 1300 1301 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_time_agt, & 1302 (/ time_since_reference_point /), & 1303 start = (/ agt_time_count /), & 1304 count = (/ 1 /) ) 1241 1305 CALL netcdf_handle_error( 'mas_data_output_agents', 1 ) 1242 1306 1243 ! 1244 !-- Output all agent attributes 1245 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(1), agents%x, & 1307 ! 1308 !-- Output agent attributes 1309 1310 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(1), agents%id, & 1311 start = (/ 1, agt_time_count /), & 1312 count = (/ out_noa /) ) 1313 CALL netcdf_handle_error( 'mas_data_output_agents', 2 ) 1314 1315 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(2), agents%x, & 1246 1316 start = (/ 1, agt_time_count /), & 1247 1317 count = (/ out_noa /) ) 1248 1318 CALL netcdf_handle_error( 'mas_data_output_agents', 3 ) 1249 1319 1250 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt( 2), agents%y, &1320 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(3), agents%y, & 1251 1321 start = (/ 1, agt_time_count /), & 1252 1322 count = (/ out_noa /) ) 1253 1323 CALL netcdf_handle_error( 'mas_data_output_agents', 4 ) 1254 1324 1255 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt( 3), agents%windspeed, &1325 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(4), agents%windspeed, & 1256 1326 start = (/ 1, agt_time_count /), & 1257 1327 count = (/ out_noa /) ) 1258 1328 CALL netcdf_handle_error( 'mas_data_output_agents', 5 ) 1259 1329 1260 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt( 4), agents%t, &1330 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(5), agents%t, & 1261 1331 start = (/ 1, agt_time_count /), & 1262 1332 count = (/ out_noa /) ) 1263 1333 CALL netcdf_handle_error( 'mas_data_output_agents', 6 ) 1264 1334 1265 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt( 5), agents%group, &1335 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(6), agents%group, & 1266 1336 start = (/ 1, agt_time_count /), & 1267 1337 count = (/ out_noa /) ) 1268 1338 CALL netcdf_handle_error( 'mas_data_output_agents', 7 ) 1269 1270 nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(6), agents%id, & 1271 start = (/ 1, agt_time_count /), & 1272 count = (/ out_noa /) ) 1273 CALL netcdf_handle_error( 'mas_data_output_agents', 8 ) 1339 CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' ) 1274 1340 1275 1341 … … 1291 1357 ! start = (/ 1, agt_time_count /), & 1292 1358 ! count = (/ out_noa /) ) 1293 CALL netcdf_handle_error( 'mas_data_output_agents', 10 )1359 ! CALL netcdf_handle_error( 'mas_data_output_agents', 10 ) 1294 1360 1295 1361 #endif 1296 1362 1297 1363 DEALLOCATE(out_agents) 1364 ELSE 1365 CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' ) 1298 1366 ENDIF 1299 1367 1300 CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' )1301 1368 1302 1369 END SUBROUTINE mas_data_output_agents … … 1616 1683 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: trsa !< agents send to south PE 1617 1684 1618 CALL cpu_log( log_point_s(18), 'mas_eh_exchange_horiz', 'start' )1619 1620 1685 #if defined( __parallel ) 1621 1686 … … 2171 2236 !-- Accumulate the number of agents transferred between the subdomains) 2172 2237 CALL mas_eh_ghost_exchange 2173 2174 CALL cpu_log( log_point_s(18), 'mas_eh_exchange_horiz', 'stop' )2175 2238 2176 2239 END SUBROUTINE mas_eh_exchange_horiz … … 2499 2562 TYPE(agent_type), DIMENSION(:), POINTER :: agents_before_move !< agents before moving 2500 2563 2501 CALL cpu_log( log_point_s(19), 'mas_eh_move_agent', 'start' )2502 2503 2564 DO ip = nxl, nxr 2504 2565 DO jp = nys, nyn … … 2545 2606 ENDDO 2546 2607 ENDDO 2547 2548 CALL cpu_log( log_point_s(19), 'mas_eh_move_agent', 'stop' )2549 2608 2550 2609 RETURN … … 3153 3212 ! Description: 3154 3213 ! ------------ 3214 !> Output of informative message about maximum agent number 3215 !------------------------------------------------------------------------------! 3216 SUBROUTINE mas_last_actions 3217 3218 USE control_parameters, & 3219 ONLY: message_string 3220 3221 IMPLICIT NONE 3222 3223 WRITE(message_string,'(A,I8,A)') & 3224 'The maximumn number of agents durin this run was', & 3225 maximum_number_of_agents, & 3226 '&Consider adjusting the INPUT parameter'// & 3227 '&dim_size_agtnum_manual accordingly for the next run.' 3228 3229 CALL message( 'mas_data_output_agents', 'PA0457', 0, 0, 0, 6, 0 ) 3230 3231 END SUBROUTINE mas_last_actions 3232 3233 !------------------------------------------------------------------------------! 3234 ! Description: 3235 ! ------------ 3155 3236 !> Finds the shortest path from a start position to a target position using the 3156 3237 !> A*-algorithm … … 3194 3275 TYPE(coord), DIMENSION(:), ALLOCATABLE, TARGET :: tmp_path !< temporary path for resizing 3195 3276 3196 CALL cpu_log( log_point_s(20), 'mas_nav_find_path', 'start' )3197 3277 node_counter = 0 3198 3199 3278 ! 3200 3279 !-- Create temporary navigation mesh including agent and target positions … … 3304 3383 !-- Set current intermittent target of this agent 3305 3384 DEALLOCATE(tmp_mesh, path) 3306 CALL cpu_log( log_point_s(20), 'mas_nav_find_path', 'stop' )3307 3385 3308 3386 END SUBROUTINE mas_nav_a_star … … 3678 3756 corner_gate_start, & 3679 3757 corner_gate_width, & 3758 dim_size_agtnum_manual, & 3759 dim_size_factor_agtnum, & 3680 3760 deallocate_memory_mas, & 3681 3761 dist_to_int_target, & … … 3745 3825 TYPE(agent_type), DIMENSION(:,:), ALLOCATABLE :: sort_agents !< sorted agent array 3746 3826 3747 CALL cpu_log( log_point_s(21), 'mas_ps_sort_in_subboxes', 'start' )3748 3827 DO ip = nxl, nxr 3749 3828 DO jp = nys, nyn … … 3796 3875 ENDDO 3797 3876 ENDDO 3798 CALL cpu_log( log_point_s(21), 'mas_ps_sort_in_subboxes', 'stop' )3799 3877 3800 3878 END SUBROUTINE mas_ps_sort_in_subboxes … … 3945 4023 CALL mas_agent_direction 3946 4024 3947 CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )3948 4025 DO n = 1, number_of_agents 3949 4026 … … 3962 4039 ENDDO 3963 4040 3964 CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )3965 3966 3967 4041 END SUBROUTINE mas_timestep_forces_call 3968 4042 … … 3980 4054 REAL(wp) :: abs_v !< absolute value of velocity 3981 4055 REAL(wp) :: abs_f !< absolute value of force 3982 3983 CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )3984 4056 3985 4057 DO n = 1, number_of_agents … … 4023 4095 4024 4096 ENDDO 4025 4026 CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )4027 4028 4097 4029 4098 END SUBROUTINE mas_timestep … … 4108 4177 !-- current one 4109 4178 CASE ( 'other_agents' ) 4110 CALL cpu_log( log_point_s(16), 'mas_other_agents', 'continue' )4111 4179 4112 4180 sra = scan_radius_agent … … 4206 4274 ENDDO 4207 4275 ENDDO 4208 CALL cpu_log( log_point_s(16), 'mas_other_agents', 'pause' )4209 4276 4210 4277 CASE ( 'walls' )
Note: See TracChangeset
for help on using the changeset viewer.
