Home


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

Changeset 2602 for palm/trunk/SOURCE


Ignore:
Timestamp:
Nov 3, 2017 11:06:41 AM (6 years ago)
Author:
hellstea
Message:

Bug fixes and cleaning up in pmc_interface_mod

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2599 r2602  
    2626! -----------------
    2727! $Id$
    28 ! Some cleanup and commenting improvements only.
     28! Index-limit related bug (occurred with nesting_mode='vertical') fixed in
     29! pmci_interp_tril_t. Check for too high nest domain added in pmci_setup_parent.   
     30! Some cleaning up made.
    2931!
    3032! 2582 2017-10-26 13:19:46Z hellstea
    … …  
    159161! only the total number of PEs is given for the domains, npe_x and npe_y
    160162! replaced by npe_total, two unused elements removed from array
    161 ! define_coarse_grid_real,
     163! parent_grid_info_real,
    162164! array management changed from linked list to sequential loop
    163165!
    … …  
    258260
    259261    PRIVATE
    260 
    261262!
    262263!-- Constants
    263264    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !:
    264265    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !:
    265 
    266266!
    267267!-- Coupler setup
    … …  
    271271    INTEGER(iwp), SAVE      ::  cpl_npe_total          !:
    272272    INTEGER(iwp), SAVE      ::  cpl_parent_id          !:
    273 
    274273!
    275274!-- Control parameters, will be made input parameters later
    … …  
    287286    REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !:
    288287    REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !:
    289 
    290288!
    291289!-- Geometry
    … …  
    295293    REAL(wp), SAVE                            ::  lower_left_coord_x   !:
    296294    REAL(wp), SAVE                            ::  lower_left_coord_y   !:
    297 
    298295!
    299296!-- Child coarse data arrays
    … …  
    321318    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !:
    322319    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !:
    323 
    324320!
    325321!-- Child interpolation coefficients and child-array indices to be
    … …  
    343339    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !:
    344340    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !:
    345 
    346341!
    347342!-- Child index arrays and log-ratio arrays for the log-law near-wall
    … …  
    372367    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !:
    373368    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !:
    374 
    375369!
    376370!-- Upper bounds for k in anterpolation.
    377371    INTEGER(iwp), SAVE ::  kctu   !:
    378372    INTEGER(iwp), SAVE ::  kctw   !:
    379 
    380373!
    381374!-- Upper bound for k in log-law correction in interpolation.
    … …  
    384377    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !:
    385378    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !:
    386 
    387379!
    388380!-- Number of ghost nodes in coarse-grid arrays for i and j in anterpolation.
    … …  
    391383    INTEGER(iwp), SAVE ::  nhls   !:
    392384    INTEGER(iwp), SAVE ::  nhln   !:
    393 
    394385!
    395386!-- Spatial under-relaxation coefficients for anterpolation.
    … …  
    397388    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !:
    398389    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !:
    399 
    400390!
    401391!-- Child-array indices to be precomputed and stored for anterpolation.
    … …  
    412402    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !:
    413403    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !:
    414 
    415404!
    416405!-- Number of fine-grid nodes inside coarse-grid ij-faces
    … …  
    422411    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !:
    423412   
    424     INTEGER(iwp), DIMENSION(3)          ::  define_coarse_grid_int    !:
    425     REAL(wp), DIMENSION(7)              ::  define_coarse_grid_real   !:
     413    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !:
     414    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !:
    426415
    427416    TYPE coarsegrid_def
    … …  
    535524
    536525    ENDIF
    537 
    538526!
    539527!-- Check steering parameter values
    … …  
    554542       CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
    555543    ENDIF
    556 
    557544!
    558545!-- Set the general steering switch which tells PALM that its a nested run
    559546    nested_run = .TRUE.
    560 
    561547!
    562548!-- Get some variables required by the pmc-interface (and in some cases in the
    … …  
    650636    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !:
    651637    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !:
     638    REAL(wp) ::  cl_height        !:
    652639    REAL(wp) ::  dx_cl            !:
    653640    REAL(wp) ::  dy_cl            !:
    … …  
    663650    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !:
    664651    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !:
    665    
    666652
    667653!
    668654!   Initialize the pmc parent
    669655    CALL pmc_parentinit
    670 
    671656!
    672657!-- Corners of all children of the present parent
    … …  
    677662       ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) )
    678663    ENDIF
    679 
    680664!
    681665!-- Get coordinates from all children
    … …  
    692676          dx_cl = val(4)
    693677          dy_cl = val(5)
    694 
     678          cl_height = fval(1)
    695679          nz_cl = nz
    696 
    697680!
    698681!--       Find the highest nest level in the coarse grid for the reduced z
    … …  
    704687             ENDIF
    705688          ENDDO
    706 
    707689!   
    708690!--       Get absolute coordinates from the child
    … …  
    711693         
    712694          CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),   &
    713                                      0, 11, ierr )
     695               0, 11, ierr )
    714696          CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),   &
    715                                      0, 12, ierr )
    716 !          WRITE ( 0, * )  'receive from pmc child ', child_id, nx_cl, ny_cl
     697               0, 12, ierr )
    717698         
    718           define_coarse_grid_real(1) = lower_left_coord_x
    719           define_coarse_grid_real(2) = lower_left_coord_y
    720           define_coarse_grid_real(3) = dx
    721           define_coarse_grid_real(4) = dy
    722           define_coarse_grid_real(5) = lower_left_coord_x + ( nx + 1 ) * dx
    723           define_coarse_grid_real(6) = lower_left_coord_y + ( ny + 1 ) * dy
    724           define_coarse_grid_real(7) = dz
    725 
    726           define_coarse_grid_int(1)  = nx
    727           define_coarse_grid_int(2)  = ny
    728           define_coarse_grid_int(3)  = nz_cl
    729 
     699          parent_grid_info_real(1) = lower_left_coord_x
     700          parent_grid_info_real(2) = lower_left_coord_y
     701          parent_grid_info_real(3) = dx
     702          parent_grid_info_real(4) = dy
     703          parent_grid_info_real(5) = lower_left_coord_x + ( nx + 1 ) * dx
     704          parent_grid_info_real(6) = lower_left_coord_y + ( ny + 1 ) * dy
     705          parent_grid_info_real(7) = dz
     706
     707          parent_grid_info_int(1)  = nx
     708          parent_grid_info_int(2)  = ny
     709          parent_grid_info_int(3)  = nz_cl
    730710!
    731711!--       Check that the child domain matches parent domain.
    732712          nomatch = 0
    733713          IF ( nesting_mode == 'vertical' )  THEN
    734              right_limit = define_coarse_grid_real(5)
    735              north_limit = define_coarse_grid_real(6)
     714             right_limit = parent_grid_info_real(5)
     715             north_limit = parent_grid_info_real(6)
    736716             IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                   &
    737717                  ( cl_coord_y(ny_cl+1) /= north_limit ) )  THEN
    738718                nomatch = 1
    739719             ENDIF
    740           ELSE
    741          
     720          ELSE       
    742721!
    743722!--       Check that the child domain is completely inside the parent domain.
    … …  
    745724             yez = ( nbgp + 1 ) * dy
    746725             left_limit  = lower_left_coord_x + xez
    747              right_limit = define_coarse_grid_real(5) - xez
     726             right_limit = parent_grid_info_real(5) - xez
    748727             south_limit = lower_left_coord_y + yez
    749              north_limit = define_coarse_grid_real(6) - yez
     728             north_limit = parent_grid_info_real(6) - yez
    750729             IF ( ( cl_coord_x(0) < left_limit )        .OR.                    &
    751730                  ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                    &
    … …  
    755734             ENDIF
    756735          ENDIF
    757 
     736!             
     737!--       Child domain must be lower than the parent domain such
     738!--       that the top ghost layer of the child grid does not exceed
     739!--       the parent domain top boundary.
     740          IF ( cl_height > zw(nz) ) THEN
     741             nomatch = 1
     742          ENDIF
    758743!
    759744!--       Check that parallel nest domains, if any, do not overlap.
    … …  
    779764          DEALLOCATE( cl_coord_x )
    780765          DEALLOCATE( cl_coord_y )
    781 
    782766!
    783767!--       Send coarse grid information to child
    784           CALL pmc_send_to_child( child_id, define_coarse_grid_real,            &
    785                                    SIZE( define_coarse_grid_real ), 0, 21,      &
     768          CALL pmc_send_to_child( child_id, parent_grid_info_real,              &
     769                                   SIZE( parent_grid_info_real ), 0, 21,        &
    786770                                   ierr )
    787           CALL pmc_send_to_child( child_id, define_coarse_grid_int,  3, 0,      &
     771          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,        &
    788772                                   22, ierr )
    789 
    790773!
    791774!--       Send local grid to child
    … …  
    794777          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,        &
    795778                                   ierr )
    796 
    797779!
    798780!--       Also send the dzu-, dzw-, zu- and zw-arrays here
    … …  
    818800     
    819801       CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
    820 
    821802!
    822803!--    TO_DO: Klaus: please give a comment what is done here
    823804       CALL pmci_create_index_list
    824 
    825805!
    826806!--    Include couple arrays into parent content
    … …  
    870850
    871851       IF ( myid == 0 )  THEN
     852!         
    872853!--       TO_DO: Klaus: give more specific comment what size_of_array stands for
    873854          CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr )
    … …  
    875856          CALL pmc_recv_from_child( child_id, coarse_bound_all,                 &
    876857                                    SIZE( coarse_bound_all ), 0, 41, ierr )
    877 
    878858!
    879859!--       Compute size of index_list.
    … …  
    10231003
    10241004       CALL pmc_set_dataarray_name( lastentry = .TRUE. )
    1025 
    10261005!
    10271006!--    Send grid to parent
    … …  
    10391018          CALL pmc_send_to_parent( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
    10401019          CALL pmc_send_to_parent( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
    1041 
    10421020!
    10431021!--       Receive Coarse grid information.
    1044 !--       TO_DO: find shorter and more meaningful name for  define_coarse_grid_real
    1045           CALL pmc_recv_from_parent( define_coarse_grid_real,                  &
    1046                                      SIZE(define_coarse_grid_real), 0, 21, ierr )
    1047           CALL pmc_recv_from_parent( define_coarse_grid_int,  3, 0, 22, ierr )
     1022          CALL pmc_recv_from_parent( parent_grid_info_real,                     &
     1023                                     SIZE(parent_grid_info_real), 0, 21, ierr )
     1024          CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
    10481025!
    10491026!--        Debug-printouts - keep them
    10501027!          WRITE(0,*) 'Coarse grid from parent '
    1051 !          WRITE(0,*) 'startx_tot    = ',define_coarse_grid_real(1)
    1052 !          WRITE(0,*) 'starty_tot    = ',define_coarse_grid_real(2)
    1053 !          WRITE(0,*) 'endx_tot      = ',define_coarse_grid_real(5)
    1054 !          WRITE(0,*) 'endy_tot      = ',define_coarse_grid_real(6)
    1055 !          WRITE(0,*) 'dx            = ',define_coarse_grid_real(3)
    1056 !          WRITE(0,*) 'dy            = ',define_coarse_grid_real(4)
    1057 !          WRITE(0,*) 'dz            = ',define_coarse_grid_real(7)
    1058 !          WRITE(0,*) 'nx_coarse     = ',define_coarse_grid_int(1)
    1059 !          WRITE(0,*) 'ny_coarse     = ',define_coarse_grid_int(2)
    1060 !          WRITE(0,*) 'nz_coarse     = ',define_coarse_grid_int(3)
    1061        ENDIF
    1062 
    1063        CALL MPI_BCAST( define_coarse_grid_real, SIZE(define_coarse_grid_real),  &
     1028!          WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
     1029!          WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
     1030!          WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
     1031!          WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
     1032!          WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
     1033!          WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
     1034!          WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
     1035!          WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
     1036!          WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
     1037!          WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
     1038       ENDIF
     1039
     1040       CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real),      &
    10641041                       MPI_REAL, 0, comm2d, ierr )
    1065        CALL MPI_BCAST( define_coarse_grid_int, 3, MPI_INTEGER, 0, comm2d, ierr )
    1066 
    1067        cg%dx = define_coarse_grid_real(3)
    1068        cg%dy = define_coarse_grid_real(4)
    1069        cg%dz = define_coarse_grid_real(7)
    1070        cg%nx = define_coarse_grid_int(1)
    1071        cg%ny = define_coarse_grid_int(2)
    1072        cg%nz = define_coarse_grid_int(3)
    1073 
     1042       CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr )
     1043
     1044       cg%dx = parent_grid_info_real(3)
     1045       cg%dy = parent_grid_info_real(4)
     1046       cg%dz = parent_grid_info_real(7)
     1047       cg%nx = parent_grid_info_int(1)
     1048       cg%ny = parent_grid_info_int(2)
     1049       cg%nz = parent_grid_info_int(3)
    10741050!
    10751051!--    Get parent coordinates on coarse grid
    … …  
    10811057       ALLOCATE( cg%zu(0:cg%nz+1) )
    10821058       ALLOCATE( cg%zw(0:cg%nz+1) )
    1083 
    10841059!
    10851060!--    Get coarse grid coordinates and values of the z-direction from the parent
    … …  
    10941069
    10951070       ENDIF
    1096 
    10971071!
    10981072!--    Broadcast this information
    … …  
    11101084!--    TO_DO: Klaus give a comment what is happening here
    11111085       CALL pmc_c_get_2d_index_list
    1112 
    11131086!
    11141087!--    Include couple arrays into child content
    … …  
    11161089       CALL  pmc_c_clear_next_array_list
    11171090       DO  WHILE ( pmc_c_getnextarray( myname ) )
    1118 !--       TO_DO: Klaus, why the child-arrays are still up to cg%nz??
     1091!--       Note that cg%nz is not th eoriginal nz of parent, but the highest
     1092!--       parent-grid level needed for nesting.           
    11191093          CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz )
    11201094       ENDDO
    11211095       CALL pmc_c_setind_and_allocmem
    1122 
    11231096!
    11241097!--    Precompute interpolation coefficients and child-array indices
    11251098       CALL pmci_init_interp_tril
    1126 
    11271099!
    11281100!--    Precompute the log-law correction index- and ratio-arrays
    11291101       CALL pmci_init_loglaw_correction
    1130 
    11311102!
    11321103!--    Define the SGS-TKE scaling factor based on the grid-spacing ratio
    11331104       CALL pmci_init_tkefactor
    1134 
    11351105!
    11361106!--    Two-way coupling for general and vertical nesting.
    … …  
    11411111          CALL pmci_init_anterp_tophat
    11421112       ENDIF
    1143 
    11441113!
    11451114!--    Finally, compute the total area of the top-boundary face of the domain.
    … …  
    11501119
    11511120 CONTAINS
     1121
    11521122
    11531123    SUBROUTINE pmci_map_fine_to_coarse_grid
    … …  
    12631233       INTEGER(iwp) ::  k       !:
    12641234       INTEGER(iwp) ::  kc      !:
     1235       INTEGER(iwp) ::  kdzo    !:
     1236       INTEGER(iwp) ::  kdzw    !:       
    12651237
    12661238       REAL(wp) ::  xb          !:
    … …  
    13011273       ALLOCATE( r1zo(nzb:nzt+1) )
    13021274       ALLOCATE( r2zo(nzb:nzt+1) )
    1303 
    13041275!
    13051276!--    Note that the node coordinates xfs... and xcs... are relative to the
    … …  
    13361307          zfso = zu(k)
    13371308
    1338           kc = 0
    1339           DO  WHILE ( cg%zw(kc) <= zfsw )
    1340              kc = kc + 1
     1309          DO kc = 0, cg%nz+1
     1310             IF ( cg%zw(kc) > zfsw )  EXIT
    13411311          ENDDO
    13421312          kcw(k) = kc - 1
    1343          
    1344           kc = 0
    1345           DO  WHILE ( cg%zu(kc) <= zfso )
    1346              kc = kc + 1
     1313         
     1314          !if ( myid == 0 .and. nx==191 )  then
     1315          !   write(162,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
     1316          !endif
     1317          !if ( myid == 0 .and. nx==383 )  then
     1318          !   write(163,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
     1319          !endif
     1320
     1321          DO kc = 0, cg%nz+1
     1322             IF ( cg%zu(kc) > zfso )  EXIT
    13471323          ENDDO
    13481324          kco(k) = kc - 1
    … …  
    13501326          zcsw    = cg%zw(kcw(k))
    13511327          zcso    = cg%zu(kco(k))
    1352           r2zw(k) = ( zfsw - zcsw ) / cg%dzw(kcw(k)+1)
    1353           r2zo(k) = ( zfso - zcso ) / cg%dzu(kco(k)+1)
     1328          kdzw    = MIN( kcw(k)+1, cg%nz+1 )
     1329          kdzo    = MIN( kco(k)+1, cg%nz+1 )
     1330          r2zw(k) = ( zfsw - zcsw ) / cg%dzw(kdzw)
     1331          r2zo(k) = ( zfso - zcso ) / cg%dzu(kdzo)
    13541332          r1zw(k) = 1.0_wp - r2zw(k)
    13551333          r1zo(k) = 1.0_wp - r2zo(k)
    … …  
    15071485          nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
    15081486       ENDIF
    1509 
    15101487!
    15111488!--    Then determine the maximum number of near-wall nodes per wall point based
    … …  
    15131490       nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r,                &
    15141491                           nzt_topo_nestbc_s, nzt_topo_nestbc_n )
    1515 
    15161492!
    15171493!--    Note that the outer division must be integer division.
    … …  
    15291505
    15301506       z0_topo = roughness_length
    1531 
    15321507!
    15331508!--    First horizontal walls. Note that also logc_w_? and logc_ratio_w_? need to
    … …  
    15901565
    15911566       ENDIF
    1592 
    15931567!
    15941568!--    Right boundary
    … …  
    16501624
    16511625       ENDIF
    1652 
    16531626!
    16541627!--    South boundary
    … …  
    17071680
    17081681       ENDIF
    1709 
    17101682!
    17111683!--    North boundary
    … …  
    17631735
    17641736       ENDIF
    1765 
    17661737!       
    17671738!--    Then vertical walls and corners if necessary
    … …  
    18171788                      lcr(0:ncorr-1) = 1.0_wp
    18181789                   ENDIF
    1819 
    18201790!
    18211791!--                Wall for u on the north side, but not on the south side
    … …  
    18511821                      lcr(0:ncorr-1) = 1.0_wp
    18521822                   ENDIF
    1853 
    18541823!
    18551824!--                Wall for w on the north side, but not on the south side.
    … …  
    18721841
    18731842          ENDIF   !  IF ( nest_bound_l )
    1874 
    18751843!       
    18761844!--       Right boundary
    … …  
    19071875                      lcr(0:ncorr-1) = 1.0_wp
    19081876                   ENDIF
    1909 
    19101877!
    19111878!--                Wall for u on the north side, but not on the south side
    … …  
    19231890                      lcr(0:ncorr-1) = 1.0_wp
    19241891                   ENDIF
    1925 
    19261892!
    19271893!--                Wall for w on the south side, but not on the north side
    … …  
    19391905                      lcr(0:ncorr-1) = 1.0_wp
    19401906                   ENDIF
    1941 
    19421907!
    19431908!--                Wall for w on the north side, but not on the south side
    … …  
    19481913                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    19491914                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    1950 
    19511915!
    19521916!--                   The direction of the wall-normal index is stored as the
    … …  
    19611925
    19621926          ENDIF   !  IF ( nest_bound_r )
    1963 
    19641927!       
    19651928!--       South boundary
    … …  
    19961959                      lcr(0:ncorr-1) = 1.0_wp
    19971960                   ENDIF
    1998 
    19991961!
    20001962!--                Wall for v on the right side, but not on the left side
    … …  
    20131975                      lcr(0:ncorr-1) = 1.0_wp
    20141976                   ENDIF
    2015 
    20161977!
    20171978!--                Wall for w on the left side, but not on the right side
    … …  
    20522013
    20532014          ENDIF   !  IF (nest_bound_s )
    2054 
    20552015!       
    20562016!--       North boundary
    … …  
    20872047                      lcr(0:ncorr-1) = 1.0_wp
    20882048                   ENDIF
    2089 
    20902049!
    20912050!--                Wall for v on the right side, but not on the left side
    … …  
    21032062                      lcr(0:ncorr-1) = 1.0_wp
    21042063                   ENDIF
    2105 
    21062064!
    21072065!--                Wall for w on the left side, but not on the right side
    … …  
    21192077                      lcr(0:ncorr-1) = 1.0_wp
    21202078                   ENDIF
    2121 
    21222079!
    21232080!--                Wall for w on the right side, but not on the left side
    … …  
    22042161                                                z0_l, inc )
    22052162                ENDIF
    2206 
    22072163!
    22082164!--             The role of inc here is to make the comparison operation "<"
    … …  
    23112267       REAL(wp) ::  logyc1   !:
    23122268       REAL(wp) ::  yc1      !:
    2313 
     2269       
    23142270!
    23152271!--    yc1 is the y-coordinate of the first coarse-grid u- and w-nodes out from
    … …  
    24162372          anterp_relax_length_t = 0.1_wp * zu(nzt)
    24172373       ENDIF
    2418 
    24192374!
    24202375!--    First determine kctu and kctw that are the coarse-grid upper bounds for
    … …  
    24722427       iflu(icr) = nxrg
    24732428       ifuu(icr) = nxrg
    2474 
    24752429!
    24762430!--    i-indices of others for each ii-index value
    … …  
    24952449       iflo(icr) = nxrg
    24962450       ifuo(icr) = nxrg
    2497 
    24982451!
    24992452!--    j-indices of v for each jj-index value
    … …  
    25402493       jflo(jcn) = nyng
    25412494       jfuo(jcn) = nyng
    2542 
    25432495!
    25442496!--    k-indices of w for each kk-index value
    … …  
    25582510          kstart = kflw(kk)
    25592511       ENDDO
    2560 
    25612512!
    25622513!--    k-indices of others for each kk-index value
    … …  
    25762527          kstart = kflo(kk)
    25772528       ENDDO
    2578  
    25792529!
    25802530!--    Precomputation of number of fine-grid nodes inside coarse-grid ij-faces.
    … …  
    26452595
    26462596
    2647 SUBROUTINE pmci_init_tkefactor
     2597    SUBROUTINE pmci_init_tkefactor
    26482598
    26492599!
    … …  
    27122662       ENDIF
    27132663
    2714       IF ( nest_bound_s )  THEN
     2664       IF ( nest_bound_s )  THEN
    27152665          ALLOCATE( tkefactor_s(nzb:nzt+1,nxlg:nxrg) )
    27162666          tkefactor_s = 0.0_wp
    … …  
    27182668          DO  i = nxlg, nxrg
    27192669             k_wall = get_topography_top_index( j, i, 's' )
    2720 
     2670             
    27212671             DO  k = k_wall + 1, nzt
    2722 
     2672               
    27232673                kc     = kco(k+1)
    27242674                glsf   = ( dx * dy * dzu(k) )**p13
    … …  
    27272677                fw     = EXP( -cfw*height / glsf )
    27282678                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    2729                                               ( glsf / glsc )**p23 )
     2679                     ( glsf / glsc )**p23 )
    27302680             ENDDO
    27312681             tkefactor_s(k_wall,i) = c_tkef * fw0
    … …  
    28272777    NULLIFY( p_3d )
    28282778    NULLIFY( p_2d )
    2829 
    28302779!
    28312780!-- List of array names, which can be coupled.
    … …  
    29282877    NULLIFY( p_3d )
    29292878    NULLIFY( p_2d )
    2930 
    29312879!
    29322880!-- List of array names, which can be coupled
    … …  
    30362984
    30372985!
    3038 !-- Root id is never a child
     2986!-- Root model is never anyone's child
    30392987    IF ( cpl_id > 1 )  THEN
    3040 
    30412988!
    30422989!--    Child domain boundaries in the parent index space
    … …  
    30452992       jcs = coarse_bound(3)
    30462993       jcn = coarse_bound(4)
    3047 
    30482994!
    30492995!--    Get data from the parent
    30502996       CALL pmc_c_getbuffer( waittime = waittime )
    3051 
    30522997!
    30532998!--    The interpolation.
    … …  
    32033148          ENDIF
    32043149       ENDIF
    3205 
    32063150!
    32073151!--    Trilinear interpolation.
    … …  
    32223166          ENDDO
    32233167       ENDDO
    3224 
    32253168!
    32263169!--    Correct the interpolated values of u and v in near-wall nodes, i.e. in
    … …  
    33213264       ENDIF
    33223265    ENDIF
    3323 
    33243266!
    33253267!-- Same for restart time
    … …  
    33383280       ENDIF
    33393281    ENDIF
    3340 
    33413282!
    33423283!-- Same for dt_restart
    … …  
    33553296       ENDIF
    33563297    ENDIF
    3357 
    33583298!
    33593299!-- Same for time_restart
    … …  
    34323372    volume_flow(1) = volume_flow_l(1)
    34333373#endif
    3434 
     3374   
    34353375!
    34363376!-- Sum up the volume flow through the south/north boundaries
    … …  
    35123452!-- MPI_ALLREDUCE with the MPI_MIN operator over all processes using
    35133453!-- the global communicator MPI_COMM_WORLD.
     3454   
    35143455   IMPLICIT NONE
    35153456
    … …  
    36053546
    36063547 END SUBROUTINE pmci_datatrans
    3607 
    36083548
    36093549
    … …  
    36423582          CALL pmc_s_getdata_from_buffer( child_id )
    36433583          CALL cpu_log( log_point_s(72), 'pmc parent recv', 'stop' )
    3644 
    36453584!
    36463585!--       The anterpolated data is now available in u etc
    36473586          IF ( topography /= 'flat' )  THEN
    3648 
    36493587!
    36503588!--          Inside buildings/topography reset velocities back to zero.
    … …  
    37323670    ENDIF
    37333671
    3734  CONTAINS
    3735 
     3672  CONTAINS
     3673
     3674   
    37363675    SUBROUTINE pmci_interpolation
    37373676
    37383677!
    37393678!--    A wrapper routine for all interpolation and extrapolation actions
     3679     
    37403680       IMPLICIT NONE
    3741 
     3681     
    37423682!
    37433683!--    In case of vertical nesting no interpolation is needed for the
    … …  
    37463686       
    37473687!
    3748 !--    Left border pe:
     3688!--       Left border pe:
    37493689          IF ( nest_bound_l )  THEN
    37503690             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    … …  
    38553795
    38563796          ENDIF
    3857 
    3858    !
    3859    !--    Right border pe
     3797!
     3798!--       Right border pe
    38603799          IF ( nest_bound_r )  THEN
    38613800             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    … …  
    39693908
    39703909          ENDIF
    3971 
    3972    !
    3973    !--    South border pe
     3910!
     3911!--       South border pe
    39743912          IF ( nest_bound_s )  THEN
    39753913             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    … …  
    40774015
    40784016          ENDIF
    4079 
    4080    !
    4081    !--    North border pe
     4017!
     4018!--       North border pe
    40824019          IF ( nest_bound_n )  THEN
    40834020             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    … …  
    41894126
    41904127       ENDIF       ! IF ( nesting_mode /= 'vertical' )
    4191 
    41924128!
    41934129!--    All PEs are top-border PEs
    … …  
    44134349     
    44144350      DO  j = nys, nyn+1
    4415          DO  k = nzb, nzt+1
     4351!
     4352!--      Determine vertical index of topography top at grid point (j,i)
     4353         k_wall = get_topography_top_index( j, i, TRIM( var ) )
     4354
     4355         DO  k = k_wall, nzt+1
    44164356            l = ic(i)
    44174357            m = jc(j)
    … …  
    44264366         ENDDO
    44274367      ENDDO
    4428 
    44294368!
    44304369!--   Generalized log-law-correction algorithm.
    … …  
    44504389         ENDDO
    44514390      ENDIF
    4452 
    44534391!
    44544392!--   In case of non-flat topography, also vertical walls and corners need to be
    … …  
    45134451
    45144452      ENDIF  ! ( topography /= 'flat' )
    4515 
    45164453!
    45174454!--   Rescale if f is the TKE.
    … …  
    45394476         ENDIF
    45404477      ENDIF
    4541 
    45424478!
    45434479!--   Store the boundary values also into the other redundant ghost node layers
    … …  
    46344570      ENDIF
    46354571
    4636 
    46374572      DO  i = nxl, nxr+1
    46384573!
    … …  
    46534588         ENDDO
    46544589      ENDDO
    4655 
    46564590!
    46574591!--   Generalized log-law-correction algorithm.
    … …  
    46774611         ENDDO
    46784612      ENDIF
    4679 
    46804613!
    46814614!--   In case of non-flat topography, also vertical walls and corners need to be
    … …  
    47414674         
    47424675      ENDIF  ! ( topography /= 'flat' )
    4743 
    47444676!
    47454677!--   Rescale if f is the TKE.
    … …  
    47654697         ENDIF
    47664698      ENDIF
    4767 
    47684699!
    47694700!--   Store the boundary values also into the other redundant ghost node layers
    … …  
    48104741
    48114742      INTEGER(iwp) ::  i   !:
     4743      INTEGER(iwp) ::  ib  !:
     4744      INTEGER(iwp) ::  ie  !:
    48124745      INTEGER(iwp) ::  j   !:
     4746      INTEGER(iwp) ::  jb   !:
     4747      INTEGER(iwp) ::  je   !:     
    48134748      INTEGER(iwp) ::  k   !:
    48144749      INTEGER(iwp) ::  l   !:
    … …  
    48324767         k  = nzt + 1
    48334768      ENDIF
    4834      
    4835       DO  i = nxl-1, nxr+1
    4836          DO  j = nys-1, nyn+1
     4769!
     4770!--   These exceedings by one are needed only to avoid stripes
     4771!--   and spots in visualization. They have no effect on the
     4772!--   actual solution.     
     4773      ib = nxl-1
     4774      ie = nxr+1
     4775      jb = nys-1
     4776      je = nyn+1
     4777!
     4778!--   The exceedings must not be made past the outer edges in
     4779!--   case of pure vertical nesting.
     4780      IF ( nesting_mode == 'vertical' )  THEN
     4781         IF ( nxl == 0  )  ib = nxl
     4782         IF ( nxr == nx )  ie = nxr
     4783         IF ( nys == 0  )  jb = nys
     4784         IF ( nyn == ny )  je = nyn
     4785      ENDIF
     4786         
     4787      DO  i = ib, ie
     4788         DO  j = jb, je
    48374789            l = ic(i)
    48384790            m = jc(j)
    4839             n = kc(k)             
     4791            n = kc(k)           
    48404792            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
    48414793            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
    … …  
    48474799         ENDDO
    48484800      ENDDO
    4849 
    48504801!
    48514802!--   Just fill up the second ghost-node layer for w.
    … …  
    48534804         f(nzt+1,:,:) = f(nzt,:,:)
    48544805      ENDIF
    4855 
    48564806!
    48574807!--   Rescale if f is the TKE.
    … …  
    48964846
    48974847       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
    4898 
    48994848!
    49004849!--    Check which edge is to be handled: left or right
    … …  
    49174866       ENDIF
    49184867
    4919 
    49204868       DO  j = nys, nyn+1
    49214869!
    … …  
    49354883          ENDIF
    49364884       ENDDO
    4937 
    49384885!
    49394886!--    Store the boundary values also into the redundant ghost node layers.
    … …  
    49984945       ENDIF
    49994946
    5000 
    50014947       DO  i = nxl, nxr+1
    50024948!
    … …  
    50164962          ENDIF
    50174963       ENDDO
    5018 
    50194964!
    50204965!--    Store the boundary values also into the redundant ghost node layers.
    … …  
    50725017          ENDDO
    50735018       ENDDO
    5074 
    50755019!
    50765020!--    Just fill up the second ghost-node layer for w
    … …  
    51265070       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc  !< Treated variable - parent domain
    51275071 
    5128 
    51295072!
    51305073!--    Initialize the index bounds for anterpolation
    … …  
    51795122             jcnm = jcn - nhln - 1
    51805123          ENDIF
    5181        ENDIF
    5182        
     5124       ENDIF     
    51835125!
    51845126!--    Note that ii, jj, and kk are coarse-grid indices and i,j, and k
    … …  
    52115153          ENDDO
    52125154       ENDDO
    5213 
    52145155
    52155156    END SUBROUTINE pmci_anterp_tophat
    … …  
    52985239       ENDIF
    52995240    ENDIF
    5300 
    53015241!
    53025242!-- Set Neumann boundary conditions for humidity and cloud-physical quantities
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |