Changeset 8738 for branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
- Timestamp:
- 2017-11-17T15:40:12+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r8183_ICEMODEL_svn_removed/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8733 r8738 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(2: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(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2: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(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2: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 ! Mask domain edges: 163 !------------------- 164 ! DO jk = 1, jpkm1 165 ! DO jj = 1, jpj 166 ! ua(1,jj,jk) = 0._wp 167 ! va(1,jj,jk) = 0._wp 168 ! END DO 169 ! END DO 170 ! 171 ENDIF 172 173 ! --- East --- ! 174 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 175 176 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 177 ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 178 DO jk=1,jpkm1 179 DO jj=1,jpj 180 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk) & 181 & * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 182 END DO 183 END DO 184 DO jj=1,jpj 185 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj) 186 END DO 187 ENDIF 188 ! 189 ! Smoothing if only 1 ghostcell 190 ! ----------------------------- 191 IF( nbghostcells == 1 ) THEN 192 DO jk = 1, jpkm1 ! Smooth 193 DO jj = j1, j2 194 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 195 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 196 END DO 197 END DO 198 199 zub(nlci-2,:) = 0._wp ! Correct transport 153 200 DO jk = 1, jpkm1 154 201 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 202 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 203 END DO 204 END DO 205 DO jj = 1, jpj 206 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 207 END DO 208 209 DO jk = 1, jpkm1 210 DO jj = 1, jpj 211 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 212 END DO 213 END DO 214 ! 215 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 216 zvb(nlci-1,:) = 0._wp 217 DO jk = 1, jpkm1 218 DO jj = 1, jpj 219 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 220 END DO 221 END DO 222 DO jj=1,jpj 223 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 224 END DO 225 DO jk = 1, jpkm1 226 DO jj = 1, jpj 227 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 228 END DO 229 END DO 230 ENDIF 231 ! 158 232 ENDIF 159 233 ! 160 234 ! Mask domain edges: 161 235 !------------------- 162 DO jk = 1, jpkm1 163 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 ! --------- 236 ! DO jk = 1, jpkm1 237 ! DO jj = 1, jpj 238 ! ua(nlci-1,jj,jk) = 0._wp 239 ! va(nlci ,jj,jk) = 0._wp 240 ! END DO 241 ! END DO 242 ! 243 ENDIF 244 245 ! --- South --- ! 246 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 247 175 248 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 176 ua_b(nlci-2,:) = 0._wp 249 va_b(:,2:nbghostcells+1) = 0._wp 250 DO jk = 1, jpkm1 251 DO ji = 1, jpi 252 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 253 END DO 254 END DO 255 DO ji=1,jpi 256 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 257 END DO 258 ENDIF 259 ! 260 ! Smoothing if only 1 ghostcell 261 ! ----------------------------- 262 IF( nbghostcells == 1 ) THEN 263 DO jk = 1, jpkm1 ! Smooth 264 DO ji = i1, i2 265 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 266 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 267 END DO 268 END DO 269 ! 270 zvb(:,2) = 0._wp ! Correct transport 177 271 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 272 DO ji=1,jpi 273 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 274 END DO 275 END DO 276 DO ji = 1, jpi 277 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 278 END DO 214 279 DO jk = 1, jpkm1 215 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 280 DO ji = 1, jpi 281 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 282 END DO 283 END DO 284 285 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 286 zub(:,2) = 0._wp 287 DO jk = 1, jpkm1 288 DO ji = 1, jpi 289 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 290 END DO 291 END DO 292 DO ji = 1, jpi 293 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 294 END DO 295 296 DO jk = 1, jpkm1 297 DO ji = 1, jpi 298 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 299 END DO 300 END DO 301 ENDIF 302 ! 227 303 ENDIF 228 304 ! 229 305 ! Mask domain edges: 230 306 !------------------- 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 240 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 241 242 ! Smoothing 243 ! --------- 307 ! DO jk = 1, jpkm1 308 ! DO ji = 1, jpi 309 ! ua(ji,1,jk) = 0._wp 310 ! va(ji,1,jk) = 0._wp 311 ! END DO 312 ! END DO 313 ! 314 ENDIF 315 316 ! --- North --- ! 317 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 318 ! 244 319 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 245 va_b(:, 2) = 0._wp320 va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 246 321 DO jk = 1, jpkm1 247 322 DO ji = 1, jpi 248 va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) 249 END DO 250 END DO 251 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 323 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk) & 324 & * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 325 END DO 326 END DO 273 327 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 328 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 329 END DO 330 ENDIF 331 ! 332 ! Smoothing if only 1 ghostcell 333 ! ----------------------------- 334 IF( nbghostcells == 1 ) THEN 335 DO jk = 1, jpkm1 ! Smooth 336 DO ji = i1, i2 337 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 338 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 339 END DO 340 END DO 341 ! 342 zvb(:,nlcj-2) = 0._wp ! Correct transport 282 343 DO jk = 1, jpkm1 283 344 DO ji = 1, jpi 284 z ub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)345 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 285 346 END DO 286 347 END DO 287 348 DO ji = 1, jpi 288 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 289 END DO 290 349 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 350 END DO 291 351 DO jk = 1, jpkm1 292 352 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 353 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 354 END DO 355 END DO 356 ! 357 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 358 zub(:,nlcj-1) = 0._wp 359 DO jk = 1, jpkm1 360 DO ji = 1, jpi 361 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 362 END DO 363 END DO 364 DO ji = 1, jpi 365 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 366 END DO 367 ! 368 DO jk = 1, jpkm1 369 DO ji = 1, jpi 370 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 371 END DO 372 END DO 373 ENDIF 374 ! 375 ENDIF 376 ! 298 377 ! Mask domain edges: 299 378 !------------------- 300 DO jk = 1, jpkm1 301 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 315 DO jk = 1, jpkm1 316 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 END DO 319 END DO 320 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 351 DO jk = 1, jpkm1 352 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 361 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 379 ! DO jk = 1, jpkm1 380 ! DO ji = 1, jpi 381 ! ua(ji,nlcj ,jk) = 0._wp 382 ! va(ji,nlcj-1,jk) = 0._wp 383 ! END DO 384 ! END DO 375 385 ! 376 386 ENDIF … … 392 402 ! 393 403 IF( Agrif_Root() ) RETURN 394 ! 404 !! clem ghost 395 405 IF((nbondi == -1).OR.(nbondi == 2)) THEN 396 406 DO jj=1,jpj 397 va_e(2 ,jj) = vbdy_w(jj) * hvr_e(2,jj)407 va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj) 398 408 ! Specified fluxes: 399 ua_e(2 ,jj) = ubdy_w(jj) * hur_e(2,jj)400 ! Characteristics method :409 ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj) 410 ! Characteristics method (only if ghostcells=1): 401 411 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 402 412 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) … … 406 416 IF((nbondi == 1).OR.(nbondi == 2)) THEN 407 417 DO jj=1,jpj 408 va_e(nlci- 1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)418 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 409 419 ! Specified fluxes: 410 ua_e(nlci- 2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)411 ! Characteristics method :420 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 421 ! Characteristics method (only if ghostcells=1): 412 422 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 413 423 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) … … 417 427 IF((nbondj == -1).OR.(nbondj == 2)) THEN 418 428 DO ji=1,jpi 419 ua_e(ji,2 ) = ubdy_s(ji) * hur_e(ji,2)429 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1) 420 430 ! Specified fluxes: 421 va_e(ji,2 ) = vbdy_s(ji) * hvr_e(ji,2)422 ! Characteristics method :431 va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1) 432 ! Characteristics method (only if ghostcells=1): 423 433 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 424 434 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) … … 428 438 IF((nbondj == 1).OR.(nbondj == 2)) THEN 429 439 DO ji=1,jpi 430 ua_e(ji,nlcj- 1) = ubdy_n(ji) * hur_e(ji,nlcj-1)440 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 431 441 ! Specified fluxes: 432 va_e(ji,nlcj- 2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)433 ! Characteristics method :442 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 443 ! Characteristics method (only if ghostcells=1): 434 444 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 435 445 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) … … 476 486 ! 477 487 IF( ll_int_cons ) THEN ! Conservative interpolation 478 ! order smatters here !!!!!!488 ! order matters here !!!!!! 479 489 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 480 490 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) … … 504 514 !!---------------------------------------------------------------------- 505 515 INTEGER, INTENT(in) :: kt 506 !! 516 ! 517 INTEGER :: ji, jj, indx 507 518 !!---------------------------------------------------------------------- 508 519 ! 509 520 IF( Agrif_Root() ) RETURN 510 ! 521 !! clem ghost 522 ! --- West --- ! 511 523 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 514 ENDIF 515 ! 524 indx = 1+nbghostcells 525 DO jj = 1, jpj 526 DO ji = 2, indx 527 ssha(ji,jj)=ssha(indx+1,jj) 528 sshn(ji,jj)=sshn(indx+1,jj) 529 ENDDO 530 ENDDO 531 ENDIF 532 ! 533 ! --- East --- ! 516 534 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 519 ENDIF 520 ! 535 indx = nlci-nbghostcells 536 DO jj = 1, jpj 537 DO ji = indx, nlci-1 538 ssha(ji,jj)=ssha(indx-1,jj) 539 sshn(ji,jj)=sshn(indx-1,jj) 540 ENDDO 541 ENDDO 542 ENDIF 543 ! 544 ! --- South --- ! 521 545 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 524 ENDIF 525 ! 546 indx = 1+nbghostcells 547 DO jj = 2, indx 548 DO ji = 1, jpi 549 ssha(ji,jj)=ssha(ji,indx+1) 550 sshn(ji,jj)=sshn(ji,indx+1) 551 ENDDO 552 ENDDO 553 ENDIF 554 ! 555 ! --- North --- ! 526 556 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 557 indx = nlcj-nbghostcells 558 DO jj = indx, nlcj-1 559 DO ji = 1, jpi 560 ssha(ji,jj)=ssha(ji,indx-1) 561 sshn(ji,jj)=sshn(ji,indx-1) 562 ENDDO 563 ENDDO 529 564 ENDIF 530 565 ! … … 538 573 INTEGER, INTENT(in) :: jn 539 574 !! 540 INTEGER :: ji, jj541 !!---------------------------------------------------------------------- 542 ! 575 INTEGER :: ji, jj 576 !!---------------------------------------------------------------------- 577 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 543 578 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 579 DO jj = 1, jpj 545 ssha_e(2 ,jj) = hbdy_w(jj)580 ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 546 581 END DO 547 582 ENDIF … … 549 584 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 585 DO jj = 1, jpj 551 ssha_e(nlci- 1,jj) = hbdy_e(jj)586 ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 552 587 END DO 553 588 ENDIF … … 555 590 IF((nbondj == -1).OR.(nbondj == 2)) THEN 556 591 DO ji = 1, jpi 557 ssha_e(ji,2 ) = hbdy_s(ji)592 ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 558 593 END DO 559 594 ENDIF … … 561 596 IF((nbondj == 1).OR.(nbondj == 2)) THEN 562 597 DO ji = 1, jpi 563 ssha_e(ji,nlcj- 1) = hbdy_n(ji)598 ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 564 599 END DO 565 600 ENDIF … … 601 636 INTEGER :: ji, jj, jk, jn ! dummy loop indices 602 637 INTEGER :: imin, imax, jmin, jmax 603 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 604 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 638 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 605 639 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 640 !!---------------------------------------------------------------------- … … 610 644 ELSE 611 645 ! 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) 646 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 647 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 648 ! 649 IF( nbghostcells > 1 ) THEN ! no smoothing 650 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 651 ELSE ! smoothing 652 ! 653 zrhox = Agrif_Rhox() 654 z1 = ( zrhox - 1. ) * 0.5 655 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 656 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 657 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 658 ! 659 z2 = 1. - z1 660 z4 = 1. - z3 661 z5 = 1. - z6 - z7 662 ! 663 imin = i1 ; imax = i2 664 jmin = j1 ; jmax = j2 665 ! 666 ! Remove CORNERS 667 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 668 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 669 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 670 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 671 ! 672 IF( eastern_side ) THEN 673 DO jn = 1, jpts 674 tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 675 DO jk = 1, jpkm1 676 DO jj = jmin,jmax 677 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 678 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 679 ELSE 680 tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 681 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 682 tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 683 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 684 ENDIF 652 685 ENDIF 653 END IF686 END DO 654 687 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)688 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 689 END DO 690 ENDIF 691 ! 692 IF( northern_side ) THEN 693 DO jn = 1, jpts 694 tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 695 DO jk = 1, jpkm1 696 DO ji = imin,imax 697 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 698 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 699 ELSE 700 tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 701 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 702 tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) & 703 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 704 ENDIF 672 705 ENDIF 673 END IF706 END DO 674 707 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)708 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 709 END DO 710 ENDIF 711 ! 712 IF( western_side ) THEN 713 DO jn = 1, jpts 714 tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 715 DO jk = 1, jpkm1 716 DO jj = jmin,jmax 717 IF( umask(2,jj,jk) == 0._wp ) THEN 718 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 719 ELSE 720 tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 721 IF( un(2,jj,jk) < 0._wp ) THEN 722 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) 723 ENDIF 691 724 ENDIF 692 END IF725 END DO 693 726 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)727 tsa(1,j1:j2,k1:k2,jn) = 0._wp 728 END DO 729 ENDIF 730 ! 731 IF( southern_side ) THEN 732 DO jn = 1, jpts 733 tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 734 DO jk = 1, jpk 735 DO ji=imin,imax 736 IF( vmask(ji,2,jk) == 0._wp ) THEN 737 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 738 ELSE 739 tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 740 IF( vn(ji,2,jk) < 0._wp ) THEN 741 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) 742 ENDIF 710 743 ENDIF 711 END IF744 END DO 712 745 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 ! 746 tsa(i1:i2,1,k1:k2,jn) = 0._wp 747 END DO 748 ENDIF 749 ! 750 ! Treatment of corners 751 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 752 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 753 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(2,2,:,:) = ptab(2,2,:,:) ! West south 754 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 755 ! 756 ENDIF 737 757 ENDIF 738 758 ! … … 759 779 southern_side = (nb == 2).AND.(ndir == 1) 760 780 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) 781 !! clem ghost 782 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 783 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 784 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 764 785 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 765 786 ENDIF … … 854 875 ELSEIF( bdy_tinterp == 2 ) THEN 855 876 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 856 & - zt0 * ( zt0 - 1._wp)**2._wp ) 857 877 & - zt0 * ( zt0 - 1._wp)**2._wp ) 858 878 ELSE 859 879 ztcoeff = 1 860 880 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 881 !! clem ghost 882 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 883 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 884 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 885 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 874 886 ! 875 887 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 888 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 889 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 890 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 891 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 888 892 ENDIF 889 893 ENDIF … … 927 931 ztcoeff = 1 928 932 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 933 !! clem ghost 934 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 935 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 936 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 937 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 942 938 ! 943 939 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 940 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 941 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 942 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 943 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 960 944 ENDIF 961 945 ENDIF … … 991 975 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 992 976 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 993 ! 994 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i 1,j1:j2)995 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) 996 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j 1)977 !! clem ghost 978 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2) 979 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 980 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 997 981 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 998 982 ENDIF … … 1030 1014 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1031 1015 ! 1032 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i 1,j1:j2)1033 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1034 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j 1)1016 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i2,j1:j2) 1017 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 1018 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 1035 1019 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 1020 ENDIF … … 1050 1034 INTEGER :: ji, jj, jk 1051 1035 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1052 REAL(wp) :: ztmpmsk1053 1036 !!---------------------------------------------------------------------- 1054 1037 ! … … 1060 1043 southern_side = (nb == 2).AND.(ndir == 1) 1061 1044 northern_side = (nb == 2).AND.(ndir == 2) 1062 1045 ! 1063 1046 DO jk = k1, k2 1064 1047 DO jj = j1, j2 1065 1048 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 1049 ! 1072 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) *ztmpmsk> 1.D-2) THEN1050 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1073 1051 IF (western_side) THEN 1074 1052 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.