Changeset 9806
- Timestamp:
- 2018-06-15T17:57:53+02:00 (5 years ago)
- Location:
- NEMO/trunk/src/NST
- Files:
-
- 3 edited
-
agrif_oce_interp.F90 (modified) (10 diffs)
-
agrif_oce_sponge.F90 (modified) (8 diffs)
-
agrif_top_interp.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/NST/agrif_oce_interp.F90
r9759 r9806 94 94 ! 95 95 ! prevent smoothing in ghost cells 96 i1 = 1 ; i2 = jpi97 j1 = 1 ; j2 = jpj96 i1 = 1 ; i2 = nlci 97 j1 = 1 ; j2 = nlcj 98 98 IF( nbondj == -1 .OR. nbondj == 2 ) j1 = 2 + nbghostcells 99 99 IF( nbondj == +1 .OR. nbondj == 2 ) j2 = nlcj - nbghostcells - 1 … … 645 645 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 646 646 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 647 REAL(wp) :: zrho x, z1, z2, z3, z4, z5, z6, z7647 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 648 648 LOGICAL :: western_side, eastern_side,northern_side,southern_side 649 649 ! vertical interpolation: … … 718 718 IF ( .NOT.lk_agrif_clp ) THEN 719 719 ! 720 zrhox = Agrif_Rhox()721 z1 = ( zrhox - 1. ) * 0.5722 z3 = ( zrhox - 1. ) / ( zrhox + 1. )723 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )724 z7 = - ( zrhox - 1. ) / ( zrhox + 3. )725 !726 z2 = 1. - z1727 z4 = 1. - z3728 z5 = 1. - z6 - z7729 !730 720 imin = i1 ; imax = i2 731 721 jmin = j1 ; jmax = j2 … … 734 724 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 735 725 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 736 IF((nbondi == -1).OR.(nbondi == 2)) imin = 1+ nbghostcells726 IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 737 727 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1 738 728 ! 739 729 IF( eastern_side ) THEN 730 zrho = Agrif_Rhox() 731 z1 = ( zrho - 1._wp ) * 0.5_wp 732 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 733 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 734 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 735 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 736 ! 740 737 ibdy = nlci-nbghostcells 741 738 DO jn = 1, jpts 742 tsa(ibdy+1,jmin:jmax, k1:k2,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn)739 tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 743 740 DO jk = 1, jpkm1 744 741 DO jj = jmin,jmax … … 755 752 END DO 756 753 ! Restore ghost points: 757 tsa(ibdy+1,jmin:jmax, k1:k2,jn) = ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) * tmask(ibdy+1,jmin:jmax,k1:k2)754 tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 758 755 END DO 759 756 ENDIF 760 757 ! 761 758 IF( northern_side ) THEN 759 zrho = Agrif_Rhoy() 760 z1 = ( zrho - 1._wp ) * 0.5_wp 761 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 762 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 763 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 764 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 765 ! 762 766 jbdy = nlcj-nbghostcells 763 767 DO jn = 1, jpts 764 tsa(imin:imax,jbdy+1, k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy+1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn)768 tsa(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 765 769 DO jk = 1, jpkm1 766 770 DO ji = imin,imax … … 777 781 END DO 778 782 ! Restore ghost points: 779 tsa(imin:imax,jbdy+1, k1:k2,jn) = ptab_child(imin:imax,jbdy+1,k1:k2,jn) * tmask(imin:imax,jbdy+1,k1:k2)783 tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 780 784 END DO 781 785 ENDIF 782 786 ! 783 IF( western_side ) THEN 787 IF( western_side ) THEN 788 zrho = Agrif_Rhox() 789 z1 = ( zrho - 1._wp ) * 0.5_wp 790 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 791 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 792 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 793 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 794 ! 784 795 ibdy = 1+nbghostcells 785 796 DO jn = 1, jpts 786 tsa(ibdy-1,jmin:jmax, k1:k2,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn)797 tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 787 798 DO jk = 1, jpkm1 788 799 DO jj = jmin,jmax … … 792 803 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk) 793 804 IF( un(ibdy,jj,jk) < 0._wp ) THEN 794 tsa(ibdy,jj,jk,jn)=(z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn)+z7*tsa(ibdy+2,jj,jk,jn))*tmask(ibdy,jj,jk) 805 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) & 806 + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 795 807 ENDIF 796 808 ENDIF … … 798 810 END DO 799 811 ! Restore ghost points: 800 tsa(ibdy-1,jmin:jmax, k1:k2,jn) = ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) * tmask(ibdy-1,jmin:jmax,k1:k2)812 tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 801 813 END DO 802 814 ENDIF 803 815 ! 804 IF( southern_side ) THEN 816 IF( southern_side ) THEN 817 zrho = Agrif_Rhoy() 818 z1 = ( zrho - 1._wp ) * 0.5_wp 819 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 820 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 821 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 822 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 823 ! 805 824 jbdy=1+nbghostcells 806 825 DO jn = 1, jpts 807 tsa(imin:imax,jbdy-1, k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy-1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn)808 DO jk = 1, jpk 809 DO ji =imin,imax826 tsa(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 827 DO jk = 1, jpkm1 828 DO ji = imin,imax 810 829 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 811 830 tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) … … 813 832 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 814 833 IF( vn(ji,jbdy,jk) < 0._wp ) THEN 815 tsa(ji,jbdy,jk,jn)=(z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn)+z7*tsa(ji,jbdy+2,jk,jn))*tmask(ji,jbdy,jk) 834 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) & 835 + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 816 836 ENDIF 817 837 ENDIF … … 819 839 END DO 820 840 ! Restore ghost points: 821 tsa(imin:imax,jbdy-1, k1:k2,jn) = tsa(imin:imax,jbdy-1,k1:k2,jn) * tmask(imin:imax,jbdy-1,k1:k2)841 tsa(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 822 842 END DO 823 843 ENDIF -
NEMO/trunk/src/NST/agrif_oce_sponge.F90
r9786 r9806 103 103 ! Store it in ztabramp 104 104 105 ispongearea = 2+ nn_sponge_len * Agrif_irhox()106 z1_spongearea = 1._wp / REAL( ispongearea - 1)105 ispongearea = 1 + nn_sponge_len * Agrif_irhox() 106 z1_spongearea = 1._wp / REAL( ispongearea ) 107 107 108 108 ztabramp(:,:) = 0._wp … … 111 111 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 112 112 ind1 = 1+nbghostcells 113 ind2 = 1+nbghostcells + (ispongearea-1)113 ind2 = 1+nbghostcells + ispongearea 114 114 DO jj = 1, jpj 115 DO ji = ind1, ind2 115 DO ji = ind1, ind2 116 116 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 117 117 END DO … … 121 121 ! --- East --- ! 122 122 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 123 ind1 = nlci - (1+nbghostcells) - (ispongearea-1)124 ind2 = nlci - (1+nbghostcells)123 ind1 = nlci - nbghostcells - ispongearea 124 ind2 = nlci - nbghostcells 125 125 DO jj = 1, jpj 126 126 DO ji = ind1, ind2 … … 133 133 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 134 134 ind1 = 1+nbghostcells 135 ind2 = 1+nbghostcells + (ispongearea-1)136 DO jj = ind1, ind2 135 ind2 = 1+nbghostcells + ispongearea 136 DO jj = ind1, ind2 137 137 DO ji = 1, jpi 138 138 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) … … 143 143 ! --- North --- ! 144 144 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 145 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1)146 ind2 = nlcj - (1+nbghostcells)145 ind1 = nlcj - nbghostcells - ispongearea 146 ind2 = nlcj - nbghostcells 147 147 DO jj = ind1, ind2 148 148 DO ji = 1, jpi … … 177 177 DO ji = 2, jpim1 ! vector opt. 178 178 fsahm_spt(ji,jj) = visc_dyn * ztabramp(ji,jj) 179 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji ,jj) + ztabramp(ji ,jj+1) &180 & +ztabramp(ji ,jj) + ztabramp(ji+1,jj ) )179 fsahm_spf(ji,jj) = 0.25_wp * visc_dyn * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & 180 & +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) ) 181 181 END DO 182 182 END DO … … 278 278 DO jn = 1, jpts 279 279 DO jk = 1, jpkm1 280 DO jj = j1,j2-1 280 ztu(i1:i2,j1:j2,jk) = 0._wp 281 DO jj = j1,j2 281 282 DO ji = i1,i2-1 282 283 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 284 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 285 END DO 286 END DO 287 ztv(i1:i2,j1:j2,jk) = 0._wp 288 DO ji = i1,i2 289 DO jj = j1,j2-1 283 290 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 284 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) )285 291 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 286 292 END DO … … 288 294 ! 289 295 IF( ln_zps ) THEN ! set gradient at partial step level 290 DO jj = j1,j2 -1291 DO ji = i1,i2 -1296 DO jj = j1,j2 297 DO ji = i1,i2 292 298 ! last level 293 299 iku = mbku(ji,jj) -
NEMO/trunk/src/NST/agrif_top_interp.F90
r9788 r9806 59 59 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 60 60 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 61 REAL(wp) :: zrho x, z1, z2, z3, z4, z5, z6, z761 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 62 62 LOGICAL :: western_side, eastern_side,northern_side,southern_side 63 63 ! vertical interpolation: … … 132 132 IF ( .NOT.lk_agrif_clp ) THEN 133 133 ! 134 zrhox = Agrif_Rhox()135 z1 = ( zrhox - 1. ) * 0.5136 z3 = ( zrhox - 1. ) / ( zrhox + 1. )137 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )138 z7 = - ( zrhox - 1. ) / ( zrhox + 3. )139 !140 z2 = 1. - z1141 z4 = 1. - z3142 z5 = 1. - z6 - z7143 !144 134 imin = i1 ; imax = i2 145 135 jmin = j1 ; jmax = j2 … … 148 138 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 149 139 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 150 IF((nbondi == -1).OR.(nbondi == 2)) imin = 1+ nbghostcells140 IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 151 141 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1 152 142 ! 153 143 IF( eastern_side ) THEN 144 zrho = Agrif_Rhox() 145 z1 = ( zrho - 1._wp ) * 0.5_wp 146 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 147 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 148 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 149 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 150 ! 154 151 ibdy = nlci-nbghostcells 155 152 DO jn = 1, jptra 156 tra(ibdy+1,jmin:jmax, k1:k2,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn)153 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 157 154 DO jk = 1, jpkm1 158 155 DO jj = jmin,jmax … … 169 166 END DO 170 167 ! Restore ghost points: 171 tra(ibdy+1,jmin:jmax, k1:k2,jn) = ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) * tmask(ibdy+1,jmin:jmax,k1:k2)168 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 172 169 END DO 173 170 ENDIF 174 171 ! 175 172 IF( northern_side ) THEN 173 zrho = Agrif_Rhoy() 174 z1 = ( zrho - 1._wp ) * 0.5_wp 175 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 176 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 177 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 178 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 179 ! 176 180 jbdy = nlcj-nbghostcells 177 181 DO jn = 1, jptra 178 tra(imin:imax,jbdy+1, k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy+1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn)182 tra(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 179 183 DO jk = 1, jpkm1 180 184 DO ji = imin,imax … … 191 195 END DO 192 196 ! Restore ghost points: 193 tra(imin:imax,jbdy+1,k1:k2,jn) = ptab_child(imin:imax,jbdy+1,k1:k2,jn) * tmask(imin:imax,jbdy+1,k1:k2) 194 END DO 195 ENDIF 196 ! 197 IF( western_side ) THEN 197 tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 198 END DO 199 ENDIF 200 ! 201 IF( western_side ) THEN 202 zrho = Agrif_Rhox() 203 z1 = ( zrho - 1._wp ) * 0.5_wp 204 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 205 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 206 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 207 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 208 ! 198 209 ibdy = 1+nbghostcells 199 210 DO jn = 1, jptra 200 tra(ibdy-1,jmin:jmax, k1:k2,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn)211 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 201 212 DO jk = 1, jpkm1 202 213 DO jj = jmin,jmax … … 206 217 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk) 207 218 IF( un(ibdy,jj,jk) < 0._wp ) THEN 208 tra(ibdy,jj,jk,jn)=(z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn)+z7*tra(ibdy+2,jj,jk,jn))*tmask(ibdy,jj,jk) 209 ENDIF 210 ENDIF 211 END DO 212 END DO 213 ! Restore ghost points: 214 tra(ibdy-1,jmin:jmax,k1:k2,jn) = ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) * tmask(ibdy-1,jmin:jmax,k1:k2) 215 END DO 216 ENDIF 217 ! 218 IF( southern_side ) THEN 219 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) & 220 + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 221 ENDIF 222 ENDIF 223 END DO 224 END DO 225 ! Restore ghost points: 226 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 227 END DO 228 ENDIF 229 ! 230 IF( southern_side ) THEN 231 zrho = Agrif_Rhoy() 232 z1 = ( zrho - 1._wp ) * 0.5_wp 233 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp ) 234 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 235 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp ) 236 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 237 ! 219 238 jbdy=1+nbghostcells 220 239 DO jn = 1, jptra 221 tra(imin:imax,jbdy-1, k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy-1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn)222 DO jk = 1, jpk 223 DO ji =imin,imax240 tra(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 241 DO jk = 1, jpkm1 242 DO ji = imin,imax 224 243 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 225 244 tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) … … 227 246 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 228 247 IF( vn(ji,jbdy,jk) < 0._wp ) THEN 229 tra(ji,jbdy,jk,jn)=(z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn)+z7*tra(ji,jbdy+2,jk,jn))*tmask(ji,jbdy,jk) 230 ENDIF 231 ENDIF 232 END DO 233 END DO 234 ! Restore ghost points: 235 tra(imin:imax,jbdy-1,k1:k2,jn) = tra(imin:imax,jbdy-1,k1:k2,jn) * tmask(imin:imax,jbdy-1,k1:k2) 248 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) & 249 + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 250 ENDIF 251 ENDIF 252 END DO 253 END DO 254 ! Restore ghost points: 255 tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 236 256 END DO 237 257 ENDIF 238 258 ! 239 259 ENDIF 260 240 261 ENDIF 241 262 !
Note: See TracChangeset
for help on using the changeset viewer.
