Changeset 3798 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 15, 2019 3:06:49 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r3794 r3798 25 25 ! ----------------- 26 26 ! $Id$ 27 ! A bug fixed in lateral boundary interpolations. Dimension of val changed from 28 ! 5 to 3 in pmci_setup_parent and pmci_setup_child. 29 ! 30 ! 3794 2019-03-15 09:36:33Z raasch 27 31 ! two remaining unused variables removed 28 32 ! … … 788 792 CHARACTER(LEN=32) :: myname 789 793 790 INTEGER(iwp) :: child_id !< 791 INTEGER(iwp) :: ierr !< 792 INTEGER(iwp) :: k !< 793 INTEGER(iwp) :: m !< 794 INTEGER(iwp) :: mid !< 795 INTEGER(iwp) :: mm !< 796 INTEGER(iwp) :: n = 1 !< running index for chemical species 797 INTEGER(iwp) :: nest_overlap !< 798 INTEGER(iwp) :: nomatch !< 799 INTEGER(iwp) :: nx_cl !< 800 INTEGER(iwp) :: ny_cl !< 801 INTEGER(iwp) :: nz_cl !< 802 803 INTEGER(iwp), DIMENSION(5) :: val !< 804 805 794 INTEGER(iwp) :: child_id !< 795 INTEGER(iwp) :: ierr !< 796 INTEGER(iwp) :: k !< 797 INTEGER(iwp) :: m !< 798 INTEGER(iwp) :: mid !< 799 INTEGER(iwp) :: mm !< 800 INTEGER(iwp) :: n = 1 !< Running index for chemical species 801 INTEGER(iwp) :: nest_overlap !< 802 INTEGER(iwp) :: nomatch !< 803 INTEGER(iwp) :: nx_cl !< 804 INTEGER(iwp) :: ny_cl !< 805 INTEGER(iwp) :: nz_cl !< 806 INTEGER(iwp), DIMENSION(3) :: val !< Array for receiving the child-grid dimensions 806 807 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xl !< 807 808 REAL(wp), DIMENSION(:), ALLOCATABLE :: ch_xr !< … … 818 819 REAL(wp) :: xez !< 819 820 REAL(wp) :: yez !< 820 REAL(wp), DIMENSION(5) :: fval !< 821 REAL(wp), DIMENSION(5) :: fval !< Array for receiving the child-grid spacings etc 821 822 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_x !< 822 823 REAL(wp), DIMENSION(:), ALLOCATABLE :: cl_coord_y !< … … 1190 1191 INTEGER(iwp) :: jcsw !< South index limit for children's parent-grid work arrays 1191 1192 INTEGER(iwp) :: n !< Running index for number of chemical species 1192 INTEGER(iwp), DIMENSION( 5) :: val !<1193 INTEGER(iwp), DIMENSION(3) :: val !< Array for sending the child-grid dimensions to parent 1193 1194 REAL(wp) :: xcs !< 1194 1195 REAL(wp) :: xce !< … … 1196 1197 REAL(wp) :: yce !< 1197 1198 1198 REAL(wp), DIMENSION(5) :: fval !<1199 REAL(wp), DIMENSION(5) :: fval !< Array for sending the child-grid spacings etc to parent 1199 1200 1200 1201 ! … … 1276 1277 val(2) = ny 1277 1278 val(3) = nz 1278 val(4) = dx1279 val(5) = dy1280 1279 fval(1) = zw(nzt+1) 1281 1280 fval(2) = zw(nzt) … … 3536 3535 !-- Use averages of the neighbouring matching grid-line values 3537 3536 DO j = jfl(m), jfl(m+1) 3538 ! f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw) &3539 ! + workarrc_lr(n,m+1,lw) )3540 3537 f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( f_interp_1 + f_interp_2 ) 3541 3538 ENDDO … … 3543 3540 !-- Then set the values along the matching grid-lines 3544 3541 IF ( MOD( jfl(m), jgsr ) == 0 ) THEN 3545 ! f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)3546 3542 f(kfl(n):kfu(n),jfl(m),ibc) = f_interp_1 3547 3543 ENDIF … … 3551 3547 !-- Finally, set the values along the last matching grid-line 3552 3548 IF ( MOD( jfl(jcnw), jgsr ) == 0 ) THEN 3553 f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)3554 3549 DO n = 0, kct 3555 ! f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)3550 f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp) 3556 3551 f(kfl(n):kfu(n),jfl(jcnw),ibc) = f_interp_1 3557 3552 ENDDO … … 3579 3574 ! 3580 3575 !-- First substitute only the matching-node values 3581 ! f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)3582 3576 f(kfu(n),jfl(m):jfu(m),ibc) = f_interp_1 3583 3577 … … 3606 3600 DO j = jfl(m), jfu(m) 3607 3601 DO k = kfl(n), kfu(n) 3608 ! f(k,j,ibc) = workarrc_lr(n,m,lw)3609 3602 f(k,j,ibc) = f_interp_1 3610 3603 ENDDO … … 3771 3764 !-- Use averages of the neighbouring matching grid-line values 3772 3765 DO i = ifl(l), ifl(l+1) 3773 ! f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l) &3774 ! + workarrc_sn(n,mw,l+1) )3775 3766 f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( f_interp_1 + f_interp_2 ) 3776 3767 ENDDO … … 3778 3769 !-- Then set the values along the matching grid-lines 3779 3770 IF ( MOD( ifl(l), igsr ) == 0 ) THEN 3780 ! f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)3781 3771 f(kfl(n):kfu(n),jbc,ifl(l)) = f_interp_1 3782 3772 ENDIF … … 3787 3777 !-- Finally, set the values along the last matching grid-line 3788 3778 IF ( MOD( ifl(icrw), igsr ) == 0 ) THEN 3789 f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)3790 3779 DO n = 0, kct 3791 ! f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)3780 f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw) 3792 3781 f(kfl(n):kfu(n),jbc,ifl(icrw)) = f_interp_1 3793 3782 ENDDO … … 3815 3804 ! 3816 3805 !-- First substitute only the matching-node values 3817 ! f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)3818 3806 f(kfu(n),jbc,ifl(l):ifu(l)) = f_interp_1 3819 3807 … … 3842 3830 DO i = ifl(l), ifu(l) 3843 3831 DO k = kfl(n), kfu(n) 3844 ! f(k,jbc,i) = workarrc_sn(n,mw,l)3845 3832 f(k,jbc,i) = f_interp_1 3846 3833 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
