Changeset 8129 for branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2017-06-02T16:08:12+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r8129 35 35 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 36 36 PUBLIC interpun, interpvn 37 PUBLIC interptsn, 37 PUBLIC interptsn, interpsshn 38 38 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 39 39 PUBLIC interpe3t, interpumsk, interpvmsk … … 100 100 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2 101 101 102 ! --- West --- ! 102 103 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 103 104 ! 104 ! Smoothing105 ! ---------106 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 107 ua_b( 2,:) = 0._wp106 ua_b(1:1+nbghostcells,:) = 0._wp 108 107 DO jk = 1, jpkm1 109 108 DO jj = 1, jpj 110 ua_b( 2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)109 ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) + e3u_a(1:1+nbghostcells,jj,jk) * ua(1:1+nbghostcells,jj,jk) 111 110 END DO 112 111 END DO 113 112 DO jj = 1, jpj 114 ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj) 115 END DO 116 ENDIF 117 ! 118 DO jk=1,jpkm1 ! Smooth 119 DO jj=j1,j2 120 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 121 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 122 END DO 123 END DO 124 ! 125 zub(2,:) = 0._wp ! Correct transport 126 DO jk = 1, jpkm1 127 DO jj = 1, jpj 128 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 129 END DO 130 END DO 131 DO jj=1,jpj 132 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 133 END DO 134 135 DO jk=1,jpkm1 136 DO jj=1,jpj 137 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 138 END DO 139 END DO 140 141 ! Set tangential velocities to time splitting estimate 142 !----------------------------------------------------- 143 IF( ln_dynspg_ts ) THEN 144 zvb(2,:) = 0._wp 113 ua_b(1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) * r1_hu_a(1:1+nbghostcells,jj) 114 END DO 115 ENDIF 116 ! 117 ! Smoothing if only 1 ghostcell 118 ! ----------------------------- 119 IF( nbghostcells == 1 ) THEN 120 DO jk=1,jpkm1 ! Smooth 121 DO jj=j1,j2 122 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 123 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 124 END DO 125 END DO 126 ! 127 zub(2,:) = 0._wp ! Correct transport 145 128 DO jk = 1, jpkm1 146 129 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 130 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 131 END DO 132 END DO 133 DO jj=1,jpj 134 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 135 END DO 136 137 DO jk=1,jpkm1 138 DO jj=1,jpj 139 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 140 END DO 141 END DO 142 143 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 144 zvb(2,:) = 0._wp 145 DO jk = 1, jpkm1 146 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 153 DO jk = 1, jpkm1 154 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ENDIF 161 ! 162 ENDIF 163 164 ! --- East --- ! 165 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 166 167 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 168 ua_b(nlci-nbghostcells-1:nlci,:) = 0._wp 169 DO jk=1,jpkm1 170 DO jj=1,jpj 171 ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) + e3u_a(nlci-nbghostcells-1:nlci,jj,jk) & 172 & * ua(nlci-nbghostcells-1:nlci,jj,jk) 173 END DO 174 END DO 175 DO jj=1,jpj 176 ua_b(nlci-nbghostcells-1:nlci,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) * r1_hu_a(nlci-nbghostcells-1:nlci,jj) 177 END DO 178 ENDIF 179 ! 180 ! Smoothing if only 1 ghostcell 181 ! ----------------------------- 182 IF( nbghostcells == 1 ) THEN 183 DO jk = 1, jpkm1 ! Smooth 184 DO jj = j1, j2 185 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 186 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 187 END DO 188 END DO 189 190 zub(nlci-2,:) = 0._wp ! Correct transport 153 191 DO jk = 1, jpkm1 154 192 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ! Mask domain edges: 161 !------------------- 162 DO jk = 1, jpkm1 193 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 194 END DO 195 END DO 163 196 DO jj = 1, jpj 164 ua(1,jj,jk) = 0._wp 165 va(1,jj,jk) = 0._wp 166 END DO 167 END DO 168 ! 169 ENDIF 170 171 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 172 173 ! Smoothing 174 ! --------- 175 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 176 ua_b(nlci-2,:) = 0._wp 177 DO jk=1,jpkm1 178 DO jj=1,jpj 179 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 180 END DO 181 END DO 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj) 184 END DO 185 ENDIF 186 187 DO jk = 1, jpkm1 ! Smooth 188 DO jj = j1, j2 189 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 190 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 191 END DO 192 END DO 193 194 zub(nlci-2,:) = 0._wp ! Correct transport 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 198 END DO 199 END DO 200 DO jj = 1, jpj 201 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 202 END DO 203 204 DO jk = 1, jpkm1 205 DO jj = 1, jpj 206 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 207 END DO 208 END DO 209 ! 210 ! Set tangential velocities to time splitting estimate 211 !----------------------------------------------------- 212 IF( ln_dynspg_ts ) THEN 213 zvb(nlci-1,:) = 0._wp 197 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 198 END DO 199 214 200 DO jk = 1, jpkm1 215 201 DO jj = 1, jpj 216 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 217 END DO 218 END DO 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 221 END DO 222 DO jk = 1, jpkm1 223 DO jj = 1, jpj 224 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 225 END DO 226 END DO 227 ENDIF 228 ! 229 ! Mask domain edges: 230 !------------------- 231 DO jk = 1, jpkm1 232 DO jj = 1, jpj 233 ua(nlci-1,jj,jk) = 0._wp 234 va(nlci ,jj,jk) = 0._wp 235 END DO 236 END DO 237 ! 238 ENDIF 239 202 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 203 END DO 204 END DO 205 ! 206 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 207 zvb(nlci-1,:) = 0._wp 208 DO jk = 1, jpkm1 209 DO jj = 1, jpj 210 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 211 END DO 212 END DO 213 DO jj=1,jpj 214 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 215 END DO 216 DO jk = 1, jpkm1 217 DO jj = 1, jpj 218 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 219 END DO 220 END DO 221 ENDIF 222 ! 223 ENDIF 224 ! 225 ENDIF 226 227 ! --- South --- ! 240 228 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 241 229 242 ! Smoothing243 ! ---------244 230 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 245 va_b(:, 2) = 0._wp231 va_b(:,1:nbghostcells+1) = 0._wp 246 232 DO jk = 1, jpkm1 247 233 DO ji = 1, jpi 248 va_b(ji, 2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)234 va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) + e3v_a(ji,1:nbghostcells+1,jk) * va(ji,1:nbghostcells+1,jk) 249 235 END DO 250 236 END DO 251 237 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2) 253 END DO 254 ENDIF 255 ! 256 DO jk = 1, jpkm1 ! Smooth 257 DO ji = i1, i2 258 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 259 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 260 END DO 261 END DO 262 ! 263 zvb(:,2) = 0._wp ! Correct transport 264 DO jk=1,jpkm1 265 DO ji=1,jpi 266 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 267 END DO 268 END DO 269 DO ji = 1, jpi 270 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 271 END DO 272 DO jk = 1, jpkm1 238 va_b(ji,1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) * r1_hv_a(ji,1:nbghostcells+1) 239 END DO 240 ENDIF 241 ! 242 ! Smoothing if only 1 ghostcell 243 ! ----------------------------- 244 IF( nbghostcells == 1 ) THEN 245 DO jk = 1, jpkm1 ! Smooth 246 DO ji = i1, i2 247 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 248 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 249 END DO 250 END DO 251 ! 252 zvb(:,2) = 0._wp ! Correct transport 253 DO jk=1,jpkm1 254 DO ji=1,jpi 255 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 256 END DO 257 END DO 273 258 DO ji = 1, jpi 274 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 275 END DO 276 END DO 277 278 ! Set tangential velocities to time splitting estimate 279 !----------------------------------------------------- 280 IF( ln_dynspg_ts ) THEN 281 zub(:,2) = 0._wp 259 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 260 END DO 282 261 DO jk = 1, jpkm1 283 262 DO ji = 1, jpi 284 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 285 END DO 286 END DO 287 DO ji = 1, jpi 288 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 289 END DO 290 263 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 264 END DO 265 END DO 266 267 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 268 zub(:,2) = 0._wp 269 DO jk = 1, jpkm1 270 DO ji = 1, jpi 271 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 272 END DO 273 END DO 274 DO ji = 1, jpi 275 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 276 END DO 277 278 DO jk = 1, jpkm1 279 DO ji = 1, jpi 280 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 281 END DO 282 END DO 283 ENDIF 284 ! 285 ENDIF 286 ! 287 ENDIF 288 289 ! --- North --- ! 290 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 291 ! 292 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 293 va_b(:,nlcj-nbghostcells-1:nlcj) = 0._wp 291 294 DO jk = 1, jpkm1 292 295 DO ji = 1, jpi 293 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 294 END DO 295 END DO 296 ENDIF 297 298 ! Mask domain edges: 299 !------------------- 300 DO jk = 1, jpkm1 296 va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) + e3v_a(ji,nlcj-nbghostcells-1:nlcj,jk) & 297 & * va(ji,nlcj-nbghostcells-1:nlcj,jk) 298 END DO 299 END DO 301 300 DO ji = 1, jpi 302 ua(ji,1,jk) = 0._wp 303 va(ji,1,jk) = 0._wp 304 END DO 305 END DO 306 307 ENDIF 308 309 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 310 ! 311 ! Smoothing 312 ! --------- 313 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 314 va_b(:,nlcj-2) = 0._wp 301 va_b(ji,nlcj-nbghostcells-1:nlcj) = va_b(ji,nlcj-nbghostcells-1:nlcj) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj) 302 END DO 303 ENDIF 304 ! 305 ! Smoothing if only 1 ghostcell 306 ! ----------------------------- 307 IF( nbghostcells == 1 ) THEN 308 DO jk = 1, jpkm1 ! Smooth 309 DO ji = i1, i2 310 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 311 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 312 END DO 313 END DO 314 ! 315 zvb(:,nlcj-2) = 0._wp ! Correct transport 315 316 DO jk = 1, jpkm1 316 317 DO ji = 1, jpi 317 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)318 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 318 319 END DO 319 320 END DO 320 321 DO ji = 1, jpi 321 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 322 END DO 323 ENDIF 324 ! 325 DO jk = 1, jpkm1 ! Smooth 326 DO ji = i1, i2 327 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 328 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 329 END DO 330 END DO 331 ! 332 zvb(:,nlcj-2) = 0._wp ! Correct transport 333 DO jk = 1, jpkm1 334 DO ji = 1, jpi 335 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 336 END DO 337 END DO 338 DO ji = 1, jpi 339 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 340 END DO 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 344 END DO 345 END DO 346 ! 347 ! Set tangential velocities to time splitting estimate 348 !----------------------------------------------------- 349 IF( ln_dynspg_ts ) THEN 350 zub(:,nlcj-1) = 0._wp 322 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 323 END DO 351 324 DO jk = 1, jpkm1 352 325 DO ji = 1, jpi 353 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 354 END DO 355 END DO 356 DO ji = 1, jpi 357 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 358 END DO 359 ! 360 DO jk = 1, jpkm1 326 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 327 END DO 328 END DO 329 ! 330 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 331 zub(:,nlcj-1) = 0._wp 332 DO jk = 1, jpkm1 333 DO ji = 1, jpi 334 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 335 END DO 336 END DO 361 337 DO ji = 1, jpi 362 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 363 END DO 364 END DO 365 ENDIF 366 ! 367 ! Mask domain edges: 368 !------------------- 369 DO jk = 1, jpkm1 370 DO ji = 1, jpi 371 ua(ji,nlcj ,jk) = 0._wp 372 va(ji,nlcj-1,jk) = 0._wp 373 END DO 374 END DO 338 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 339 END DO 340 ! 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 344 END DO 345 END DO 346 ENDIF 347 ! 348 ENDIF 375 349 ! 376 350 ENDIF … … 392 366 ! 393 367 IF( Agrif_Root() ) RETURN 394 ! 368 !! clem ghost 395 369 IF((nbondi == -1).OR.(nbondi == 2)) THEN 396 370 DO jj=1,jpj 397 va_e( 2,jj) = vbdy_w(jj) * hvr_e(2,jj)371 va_e(1:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(1:nbghostcells+1,jj) 398 372 ! Specified fluxes: 399 ua_e( 2,jj) = ubdy_w(jj) * hur_e(2,jj)400 ! Characteristics method :373 ua_e(1:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(1:nbghostcells+1,jj) 374 ! Characteristics method (only if ghostcells=1): 401 375 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 402 376 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) … … 406 380 IF((nbondi == 1).OR.(nbondi == 2)) THEN 407 381 DO jj=1,jpj 408 va_e(nlci- 1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)382 va_e(nlci-nbghostcells:nlci,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci,jj) 409 383 ! Specified fluxes: 410 ua_e(nlci- 2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)411 ! Characteristics method :384 ua_e(nlci-nbghostcells-1:nlci-1,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-1,jj) 385 ! Characteristics method (only if ghostcells=1): 412 386 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 413 387 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) … … 417 391 IF((nbondj == -1).OR.(nbondj == 2)) THEN 418 392 DO ji=1,jpi 419 ua_e(ji, 2) = ubdy_s(ji) * hur_e(ji,2)393 ua_e(ji,1:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,1:nbghostcells+1) 420 394 ! Specified fluxes: 421 va_e(ji, 2) = vbdy_s(ji) * hvr_e(ji,2)422 ! Characteristics method :395 va_e(ji,1:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,1:nbghostcells+1) 396 ! Characteristics method (only if ghostcells=1): 423 397 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 424 398 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) … … 428 402 IF((nbondj == 1).OR.(nbondj == 2)) THEN 429 403 DO ji=1,jpi 430 ua_e(ji,nlcj- 1) = ubdy_n(ji) * hur_e(ji,nlcj-1)404 ua_e(ji,nlcj-nbghostcells:nlcj) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj) 431 405 ! Specified fluxes: 432 va_e(ji,nlcj- 2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)433 ! Characteristics method :406 va_e(ji,nlcj-nbghostcells-1:nlcj-1) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-1) 407 ! Characteristics method (only if ghostcells=1): 434 408 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 435 409 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) … … 476 450 ! 477 451 IF( ll_int_cons ) THEN ! Conservative interpolation 478 ! order smatters here !!!!!!452 ! order matters here !!!!!! 479 453 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 480 454 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) … … 504 478 !!---------------------------------------------------------------------- 505 479 INTEGER, INTENT(in) :: kt 506 !! 480 ! 481 INTEGER :: ji, jj, indx 507 482 !!---------------------------------------------------------------------- 508 483 ! 509 484 IF( Agrif_Root() ) RETURN 510 ! 485 !! clem ghost 486 ! --- West --- ! 511 487 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 514 ENDIF 515 ! 488 indx = 1+nbghostcells 489 DO jj = 1, jpj 490 DO ji = 1, indx 491 ssha(ji,jj)=ssha(indx+1,jj) 492 sshn(ji,jj)=sshn(indx+1,jj) 493 ENDDO 494 ENDDO 495 ENDIF 496 ! 497 ! --- East --- ! 516 498 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 519 ENDIF 520 ! 499 indx = nlci-nbghostcells 500 DO jj = 1, jpj 501 DO ji = indx, nlci 502 ssha(ji,jj)=ssha(indx-1,jj) 503 sshn(ji,jj)=sshn(indx-1,jj) 504 ENDDO 505 ENDDO 506 ENDIF 507 ! 508 ! --- South --- ! 521 509 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 524 ENDIF 525 ! 510 indx = 1+nbghostcells 511 DO jj = 1, indx 512 DO ji = 1, jpi 513 ssha(ji,jj)=ssha(ji,indx+1) 514 sshn(ji,jj)=sshn(ji,indx+1) 515 ENDDO 516 ENDDO 517 ENDIF 518 ! 519 ! --- North --- ! 526 520 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 521 indx = nlcj-nbghostcells 522 DO jj = indx, nlcj 523 DO ji = 1, jpi 524 ssha(ji,jj)=ssha(ji,indx-1) 525 sshn(ji,jj)=sshn(ji,indx-1) 526 ENDDO 527 ENDDO 529 528 ENDIF 530 529 ! … … 538 537 INTEGER, INTENT(in) :: jn 539 538 !! 540 INTEGER :: ji, jj541 !!---------------------------------------------------------------------- 542 ! 539 INTEGER :: ji, jj 540 !!---------------------------------------------------------------------- 541 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 543 542 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 543 DO jj = 1, jpj 545 ssha_e( 2,jj) = hbdy_w(jj)544 ssha_e(1:nbghostcells+1,jj) = hbdy_w(jj) 546 545 END DO 547 546 ENDIF … … 549 548 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 549 DO jj = 1, jpj 551 ssha_e(nlci- 1,jj) = hbdy_e(jj)550 ssha_e(nlci-nbghostcells:nlci,jj) = hbdy_e(jj) 552 551 END DO 553 552 ENDIF … … 555 554 IF((nbondj == -1).OR.(nbondj == 2)) THEN 556 555 DO ji = 1, jpi 557 ssha_e(ji, 2) = hbdy_s(ji)556 ssha_e(ji,1:nbghostcells+1) = hbdy_s(ji) 558 557 END DO 559 558 ENDIF … … 561 560 IF((nbondj == 1).OR.(nbondj == 2)) THEN 562 561 DO ji = 1, jpi 563 ssha_e(ji,nlcj- 1) = hbdy_n(ji)562 ssha_e(ji,nlcj-nbghostcells:nlcj) = hbdy_n(ji) 564 563 END DO 565 564 ENDIF … … 601 600 INTEGER :: ji, jj, jk, jn ! dummy loop indices 602 601 INTEGER :: imin, imax, jmin, jmax 603 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 604 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 602 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 605 603 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 604 !!---------------------------------------------------------------------- … … 610 608 ELSE 611 609 ! 612 western_side = (nb == 1).AND.(ndir == 1) 613 eastern_side = (nb == 1).AND.(ndir == 2) 614 southern_side = (nb == 2).AND.(ndir == 1) 615 northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 ! 619 zalpha1 = ( zrhox - 1. ) * 0.5 620 zalpha2 = 1. - zalpha1 621 ! 622 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 623 zalpha4 = 1. - zalpha3 624 ! 625 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 626 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 627 zalpha5 = 1. - zalpha6 - zalpha7 628 ! 629 imin = i1 630 imax = i2 631 jmin = j1 632 jmax = j2 633 ! 634 ! Remove CORNERS 635 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 636 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 637 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 638 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 639 ! 640 IF( eastern_side ) THEN 641 DO jn = 1, jpts 642 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 643 DO jk = 1, jpkm1 644 DO jj = jmin,jmax 645 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 647 ELSE 648 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 649 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 650 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 651 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 610 IF( nbghostcells > 1 ) THEN ! no smoothing 611 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 612 ELSE ! smoothing 613 ! 614 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 615 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 z1 = ( zrhox - 1. ) * 0.5 619 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 620 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 621 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 622 ! 623 z2 = 1. - z1 624 z4 = 1. - z3 625 z5 = 1. - z6 - z7 626 ! 627 imin = i1 ; imax = i2 628 jmin = j1 ; jmax = j2 629 ! 630 ! Remove CORNERS 631 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 632 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 633 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 634 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 635 ! 636 IF( eastern_side ) THEN 637 DO jn = 1, jpts 638 tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 639 DO jk = 1, jpkm1 640 DO jj = jmin,jmax 641 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 642 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 643 ELSE 644 tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 645 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 647 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 648 ENDIF 652 649 ENDIF 653 END IF650 END DO 654 651 END DO 655 END DO656 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp657 END DO658 ENDIF659 !660 IF( northern_side ) THEN661 DO jn = 1, jpts662 tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)663 DO jk = 1, jpkm1664 DO ji = imin,imax665 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN666 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)667 ELSE668 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)669 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN670 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) &671 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)652 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 653 END DO 654 ENDIF 655 ! 656 IF( northern_side ) THEN 657 DO jn = 1, jpts 658 tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 659 DO jk = 1, jpkm1 660 DO ji = imin,imax 661 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 662 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 663 ELSE 664 tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 665 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 666 tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) & 667 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 668 ENDIF 672 669 ENDIF 673 END IF670 END DO 674 671 END DO 675 END DO676 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp677 END DO678 ENDIF679 !680 IF( western_side ) THEN681 DO jn = 1, jpts682 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)683 DO jk = 1, jpkm1684 DO jj = jmin,jmax685 IF( umask(2,jj,jk) == 0._wp ) THEN686 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)687 ELSE688 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)689 IF( un(2,jj,jk) < 0._wp ) THEN690 tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)672 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 673 END DO 674 ENDIF 675 ! 676 IF( western_side ) THEN 677 DO jn = 1, jpts 678 tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 679 DO jk = 1, jpkm1 680 DO jj = jmin,jmax 681 IF( umask(2,jj,jk) == 0._wp ) THEN 682 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 683 ELSE 684 tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 685 IF( un(2,jj,jk) < 0._wp ) THEN 686 tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 687 ENDIF 691 688 ENDIF 692 END IF689 END DO 693 690 END DO 694 END DO695 tsa(1,j1:j2,k1:k2,jn) = 0._wp696 END DO697 ENDIF698 !699 IF( southern_side ) THEN700 DO jn = 1, jpts701 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)702 DO jk = 1, jpk703 DO ji=imin,imax704 IF( vmask(ji,2,jk) == 0._wp ) THEN705 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)706 ELSE707 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)708 IF( vn(ji,2,jk) < 0._wp ) THEN709 tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)691 tsa(1,j1:j2,k1:k2,jn) = 0._wp 692 END DO 693 ENDIF 694 ! 695 IF( southern_side ) THEN 696 DO jn = 1, jpts 697 tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 698 DO jk = 1, jpk 699 DO ji=imin,imax 700 IF( vmask(ji,2,jk) == 0._wp ) THEN 701 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 702 ELSE 703 tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 704 IF( vn(ji,2,jk) < 0._wp ) THEN 705 tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 706 ENDIF 710 707 ENDIF 711 END IF708 END DO 712 709 END DO 713 END DO 714 tsa(i1:i2,1,k1:k2,jn) = 0._wp 715 END DO 716 ENDIF 717 ! 718 ! Treatment of corners 719 ! 720 ! East south 721 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 722 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 723 ENDIF 724 ! East north 725 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 726 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 727 ENDIF 728 ! West south 729 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 730 tsa(2,2,:,:) = ptab(2,2,:,:) 731 ENDIF 732 ! West north 733 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 734 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 735 ENDIF 736 ! 710 tsa(i1:i2,1,k1:k2,jn) = 0._wp 711 END DO 712 ENDIF 713 ! 714 ! Treatment of corners 715 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 716 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 717 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(2,2,:,:) = ptab(2,2,:,:) ! West south 718 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 719 ! 720 ENDIF 737 721 ENDIF 738 722 ! … … 759 743 southern_side = (nb == 2).AND.(ndir == 1) 760 744 northern_side = (nb == 2).AND.(ndir == 2) 761 IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 762 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 763 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 764 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 745 !! clem ghost 746 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i1,j1:j2,1) 747 IF(eastern_side) hbdy_e(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) !clem previously i1 748 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 749 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j1,1) 765 750 ENDIF 766 751 ! … … 854 839 ELSEIF( bdy_tinterp == 2 ) THEN 855 840 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 856 & - zt0 * ( zt0 - 1._wp)**2._wp ) 857 841 & - zt0 * ( zt0 - 1._wp)**2._wp ) 858 842 ELSE 859 843 ztcoeff = 1 860 844 ENDIF 861 ! 862 IF(western_side) THEN 863 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 864 ENDIF 865 IF(eastern_side) THEN 866 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 867 ENDIF 868 IF(southern_side) THEN 869 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 870 ENDIF 871 IF(northern_side) THEN 872 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 873 ENDIF 845 !! clem ghost 846 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 847 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1 848 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 849 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 874 850 ! 875 851 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 876 IF(western_side) THEN 877 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 878 ENDIF 879 IF(eastern_side) THEN 880 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 881 ENDIF 882 IF(southern_side) THEN 883 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 884 ENDIF 885 IF(northern_side) THEN 886 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 887 ENDIF 852 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 853 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 854 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 855 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 888 856 ENDIF 889 857 ENDIF … … 927 895 ztcoeff = 1 928 896 ENDIF 929 ! 930 IF(western_side) THEN 931 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 932 ENDIF 933 IF(eastern_side) THEN 934 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 935 ENDIF 936 IF(southern_side) THEN 937 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 938 ENDIF 939 IF(northern_side) THEN 940 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 941 ENDIF 897 !! clem ghost 898 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 899 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i2,j1:j2) !clem previously i1 900 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 901 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 942 902 ! 943 903 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 944 IF(western_side) THEN 945 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 946 & * vmask(i1,j1:j2,1) 947 ENDIF 948 IF(eastern_side) THEN 949 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 950 & * vmask(i1,j1:j2,1) 951 ENDIF 952 IF(southern_side) THEN 953 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 954 & * vmask(i1:i2,j1,1) 955 ENDIF 956 IF(northern_side) THEN 957 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 958 & * vmask(i1:i2,j1,1) 959 ENDIF 904 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 905 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 906 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 907 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 960 908 ENDIF 961 909 ENDIF … … 991 939 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 992 940 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 993 ! 941 !! clem ghost 994 942 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) 995 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i 1,j1:j2)996 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j 1)943 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1 944 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 997 945 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 998 946 ENDIF … … 1031 979 ! 1032 980 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1033 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i 1,j1:j2)1034 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j 1)981 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i2,j1:j2) !clem previously i1 982 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 1035 983 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 984 ENDIF … … 1050 998 INTEGER :: ji, jj, jk 1051 999 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1052 REAL(wp) :: ztmpmsk1053 1000 !!---------------------------------------------------------------------- 1054 1001 ! … … 1060 1007 southern_side = (nb == 2).AND.(ndir == 1) 1061 1008 northern_side = (nb == 2).AND.(ndir == 2) 1062 1009 ! 1063 1010 DO jk = k1, k2 1064 1011 DO jj = j1, j2 1065 1012 DO ji = i1, i2 1066 ! Get velocity mask at boundary edge points:1067 IF( western_side ) ztmpmsk = umask(ji ,jj ,1)1068 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1)1069 IF( northern_side) ztmpmsk = vmask(ji ,nlcj-2,1)1070 IF( southern_side) ztmpmsk = vmask(ji ,2 ,1)1071 1013 ! 1072 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) *ztmpmsk> 1.D-2) THEN1014 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1073 1015 IF (western_side) THEN 1074 1016 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
Note: See TracChangeset
for help on using the changeset viewer.
