Changeset 2177 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 13, 2017 11:11:15 AM (8 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2175 r2177 363 363 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_v !: 364 364 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: ijfc_s !: 365 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_w !: 366 INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) :: kfc_s !: 365 367 366 368 INTEGER(iwp), DIMENSION(3) :: define_coarse_grid_int !: … … 2021 2023 SUBROUTINE pmci_find_logc_pivot_k( lc, logzc1, z0_l, kb ) 2022 2024 ! 2023 !-- Finds the pivot node and t e log-law factor for near-wall nodes for2025 !-- Finds the pivot node and the log-law factor for near-wall nodes for 2024 2026 !-- which the wall-parallel velocity components will be log-law corrected 2025 2027 !-- after interpolation. This subroutine is only for horizontal walls. … … 2212 2214 ALLOCATE( ijfc_v(jcs:jcn,icl:icr) ) 2213 2215 ALLOCATE( ijfc_s(jcs:jcn,icl:icr) ) 2214 2216 ALLOCATE( kfc_w(0:kctw) ) 2217 ALLOCATE( kfc_s(0:kctu) ) 2215 2218 ! 2216 2219 !-- i-indices of u for each ii-index value … … 2345 2348 ENDDO 2346 2349 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 2348 2356 ! 2349 2357 !-- Spatial under-relaxation coefficients … … 3951 3959 3952 3960 CALL pmci_anterp_tophat( u, uc, kctu, iflu, ifuu, jflo, jfuo, kflo, & 3953 kfuo, ijfc_u, 'u' )3961 kfuo, ijfc_u, kfc_s, 'u' ) 3954 3962 CALL pmci_anterp_tophat( v, vc, kctu, iflo, ifuo, jflv, jfuv, kflo, & 3955 kfuo, ijfc_v, 'v' )3963 kfuo, ijfc_v, kfc_s, 'v' ) 3956 3964 CALL pmci_anterp_tophat( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, & 3957 kfuw, ijfc_s, 'w' )3965 kfuw, ijfc_s, kfc_w, 'w' ) 3958 3966 3959 3967 IF ( .NOT. neutral ) THEN 3960 3968 CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3961 kfuo, ijfc_s, 's' )3969 kfuo, ijfc_s, kfc_s, 's' ) 3962 3970 ENDIF 3963 3971 … … 3965 3973 3966 3974 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' ) 3968 3976 3969 3977 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3970 3978 3971 3979 ! 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' ) 3973 3981 3974 3982 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' ) 3976 3984 3977 3985 ! 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' ) 3979 3987 3980 3988 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' ) 3982 3990 3983 3991 ENDIF … … 3987 3995 IF ( passive_scalar ) THEN 3988 3996 CALL pmci_anterp_tophat( s, sc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3989 kfuo, ijfc_s, 's' )3997 kfuo, ijfc_s, kfc_s, 's' ) 3990 3998 ENDIF 3991 3999 … … 4691 4699 4692 4700 SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, & 4693 ijfc, var )4701 ijfc, kfc, var ) 4694 4702 ! 4695 4703 !-- Anterpolation of internal-node values to be used as the parent-domain … … 4710 4718 INTEGER(iwp) :: jcnm !: 4711 4719 INTEGER(iwp) :: jcsp !: 4712 INTEGER(iwp) :: k !: Fine-grid index 4720 INTEGER(iwp) :: k !: Fine-grid index 4713 4721 INTEGER(iwp) :: kk !: Coarse-grid index 4714 4722 INTEGER(iwp) :: kcb = 0 !: … … 4717 4725 INTEGER(iwp), INTENT(IN) :: kct !: 4718 4726 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) :: jf u!:4723 INTEGER(iwp), DIMENSION( 0:kct), INTENT(IN) :: kfl!:4724 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kf u!: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 !: 4727 4735 4728 4736 REAL(wp) :: cellsum !: … … 4740 4748 jcsp = jcs 4741 4749 jcnm = jcn 4742 4750 kcb = 0 4743 4751 ! 4744 4752 !-- Define the index bounds iclp, icrm, jcsp and jcnm. … … 4792 4800 DO kk = kcb, kct 4793 4801 ! 4794 !-- ijfc isprecomputed in pmci_init_anterp_tophat4795 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) 4796 4804 cellsum = 0.0_wp 4797 4805 DO i = ifl(ii), ifu(ii) … … 4805 4813 !-- Spatial under-relaxation. 4806 4814 fra = frax(ii) * fray(jj) * fraz(kk) 4807 !4808 !-- Block out the fine-grid corner patches from the anterpolation4809 ! IF ( ( ifl(ii) < nxl ) .OR. ( ifu(ii) > nxr ) ) THEN4810 ! IF ( ( jfl(jj) < nys ) .OR. ( jfu(jj) > nyn ) ) THEN4811 ! fra = 0.0_wp4812 ! ENDIF4813 ! ENDIF4814 4815 4815 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) + & 4816 4816 fra * cellsum / REAL( nfc, KIND = wp )
Note: See TracChangeset
for help on using the changeset viewer.
