Changeset 3697 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Jan 24, 2019 5:16:13 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r3681 r3697 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Bugfix: upper k-bound in the child initialization interpolation 28 ! pmci_interp_1sto_all corrected. 29 ! Copying of the nest boundary values into the redundant 2nd and 3rd ghost-node 30 ! layers is added to the pmci_interp_1sto_*-routines. 31 ! 32 ! 3681 2019-01-18 15:06:05Z hellstea 27 33 ! Linear interpolations are replaced by first order interpolations. The linear 28 34 ! interpolation routines are still included but not called. In the child … … 3970 3976 IF ( air_chemistry .AND. nest_chemistry ) & 3971 3977 pmc_max_array = pmc_max_array + nspec 3972 3973 3974 3978 #endif 3975 3979 END SUBROUTINE pmci_num_arrays … … 4534 4538 DO l = lb, le 4535 4539 DO m = mb, me 4536 DO n = 0, kct 4540 DO n = 0, kct + 1 4537 4541 4538 4542 DO i = ifl(l), ifl(l+1)-1 4539 4543 DO j = jfl(m), jfu(m) 4540 DO k = kfl(n), kfu(n)4544 DO k = kfl(n), MIN( kfu(n), nzt+1 ) 4541 4545 f(k,j,i) = fc(n,m,l) 4542 4546 ENDDO … … 4552 4556 DO l = lb, le 4553 4557 DO m = mb, me 4554 DO n = 0, kct 4558 DO n = 0, kct + 1 4555 4559 4556 4560 DO i = ifl(l), ifu(l) 4557 4561 DO j = jfl(m), jfl(m+1)-1 4558 DO k = kfl(n), kfu(n)4562 DO k = kfl(n), MIN( kfu(n), nzt+1 ) 4559 4563 f(k,j,i) = fc(n,m,l) 4560 4564 ENDDO … … 4570 4574 DO l = lb, le 4571 4575 DO m = mb, me 4572 DO n = 1, kct + 1 ! It is important to go up to kct+14576 DO n = 1, kct + 1 4573 4577 4574 4578 DO i = ifl(l), ifu(l) … … 4589 4593 DO l = lb, le 4590 4594 DO m = mb, me 4591 DO n = 0, kct 4595 DO n = 0, kct + 1 4592 4596 4593 4597 DO i = ifl(l), ifu(l) 4594 4598 DO j = jfl(m), jfu(m) 4595 DO k = kfl(n), kfu(n)4599 DO k = kfl(n), MIN( kfu(n), nzt+1 ) 4596 4600 f(k,j,i) = fc(n,m,l) 4597 4601 ENDDO … … 5738 5742 INTEGER(iwp) :: iaw !< Reduced ia-index for workarr_lr 5739 5743 INTEGER(iwp) :: iawbc !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1) 5744 INTEGER(iwp) :: ib !< Fixed i-index pointing to the node just behind the boundary-value node 5740 5745 INTEGER(iwp) :: ibc !< Fixed i-index pointing to the boundary-value nodes (either i or iend) 5746 INTEGER(iwp) :: ibgp !< Index running over the redundant boundary ghost points in i-direction 5741 5747 !AH INTEGER(iwp) :: ibeg !< i-index pointing to the starting point of workarr_lr in the i-direction 5742 5748 INTEGER(iwp) :: iend !< Upper bound of the running index ia … … 5788 5794 i = nxl 5789 5795 iend = nxl 5790 ibc = nxl 5796 ibc = nxl 5797 ib = ibc - 1 5791 5798 iawbc = 0 5792 5799 l = icl + 2 5793 5800 lw = 2 5794 5801 lbeg = icl 5795 loff = 0 5802 loff = 0 5796 5803 ELSE 5797 5804 i = nxl - igsr 5798 5805 iend = nxl - 1 5799 5806 ibc = nxl - 1 5807 ib = ibc - 1 5800 5808 iawbc = igsr-1 5801 5809 l = icl + 1 … … 5803 5811 lbeg = icl 5804 5812 loff = 0 5805 ENDIF 5813 ENDIF 5806 5814 ELSEIF ( edge == 'r' ) THEN 5807 5815 IF ( var == 'u' ) THEN … … 5809 5817 iend = nxr + 1 5810 5818 ibc = nxr + 1 5819 ib = ibc + 1 5811 5820 iawbc = 0 5812 5821 l = icr - 1 … … 5818 5827 iend = nxr + igsr 5819 5828 ibc = nxr + 1 5829 ib = ibc + 1 5820 5830 iawbc = 0 5821 5831 l = icr - 1 … … 5823 5833 lbeg = icr - 2 5824 5834 loff = 1 5825 ENDIF 5835 ENDIF 5826 5836 ENDIF 5827 5837 … … 5944 5954 5945 5955 ENDIF ! var 5956 ! 5957 !-- Fill up also the redundant 2nd and 3rd ghost-node layers 5958 IF ( edge == 'l' ) THEN 5959 DO ibgp = -nbgp, ib 5960 f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc) 5961 ENDDO 5962 ELSEIF ( edge == 'r' ) THEN 5963 DO ibgp = ib, nx+nbgp 5964 f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc) 5965 ENDDO 5966 ENDIF 5946 5967 5947 5968 END SUBROUTINE pmci_interp_1sto_lr … … 6026 6047 INTEGER(iwp) :: jawbc !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1) 6027 6048 !AH INTEGER(iwp) :: jbeg !< j-index pointing to the starting point of workarr_sn in the j-direction 6049 INTEGER(iwp) :: jb !< Fixed j-index pointing to the node just behind the boundary-value node 6028 6050 INTEGER(iwp) :: jbc !< Fixed j-index pointing to the boundary-value nodes (either j or jend) 6051 INTEGER(iwp) :: jbgp !< Index running over the redundant boundary ghost points in j-direction 6029 6052 INTEGER(iwp) :: jend !< Upper bound of the running index ja 6030 6053 INTEGER(iwp) :: jw !< j-index for wall_flags_0 … … 6069 6092 jawbc = 0 6070 6093 jbc = nys 6094 jb = jbc - 1 6071 6095 m = jcs + 2 6072 6096 mw = 2 … … 6078 6102 jawbc = jgsr - 1 6079 6103 jbc = nys - 1 6104 jb = jbc - 1 6080 6105 m = jcs + 1 6081 6106 mw = 1 … … 6089 6114 jawbc = 0 6090 6115 jbc = nyn + 1 6116 jb = jbc + 1 6091 6117 m = jcn - 1 6092 6118 mw = 1 … … 6098 6124 jawbc = 0 6099 6125 jbc = nyn + 1 6126 jb = jbc + 1 6100 6127 m = jcn - 1 6101 6128 mw = 1 … … 6187 6214 DO k = kfl(n), kfu(n) 6188 6215 f(k,jbc,i) = fc(n,m,l) 6216 !AH 6217 ! write(9,"('sn u: ',6(i3,2x),2(e12.5,2x))") n, m, l, k, jbc, i, fc(n,m,l), f(k,jbc,i) 6218 ! flush(9) 6219 !AH 6189 6220 ENDDO 6190 6221 ENDDO … … 6223 6254 6224 6255 ENDIF ! var 6256 ! 6257 !-- Fill up also the redundant 2nd and 3rd ghost-node layers 6258 IF ( edge == 's' ) THEN 6259 DO jbgp = -nbgp, jb 6260 f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg) 6261 ENDDO 6262 ELSEIF ( edge == 'n' ) THEN 6263 DO jbgp = jb, ny+nbgp 6264 f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg) 6265 ENDDO 6266 ENDIF 6225 6267 6226 6268 END SUBROUTINE pmci_interp_1sto_sn … … 6464 6506 6465 6507 ENDIF ! var 6508 ! 6509 !-- Just fill up the redundant second ghost-node layer in case of var == w. 6510 IF ( var == 'w' ) THEN 6511 f(nzt+1,:,:) = f(nzt,:,:) 6512 ENDIF 6466 6513 6467 6514 END SUBROUTINE pmci_interp_1sto_t … … 7936 7983 ENDIF 7937 7984 IF ( bc_dirichlet_r ) THEN 7938 ! icrant = icr - 57939 7985 icrant = icr - 3 7940 7986 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
