Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Ignore:
Timestamp:
May 16, 2019 3:17:03 PM (6 years ago)
Author:
hellstea
Message:

Some cleaning up in pmc_interface_mod, renamings, commenting improvements, etc

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3979 r3984  
    2525! -----------------
    2626! $Id$
     27! Commenting improved, pmci_map_fine_to_coarse_grid renamed as pmci_map_child_grid_to_parent_grid,
     28! set_child_edge_coords renamed as pmci_set_child_edge_coords, some variables renamed, etc.
     29!
     30! 3979 2019-05-15 13:54:29Z hellstea
    2731! Bugfix in pmc_interp_1sto_sn. This bug had effect only in case of 1-d domain
    2832! decomposition with npex = 1.
    … …  
    524528!
    525529!-- Constants
    526     INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
    527     INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
     530    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !< Parameter for pmci_parent_datatrans indicating the direction of transfer
     531    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !< Parameter for pmci_parent_datatrans indicating the direction of transfer
    528532    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn  = 2  !< Interpolation scheme to be used on lateral boundaries
    529533    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t     = 3  !< Interpolation scheme to be used on top boundary
    530534!
    531535!-- Coupler setup
    532     INTEGER(iwp), SAVE      ::  comm_world_nesting    !<
    533     INTEGER(iwp), SAVE      ::  cpl_id  = 1           !<
     536    INTEGER(iwp), SAVE      ::  comm_world_nesting    !< Global nesting communicator
     537    INTEGER(iwp), SAVE      ::  cpl_id  = 1           !< 
    534538    INTEGER(iwp), SAVE      ::  cpl_npe_total         !<
    535539    INTEGER(iwp), SAVE      ::  cpl_parent_id         !<
    … …  
    547551!
    548552!-- Geometry
    549     REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_x            !<
    550     REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_y            !<
    551     REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !<
    552     REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !<
     553    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_x            !< Array for the absolute x-coordinates
     554    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_y            !< Array for the absolute y-coordinates
     555    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !< x-coordinate of the lower left corner of the domain
     556    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !< y-coordinate of the lower left corner of the domain
    553557!
    554558!-- Children's parent-grid arrays
    … …  
    644648
    645649    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
    646     REAL(wp), DIMENSION(2)              ::  zmax_coarse             !<
    647650
    648651    TYPE parentgrid_def
    … …  
    865868!
    866869!-- Initialize the child (must be called before pmc_setup_parent)
    867 !  EXTEND THIS COMMENT EXPLAINEIN WHY IT MUST BE CALLED BEFORE   
     870!-- Klaus, extend this comment to explain why it must be called before   
    868871    CALL pmci_setup_child               ! CONTAIN THIS
    869872!
    … …  
    9991002             ENDIF
    10001003          ENDDO
    1001           zmax_coarse  = child_grid_info(1:2)
    10021004!   
    10031005!--       Get absolute coordinates from the child
    … …  
    11011103          ENDIF         
    11021104
    1103           CALL set_child_edge_coords
     1105          CALL pmci_set_child_edge_coords
    11041106
    11051107          DEALLOCATE( child_coord_x )
    … …  
    11101112          CALL pmc_send_to_child( child_id, rans_mode, 1, 0, 19, ierr ) 
    11111113!
    1112 !--       Send coarse grid information to child
     1114!--       Send parent grid information to child
    11131115          CALL pmc_send_to_child( child_id, parent_grid_info_real,                                  &
    11141116                                  SIZE( parent_grid_info_real ), 0, 21,                             &
    … …  
    12901292
    12911293
    1292      SUBROUTINE set_child_edge_coords
     1294     SUBROUTINE pmci_set_child_edge_coords
    12931295        IMPLICIT  NONE
    12941296
    1295         INTEGER(iwp) ::  nbgp_lpm = 1  !<
     1297        INTEGER(iwp) ::  nbgp_lpm = 1  !< Number of ghost-point layers used for lpm (Klaus, is this correct?)
    12961298
    12971299       
    … …  
    13131315        childgrid(m)%ny_coord   = child_coord_y(ny_child) + dy_child
    13141316        childgrid(m)%ny_coord_b = child_coord_y(ny_child+nbgp_lpm) + dy_child
    1315         childgrid(m)%uz_coord   = zmax_coarse(2)
    1316         childgrid(m)%uz_coord_b = zmax_coarse(1)
    1317 
    1318      END SUBROUTINE set_child_edge_coords
     1317        childgrid(m)%uz_coord   = child_grid_info(2)
     1318        childgrid(m)%uz_coord_b = child_grid_info(1)
     1319
     1320     END SUBROUTINE pmci_set_child_edge_coords
    13191321
    13201322#endif
    … …  
    13311333    INTEGER(iwp) ::  lb                            !< Running index for aerosol size bins
    13321334    INTEGER(iwp) ::  lc                            !< Running index for aerosol mass bins
    1333     INTEGER(iwp) ::  lg                            !< Running index for salsa gases
     1335    INTEGER(iwp) ::  lg                            !< Running index for SALSA gases
    13341336    INTEGER(iwp) ::  n                             !< Running index for number of chemical species
    13351337    INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for sending the child-grid dimensions to parent
    … …  
    13371339    REAL(wp), DIMENSION(5) ::  child_grid_info     !< Array for sending the child-grid spacings etc to parent
    13381340         
    1339     CHARACTER( LEN=da_namelen ) ::  myname         !<
    1340     CHARACTER(LEN=5) ::  salsa_char                !<
     1341    CHARACTER( LEN=da_namelen ) ::  myname         !< Name of the variable to be coupled
     1342    CHARACTER(LEN=5) ::  salsa_char                !< Name extension for the variable name in case of SALSA variable
    13411343   
    13421344!
    … …  
    13451347    IF ( .NOT. pmc_is_rootmodel() )  THEN
    13461348!
    1347 !--    ADD A DESCRIPTION HERE WHAT PMC_CHILDINIT DOES       
     1349!--    KLaus, add a description here what pmc_childinit does       
    13481350       CALL pmc_childinit
    13491351!
    … …  
    13551357!--    pmci_set_array_pointer (for parent arrays)
    13561358!--    pmci_create_childs_parent_grid_arrays (for child's parent-grid arrays)
    1357        CALL pmc_set_dataarray_name( 'coarse', 'u'  ,'fine', 'u', ierr )
    1358        CALL pmc_set_dataarray_name( 'coarse', 'v'  ,'fine', 'v', ierr )
    1359        CALL pmc_set_dataarray_name( 'coarse', 'w'  ,'fine', 'w', ierr )
     1359       CALL pmc_set_dataarray_name( 'parent', 'u', 'child', 'u', ierr )
     1360       CALL pmc_set_dataarray_name( 'parent', 'v', 'child', 'v', ierr )
     1361       CALL pmc_set_dataarray_name( 'parent', 'w', 'child', 'w', ierr )
    13601362!
    13611363!--    Set data array name for TKE. Please note, nesting of TKE is actually
    … …  
    13631365!--    design of model coupler, however, data array names must be already
    13641366!--    available at this point.
    1365        IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.         &
    1366             (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.          &
     1367       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                              &
     1368            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                               &
    13671369               .NOT. constant_diffusion ) )  THEN
    1368           CALL pmc_set_dataarray_name( 'coarse', 'e'  ,'fine', 'e', ierr )
     1370          CALL pmc_set_dataarray_name( 'parent', 'e', 'child', 'e', ierr )
    13691371       ENDIF
    13701372!
    … …  
    13731375!--    above.
    13741376       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    1375           CALL pmc_set_dataarray_name( 'coarse', 'diss'  ,'fine', 'diss', ierr )
     1377          CALL pmc_set_dataarray_name( 'parent', 'diss', 'child', 'diss', ierr )
    13761378       ENDIF
    13771379
    13781380       IF ( .NOT. neutral )  THEN
    1379           CALL pmc_set_dataarray_name( 'coarse', 'pt' ,'fine', 'pt', ierr )
     1381          CALL pmc_set_dataarray_name( 'parent', 'pt' ,'child', 'pt', ierr )
    13801382       ENDIF
    13811383
    13821384       IF ( humidity )  THEN
    13831385
    1384           CALL pmc_set_dataarray_name( 'coarse', 'q'  ,'fine', 'q', ierr )
     1386          CALL pmc_set_dataarray_name( 'parent', 'q', 'child', 'q', ierr )
    13851387
    13861388          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    1387             CALL pmc_set_dataarray_name( 'coarse', 'qc'  ,'fine', 'qc', ierr ) 
    1388             CALL pmc_set_dataarray_name( 'coarse', 'nc'  ,'fine', 'nc', ierr )
     1389            CALL pmc_set_dataarray_name( 'parent', 'qc', 'child', 'qc', ierr ) 
     1390            CALL pmc_set_dataarray_name( 'parent', 'nc', 'child', 'nc', ierr )
    13891391          ENDIF
    13901392
    13911393          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    1392              CALL pmc_set_dataarray_name( 'coarse', 'qr'  ,'fine', 'qr', ierr )
    1393              CALL pmc_set_dataarray_name( 'coarse', 'nr'  ,'fine', 'nr', ierr )
     1394             CALL pmc_set_dataarray_name( 'parent', 'qr', 'child', 'qr', ierr )
     1395             CALL pmc_set_dataarray_name( 'parent', 'nr', 'child', 'nr', ierr )
    13941396          ENDIF
    13951397     
    … …  
    13971399
    13981400       IF ( passive_scalar )  THEN
    1399           CALL pmc_set_dataarray_name( 'coarse', 's'  ,'fine', 's', ierr )
     1401          CALL pmc_set_dataarray_name( 'parent', 's', 'child', 's', ierr )
    14001402       ENDIF
    14011403
    14021404       IF ( particle_advection )  THEN
    1403           CALL pmc_set_dataarray_name( 'coarse', 'nr_part'  ,'fine',           &
    1404                'nr_part',  ierr )
    1405           CALL pmc_set_dataarray_name( 'coarse', 'part_adr'  ,'fine',          &
    1406                'part_adr',  ierr )
     1405          CALL pmc_set_dataarray_name( 'parent', 'nr_part', 'child', 'nr_part', ierr )
     1406          CALL pmc_set_dataarray_name( 'parent', 'part_adr', 'child', 'part_adr', ierr )
    14071407       ENDIF
    14081408       
    14091409       IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    14101410          DO n = 1, nspec
    1411              CALL pmc_set_dataarray_name( 'coarse',                            &
    1412                                           'chem_' //                           &
    1413                                           TRIM( chem_species(n)%name ),        &
    1414                                          'fine',                               &
    1415                                           'chem_' //                           &
    1416                                           TRIM( chem_species(n)%name ),        &
    1417                                           ierr )
     1411             CALL pmc_set_dataarray_name( 'parent', 'chem_' // TRIM( chem_species(n)%name ),        &
     1412                                          'child',  'chem_' // TRIM( chem_species(n)%name ), ierr )
    14181413          ENDDO
    14191414       ENDIF
    … …  
    14221417          DO  lb = 1, nbins_aerosol
    14231418             WRITE(salsa_char,'(i0)') lb
    1424              CALL pmc_set_dataarray_name( 'coarse',                            &
    1425                                           'an_' //                             &
    1426                                           TRIM( salsa_char ),                  &
    1427                                           'fine',                              &
    1428                                           'an_' //                             &
    1429                                           TRIM( salsa_char ),                  &
    1430                                           ierr )
     1419             CALL pmc_set_dataarray_name( 'parent', 'an_' // TRIM( salsa_char ),                    &
     1420                                          'child',  'an_' // TRIM( salsa_char ), ierr )
    14311421          ENDDO
    14321422          DO  lc = 1, nbins_aerosol * ncomponents_mass
    14331423             WRITE(salsa_char,'(i0)') lc
    1434              CALL pmc_set_dataarray_name( 'coarse',                            &
    1435                                           'am_' //                             &
    1436                                           TRIM( salsa_char ),                  &
    1437                                           'fine',                              &
    1438                                           'am_' //                             &
    1439                                           TRIM( salsa_char ),                  &
    1440                                           ierr )
     1424             CALL pmc_set_dataarray_name( 'parent', 'am_' // TRIM( salsa_char ),                    &
     1425                                          'child',  'am_' // TRIM( salsa_char ), ierr )
    14411426          ENDDO
    14421427          IF ( .NOT. salsa_gases_from_chem )  THEN
    14431428             DO  lg = 1, ngases_salsa
    14441429                WRITE(salsa_char,'(i0)') lg
    1445                 CALL pmc_set_dataarray_name( 'coarse',                         &
    1446                                              'sg_' //                          &
    1447                                              TRIM( salsa_char ),               &
    1448                                              'fine',                           &
    1449                                              'sg_' //                          &
    1450                                              TRIM( salsa_char ),               &
    1451                                              ierr )
     1430                CALL pmc_set_dataarray_name( 'parent', 'sg_' // TRIM( salsa_char ),                 &
     1431                                             'child',  'sg_' // TRIM( salsa_char ), ierr )
    14521432             ENDDO
    14531433          ENDIF
    … …  
    15201500       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )       
    15211501!
    1522 !--    Find the index bounds for the nest domain in the coarse-grid index space
    1523        CALL pmci_map_fine_to_coarse_grid
     1502!--    Find the index bounds for the nest domain in the parent-grid index space
     1503       CALL pmci_map_child_grid_to_parent_grid
    15241504!
    15251505!--    TO_DO: Klaus give a comment what is happening here
    … …  
    15371517       DO  WHILE ( pmc_c_getnextarray( myname ) )
    15381518!
    1539 !--       Note that cg%nz is not the original nz of parent, but the highest
     1519!--       Note that pg%nz is not the original nz of parent, but the highest
    15401520!--       parent-grid level needed for nesting.
    1541 !--       Please note, in case of chemical species an additional parameter
    1542 !--       need to be passed, which is required to set the pointer correctly
    1543 !--       to the chemical-species data structure. Hence, first check if current
    1544 !--       variable is a chemical species. If so, pass index id of respective
    1545 !--       species and increment this subsequently.
     1521!--       Note that in case of chemical species or SALSA variables an additional
     1522!--       parameter needs to be passed. The parameter is required to set the pointer
     1523!--       correctlyto the chemical-species or SALSA data structure. Hence, first check if
     1524!--       the current variable is a chemical species or a SALSA variable. If so, pass
     1525!--       index id of respective sub-variable (species or bin) and increment this subsequently.
    15461526          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN             
    15471527             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, n )
    … …  
    15731553
    15741554
    1575     SUBROUTINE pmci_map_fine_to_coarse_grid
    1576 !
    1577 !--    Determine index bounds of interpolation/anterpolation area in the coarse
    1578 !--    grid index space
     1555    SUBROUTINE pmci_map_child_grid_to_parent_grid
     1556!
     1557!--    Determine index bounds of interpolation/anterpolation area in the parent-grid index space
    15791558       IMPLICIT NONE
    15801559
    … …  
    15821561
    15831562       INTEGER(iwp), DIMENSION(4)          ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
    1584        INTEGER(iwp), DIMENSION(2)          ::  size_of_array        !<
    1585 
    1586        INTEGER(iwp) ::  i       !<
    1587        INTEGER(iwp) ::  iauxl   !<
    1588        INTEGER(iwp) ::  iauxr   !<
    1589        INTEGER(iwp) ::  ijaux   !<
    1590        INTEGER(iwp) ::  j       !<
    1591        INTEGER(iwp) ::  jauxs   !<
    1592        INTEGER(iwp) ::  jauxn   !<
     1563       INTEGER(iwp), DIMENSION(2)          ::  size_of_array        !< For sending the dimensions of parent_bound_all to parent
     1564
     1565       INTEGER(iwp) ::  ip      !< Running parent-grid index in the x-direction
     1566       INTEGER(iwp) ::  iauxl   !< Offset between the index bound ipl and the auxiliary index bound ipla
     1567       INTEGER(iwp) ::  iauxr   !< Offset between the index bound ipr and the auxiliary index bound ipra
     1568       INTEGER(iwp) ::  ijaux   !< Temporary variable for receiving the index bound from the neighbouring subdomain
     1569       INTEGER(iwp) ::  jp      !< Running parent-grid index in the y-direction
     1570       INTEGER(iwp) ::  jauxs   !< Offset between the index bound jps and the auxiliary index bound jpsa
     1571       INTEGER(iwp) ::  jauxn   !< Offset between the index bound jpn and the auxiliary index bound jpna
    15931572
    15941573       REAL(wp) ::  xexl        !< Parent-grid array exceedance behind the left edge of the child PE subdomain
    … …  
    15961575       REAL(wp) ::  yexs        !< Parent-grid array exceedance behind the south edge of the child PE subdomain
    15971576       REAL(wp) ::  yexn        !< Parent-grid array exceedance behind the north edge of the child PE subdomain
    1598        REAL(wp) ::  xcs         !< RENAME
    1599        REAL(wp) ::  xce         !< RENAME
    1600        REAL(wp) ::  ycs         !< RENAME
    1601        REAL(wp) ::  yce         !< RENAME
    1602 
    1603 !
    1604 !--    Determine the anterpolation index limits. If at least half of the
    1605 !--    parent-grid cell is within the current child sub-domain, then it
    1606 !--    is included in the current sub-domain's anterpolation domain.
    1607 !--    Else the parent-grid cell is included in the neighbouring subdomain's
    1608 !--    anterpolation domain, or not included at all if we are at the outer
    1609 !--    edge of the child domain. This may occur especially when a large grid-spacing
    1610 !--    ratio is used.       
    1611 !
    1612 !--    Left
    1613 !--    EXPLAIN THE EXTENSION HERE AND IN THE OTHER OCCASIONS (r, s, n)       
     1577       REAL(wp) ::  xpl         !< Requested left-edge x-coordinate of the parent-grid array domain (at the internal boundaries
     1578                                !< the real edge may differ from this in some cases as explained in the comment block below) 
     1579       REAL(wp) ::  xpr         !< Requested right-edge x-coordinate of the parent-grid array domain (at the internal boundaries
     1580                                !< the real edge may differ from this in some cases as explained in the comment block below)
     1581       REAL(wp) ::  yps         !< Requested south-edge y-coordinate of the parent-grid array domain (at the internal boundaries
     1582                                !< the real edge may differ from this in some cases as explained in the comment block below)
     1583       REAL(wp) ::  ypn         !< Requested south-edge y-coordinate of the parent-grid array domain (at the internal boundaries
     1584                                !< the real edge may differ from this in some cases as explained in the comment block below)
     1585
     1586!
     1587!--    Determine the index limits for the child's parent-grid arrays (such as uc for example).
     1588!--    Note that at the outer edges of the child domain (nest boundaries) these arrays exceed
     1589!--    the boundary by two parent-grid cells. At the internal boundaries, there are no
     1590!--    exceedances and thus no overlaps with the neighbouring subdomain. If at least half
     1591!--    of the parent-grid cell is within the current child sub-domain, then it is included
     1592!--    in the current sub-domain's parent-grid array. Else the parent-grid cell is
     1593!--    included in the neighbouring subdomain's parent-grid array, or not included at all if
     1594!--    we are at the outer edge of the child domain. This may occur especially when a large
     1595!--    grid-spacing ratio is used.       
     1596!
     1597!--    Left boundary.
     1598!--    Extension by two parent-grid cells behind the boundary, see the comment block above.   
    16141599       IF ( bc_dirichlet_l )  THEN
    1615           xexl  = 2 * pg%dx
     1600          xexl  = 2.0_wp * pg%dx
    16161601          iauxl = 0
    16171602       ELSE
    … …  
    16191604          iauxl = 1
    16201605       ENDIF
    1621        xcs     = coord_x(nxl) - xexl
    1622        DO  i = 0, pg%nx
    1623           IF ( pg%coord_x(i) + 0.5_wp * pg%dx >= xcs )  THEN   ! Consider changing >= to ==
    1624              ipl = MAX( 0, i )
     1606       xpl     = coord_x(nxl) - xexl
     1607       DO  ip = 0, pg%nx
     1608          IF ( pg%coord_x(ip) + 0.5_wp * pg%dx >= xpl )  THEN
     1609             ipl = MAX( 0, ip )
    16251610             EXIT
    16261611          ENDIF
    16271612       ENDDO
    16281613!
    1629 !--    Right
     1614!--    Right boundary.
     1615!--    Extension by two parent-grid cells behind the boundary, see the comment block above.       
    16301616       IF ( bc_dirichlet_r )  THEN
    1631           xexr  = 2 * pg%dx
     1617          xexr  = 2.0_wp * pg%dx
    16321618          iauxr = 0 
    16331619       ELSE
    … …  
    16351621          iauxr = 1 
    16361622       ENDIF
    1637        xce  = coord_x(nxr+1) + xexr
    1638        DO  i = pg%nx, 0 , -1
    1639           IF ( pg%coord_x(i) + 0.5_wp * pg%dx <= xce )  THEN
    1640              ipr = MIN( pg%nx, MAX( ipl, i ) )
     1623       xpr  = coord_x(nxr+1) + xexr
     1624       DO  ip = pg%nx, 0 , -1
     1625          IF ( pg%coord_x(ip) + 0.5_wp * pg%dx <= xpr )  THEN
     1626             ipr = MIN( pg%nx, MAX( ipl, ip ) )
    16411627             EXIT
    16421628          ENDIF
    16431629       ENDDO
    16441630!
    1645 !--    South
     1631!--    South boundary.
     1632!--    Extension by two parent-grid cells behind the boundary, see the comment block above.   
    16461633       IF ( bc_dirichlet_s )  THEN
    1647           yexs  = 2 * pg%dy
     1634          yexs  = 2.0_wp * pg%dy
    16481635          jauxs = 0 
    16491636       ELSE
    … …  
    16511638          jauxs = 1 
    16521639       ENDIF
    1653        ycs  = coord_y(nys) - yexs
    1654        DO  j = 0, pg%ny
    1655           IF ( pg%coord_y(j) + 0.5_wp * pg%dy >= ycs )  THEN
    1656              jps = MAX( 0, j )
     1640       yps  = coord_y(nys) - yexs
     1641       DO  jp = 0, pg%ny
     1642          IF ( pg%coord_y(jp) + 0.5_wp * pg%dy >= yps )  THEN
     1643             jps = MAX( 0, jp )
    16571644             EXIT
    16581645          ENDIF
    16591646       ENDDO
    16601647!
    1661 !--    North
     1648!--    North boundary.
     1649!--    Extension by two parent-grid cells behind the boundary, see the comment block above. 
    16621650       IF  ( bc_dirichlet_n )  THEN
    1663           yexn  = 2 * pg%dy
     1651          yexn  = 2.0_wp * pg%dy
    16641652          jauxn = 0
    16651653       ELSE
    … …  
    16671655          jauxn = 1
    16681656       ENDIF
    1669        yce  = coord_y(nyn+1) + yexn
    1670        DO  j = pg%ny, 0 , -1
    1671           IF ( pg%coord_y(j) + 0.5_wp * pg%dy <= yce )  THEN
    1672              jpn = MIN( pg%ny, MAX( jps, j ) )
     1657       ypn  = coord_y(nyn+1) + yexn
     1658       DO  jp = pg%ny, 0 , -1
     1659          IF ( pg%coord_y(jp) + 0.5_wp * pg%dy <= ypn )  THEN
     1660             jpn = MIN( pg%ny, MAX( jps, jp ) )
    16731661             EXIT
    16741662          ENDIF
    … …  
    16781666!--    This is a safety measure mainly for cases with high grid-spacing
    16791667!--    ratio and narrow child subdomains.
    1680        IF ( nxl == 0 )  THEN
    1681           CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
    1682        ELSE IF ( nxr == nx )  THEN
    1683           CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
    1684           ipl = ijaux + 1
    1685        ELSE
    1686           CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
    1687           CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
    1688           ipl = ijaux + 1
    1689        ENDIF
    1690        IF ( nys == 0 )  THEN
    1691           CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
    1692        ELSE IF ( nyn == ny )  THEN
    1693           CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
    1694           jps = ijaux + 1
    1695        ELSE
    1696           CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
    1697           CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
    1698           jps = ijaux + 1
    1699        ENDIF
    1700 
    1701        WRITE(9,"('Pmci_map_fine_to_coarse_grid. Parent-grid array bounds: ',4(i4,2x))")             &
     1668       IF ( pdims(1) > 1 )  THEN
     1669          IF ( nxl == 0 )  THEN
     1670             CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1671          ELSE IF ( nxr == nx )  THEN
     1672             CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
     1673             ipl = ijaux + 1
     1674          ELSE
     1675             CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1676             CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
     1677             ipl = ijaux + 1
     1678          ENDIF
     1679       ENDIF
     1680
     1681       IF ( pdims(2) > 1 )  THEN
     1682          IF ( nys == 0 )  THEN
     1683             CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1684          ELSE IF ( nyn == ny )  THEN
     1685             CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
     1686             jps = ijaux + 1
     1687          ELSE
     1688             CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1689             CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
     1690             jps = ijaux + 1
     1691          ENDIF
     1692       ENDIF
     1693         
     1694       WRITE(9,"('pmci_map_child_grid_to_parent_grid. Parent-grid array bounds: ',4(i4,2x))")             &
    17021695            ipl, ipr, jps, jpn
    17031696       FLUSH(9)
    … …  
    17091702       parent_bound(5) = myid
    17101703!
    1711 !--    The following index bounds are used for allocating index mapping and some other auxiliary arrays
     1704!--    The following auxiliary index bounds are used for allocating index mapping and
     1705!--    some other auxiliary arrays.
    17121706       ipla = ipl - iauxl
    17131707       ipra = ipr + iauxr
    … …  
    17151709       jpna = jpn + jauxn
    17161710!
     1711!--    The index-bounds parent_bound of all subdomains of the current child domain
     1712!--    must be sent to the parent in order for the parent to create the index list.
     1713!--    For this reason, the parent_bound arrays are packed together in single
     1714!--    array parent_bound_all using MPI_GATHER.       
    17171715!--    Note that MPI_Gather receives data from all processes in the rank order
    1718 !--    This fact is exploited in creating the index list in pmci_create_index_list
    1719 !    IMPROVE THIS COMMENT. EXPLAIN WHERE THIS INFORMATION IS NEEDED.
     1716!--    This fact is exploited in creating the index list in pmci_create_index_list.
    17201717       CALL MPI_GATHER( parent_bound, 5, MPI_INTEGER, parent_bound_all, 5,                          &
    17211718                        MPI_INTEGER, 0, comm2d, ierr )
    … …  
    17341731       ENDIF
    17351732!
    1736 !--    Broadcat the global parent-grid index bounds to all current child processes
     1733!--    Broadcast the global parent-grid index bounds to all current child processes
    17371734       CALL MPI_BCAST( parent_bound_global, 4, MPI_INTEGER, 0, comm2d, ierr )
    17381735       iplg = parent_bound_global(1)
    … …  
    17401737       jpsg = parent_bound_global(3)
    17411738       jpng = parent_bound_global(4)
    1742        WRITE( 9, "('Pmci_map_fine_to_coarse_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))" ) &
     1739       WRITE( 9, "('pmci_map_child_grid_to_parent_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))" ) &
    17431740            iplg, iprg, jpsg, jpng
    17441741       FLUSH( 9 )
    17451742       
    1746     END SUBROUTINE pmci_map_fine_to_coarse_grid
     1743    END SUBROUTINE pmci_map_child_grid_to_parent_grid
    17471744
    17481745     
    … …  
    17861783!
    17871784!--    First determine kcto and kctw which refer to the uppermost
    1788 !--    coarse-grid levels below the child top-boundary level.
     1785!--    parent-grid levels below the child top-boundary level.
    17891786       kk = 0
    17901787       DO WHILE ( pg%zu(kk) <= zu(nzt) )
    … …  
    19921989       WRITE( 9, * )
    19931990!
    1994 !--    Precomputation of number of fine-grid nodes inside parent-grid cells.
     1991!--    Precomputation of number of child-grid nodes inside parent-grid cells.
    19951992!--    Note that ii, jj, and kk are parent-grid indices.
    19961993!--    This information is needed in the anterpolation.
    … …  
    20762073!--          Error
    20772074             WRITE( message_string, * ) 'child domain too narrow for anterpolation in x-direction'
    2078              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
     2075             CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
    20792076          ELSE IF ( iprg - iplg + 1 < 11 )  THEN
    20802077!               
    20812078!--          Warning
    20822079             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
    2083              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
     2080             CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
    20842081             anterpolation_buffer_width = 0
    20852082          ELSE
    … …  
    20872084!--          Informative message
    20882085             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
    2089              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
     2086             CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
    20902087             anterpolation_buffer_width = 2
    20912088          ENDIF
    … …  
    20982095!--          Error
    20992096             WRITE( message_string, * ) 'child domain too narrow for anterpolation in y-direction'
    2100              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
     2097             CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
    21012098          ELSE IF ( jpng - jpsg + 1 < 11 )  THEN
    21022099!               
    21032100!--          Warning
    21042101             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
    2105              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
     2102             CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
    21062103             anterpolation_buffer_width = 0
    21072104          ELSE
    … …  
    21092106!--          Informative message
    21102107             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
    2111              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
     2108             CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
    21122109             anterpolation_buffer_width = 2
    21132110          ENDIF
    … …  
    21202117!--          Error
    21212118             WRITE( message_string, * ) 'child domain too shallow for anterpolation in z-direction'
    2122              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
     2119             CALL message( 'pmci_check_child_domain_size', 'PA0652', 3, 2, 0, 6, 0 )
    21232120          ELSE IF ( kctw - 3 < 1 )  THEN
    21242121!               
    21252122!--          Warning
    21262123             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
    2127              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
     2124             CALL message( 'pmci_check_child_domain_size', 'PA0653', 0, 1, 0, 6, 0 )
    21282125             anterpolation_buffer_width = 0
    21292126          ELSE
    … …  
    21312128!--          Informative message
    21322129             WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
    2133              CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
     2130             CALL message( 'pmci_check_child_domain_size', 'PA0654', 0, 0, 0, 6, 0 )
    21342131             anterpolation_buffer_width = 2 
    21352132          ENDIF
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |