Changeset 3241 for palm/trunk/SOURCE/multi_agent_system_mod.f90
- Timestamp:
- Sep 12, 2018 3:02:00 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/multi_agent_system_mod.f90
r3235 r3241 25 25 ! ----------------- 26 26 ! $Id$ 27 ! unused variables removed 28 ! 29 ! 3235 2018-09-07 14:06:15Z sward 27 30 ! Bugfix in output, added agent-number dimension and related messages and 28 31 ! input parameters, updated cpu logging, added mas_last_actions … … 96 99 INTEGER(iwp) :: ibc_mas_lr !< agent left/right boundary condition dummy 97 100 INTEGER(iwp) :: ibc_mas_ns !< agent north/south boundary condition dummy 98 INTEGER(iwp) :: ind_pm10 = -9 !< chemical species index of PM1099 INTEGER(iwp) :: ind_pm25 = -9 !< chemical species index of PM2.5101 ! INTEGER(iwp) :: ind_pm10 = -9 !< chemical species index of PM10 102 ! INTEGER(iwp) :: ind_pm25 = -9 !< chemical species index of PM2.5 100 103 INTEGER(iwp) :: iran_agent = -1234567 !< number for random generator 101 104 INTEGER(iwp) :: min_nr_agent = 2 !< namelist parameter (see documentation) … … 536 539 INTEGER(iwp) :: n !< loop variable over all agents in a grid box 537 540 INTEGER(iwp) :: pc !< agent path counter 538 INTEGER(iwp) :: nobo !< agent path counter539 541 540 542 REAL(wp) :: abs_dir !< length of direction vector (for normalization) 541 REAL(wp) :: d_curr_target !< rounding influence expressed as x speed component542 REAL(wp) :: d_prev_target !< rounding influence expressed as x speed component543 ! REAL(wp) :: d_curr_target !< rounding influence expressed as x speed component 544 ! REAL(wp) :: d_prev_target !< rounding influence expressed as x speed component 543 545 REAL(wp) :: dir_x !< direction of agent (x) 544 546 REAL(wp) :: dir_y !< direction of agent (y) 545 REAL(wp) :: dist_round = 3. !< distance at which agents start rounding a corner547 ! REAL(wp) :: dist_round = 3. !< distance at which agents start rounding a corner 546 548 REAL(wp) :: dtit !< distance to intermittent target 547 REAL(wp) :: round_fac =.2 !< factor for rounding influence548 REAL(wp) :: speed_round_x !< rounding influence expressed as x speed component549 REAL(wp) :: speed_round_y !< rounding influence expressed as x speed component549 ! REAL(wp) :: round_fac = 0.2 !< factor for rounding influence 550 ! REAL(wp) :: speed_round_x !< rounding influence expressed as x speed component 551 ! REAL(wp) :: speed_round_y !< rounding influence expressed as x speed component 550 552 551 553 ! … … 728 730 INTEGER(iwp) :: i !< loop variable ( agent groups ) 729 731 INTEGER(iwp) :: ip !< index variable along x 730 INTEGER(iwp) :: j !< loop variable ( agents per point )731 732 INTEGER(iwp) :: jp !< index variable along y 732 733 INTEGER(iwp) :: loop_stride !< loop variable for initialization … … 1010 1011 IMPLICIT NONE 1011 1012 1012 INTEGER(iwp) :: agt_size !< Agent size in bytes1013 INTEGER(iwp) :: dummy !< dummy1014 1013 INTEGER(iwp) :: il 1015 1014 INTEGER(iwp) :: jl … … 1130 1129 1131 1130 USE netcdf_interface, & 1132 ONLY: nc_stat, id_set_agt, id_var_time_agt, id_var_rnoa_agt,&1131 ONLY: nc_stat, id_set_agt, id_var_time_agt, & 1133 1132 id_var_agt, netcdf_handle_error 1134 1133 … … 1235 1234 IF ( myid == 0 ) THEN 1236 1235 #if defined( __parallel ) 1237 agents =>out_agents1236 agents => out_agents 1238 1237 #else 1239 agents =>trf_agents1238 agents => trf_agents 1240 1239 #endif 1241 1240 … … 1530 1529 1531 1530 TYPE(agent_type), DIMENSION(:), INTENT(IN) :: agent_array !< new agents in a grid box 1532 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: temp_ns !< temporary agent array for reallocation1533 1531 1534 1532 pack_done = .FALSE. … … 1662 1660 INTEGER(iwp) :: j !< grid index (y) of agent positition 1663 1661 INTEGER(iwp) :: jp !< index variable along y 1664 INTEGER(iwp) :: kp !< index variable along z1665 1662 INTEGER(iwp) :: n !< agent index variable 1666 1663 INTEGER(iwp) :: par_size !< Agent size in bytes … … 2252 2249 #if defined( __parallel ) 2253 2250 2254 INTEGER(iwp) :: i !< grid index (x) of agent positition2255 2251 INTEGER(iwp) :: ip !< index variable along x 2256 INTEGER(iwp) :: j !< grid index (y) of agent positition2257 2252 INTEGER(iwp) :: jp !< index variable along y 2258 2253 INTEGER(iwp) :: agt_size !< Bit size of agent datatype … … 2684 2679 ONLY: u, v, pt, hyp 2685 2680 2686 USE chem_gasphase_mod, & 2687 ONLY: nvar 2688 2689 USE chemistry_model_mod, & 2690 ONLY: chem_species 2691 2692 USE control_parameters, & 2693 ONLY: air_chemistry 2681 ! USE chemistry_model_mod, & 2682 ! ONLY: chem_species 2683 2684 ! USE control_parameters, & 2685 ! ONLY: air_chemistry 2694 2686 2695 2687 IMPLICIT NONE … … 2707 2699 REAL(wp) :: u_a !< windspeed at agent position (x) 2708 2700 REAL(wp) :: v_a !< windspeed at agent position (y) 2709 REAL(wp) :: x_a !< agent position (x)2710 REAL(wp) :: y_a !< agent position (y)2711 2701 2712 2702 DO il = nxl, nxr … … 2932 2922 SUBROUTINE mas_init 2933 2923 2934 USE chem_gasphase_mod, &2935 ONLY: nspec2936 2937 USE chemistry_model_mod, &2938 ONLY: chem_species2924 ! USE chem_gasphase_mod, & 2925 ! ONLY: nspec 2926 2927 ! USE chemistry_model_mod, & 2928 ! ONLY: chem_species 2939 2929 2940 2930 USE control_parameters, & 2941 ONLY: air_chemistry, coupling_char, initializing_actions, & 2942 io_blocks, io_group 2931 ONLY: coupling_char, initializing_actions, io_blocks, io_group 2943 2932 2944 2933 USE surface_mod, & … … 2968 2957 REAL(wp) :: avg_agt_height = 1.8_wp 2969 2958 2970 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: noc !< temp: number of connections in nav_mesh2971 2959 2972 2960 ! … … 3244 3232 3245 3233 INTEGER(iwp) :: cur_node !< current node of binary heap 3246 INTEGER(iwp) :: i_ag !< agent index3247 3234 INTEGER(iwp) :: il !< counter (x) 3248 INTEGER(iwp) :: jl !< counter (y)3249 3235 INTEGER(iwp) :: neigh_node !< neighbor node 3250 3236 INTEGER(iwp) :: node_counter !< binary heap node counter 3251 3237 INTEGER(iwp) :: path_ag !< index of agent path 3252 3238 INTEGER(iwp) :: som !< size of mesh 3253 INTEGER(iwp) :: rn_side !< index of agent path3254 3239 INTEGER(iwp) :: steps !< steps along the path 3255 3240 INTEGER(iwp) :: nsteps !< number of steps … … 3259 3244 REAL(wp) :: new_cost !< updated cost to reach node 3260 3245 REAL(wp) :: new_priority !< priority of node to be added to queue 3261 REAL(wp) :: rand_nr !< x-coordinate target3262 3246 REAL(wp) :: rn_gate !< random number for corner gate 3263 3247 REAL(wp) :: target_x !< x-coordinate target … … 3927 3911 !> complete the LES timestep. 3928 3912 !------------------------------------------------------------------------------! 3929 SUBROUTINE mas_ps_sort_timeloop_done3930 3931 IMPLICIT NONE3932 3933 INTEGER(iwp) :: end_index !< agent end index for each sub-box3934 INTEGER(iwp) :: i !< index of agent grid box in x-direction3935 INTEGER(iwp) :: j !< index of agent grid box in y-direction3936 INTEGER(iwp) :: n !< running index for number of agents3937 INTEGER(iwp) :: nb !< index of subgrid boux3938 INTEGER(iwp) :: nf !< indices for agents in each sub-box that already finalized their substeps3939 INTEGER(iwp) :: nnf !< indices for agents in each sub-box that need further treatment3940 INTEGER(iwp) :: num_finalized !< number of agents in each sub-box that already finalized their substeps3941 INTEGER(iwp) :: start_index !< agent start index for each sub-box3942 3943 TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: sort_agents !< temporary agent array 3944 3945 DO i = nxl, nxr3946 DO j = nys, nyn3947 3948 number_of_agents = agt_count(j,i)3949 IF ( number_of_agents <= 0 ) CYCLE3950 3951 agents => grid_agents(j,i)%agents(1:number_of_agents)3952 3953 DO nb = 0, 33913 ! SUBROUTINE mas_ps_sort_timeloop_done 3914 ! 3915 ! IMPLICIT NONE 3916 ! 3917 ! INTEGER(iwp) :: end_index !< agent end index for each sub-box 3918 ! INTEGER(iwp) :: i !< index of agent grid box in x-direction 3919 ! INTEGER(iwp) :: j !< index of agent grid box in y-direction 3920 ! INTEGER(iwp) :: n !< running index for number of agents 3921 ! INTEGER(iwp) :: nb !< index of subgrid boux 3922 ! INTEGER(iwp) :: nf !< indices for agents in each sub-box that already finalized their substeps 3923 ! INTEGER(iwp) :: nnf !< indices for agents in each sub-box that need further treatment 3924 ! INTEGER(iwp) :: num_finalized !< number of agents in each sub-box that already finalized their substeps 3925 ! INTEGER(iwp) :: start_index !< agent start index for each sub-box 3926 ! 3927 ! TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: sort_agents !< temporary agent array 3928 ! 3929 ! DO i = nxl, nxr 3930 ! DO j = nys, nyn 3931 ! 3932 ! number_of_agents = agt_count(j,i) 3933 ! IF ( number_of_agents <= 0 ) CYCLE 3934 ! 3935 ! agents => grid_agents(j,i)%agents(1:number_of_agents) 3936 ! 3937 ! DO nb = 0, 3 3954 3938 ! 3955 3939 !-- Obtain start and end index for each subgrid box 3956 start_index = grid_agents(j,i)%start_index(nb)3957 end_index = grid_agents(j,i)%end_index(nb)3940 ! start_index = grid_agents(j,i)%start_index(nb) 3941 ! end_index = grid_agents(j,i)%end_index(nb) 3958 3942 ! 3959 3943 !-- Allocate temporary array used for sorting 3960 ALLOCATE( sort_agents(start_index:end_index) )3944 ! ALLOCATE( sort_agents(start_index:end_index) ) 3961 3945 ! 3962 3946 !-- Determine number of agents already completed the LES 3963 3947 !-- timestep, and write them into a temporary array 3964 nf = start_index3965 num_finalized = 03966 DO n = start_index, end_index3967 IF ( dt_3d - agents(n)%dt_sum < 1E-8_wp ) THEN3968 sort_agents(nf) = agents(n)3969 nf = nf + 13970 num_finalized = num_finalized + 13971 ENDIF3972 ENDDO3948 ! nf = start_index 3949 ! num_finalized = 0 3950 ! DO n = start_index, end_index 3951 ! IF ( dt_3d - agents(n)%dt_sum < 1E-8_wp ) THEN 3952 ! sort_agents(nf) = agents(n) 3953 ! nf = nf + 1 3954 ! num_finalized = num_finalized + 1 3955 ! ENDIF 3956 ! ENDDO 3973 3957 ! 3974 3958 !-- Determine number of agents that not completed the LES 3975 3959 !-- timestep, and write them into a temporary array 3976 nnf = nf3977 DO n = start_index, end_index3978 IF ( dt_3d - agents(n)%dt_sum > 1E-8_wp ) THEN3979 sort_agents(nnf) = agents(n)3980 nnf = nnf + 13981 ENDIF3982 ENDDO3960 ! nnf = nf 3961 ! DO n = start_index, end_index 3962 ! IF ( dt_3d - agents(n)%dt_sum > 1E-8_wp ) THEN 3963 ! sort_agents(nnf) = agents(n) 3964 ! nnf = nnf + 1 3965 ! ENDIF 3966 ! ENDDO 3983 3967 ! 3984 3968 !-- Write back sorted agents 3985 agents(start_index:end_index) = &3986 sort_agents(start_index:end_index)3969 ! agents(start_index:end_index) = & 3970 ! sort_agents(start_index:end_index) 3987 3971 ! 3988 3972 !-- Determine updated start_index, used to masked already 3989 3973 !-- completed agents. 3990 grid_agents(j,i)%start_index(nb) = &3991 grid_agents(j,i)%start_index(nb) &3992 + num_finalized3974 ! grid_agents(j,i)%start_index(nb) = & 3975 ! grid_agents(j,i)%start_index(nb) & 3976 ! + num_finalized 3993 3977 ! 3994 3978 !-- Deallocate dummy array 3995 DEALLOCATE ( sort_agents )3979 ! DEALLOCATE ( sort_agents ) 3996 3980 ! 3997 3981 !-- Finally, if number of non-completed agents is non zero 3998 3982 !-- in any of the sub-boxes, set control flag appropriately. 3999 IF ( nnf > nf ) &4000 grid_agents(j,i)%time_loop_done = .FALSE.4001 4002 ENDDO4003 ENDDO4004 ENDDO4005 4006 END SUBROUTINE mas_ps_sort_timeloop_done3983 ! IF ( nnf > nf ) & 3984 ! grid_agents(j,i)%time_loop_done = .FALSE. 3985 ! 3986 ! ENDDO 3987 ! ENDDO 3988 ! ENDDO 3989 ! 3990 ! END SUBROUTINE mas_ps_sort_timeloop_done 4007 3991 4008 3992 !------------------------------------------------------------------------------! … … 4106 4090 SUBROUTINE mas_timestep_social_forces ( mode, nl, ip, jp ) 4107 4091 4108 USE constants, &4109 ONLY: pi4092 ! USE constants, & 4093 ! ONLY: pi 4110 4094 4111 4095 IMPLICIT NONE … … 4138 4122 REAL(wp) :: dist !< distance to obstacle 4139 4123 REAL(wp) :: dist_sq !< distance to obstacle squared 4140 REAL(wp) :: dummy_coll_time !< dummy for collision time4141 4124 REAL(wp) :: pos_rel_x !< relative position of two agents (x) 4142 4125 REAL(wp) :: pos_rel_y !< relative position of two agents (y) … … 4311 4294 ! 4312 4295 !-- Calculate force of found wall on agent 4313 CALL mas_timestep_wall_corner_force ( nl, x_a, x_wall, &4314 y_a,y_a )4296 CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, & 4297 y_a ) 4315 4298 ! 4316 4299 !-- calculate new x starting index for later scan for corners … … 4335 4318 ! 4336 4319 !-- Calculate force of found wall on agent 4337 CALL mas_timestep_wall_corner_force ( nl, x_a, x_wall, &4338 y_a,y_a )4320 CALL mas_timestep_wall_corner_force( x_a, x_wall, y_a, & 4321 y_a ) 4339 4322 ! 4340 4323 !-- calculate new x end index for later scan for corners … … 4358 4341 y_wall = (jl+1)*dy 4359 4342 4360 CALL mas_timestep_wall_corner_force ( nl, x_a, x_a, y_a,&4361 4343 CALL mas_timestep_wall_corner_force( x_a, x_a, y_a, & 4344 y_wall ) 4362 4345 ! 4363 4346 !-- calculate new y starting index for later scan for corners … … 4381 4364 y_wall = jl*dy 4382 4365 4383 CALL mas_timestep_wall_corner_force ( nl, x_a, x_a, y_a,&4384 4366 CALL mas_timestep_wall_corner_force( x_a, x_a, y_a, & 4367 y_wall ) 4385 4368 ! 4386 4369 !-- calculate new y end index for later scan for corners … … 4412 4395 y_wall = (jl+1)*dy 4413 4396 4414 CALL mas_timestep_wall_corner_force ( nl, x_a,&4415 x_wall,y_a, y_wall )4397 CALL mas_timestep_wall_corner_force( x_a, x_wall, & 4398 y_a, y_wall ) 4416 4399 4417 4400 ENDIF … … 4426 4409 y_wall = jl*dy 4427 4410 4428 CALL mas_timestep_wall_corner_force ( nl, x_a,&4429 x_wall,y_a, y_wall )4411 CALL mas_timestep_wall_corner_force( x_a, x_wall, & 4412 y_a, y_wall ) 4430 4413 4431 4414 ENDIF … … 4442 4425 y_wall = (jl+1)*dy 4443 4426 4444 CALL mas_timestep_wall_corner_force ( nl, x_a,&4445 x_wall,y_a, y_wall )4427 CALL mas_timestep_wall_corner_force( x_a, x_wall, & 4428 y_a, y_wall ) 4446 4429 4447 4430 ENDIF … … 4456 4439 y_wall = jl*dy 4457 4440 4458 CALL mas_timestep_wall_corner_force ( nl, x_a,&4459 x_wall,y_a, y_wall )4441 CALL mas_timestep_wall_corner_force( x_a, x_wall, & 4442 y_a, y_wall ) 4460 4443 4461 4444 ENDIF … … 4477 4460 !> or wall exerts on that agent 4478 4461 !------------------------------------------------------------------------------! 4479 SUBROUTINE mas_timestep_wall_corner_force ( nl,xa, xw, ya, yw )4462 SUBROUTINE mas_timestep_wall_corner_force( xa, xw, ya, yw ) 4480 4463 4481 4464 IMPLICIT NONE 4482 4483 INTEGER(iwp) :: nl !< loop variable over all agents in a grid box4484 4465 4485 4466 REAL(wp) :: dist_l !< distance to obstacle
Note: See TracChangeset
for help on using the changeset viewer.