Changeset 3946 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- May 2, 2019 2:18:59 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r3945 r3946 21 21 ! ------------------ 22 22 ! 23 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Check added for child domains too small in terms of number of parent-grid cells so 28 ! that anterpolation is not possible. Checks added for too wide anterpolation buffer 29 ! for the same reason. Some minor code reformatting done. 30 ! 31 ! 3945 2019-05-02 11:29:27Z raasch 27 32 ! 28 33 ! 3932 2019-04-24 17:31:34Z suehring … … 1127 1132 CALL pmci_create_index_list 1128 1133 ! 1129 !-- Include couple arrays into parent content 1130 !-- The adresses of the PALM 2D or 3D array (here server coarsegrid) which are candidates1134 !-- Include couple arrays into parent content. 1135 !-- The adresses of the PALM 2D or 3D array (here parent grid) which are candidates 1131 1136 !-- for coupling are stored once into the pmc context. While data transfer, the array do not 1132 1137 !-- have to be specified again … … 1134 1139 DO WHILE ( pmc_s_getnextarray( child_id, myname ) ) 1135 1140 IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 ) THEN 1136 CALL pmci_set_array_pointer( myname, child_id = child_id, & 1137 nz_child = nz_child, n = n ) 1141 CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = n ) 1138 1142 n = n + 1 1139 1143 ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 ) THEN 1140 CALL pmci_set_array_pointer( myname, child_id = child_id, & 1141 nz_child = nz_child, n = lb ) 1144 CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lb ) 1142 1145 lb = lb + 1 1143 1146 ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 ) THEN 1144 CALL pmci_set_array_pointer( myname, child_id = child_id, & 1145 nz_child = nz_child, n = lc ) 1147 CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lc ) 1146 1148 lc = lc + 1 1147 ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0 .AND. & 1148 .NOT. salsa_gases_from_chem ) & 1149 THEN 1150 CALL pmci_set_array_pointer( myname, child_id = child_id, & 1151 nz_child = nz_child, n = lg ) 1149 ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0 .AND. .NOT. salsa_gases_from_chem ) THEN 1150 CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lg ) 1152 1151 lg = lg + 1 1153 1152 ELSE … … 1175 1174 IMPLICIT NONE 1176 1175 1177 INTEGER(iwp) :: ilist 1178 INTEGER(iwp) :: index_list_size 1179 INTEGER(iwp) :: ierr 1180 INTEGER(iwp) :: ip 1181 INTEGER(iwp) :: jp 1182 INTEGER(iwp) :: n 1183 INTEGER(iwp) :: nrx 1184 INTEGER(iwp) :: nry 1185 INTEGER(iwp) :: pex 1186 INTEGER(iwp) :: pey 1187 INTEGER(iwp) :: parent_pe 1176 INTEGER(iwp) :: ilist !< Index-list index running over the child's parent-grid jc,ic-space 1177 INTEGER(iwp) :: index_list_size !< Dimension 2 of the array index_list 1178 INTEGER(iwp) :: ierr !< MPI error code 1179 INTEGER(iwp) :: ip !< Running parent-grid index on the child domain in the x-direction 1180 INTEGER(iwp) :: jp !< Running parent-grid index on the child domain in the y-direction 1181 INTEGER(iwp) :: n !< Running index over child subdomains 1182 INTEGER(iwp) :: nrx !< Parent subdomain dimension in the x-direction 1183 INTEGER(iwp) :: nry !< Parent subdomain dimension in the y-direction 1184 INTEGER(iwp) :: pex !< Two-dimensional subdomain (pe) index in the x-direction 1185 INTEGER(iwp) :: pey !< Two-dimensional subdomain (pe) index in the y-direction 1186 INTEGER(iwp) :: parent_pe !< Parent subdomain index (one-dimensional) 1188 1187 1189 1188 INTEGER(iwp), DIMENSION(2) :: pe_indices_2d !< Array for two-dimensional subdomain (pe) … … 1236 1235 ilist = ilist + 1 1237 1236 ! 1238 !-- First index in parent array ! TO_DO: IMPROVE THIS COMMENT1237 !-- First index in parent array ! TO_DO: Klaus, please explain better 1239 1238 index_list(1,ilist) = ip - ( pex * nrx ) + 1 + nbgp 1240 1239 ! 1241 !-- Second index in parent array ! TO_DO: IMPROVE THIS COMMENT1240 !-- Second index in parent array ! TO_DO: Klaus, please explain better 1242 1241 index_list(2,ilist) = jp - ( pey * nry ) + 1 + nbgp 1243 1242 ! 1244 !-- x index of child's parent grid 1243 !-- x index of child's parent grid 1245 1244 index_list(3,ilist) = ip - childs_parent_grid_bounds_all(1,n) + 1 1246 1245 ! … … 1354 1353 ! 1355 1354 !-- Nesting of dissipation rate only if both parent and child are in RANS 1356 !-- mode and TKE-epsilo closure is applied. Please see also comment for TKE1355 !-- mode and TKE-epsilon closure is applied. Please see also comment for TKE 1357 1356 !-- above. 1358 1357 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN … … 1730 1729 iplg, iprg, jpsg, jpng 1731 1730 FLUSH( 9 ) 1731 ! 1732 !-- Check if the child domain is too small in terms of number of parent-grid cells 1733 !-- covered so that anterpolation buffers fill the whole domain so that anterpolation 1734 !-- not possible. Also, check that anterpolation_buffer_width is not too large to 1735 !-- prevent anterpolation. 1736 IF ( nesting_mode == 'two-way') THEN 1737 ! 1738 !-- First x-direction 1739 IF ( iplg + 3 + anterpolation_buffer_width > iprg - 3 - anterpolation_buffer_width ) THEN 1740 IF ( iprg - iplg + 1 < 7 ) THEN 1741 ! 1742 !-- Error 1743 WRITE( message_string, * ) 'child domain too narrow for anterpolation in x-direction' 1744 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 ) 1745 ELSE IF ( iprg - iplg + 1 < 11 ) THEN 1746 ! 1747 !-- Warning 1748 WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0' 1749 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 ) 1750 anterpolation_buffer_width = 0 1751 ELSE 1752 ! 1753 !-- Informative message 1754 WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2' 1755 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 ) 1756 anterpolation_buffer_width = 2 1757 ENDIF 1758 ENDIF 1759 ! 1760 !-- Then y-direction 1761 IF ( jpsg + 3 + anterpolation_buffer_width > jpng - 3 - anterpolation_buffer_width ) THEN 1762 IF ( jpng - jpsg + 1 < 7 ) THEN 1763 ! 1764 !-- Error 1765 WRITE( message_string, * ) 'child domain too narrow for anterpolation in y-direction' 1766 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 ) 1767 ELSE IF ( jpng - jpsg + 1 < 11 ) THEN 1768 ! 1769 !-- Warning 1770 WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0' 1771 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 ) 1772 anterpolation_buffer_width = 0 1773 ELSE 1774 ! 1775 !-- Informative message 1776 WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2' 1777 CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 ) 1778 anterpolation_buffer_width = 2 1779 ENDIF 1780 ENDIF 1781 1782 ENDIF 1732 1783 1733 1784 END SUBROUTINE pmci_map_fine_to_coarse_grid
Note: See TracChangeset
for help on using the changeset viewer.
