Changeset 9806 for NEMO/trunk/src/NST/agrif_top_interp.F90
- Timestamp:
- 2018-06-15T17:57:53+02:00 (6 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/NST/agrif_top_interp.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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.
