- Timestamp:
- Jan 15, 2020 11:10:51 AM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_mask.f90
r4360 r4377 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix: set fill value for output according to wall_flags_total_0 for 28 ! non-terrain following output 29 ! 30 ! 4360 2020-01-07 11:25:50Z suehring 27 31 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 32 ! topography information used in wall_flags_static_0 29 ! 33 ! 30 34 ! 4331 2019-12-10 18:25:02Z suehring 31 35 ! Formatting adjustment 32 ! 36 ! 33 37 ! 4329 2019-12-10 15:46:36Z motisi 34 38 ! Renamed wall_flags_0 to wall_flags_static_0 35 ! 39 ! 36 40 ! 4246 2019-09-30 09:27:52Z pavelkrc 37 41 ! Corrected "Former revisions" section 38 ! 42 ! 39 43 ! 4168 2019-08-16 13:50:17Z suehring 40 44 ! Remove variable grid 41 ! 45 ! 42 46 ! 4167 2019-08-16 11:01:48Z suehring 43 ! Changed behaviour of masked output over surface to follow terrain and ignore 47 ! Changed behaviour of masked output over surface to follow terrain and ignore 44 48 ! buildings (J.Resler, T.Gronemeier) 45 ! 49 ! 46 50 ! 4069 2019-07-01 14:05:51Z Giersch 47 ! Masked output running index mid has been introduced as a local variable to 48 ! avoid runtime error (Loop variable has been modified) in time_integration 49 ! 51 ! Masked output running index mid has been introduced as a local variable to 52 ! avoid runtime error (Loop variable has been modified) in time_integration 53 ! 50 54 ! 4039 2019-06-18 10:32:41Z suehring 51 55 ! Modularize diagnostic output 52 ! 56 ! 53 57 ! 3994 2019-05-22 18:08:09Z suehring 54 58 ! output of turbulence intensity added 55 ! 59 ! 56 60 ! 3665 2019-01-10 08:28:24Z raasch 57 61 ! unused variables removed 58 ! 62 ! 59 63 ! 3655 2019-01-07 16:51:22Z knoop 60 64 ! Fix output time levels (use time_since_reference_point) … … 69 73 SUBROUTINE data_output_mask( av, mid ) 70 74 71 75 72 76 73 77 #if defined( __netcdf ) … … 79 83 ONLY: e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, & 80 84 qc_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qv_av, qr_av, & 81 rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av 85 rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av 82 86 83 87 USE basic_constants_and_equations_mod, & … … 94 98 time_since_reference_point 95 99 96 USE diagnostic_output_quantities_mod, & 100 USE diagnostic_output_quantities_mod, & 97 101 ONLY: doq_output_mask 98 102 99 103 USE cpulog, & 100 104 ONLY: cpu_log, log_point … … 107 111 USE bulk_cloud_model_mod, & 108 112 ONLY: bulk_cloud_model 109 113 110 114 USE NETCDF 111 115 112 116 USE netcdf_interface, & 113 117 ONLY: fill_value, id_set_mask, id_var_domask, id_var_time_mask, & 114 118 nc_stat, netcdf_data_format, netcdf_handle_error 115 119 116 120 USE particle_attributes, & 117 121 ONLY: grid_particles, number_of_particles, particles, & 118 122 particle_advection_start, prt_count 119 123 120 124 USE pegrid 121 125 … … 124 128 125 129 USE salsa_mod, & 126 ONLY: salsa_data_output_mask 130 ONLY: salsa_data_output_mask 127 131 128 132 … … 131 135 INTEGER(iwp) :: av !< flag for (non-)average output 132 136 INTEGER(iwp) :: ngp !< number of grid points of an output slice 137 INTEGER(iwp) :: flag_nr !< number of masking flag 133 138 INTEGER(iwp) :: i !< loop index 134 139 INTEGER(iwp) :: ivar !< variable index … … 151 156 REAL(wp) :: s_r2 !< sum( particle-radius**2 ) 152 157 REAL(wp) :: s_r3 !< sum( particle-radius**3 ) 153 158 154 159 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: local_pf !< output array 155 160 #if defined( __parallel ) … … 175 180 IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN 176 181 CALL check_open( 200+mid+av*max_masks ) 177 ENDIF 182 ENDIF 178 183 179 184 ! … … 210 215 mask_size_l(mid,3)) ) 211 216 ENDIF 217 ! 218 !-- Set masking flag for topography for not resorted arrays 219 flag_nr = 0 212 220 ! 213 221 !-- Store the variable chosen. … … 397 405 ENDDO 398 406 ENDDO 399 ENDIF 407 ENDIF 400 408 resorted = .TRUE. 401 409 ENDIF … … 567 575 568 576 CASE ( 'u' ) 577 flag_nr = 1 569 578 IF ( av == 0 ) THEN 570 579 to_be_resorted => u … … 574 583 575 584 CASE ( 'v' ) 585 flag_nr = 2 576 586 IF ( av == 0 ) THEN 577 587 to_be_resorted => v … … 588 598 589 599 CASE ( 'w' ) 600 flag_nr = 3 590 601 IF ( av == 0 ) THEN 591 602 to_be_resorted => w … … 621 632 CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, & 622 633 local_pf, mid ) 623 ENDIF 634 ENDIF 624 635 ! 625 636 !-- User defined quantity … … 648 659 DO j = 1, mask_size_l(mid,2) 649 660 DO k = 1, mask_size_l(mid,3) 650 local_pf(i,j,k) = to_be_resorted(mask_k(mid,k), & 651 mask_j(mid,j),mask_i(mid,i)) 661 local_pf(i,j,k) = MERGE( to_be_resorted(mask_k(mid,k), & 662 mask_j(mid,j), & 663 mask_i(mid,i)), & 664 REAL( fill_value, KIND = wp ), & 665 BTEST( wall_flags_total_0( & 666 mask_k(mid,k), & 667 mask_j(mid,j), & 668 mask_i(mid,i)), & 669 flag_nr ) ) 652 670 ENDDO 653 671 ENDDO … … 705 723 !-- (1) b. Conventional I/O only through PE0 706 724 !-- PE0 receives partial arrays from all processors of the respective mask 707 !-- and outputs them. Here a barrier has to be set, because otherwise 725 !-- and outputs them. Here a barrier has to be set, because otherwise 708 726 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 709 727 CALL MPI_BARRIER( comm2d, ierr )
Note: See TracChangeset
for help on using the changeset viewer.