Changeset 2177 for palm/trunk/SOURCE


Ignore:
Timestamp:
Mar 13, 2017 11:11:15 AM (7 years ago)
Author:
hellstea
Message:

Minor changes in nesting

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/init_pegrid.f90

    r2101 r2177  
    254254
    255255!
    256 !--    Determine the processor topology or check it, if prescribed by the user
     256!-- Determine the processor topology or check it, if prescribed by the user
    257257    IF ( npex == -1  .AND.  npey == -1 )  THEN
    258258
    259259!
    260 !--       Automatic determination of the topology
     260!--    Automatic determination of the topology
    261261       numproc_sqr = SQRT( REAL( numprocs, KIND=wp ) )
    262262       pdims(1)    = MAX( numproc_sqr , 1 )
  • palm/trunk/SOURCE/palm.f90

    r2119 r2177  
    162162    USE control_parameters,                                                    &
    163163        ONLY:  constant_diffusion, coupling_char, coupling_mode,               &
    164                do2d_at_begin, do3d_at_begin, humidity, io_blocks, io_group,    &
     164               do2d_at_begin, do3d_at_begin, humidity, initializing_actions,   &
     165               io_blocks, io_group,                                            &
    165166               large_scale_forcing, message_string, nest_domain, neutral,      &
    166167               nudging, passive_scalar, simulated_time, simulated_time_chr,    &
     
    345346!--    Receive and interpolate initial data on children.
    346347!--    Child initialization must be made first if the model is both child and
    347 !--    parent
    348        CALL pmci_child_initialize
    349 !
    350 !--    Send initial condition data from parent to children
    351        CALL pmci_parent_initialize
     348!--    parent if necessary
     349       IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
     350          CALL pmci_child_initialize
     351!
     352!--       Send initial condition data from parent to children
     353          CALL pmci_parent_initialize
     354       END IF
    352355!
    353356!--    Exchange_horiz is needed after the nest initialization
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2175 r2177  
    363363    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_v        !:
    364364    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_s        !:
     365    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_w         !:
     366    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !:
    365367   
    366368    INTEGER(iwp), DIMENSION(3)          ::  define_coarse_grid_int    !:
     
    20212023    SUBROUTINE pmci_find_logc_pivot_k( lc, logzc1, z0_l, kb )
    20222024!
    2023 !--    Finds the pivot node and te log-law factor for near-wall nodes for
     2025!--    Finds the pivot node and the log-law factor for near-wall nodes for
    20242026!--    which the wall-parallel velocity components will be log-law corrected
    20252027!--    after interpolation. This subroutine is only for horizontal walls.
     
    22122214       ALLOCATE( ijfc_v(jcs:jcn,icl:icr) )
    22132215       ALLOCATE( ijfc_s(jcs:jcn,icl:icr) )
    2214 
     2216       ALLOCATE( kfc_w(0:kctw) )
     2217       ALLOCATE( kfc_s(0:kctu) )
    22152218!
    22162219!--    i-indices of u for each ii-index value
     
    23452348          ENDDO
    23462349       ENDDO
    2347    
     2350       DO kk = 0, kctw
     2351          kfc_w(kk) = kfuw(kk) - kflw(kk) + 1
     2352       ENDDO
     2353       DO kk = 0, kctu
     2354          kfc_s(kk) = kfuo(kk) - kflo(kk) + 1
     2355       ENDDO
    23482356!
    23492357!--    Spatial under-relaxation coefficients
     
    39513959
    39523960      CALL pmci_anterp_tophat( u,  uc,  kctu, iflu, ifuu, jflo, jfuo, kflo,    &
    3953                                kfuo, ijfc_u, 'u' )
     3961                               kfuo, ijfc_u, kfc_s, 'u' )
    39543962      CALL pmci_anterp_tophat( v,  vc,  kctu, iflo, ifuo, jflv, jfuv, kflo,    &
    3955                                kfuo, ijfc_v, 'v' )
     3963                               kfuo, ijfc_v, kfc_s, 'v' )
    39563964      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,    &
    3957                                kfuw, ijfc_s, 'w' )
     3965                               kfuw, ijfc_s, kfc_w, 'w' )
    39583966
    39593967      IF ( .NOT. neutral )  THEN
    39603968         CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, &
    3961                                   kfuo, ijfc_s, 's' )
     3969                                  kfuo, ijfc_s, kfc_s, 's' )
    39623970      ENDIF
    39633971
     
    39653973
    39663974         CALL pmci_anterp_tophat( q, q_c, kctu, iflo, ifuo, jflo, jfuo, kflo,  &
    3967                                   kfuo, ijfc_s, 's' )
     3975                                  kfuo, ijfc_s, kfc_s, 's' )
    39683976
    39693977         IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    39703978
    39713979!             CALL pmci_anterp_tophat( qc, qcc, kctu, iflo, ifuo, jflo, jfuo,    &
    3972 !                                      kflo, kfuo, ijfc_s, 's' )
     3980!                                      kflo, kfuo, ijfc_s, kfc_s, 's' )
    39733981
    39743982            CALL pmci_anterp_tophat( qr, qrc, kctu, iflo, ifuo, jflo, jfuo,    &
    3975                                      kflo, kfuo, ijfc_s, 's' )
     3983                                     kflo, kfuo, ijfc_s, kfc_s, 's' )
    39763984
    39773985!             CALL pmci_anterp_tophat( nc, ncc, kctu, iflo, ifuo, jflo, jfuo,    &
    3978 !                                      kflo, kfuo, ijfc_s, 's' )
     3986!                                      kflo, kfuo, ijfc_s, kfc_s,  's' )
    39793987
    39803988            CALL pmci_anterp_tophat( nr, nrc, kctu, iflo, ifuo, jflo, jfuo,    &
    3981                                      kflo, kfuo, ijfc_s, 's' )
     3989                                     kflo, kfuo, ijfc_s, kfc_s, 's' )
    39823990
    39833991         ENDIF
     
    39873995      IF ( passive_scalar )  THEN
    39883996         CALL pmci_anterp_tophat( s, sc, kctu, iflo, ifuo, jflo, jfuo, kflo,   &
    3989                                   kfuo, ijfc_s, 's' )
     3997                                  kfuo, ijfc_s, kfc_s, 's' )
    39903998      ENDIF
    39913999
     
    46914699
    46924700    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,    &
    4693                                    ijfc, var )
     4701                                   ijfc, kfc, var )
    46944702!
    46954703!--    Anterpolation of internal-node values to be used as the parent-domain
     
    47104718       INTEGER(iwp) ::  jcnm      !:
    47114719       INTEGER(iwp) ::  jcsp      !:
    4712        INTEGER(iwp) ::  k         !: Fine-grid index
     4720       INTEGER(iwp) ::  k         !: Fine-grid index       
    47134721       INTEGER(iwp) ::  kk        !: Coarse-grid index
    47144722       INTEGER(iwp) ::  kcb = 0   !:
     
    47174725       INTEGER(iwp), INTENT(IN) ::  kct   !:
    47184726
    4719        INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl   !:
    4720        INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu   !:
    4721        INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl  !:
    4722        INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu   !:
    4723        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl   !:
    4724        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu   !:
    4725 
    4726        INTEGER(iwp), DIMENSION(jcs:jcn,icl:icr), INTENT(IN) ::  ijfc !:
     4727       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl         !:
     4728       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu         !:
     4729       INTEGER(iwp), DIMENSION(jcs:jcn,icl:icr), INTENT(IN) :: ijfc !:
     4730       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl         !:
     4731       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu         !:
     4732       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfc         !:
     4733       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl         !:
     4734       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu        !:
    47274735
    47284736       REAL(wp) ::  cellsum   !:
     
    47404748       jcsp = jcs
    47414749       jcnm = jcn
    4742 
     4750       kcb  = 0
    47434751!
    47444752!--    Define the index bounds iclp, icrm, jcsp and jcnm.
     
    47924800             DO  kk = kcb, kct
    47934801!
    4794 !--             ijfc is precomputed in pmci_init_anterp_tophat
    4795                 nfc =  ijfc(jj,ii) * ( kfu(kk) - kfl(kk) + 1 )
     4802!--             ijfc and kfc are precomputed in pmci_init_anterp_tophat
     4803                nfc =  ijfc(jj,ii) * kfc(kk)
    47964804                cellsum = 0.0_wp
    47974805                DO  i = ifl(ii), ifu(ii)
     
    48054813!--             Spatial under-relaxation.
    48064814                fra  = frax(ii) * fray(jj) * fraz(kk)
    4807 !
    4808 !--             Block out the fine-grid corner patches from the anterpolation
    4809 !                 IF ( ( ifl(ii) < nxl ) .OR. ( ifu(ii) > nxr ) )  THEN
    4810 !                    IF ( ( jfl(jj) < nys ) .OR. ( jfu(jj) > nyn ) )  THEN
    4811 !                       fra = 0.0_wp
    4812 !                    ENDIF
    4813 !                 ENDIF
    4814 
    48154815                fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +                &
    48164816                               fra * cellsum / REAL( nfc, KIND = wp )
Note: See TracChangeset for help on using the changeset viewer.