Changeset 4559 for palm/trunk/SOURCE/data_output_mask.f90
- Timestamp:
- Jun 11, 2020 8:51:48 AM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_mask.f90
r4457 r4559 1 1 !> @file data_output_mask.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software7 ! Foundation, either version 3 of the License, or (at your option) any later8 ! version.9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details.13 ! 14 ! You should have received a copy of the GNU General Public License along with15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 15 16 16 ! 17 17 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------ !18 !--------------------------------------------------------------------------------------------------! 19 19 ! 20 20 ! Current revisions: … … 25 25 ! ----------------- 26 26 ! $Id$ 27 ! file re-formatted to follow the PALM coding standard 28 ! 29 ! 4457 2020-03-11 14:20:43Z raasch 27 30 ! use statement for exchange horiz added 28 ! 31 ! 29 32 ! 4444 2020-03-05 15:59:50Z raasch 30 33 ! bugfix: cpp-directives for serial mode added 31 34 ! 32 35 ! 4377 2020-01-15 11:10:51Z gronemeier 33 ! bugfix: set fill value for output according to wall_flags_total_0 for 34 ! non-terrain following output 36 ! bugfix: set fill value for output according to wall_flags_total_0 for non-terrain following output 35 37 ! 36 38 ! 4360 2020-01-07 11:25:50Z suehring 37 ! Introduction of wall_flags_total_0, which currently sets bits based on static 38 ! topographyinformation used in wall_flags_static_039 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 40 ! information used in wall_flags_static_0 39 41 ! 40 42 ! 4331 2019-12-10 18:25:02Z suehring … … 51 53 ! 52 54 ! 4167 2019-08-16 11:01:48Z suehring 53 ! Changed behaviour of masked output over surface to follow terrain and ignore 54 ! buildings(J.Resler, T.Gronemeier)55 ! Changed behaviour of masked output over surface to follow terrain and ignore buildings 56 ! (J.Resler, T.Gronemeier) 55 57 ! 56 58 ! 4069 2019-07-01 14:05:51Z Giersch 57 ! Masked output running index mid has been introduced as a local variable to 58 ! avoid runtime error(Loop variable has been modified) in time_integration59 ! Masked output running index mid has been introduced as a local variable to avoid runtime error 60 ! (Loop variable has been modified) in time_integration 59 61 ! 60 62 ! 4039 2019-06-18 10:32:41Z suehring … … 76 78 ! ------------ 77 79 !> Masked data output in netCDF format for current mask (current value of mid). 78 !------------------------------------------------------------------------------ !80 !--------------------------------------------------------------------------------------------------! 79 81 SUBROUTINE data_output_mask( av, mid ) 80 82 … … 82 84 83 85 #if defined( __netcdf ) 84 USE arrays_3d, & 85 ONLY: e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, & 86 tend, u, v, vpt, w, d_exner 87 88 USE averaging, & 89 ONLY: e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, & 90 qc_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qv_av, qr_av, & 91 rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av 92 93 USE basic_constants_and_equations_mod, & 86 USE arrays_3d, & 87 ONLY: d_exner, e, nc, nr, p, pt, q, qc, ql, ql_c, ql_v, qr, rho_ocean, s, sa, tend, u, v, & 88 vpt, w 89 90 USE averaging, & 91 ONLY: e_av, lpt_av, nc_av, nr_av, p_av, pc_av, pr_av, pt_av, q_av, qc_av, ql_av, ql_c_av, & 92 ql_v_av, ql_vp_av, qv_av, qr_av, rho_ocean_av, s_av, sa_av, u_av, v_av, vpt_av, w_av 93 94 USE basic_constants_and_equations_mod, & 94 95 ONLY: lv_d_cp 95 96 96 USE chemistry_model_mod, &97 USE chemistry_model_mod, & 97 98 ONLY: chem_data_output_mask 98 99 99 USE control_parameters, & 100 ONLY: air_chemistry, domask, domask_no, domask_time_count, mask_i, & 101 mask_j, mask_k, mask_size_l, mask_surface, & 102 max_masks, message_string, nz_do3d, salsa, & 100 USE control_parameters, & 101 ONLY: air_chemistry, domask, domask_no, domask_time_count, mask_i, mask_j, mask_k, & 102 mask_size_l, mask_surface, max_masks, message_string, nz_do3d, salsa, & 103 103 time_since_reference_point 104 104 105 105 #if defined( __parallel ) 106 USE control_parameters, &106 USE control_parameters, & 107 107 ONLY: mask_size, mask_start_l 108 108 #endif 109 109 110 USE cpulog, &110 USE cpulog, & 111 111 ONLY: cpu_log, log_point 112 112 113 USE diagnostic_output_quantities_mod, &113 USE diagnostic_output_quantities_mod, & 114 114 ONLY: doq_output_mask 115 115 116 USE exchange_horiz_mod, &116 USE exchange_horiz_mod, & 117 117 ONLY: exchange_horiz 118 118 119 USE indices, &119 USE indices, & 120 120 ONLY: nbgp, nxl, nxr, nyn, nys, nzb, nzt, wall_flags_total_0 121 121 122 122 USE kinds 123 123 124 USE bulk_cloud_model_mod, &124 USE bulk_cloud_model_mod, & 125 125 ONLY: bulk_cloud_model 126 126 127 127 USE NETCDF 128 128 129 USE netcdf_interface, & 130 ONLY: fill_value, id_set_mask, id_var_domask, id_var_time_mask, & 131 nc_stat, netcdf_data_format, netcdf_handle_error 132 133 USE particle_attributes, & 134 ONLY: grid_particles, number_of_particles, particles, & 135 particle_advection_start, prt_count 129 USE netcdf_interface, & 130 ONLY: fill_value, id_set_mask, id_var_domask, id_var_time_mask, nc_stat, & 131 netcdf_data_format, netcdf_handle_error 132 133 USE particle_attributes, & 134 ONLY: grid_particles, number_of_particles, particles, particle_advection_start, prt_count 136 135 137 136 USE pegrid 138 137 139 USE radiation_model_mod, &138 USE radiation_model_mod, & 140 139 ONLY: radiation, radiation_data_output_mask 141 140 142 USE salsa_mod, &141 USE salsa_mod, & 143 142 ONLY: salsa_data_output_mask 144 143 … … 149 148 INTEGER(iwp) :: flag_nr !< number of masking flag 150 149 INTEGER(iwp) :: i !< loop index 150 INTEGER(iwp) :: im !< loop index for masked variables 151 151 INTEGER(iwp) :: ivar !< variable index 152 152 INTEGER(iwp) :: j !< loop index 153 INTEGER(iwp) :: jm !< loop index for masked variables 153 154 INTEGER(iwp) :: k !< loop index 154 INTEGER(iwp) :: im !< loop index for masked variables155 INTEGER(iwp) :: jm !< loop index for masked variables156 155 INTEGER(iwp) :: kk !< vertical index 156 INTEGER(iwp) :: ktt !< k index of highest terrain surface 157 157 INTEGER(iwp) :: mid !< masked output running index 158 158 INTEGER(iwp) :: n !< loop index 159 159 INTEGER(iwp) :: netcdf_data_format_save !< value of netcdf_data_format 160 INTEGER(iwp) :: ktt !< k index of highest terrain surface161 160 #if defined( __parallel ) 161 INTEGER(iwp) :: ind(6) !< index limits (lower/upper bounds) of array 'local_2d' 162 162 INTEGER(iwp) :: ngp !< number of grid points of an output slice 163 163 INTEGER(iwp) :: sender !< PE id of sending PE 164 INTEGER(iwp) :: ind(6) !< index limits (lower/upper bounds) of array 'local_2d'165 164 #endif 166 165 … … 178 177 REAL(wp), DIMENSION(:,:,:), POINTER :: to_be_resorted !< points to array which shall be output 179 178 179 180 180 ! 181 181 !-- Return, if nothing to output … … 185 185 186 186 ! 187 !-- Parallel netcdf output is not tested so far for masked data, hence 188 !-- netcdf_data_format isswitched back to non-paralell output.187 !-- Parallel netcdf output is not tested so far for masked data, hence netcdf_data_format is 188 !-- switched back to non-paralell output. 189 189 netcdf_data_format_save = netcdf_data_format 190 190 IF ( netcdf_data_format == 5 ) netcdf_data_format = 3 … … 201 201 #if defined( __parallel ) 202 202 IF ( myid == 0 ) THEN 203 ALLOCATE( total_pf( mask_size(mid,1),mask_size(mid,2),mask_size(mid,3)) )203 ALLOCATE( total_pf( mask_size(mid,1),mask_size(mid,2),mask_size(mid,3) ) ) 204 204 ENDIF 205 205 #endif 206 ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), & 207 mask_size_l(mid,3)) ) 206 ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) ) 208 207 209 208 ! … … 211 210 domask_time_count(mid,av) = domask_time_count(mid,av) + 1 212 211 IF ( myid == 0 .OR. netcdf_data_format > 4 ) THEN 213 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), &214 (/ time_since_reference_point /), &215 start = (/ domask_time_count(mid,av) /), &212 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), id_var_time_mask(mid,av), & 213 (/ time_since_reference_point /), & 214 start = (/ domask_time_count(mid,av) /), & 216 215 count = (/ 1 /) ) 217 216 CALL netcdf_handle_error( 'data_output_mask', 460 ) … … 225 224 ! 226 225 !-- Reallocate local_pf on PE 0 since its shape changes during MPI exchange 227 IF ( netcdf_data_format < 5 226 IF ( netcdf_data_format < 5 .AND. myid == 0 .AND. ivar > 1 ) THEN 228 227 DEALLOCATE( local_pf ) 229 ALLOCATE( local_pf(mask_size_l(mid,1),mask_size_l(mid,2), & 230 mask_size_l(mid,3)) ) 228 ALLOCATE( local_pf( mask_size_l(mid,1),mask_size_l(mid,2), mask_size_l(mid,3) ) ) 231 229 ENDIF 232 230 ! … … 281 279 DO j = 1, mask_size_l(mid,2) 282 280 DO k = 1, mask_size_l(mid,3) 283 local_pf(i,j,k) = tend(mask_k(mid,k), & 284 mask_j(mid,j),mask_i(mid,i)) 281 local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) 285 282 ENDDO 286 283 ENDDO … … 294 291 im = mask_i(mid,i) 295 292 jm = mask_j(mid,j) 296 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),&293 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ), & 297 294 DIM = 1 ) - 1 298 295 DO k = 1, mask_size_l(mid,3) … … 321 318 DO k = nzb, nz_do3d 322 319 number_of_particles = prt_count(k,j,i) 323 IF ( number_of_particles <= 0) CYCLE320 IF ( number_of_particles <= 0 ) CYCLE 324 321 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 325 322 s_r2 = 0.0_wp … … 327 324 DO n = 1, number_of_particles 328 325 IF ( particles(n)%particle_mask ) THEN 329 s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 * &326 s_r2 = s_r2 + grid_particles(k,j,i)%particles(n)%radius**2 * & 330 327 grid_particles(k,j,i)%particles(n)%weight_factor 331 s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 * &328 s_r3 = s_r3 + grid_particles(k,j,i)%particles(n)%radius**3 * & 332 329 grid_particles(k,j,i)%particles(n)%weight_factor 333 330 ENDIF … … 350 347 DO j = 1, mask_size_l(mid,2) 351 348 DO k = 1, mask_size_l(mid,3) 352 local_pf(i,j,k) = tend(mask_k(mid,k), & 353 mask_j(mid,j),mask_i(mid,i)) 349 local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) 354 350 ENDDO 355 351 ENDDO … … 363 359 im = mask_i(mid,i) 364 360 jm = mask_j(mid,j) 365 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &366 361 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & 362 DIM = 1 ) - 1 367 363 DO k = 1, mask_size_l(mid,3) 368 364 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 392 388 DO j = 1, mask_size_l(mid,2) 393 389 DO k = 1, mask_size_l(mid,3) 394 local_pf(i,j,k) = & 395 pt(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) & 396 + lv_d_cp * d_exner(mask_k(mid,k)) * & 397 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 390 local_pf(i,j,k) = pt( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) & 391 + lv_d_cp * d_exner( mask_k(mid,k) ) * & 392 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i) ) 398 393 ENDDO 399 394 ENDDO … … 407 402 im = mask_i(mid,i) 408 403 jm = mask_j(mid,j) 409 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &410 404 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & 405 DIM = 1 ) - 1 411 406 DO k = 1, mask_size_l(mid,3) 412 407 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 415 410 local_pf(i,j,k) = fill_value 416 411 ELSE 417 local_pf(i,j,k) = pt(kk,jm,im) + lv_d_cp * d_exner(kk) * ql(kk,jm,im) 412 local_pf(i,j,k) = pt(kk,jm,im) + & 413 lv_d_cp * d_exner(kk) * ql(kk,jm,im) 418 414 ENDIF 419 415 ENDDO … … 469 465 DO k = nzb, nz_do3d 470 466 number_of_particles = prt_count(k,j,i) 471 IF ( number_of_particles <= 0) CYCLE467 IF ( number_of_particles <= 0 ) CYCLE 472 468 particles => grid_particles(k,j,i)%particles(1:number_of_particles) 473 469 DO n = 1, number_of_particles 474 470 IF ( particles(n)%particle_mask ) THEN 475 471 tend(k,j,i) = tend(k,j,i) + & 476 particles(n)%weight_factor / & 477 prt_count(k,j,i) 472 particles(n)%weight_factor / prt_count(k,j,i) 478 473 ENDIF 479 474 ENDDO … … 489 484 DO j = 1, mask_size_l(mid,2) 490 485 DO k = 1, mask_size_l(mid,3) 491 local_pf(i,j,k) = tend(mask_k(mid,k), & 492 mask_j(mid,j),mask_i(mid,i)) 486 local_pf(i,j,k) = tend( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) 493 487 ENDDO 494 488 ENDDO … … 502 496 im = mask_i(mid,i) 503 497 jm = mask_j(mid,j) 504 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &505 498 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & 499 DIM = 1 ) - 1 506 500 DO k = 1, mask_size_l(mid,3) 507 501 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 528 522 DO j = 1, mask_size_l(mid,2) 529 523 DO k = 1, mask_size_l(mid,3) 530 local_pf(i,j,k) = & 531 q(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) - & 532 ql(mask_k(mid,k),mask_j(mid,j),mask_i(mid,i)) 524 local_pf(i,j,k) = q( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) - & 525 ql( mask_k(mid,k), mask_j(mid,j), mask_i(mid,i) ) 533 526 ENDDO 534 527 ENDDO … … 542 535 im = mask_i(mid,i) 543 536 jm = mask_j(mid,j) 544 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), &545 537 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 )), & 538 DIM = 1 ) - 1 546 539 DO k = 1, mask_size_l(mid,3) 547 540 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 622 615 CASE DEFAULT 623 616 ! 624 !-- Set flag to steer output of radiation, land-surface, or user-defined 625 !-- quantities 617 !-- Set flag to steer output of radiation, land-surface, or user-defined quantities 626 618 found = .FALSE. 627 619 ! 628 620 !-- Radiation quantity 629 621 IF ( .NOT. found .AND. radiation ) THEN 630 CALL radiation_data_output_mask(av, domask(mid,av,ivar), found,& 631 local_pf, mid ) 622 CALL radiation_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid ) 632 623 ENDIF 633 624 634 625 IF ( .NOT. found .AND. air_chemistry ) THEN 635 CALL chem_data_output_mask(av, domask(mid,av,ivar), found, & 636 local_pf, mid ) 626 CALL chem_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid ) 637 627 ENDIF 638 628 ! 639 629 !-- Check for diagnostic quantities 640 630 IF ( .NOT. found ) THEN 641 CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, & 642 mid) 631 CALL doq_output_mask( av, domask(mid,av,ivar), found, local_pf, mid ) 643 632 ENDIF 644 633 ! 645 634 !-- SALSA quantities 646 IF ( .NOT. found .AND. salsa ) THEN 647 CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, & 648 local_pf, mid ) 635 IF ( .NOT. found .AND. salsa ) THEN 636 CALL salsa_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid ) 649 637 ENDIF 650 638 ! 651 639 !-- User defined quantity 652 640 IF ( .NOT. found ) THEN 653 CALL user_data_output_mask(av, domask(mid,av,ivar), found, & 654 local_pf, mid ) 641 CALL user_data_output_mask( av, domask(mid,av,ivar), found, local_pf, mid ) 655 642 ENDIF 656 643 … … 658 645 659 646 IF ( .NOT. found ) THEN 660 WRITE ( message_string, * ) 'no masked output available for: ', &647 WRITE ( message_string, * ) 'no masked output available for: ', & 661 648 TRIM( domask(mid,av,ivar) ) 662 649 CALL message( 'data_output_mask', 'PA0327', 0, 0, 0, 6, 0 ) … … 674 661 DO j = 1, mask_size_l(mid,2) 675 662 DO k = 1, mask_size_l(mid,3) 676 local_pf(i,j,k) = MERGE( to_be_resorted( mask_k(mid,k),&677 mask_j(mid,j),&678 mask_i(mid,i)),&679 REAL( fill_value, KIND = wp ), &680 BTEST( wall_flags_total_0( &681 mask_k(mid,k),&682 mask_j(mid,j),&683 mask_i(mid,i)),&684 flag_nr ))663 local_pf(i,j,k) = MERGE( to_be_resorted( mask_k(mid,k), & 664 mask_j(mid,j), & 665 mask_i(mid,i)), & 666 REAL( fill_value, KIND = wp ), & 667 BTEST( wall_flags_total_0( mask_k(mid,k), & 668 mask_j(mid,j), & 669 mask_i(mid,i) ), & 670 flag_nr ) & 671 ) 685 672 ENDDO 686 673 ENDDO … … 695 682 im = mask_i(mid,i) 696 683 jm = mask_j(mid,j) 697 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ),&698 684 ktt = MINLOC( MERGE( 1, 0, BTEST( wall_flags_total_0(:,jm,im), 5 ) ), & 685 DIM = 1 ) - 1 699 686 DO k = 1, mask_size_l(mid,3) 700 687 kk = MIN( ktt+mask_k(mid,k), nzt+1 ) … … 726 713 ! 727 714 !-- (1) a. Parallel I/O using netCDF 4 (not yet tested) 728 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &729 id_var_domask(mid,av,ivar), local_pf,&730 start = (/ mask_start_l(mid,1), mask_start_l(mid,2),&731 mask_start_l(mid,3), domask_time_count(mid,av) /),&732 count = (/ mask_size_l(mid,1), mask_size_l(mid,2),&733 mask_size_l(mid,3), 1 /) )715 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 716 id_var_domask(mid,av,ivar), local_pf, & 717 start = (/ mask_start_l(mid,1), mask_start_l(mid,2), & 718 mask_start_l(mid,3), domask_time_count(mid,av) /), & 719 count = (/ mask_size_l(mid,1), mask_size_l(mid,2), & 720 mask_size_l(mid,3), 1 /) ) 734 721 CALL netcdf_handle_error( 'data_output_mask', 461 ) 735 722 ELSE … … 737 724 ! 738 725 !-- (1) b. Conventional I/O only through PE0 739 !-- PE0 receives partial arrays from all processors of the respective mask 740 !-- and outputs them. Here a barrier has to be set, because otherwise741 !-- "-MPI- FATAL: Remote protocol queue full"may occur.726 !-- PE0 receives partial arrays from all processors of the respective mask and outputs them. 727 !-- Here a barrier has to be set, because otherwise "-MPI- FATAL: Remote protocol queue full" 728 !-- may occur. 742 729 CALL MPI_BARRIER( comm2d, ierr ) 743 730 … … 746 733 ! 747 734 !-- Local array can be relocated directly. 748 total_pf( & 749 mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, & 750 mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, & 751 mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) & 752 = local_pf 735 total_pf( mask_start_l(mid,1):mask_start_l(mid,1)+mask_size_l(mid,1)-1, & 736 mask_start_l(mid,2):mask_start_l(mid,2)+mask_size_l(mid,2)-1, & 737 mask_start_l(mid,3):mask_start_l(mid,3)+mask_size_l(mid,3)-1 ) & 738 = local_pf 753 739 ! 754 740 !-- Receive data from all other PEs. … … 757 743 !-- Receive index limits first, then array. 758 744 !-- Index limits are received in arbitrary order from the PEs. 759 CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, & 760 comm2d, status, ierr ) 745 CALL MPI_RECV( ind(1), 6, MPI_INTEGER, MPI_ANY_SOURCE, 0, comm2d, status, ierr ) 761 746 ! 762 747 !-- Not all PEs have data for the mask 763 748 IF ( ind(1) /= -9999 ) THEN 764 ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * & 765 ( ind(6)-ind(5)+1 ) 749 ngp = ( ind(2)-ind(1)+1 ) * (ind(4)-ind(3)+1 ) * ( ind(6)-ind(5)+1 ) 766 750 sender = status(MPI_SOURCE) 767 751 DEALLOCATE( local_pf ) 768 ALLOCATE(local_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6))) 769 CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, & 770 MPI_REAL, sender, 1, comm2d, status, ierr ) 771 total_pf(ind(1):ind(2),ind(3):ind(4),ind(5):ind(6)) & 772 = local_pf 752 ALLOCATE( local_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) ) 753 CALL MPI_RECV( local_pf(ind(1),ind(3),ind(5)), ngp, MPI_REAL, sender, 1, comm2d,& 754 status, ierr ) 755 total_pf( ind(1):ind(2),ind(3):ind(4),ind(5):ind(6) ) = local_pf 773 756 ENDIF 774 757 ENDDO 775 758 776 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &777 id_var_domask(mid,av,ivar), total_pf,&778 start = (/ 1, 1, 1, domask_time_count(mid,av) /),&779 count = (/ mask_size(mid,1), mask_size(mid,2),&780 mask_size(mid,3), 1 /) )759 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 760 id_var_domask(mid,av,ivar), total_pf, & 761 start = (/ 1, 1, 1, domask_time_count(mid,av) /), & 762 count = (/ mask_size(mid,1), mask_size(mid,2), & 763 mask_size(mid,3), 1 /) ) 781 764 CALL netcdf_handle_error( 'data_output_mask', 462 ) 782 765 783 766 ELSE 784 767 ! 785 !-- If at least part of the mask resides on the PE, send the index 786 !-- limits for the target array, otherwise send -9999 to PE0. 787 IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. & 788 mask_size_l(mid,3) > 0 ) & 789 THEN 768 !-- If at least part of the mask resides on the PE, send the index limits for the target 769 !-- array, otherwise send -9999 to PE0. 770 IF ( mask_size_l(mid,1) > 0 .AND. mask_size_l(mid,2) > 0 .AND. & 771 mask_size_l(mid,3) > 0 ) THEN 790 772 ind(1) = mask_start_l(mid,1) 791 773 ind(2) = mask_start_l(mid,1) + mask_size_l(mid,1) - 1 … … 803 785 !-- If applicable, send data to PE0. 804 786 IF ( ind(1) /= -9999 ) THEN 805 CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, & 806 ierr ) 787 CALL MPI_SEND( local_pf(1,1,1), ngp, MPI_REAL, 0, 1, comm2d, ierr ) 807 788 ENDIF 808 789 ENDIF 809 790 ! 810 !-- A barrier has to be set, because otherwise some PEs may proceed too 811 !-- fast so that PE0 mayreceive wrong data on tag 0.791 !-- A barrier has to be set, because otherwise some PEs may proceed too fast so that PE0 may 792 !-- receive wrong data on tag 0. 812 793 CALL MPI_BARRIER( comm2d, ierr ) 813 794 #if defined( __netcdf4_parallel ) … … 816 797 #else 817 798 ! 818 !-- (2) For serial execution of PALM, the single processor (PE0) holds all 819 !-- data and writes themdirectly to file.820 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), &821 id_var_domask(mid,av,ivar), local_pf, &822 start = (/ 1, 1, 1, domask_time_count(mid,av) /),&823 count = (/ mask_size_l(mid,1), mask_size_l(mid,2),&824 mask_size_l(mid,3), 1 /) )799 !-- (2) For serial execution of PALM, the single processor (PE0) holds all data and writes them 800 !-- directly to file. 801 nc_stat = NF90_PUT_VAR( id_set_mask(mid,av), & 802 id_var_domask(mid,av,ivar), local_pf, & 803 start = (/ 1, 1, 1, domask_time_count(mid,av) /), & 804 count = (/ mask_size_l(mid,1), mask_size_l(mid,2), & 805 mask_size_l(mid,3), 1 /) ) 825 806 CALL netcdf_handle_error( 'data_output_mask', 463 ) 826 807 #endif
Note: See TracChangeset
for help on using the changeset viewer.