Changeset 4893 for palm/trunk/SOURCE/surface_mod.f90
- Timestamp:
- Mar 2, 2021 4:39:14 PM (3 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_mod.f90
r4882 r4893 25 25 ! ----------------- 26 26 ! $Id$ 27 ! revised output of surface data via MPI-IO for better performance 28 ! 29 ! 4882 2021-02-19 22:49:44Z forkel 27 30 ! removed lsp in subroutine nitialize_top 28 !29 31 ! 30 32 ! 4881 2021-02-19 22:05:08Z forkel 31 33 ! removed constant_top_csflux option 32 !33 34 ! 34 35 ! 4877 2021-02-17 16:17:35Z suehring … … 1484 1485 !> Allocating memory for upward and downward-facing horizontal surface types, except for top fluxes. 1485 1486 !--------------------------------------------------------------------------------------------------! 1486 SUBROUTINE allocate_surface_attributes_h( surfaces, nys_l, nyn_l, nxl_l, nxr_l ) 1487 SUBROUTINE allocate_surface_attributes_h( surfaces, nys_l, nyn_l, nxl_l, nxr_l, & 1488 no_allocate_index_arrays ) 1487 1489 1488 1490 IMPLICIT NONE … … 1493 1495 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1494 1496 1497 LOGICAL :: allocate_index_arrays 1498 LOGICAL, INTENT(IN), OPTIONAL :: no_allocate_index_arrays 1499 1495 1500 TYPE(surf_type) :: surfaces !< respective surface type 1496 1501 1502 1503 IF ( PRESENT( no_allocate_index_arrays ) ) THEN 1504 allocate_index_arrays = .NOT. no_allocate_index_arrays 1505 ELSE 1506 allocate_index_arrays = .TRUE. 1507 ENDIF 1497 1508 ! 1498 1509 !-- Allocate arrays for start and end index of horizontal surface type for each (j,i)-grid point. 1499 !-- This is required e.g. in diff ion_x, which is called for each (j,i). In order to find the1510 !-- This is required e.g. in diffusion_x, which is called for each (j,i). In order to find the 1500 1511 !-- location where the respective flux is store within the surface-type, start- and end-index are 1501 1512 !-- stored for each (j,i). For example, each (j,i) can have several entries where fluxes for … … 1503 1514 !-- surfaces might exist for given (j,i). If no surface of respective type exist at current (j,i), 1504 1515 !-- set indicies such that loop in diffusion routines will not be entered. 1505 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1506 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1507 surfaces%start_index = 0 1508 surfaces%end_index = -1 1516 IF ( allocate_index_arrays ) THEN 1517 ALLOCATE( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1518 ALLOCATE( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1519 surfaces%start_index = 0 1520 surfaces%end_index = -1 1521 ENDIF 1509 1522 ! 1510 1523 !-- Indices to locate surface element … … 2051 2064 !> Allocating memory for vertical surface types. 2052 2065 !--------------------------------------------------------------------------------------------------! 2053 SUBROUTINE allocate_surface_attributes_v( surfaces, nys_l, nyn_l, nxl_l, nxr_l ) 2066 SUBROUTINE allocate_surface_attributes_v( surfaces, nys_l, nyn_l, nxl_l, nxr_l, & 2067 no_allocate_index_arrays ) 2054 2068 2055 2069 IMPLICIT NONE … … 2060 2074 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 2061 2075 2076 LOGICAL :: allocate_index_arrays 2077 LOGICAL, INTENT(IN), OPTIONAL :: no_allocate_index_arrays 2078 2062 2079 TYPE(surf_type) :: surfaces !< respective surface type 2063 2080 2081 2082 IF ( PRESENT( no_allocate_index_arrays ) ) THEN 2083 allocate_index_arrays = .NOT. no_allocate_index_arrays 2084 ELSE 2085 allocate_index_arrays = .TRUE. 2086 ENDIF 2087 2064 2088 ! 2065 2089 !-- Allocate arrays for start and end index of vertical surface type for each (j,i)-grid point. This 2066 !-- is required in diff ion_x, which is called for each (j,i). In order to find the location where2090 !-- is required in diffusion_x, which is called for each (j,i). In order to find the location where 2067 2091 !-- the respective flux is store within the surface-type, start- and end-index are stored for each 2068 2092 !-- (j,i). For example, each (j,i) can have several entries where fluxes for vertical surfaces might 2069 2093 !-- be stored. In the flat case, where no vertical walls exit, set indicies such that loop in 2070 2094 !-- diffusion routines will not be entered. 2071 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 2072 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 2073 surfaces%start_index = 0 2074 surfaces%end_index = -1 2095 IF ( allocate_index_arrays ) THEN 2096 ALLOCATE( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 2097 ALLOCATE( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 2098 surfaces%start_index = 0 2099 surfaces%end_index = -1 2100 ENDIF 2075 2101 ! 2076 2102 !-- Indices to locate surface element. … … 3141 3167 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< start index for vertical surface elements on gathered surface array 3142 3168 3143 INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< index for surface data (MPI-IO) 3169 INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) :: global_end_index !< end index for surface data (MPI-IO) 3170 INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< start index for surface data (MPI-IO) 3144 3171 3145 3172 LOGICAL :: surface_data_to_write !< switch for MPI-I/O if PE has surface data to write … … 3988 4015 3989 4016 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, & 3990 surface_data_to_write, global_start_index ) 4017 surface_data_to_write, global_start_index, & 4018 global_end_index ) 3991 4019 IF ( .NOT. surface_data_to_write ) CYCLE 3992 4020 3993 4021 ns_h_on_file(l) = total_number_of_surface_values 3994 4022 3995 CALL wrd_mpi_io( 'surf_h(' // dum // ')%start_index', surf_h(l)%start_index )3996 CALL wrd_mpi_io( 'surf_h(' // dum // ')%end_index', surf_h(l)%end_index )3997 4023 CALL wrd_mpi_io( 'global_start_index_h_' // dum, global_start_index ) 4024 CALL wrd_mpi_io( 'global_end_index_h_' // dum, global_end_index ) 3998 4025 3999 4026 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN … … 4121 4148 4122 4149 CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, & 4123 surface_data_to_write, global_start_index ) 4150 surface_data_to_write, global_start_index, & 4151 global_end_index ) 4152 4153 IF ( .NOT. surface_data_to_write ) CYCLE 4124 4154 4125 4155 ns_v_on_file(l) = total_number_of_surface_values 4126 4156 4127 CALL wrd_mpi_io( 'surf_v(' // dum // ')%start_index', surf_v(l)%start_index )4128 CALL wrd_mpi_io( 'surf_v(' // dum // ')%end_index', surf_v(l)%end_index )4129 4157 CALL wrd_mpi_io( 'global_start_index_v_' // dum, global_start_index ) 4158 CALL wrd_mpi_io( 'global_end_index_v_' // dum, global_end_index ) 4130 4159 4131 4160 IF ( .NOT. surface_data_to_write ) CYCLE … … 5381 5410 INTEGER(iwp) :: mm !< loop index for surface types - file array 5382 5411 5383 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< index for surface data (MPI-IO) 5384 5385 LOGICAL :: ldum !< dummy variable 5412 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_end_index !< end index for surface data (MPI-IO) 5413 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< start index for surface data (MPI-IO) 5414 5415 LOGICAL :: data_to_read !< cycle in l loop, if no values to read 5386 5416 LOGICAL :: surf_match_def !< flag indicating that surface element is of default type 5387 5417 LOGICAL :: surf_match_lsm !< flag indicating that surface element is of natural type … … 5401 5431 IF ( ns_h_on_file(l) == 0 ) CYCLE !< No data of this surface type on file 5402 5432 5433 WRITE( dum, '(I1)') l 5434 5403 5435 IF ( ALLOCATED( surf_h(l)%start_index ) ) CALL deallocate_surface_attributes_h( surf_h(l) ) 5404 surf_h(l)%ns = ns_h_on_file(l) 5405 CALL allocate_surface_attributes_h( surf_h(l), nys, nyn, nxl, nxr ) 5406 5407 WRITE( dum, '(I1)') l 5408 5409 CALL rrd_mpi_io( 'surf_h(' // dum // ')%start_index', surf_h(l)%start_index ) 5410 CALL rrd_mpi_io( 'surf_h(' // dum // ')%end_index', surf_h(l)%end_index ) 5436 5437 ALLOCATE( surf_h(l)%start_index(nys:nyn,nxl:nxr) ) 5438 ALLOCATE( surf_h(l)%end_index(nys:nyn,nxl:nxr) ) 5439 surf_h(l)%start_index = 0 5440 surf_h(l)%end_index = -1 5441 5411 5442 CALL rrd_mpi_io( 'global_start_index_h_' // dum , global_start_index ) 5412 5413 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, ldum, & 5414 global_start_index ) 5443 CALL rrd_mpi_io( 'global_end_index_h_' // dum , global_end_index ) 5444 5445 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, data_to_read, & 5446 global_start_index, global_end_index ) 5447 5448 surf_h(l)%ns = MAX( 2, MAXVAL( surf_h(l)%end_index ) ) 5449 5450 CALL allocate_surface_attributes_h( surf_h(l), nys, nyn, nxl, nxr, & 5451 no_allocate_index_arrays = .TRUE. ) 5452 IF ( .NOT. data_to_read ) CYCLE 5415 5453 5416 5454 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN … … 5539 5577 5540 5578 IF ( ALLOCATED( surf_v(l)%start_index ) ) CALL deallocate_surface_attributes_v( surf_v(l) ) 5541 surf_v(l)%ns = ns_v_on_file(l) 5542 CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr ) 5543 5544 WRITE( dum, '(I1)' ) l 5545 5546 CALL rrd_mpi_io( 'surf_v(' // dum // ')%start_index', surf_v(l)%start_index ) 5547 CALL rrd_mpi_io( 'surf_v(' // dum // ')%end_index', surf_v(l)%end_index ) 5579 5580 ALLOCATE( surf_v(l)%start_index(nys:nyn,nxl:nxr) ) 5581 ALLOCATE( surf_v(l)%end_index(nys:nyn,nxl:nxr) ) 5582 surf_v(l)%start_index = 0 5583 surf_v(l)%end_index = -1 5584 5585 WRITE( dum, '(I1)' ) l 5586 5548 5587 CALL rrd_mpi_io( 'global_start_index_v_' // dum , global_start_index ) 5549 5550 CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, ldum, & 5551 global_start_index ) 5588 CALL rrd_mpi_io( 'global_end_index_v_' // dum , global_end_index ) 5589 5590 CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, data_to_read, & 5591 global_start_index, global_end_index ) 5592 IF ( .NOT. data_to_read ) CYCLE 5593 5594 surf_v(l)%ns = MAX( 2, MAXVAL( surf_v(l)%end_index ) ) 5595 CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr, & 5596 no_allocate_index_arrays = .TRUE. ) 5552 5597 5553 5598 IF ( ALLOCATED ( surf_v(l)%us ) ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
