Changeset 11219 for NEMO/branches/2019/dev_r10973_AGRIF01_jchanut_small_jpi_jpj/src/NST/agrif_oce_interp.F90
 Timestamp:
 20190705T14:07:17+02:00 (15 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/branches/2019/dev_r10973_AGRIF01_jchanut_small_jpi_jpj/src/NST/agrif_oce_interp.F90
r11205 r11219 37 37 PRIVATE 38 38 39 PUBLIC Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ ssh_ts, Agrif_dta_ts39 PUBLIC Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts 40 40 PUBLIC Agrif_tra, Agrif_avm 41 41 PUBLIC interpun , interpvn … … 43 43 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 44 44 PUBLIC interpe3t, interpumsk, interpvmsk 45 46 INTEGER :: bdy_tinterp = 047 45 48 46 # include "vectopt_loop_substitute.h90" … … 78 76 ! 79 77 INTEGER :: ji, jj, jk ! dummy loop indices 80 INTEGER :: j1, j2, i1, i281 78 INTEGER :: ibdy1, jbdy1, ibdy2, jbdy2 82 79 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb … … 93 90 Agrif_UseSpecialValue = .FALSE. 94 91 ! 95 ! prevent smoothing in ghost cells96 i1 = 1 ; i2 = nlci97 j1 = 1 ; j2 = nlcj98 IF( nbondj == 1 .OR. nbondj == 2 ) j1 = 2 + nbghostcells99 IF( nbondj == +1 .OR. nbondj == 2 ) j2 = nlcj  nbghostcells  1100 IF( nbondi == 1 .OR. nbondi == 2 ) i1 = 2 + nbghostcells101 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci  nbghostcells  1102 103 92 !  West  ! 104 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 105 ibdy1 = 2 106 ibdy2 = 1+nbghostcells 107 ! 108 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 109 ua_b(ibdy1:ibdy2,:) = 0._wp 93 ibdy1 = 2 94 ibdy2 = 1+nbghostcells 95 ! 96 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 97 DO ji = mi0(ibdy1), mi1(ibdy2) 98 ua_b(ji,:) = 0._wp 99 110 100 DO jk = 1, jpkm1 111 101 DO jj = 1, jpj 112 ua_b( ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &113 & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)114 115 END DO 102 ua_b(ji,jj) = ua_b(ji,jj) + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 103 END DO 104 END DO 105 116 106 DO jj = 1, jpj 117 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 118 END DO 119 ENDIF 120 ! 121 IF( .NOT.lk_agrif_clp ) THEN 122 DO jk=1,jpkm1 ! Smooth 123 DO jj=j1,j2 124 ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy21,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 125 END DO 126 END DO 127 ENDIF 128 ! 129 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 107 ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 108 END DO 109 END DO 110 ENDIF 111 ! 112 DO ji = mi0(ibdy1), mi1(ibdy2) 113 zub(ji,:) = 0._wp ! Correct transport 130 114 DO jk = 1, jpkm1 131 115 DO jj = 1, jpj 132 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &133 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk)116 zub(ji,jj) = zub(ji,jj) & 117 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk)*umask(ji,jj,jk) 134 118 END DO 135 119 END DO 136 120 DO jj=1,jpj 137 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)121 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 138 122 END DO 139 123 140 124 DO jk = 1, jpkm1 141 125 DO jj = 1, jpj 142 ua( ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &143 & + ua_b(ibdy1:ibdy2,jj)zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk)144 145 126 ua(ji,jj,jk) = ( ua(ji,jj,jk) + ua_b(ji,jj)zub(ji,jj)) * umask(ji,jj,jk) 127 END DO 128 END DO 129 END DO 146 130 147 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 148 zvb(ibdy1:ibdy2,:) = 0._wp 131 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 132 DO ji = mi0(ibdy1), mi1(ibdy2) 133 zvb(ji,:) = 0._wp 149 134 DO jk = 1, jpkm1 150 135 DO jj = 1, jpj 151 zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 152 & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 136 zvb(ji,jj) = zvb(ji,jj) + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 153 137 END DO 154 138 END DO 155 139 DO jj = 1, jpj 156 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)140 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 157 141 END DO 158 142 DO jk = 1, jpkm1 159 143 DO jj = 1, jpj 160 va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 161 & + va_b(ibdy1:ibdy2,jj)zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 162 END DO 163 END DO 164 ENDIF 165 ! 166 DO jk = 1, jpkm1 ! Mask domain edges 167 DO jj = 1, jpj 168 ua(1,jj,jk) = 0._wp 169 va(1,jj,jk) = 0._wp 170 END DO 171 END DO 144 va(ji,jj,jk) = ( va(ji,jj,jk) + va_b(ji,jj)zvb(ji,jj))*vmask(ji,jj,jk) 145 END DO 146 END DO 147 END DO 172 148 ENDIF 173 149 174 150 !  East  ! 175 IF( nbondi == 1 .OR. nbondi == 2 ) THEN176 ibdy1 = nlci1nbghostcells177 ibdy2 = nlci2178 !179 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport180 ua_b( ibdy1:ibdy2,:) = 0._wp151 ibdy1 = jpiglo1nbghostcells 152 ibdy2 = jpiglo2 153 ! 154 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 155 DO ji = mi0(ibdy1), mi1(ibdy2) 156 ua_b(ji,:) = 0._wp 181 157 DO jk = 1, jpkm1 182 158 DO jj = 1, jpj 183 ua_b( ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &184 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)159 ua_b(ji,jj) = ua_b(ji,jj) & 160 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 185 161 END DO 186 162 END DO 187 163 DO jj = 1, jpj 188 ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 189 END DO 190 ENDIF 191 ! 192 IF( .NOT.lk_agrif_clp ) THEN 193 DO jk=1,jpkm1 ! Smooth 194 DO jj=j1,j2 195 ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy11,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 196 END DO 197 END DO 198 ENDIF 199 ! 200 zub(ibdy1:ibdy2,:) = 0._wp ! Correct transport 164 ua_b(ji,jj) = ua_b(ji,jj) * r1_hu_a(ji,jj) 165 END DO 166 END DO 167 ENDIF 168 ! 169 DO ji = mi0(ibdy1), mi1(ibdy2) 170 zub(ji,:) = 0._wp ! Correct transport 201 171 DO jk = 1, jpkm1 202 172 DO jj = 1, jpj 203 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &204 & + e3u_a( ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk)173 zub(ji,jj) = zub(ji,jj) & 174 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 205 175 END DO 206 176 END DO 207 177 DO jj=1,jpj 208 zub( ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj)178 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 209 179 END DO 210 180 211 181 DO jk = 1, jpkm1 212 182 DO jj = 1, jpj 213 ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) & 214 & + ua_b(ibdy1:ibdy2,jj)zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 215 END DO 216 END DO 183 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 184 & + ua_b(ji,jj)zub(ji,jj))*umask(ji,jj,jk) 185 END DO 186 END DO 187 END DO 217 188 218 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 219 ibdy1 = ibdy1 + 1 220 ibdy2 = ibdy2 + 1 221 zvb(ibdy1:ibdy2,:) = 0._wp 189 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 190 ibdy1 = jpiglonbghostcells 191 ibdy2 = jpiglo1 192 DO ji = mi0(ibdy1), mi1(ibdy2) 193 zvb(ji,:) = 0._wp 222 194 DO jk = 1, jpkm1 223 195 DO jj = 1, jpj 224 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &225 & + e3v_a( ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk)196 zvb(ji,jj) = zvb(ji,jj) & 197 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 226 198 END DO 227 199 END DO 228 200 DO jj = 1, jpj 229 zvb( ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj)201 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 230 202 END DO 231 203 DO jk = 1, jpkm1 232 204 DO jj = 1, jpj 233 va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) & 234 & + va_b(ibdy1:ibdy2,jj)zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 235 END DO 236 END DO 237 ENDIF 238 ! 239 DO jk = 1, jpkm1 ! Mask domain edges 240 DO jj = 1, jpj 241 ua(nlci1,jj,jk) = 0._wp 242 va(nlci ,jj,jk) = 0._wp 243 END DO 244 END DO 205 va(ji,jj,jk) = ( va(ji,jj,jk) & 206 & + va_b(ji,jj)zvb(ji,jj)) * vmask(ji,jj,jk) 207 END DO 208 END DO 209 END DO 245 210 ENDIF 246 211 247 212 !  South  ! 248 IF( nbondj == 1 .OR. nbondj == 2 ) THEN249 jbdy1 = 2250 jbdy2 = 1+nbghostcells251 !252 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport253 va_b(:,j bdy1:jbdy2) = 0._wp213 jbdy1 = 2 214 jbdy2 = 1+nbghostcells 215 ! 216 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 217 DO jj = mj0(jbdy1), mj1(jbdy2) 218 va_b(:,jj) = 0._wp 254 219 DO jk = 1, jpkm1 255 220 DO ji = 1, jpi 256 va_b(ji,j bdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &257 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)221 va_b(ji,jj) = va_b(ji,jj) & 222 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 258 223 END DO 259 224 END DO 260 225 DO ji=1,jpi 261 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 262 END DO 263 ENDIF 264 ! 265 IF ( .NOT.lk_agrif_clp ) THEN 266 DO jk = 1, jpkm1 ! Smooth 267 DO ji = i1, i2 268 va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy21,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 269 END DO 270 END DO 271 ENDIF 272 ! 273 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 226 va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj) 227 END DO 228 END DO 229 ENDIF 230 ! 231 DO jj = mj0(jbdy1), mj1(jbdy2) 232 zvb(:,jj) = 0._wp ! Correct transport 274 233 DO jk=1,jpkm1 275 234 DO ji=1,jpi 276 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &277 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)235 zvb(ji,jj) = zvb(ji,jj) & 236 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 278 237 END DO 279 238 END DO 280 239 DO ji = 1, jpi 281 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)240 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 282 241 END DO 283 242 284 243 DO jk = 1, jpkm1 285 244 DO ji = 1, jpi 286 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 287 & + va_b(ji,jbdy1:jbdy2)  zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 288 END DO 289 END DO 245 va(ji,jj,jk) = ( va(ji,jj,jk) & 246 & + va_b(ji,jj)  zvb(ji,jj) ) * vmask(ji,jj,jk) 247 END DO 248 END DO 249 END DO 290 250 291 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 292 zub(:,jbdy1:jbdy2) = 0._wp 251 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 252 DO jj = mj0(jbdy1), mj1(jbdy2) 253 zub(:,jj) = 0._wp 293 254 DO jk = 1, jpkm1 294 255 DO ji = 1, jpi 295 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &296 & + e3u_a(ji,j bdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)256 zub(ji,jj) = zub(ji,jj) & 257 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 297 258 END DO 298 259 END DO 299 260 DO ji = 1, jpi 300 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)261 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 301 262 END DO 302 263 303 264 DO jk = 1, jpkm1 304 265 DO ji = 1, jpi 305 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 306 & + ua_b(ji,jbdy1:jbdy2)  zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 307 END DO 308 END DO 309 ENDIF 310 ! 311 DO jk = 1, jpkm1 ! Mask domain edges 312 DO ji = 1, jpi 313 ua(ji,1,jk) = 0._wp 314 va(ji,1,jk) = 0._wp 315 END DO 316 END DO 266 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 267 & + ua_b(ji,jj)  zub(ji,jj) ) * umask(ji,jj,jk) 268 END DO 269 END DO 270 END DO 317 271 ENDIF 318 272 319 273 !  North  ! 320 IF( nbondj == 1 .OR. nbondj == 2 ) THEN321 jbdy1 = nlcj1nbghostcells322 jbdy2 = nlcj2323 !324 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport325 va_b(:,j bdy1:jbdy2) = 0._wp274 jbdy1 = nlcj1nbghostcells 275 jbdy2 = nlcj2 276 ! 277 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 278 DO jj = mj0(jbdy1), mj1(jbdy2) 279 va_b(:,jj) = 0._wp 326 280 DO jk = 1, jpkm1 327 281 DO ji = 1, jpi 328 va_b(ji,j bdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &329 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)282 va_b(ji,jj) = va_b(ji,jj) & 283 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 330 284 END DO 331 285 END DO 332 286 DO ji=1,jpi 333 va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 334 END DO 335 ENDIF 336 ! 337 IF ( .NOT.lk_agrif_clp ) THEN 338 DO jk = 1, jpkm1 ! Smooth 339 DO ji = i1, i2 340 va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy11,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 341 END DO 342 END DO 343 ENDIF 344 ! 345 zvb(:,jbdy1:jbdy2) = 0._wp ! Correct transport 287 va_b(ji,jj) = va_b(ji,jj) * r1_hv_a(ji,jj) 288 END DO 289 END DO 290 ENDIF 291 ! 292 DO jj = mj0(jbdy1), mj1(jbdy2) 293 zvb(:,jj) = 0._wp ! Correct transport 346 294 DO jk=1,jpkm1 347 295 DO ji=1,jpi 348 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &349 & + e3v_a(ji,j bdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk)296 zvb(ji,jj) = zvb(ji,jj) & 297 & + e3v_a(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 350 298 END DO 351 299 END DO 352 300 DO ji = 1, jpi 353 zvb(ji,j bdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2)301 zvb(ji,jj) = zvb(ji,jj) * r1_hv_a(ji,jj) 354 302 END DO 355 303 356 304 DO jk = 1, jpkm1 357 305 DO ji = 1, jpi 358 va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) & 359 & + va_b(ji,jbdy1:jbdy2)  zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 360 END DO 361 END DO 306 va(ji,jj,jk) = ( va(ji,jj,jk) & 307 & + va_b(ji,jj)  zvb(ji,jj) ) * vmask(ji,jj,jk) 308 END DO 309 END DO 310 END DO 362 311 363 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 364 jbdy1 = jbdy1 + 1 365 jbdy2 = jbdy2 + 1 366 zub(:,jbdy1:jbdy2) = 0._wp 312 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 313 jbdy1 = jbdy1 + 1 314 jbdy2 = jbdy2 + 1 315 DO jj = mj0(jbdy1), mj1(jbdy2) 316 zub(:,jj) = 0._wp 367 317 DO jk = 1, jpkm1 368 318 DO ji = 1, jpi 369 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &370 & + e3u_a(ji,j bdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk)319 zub(ji,jj) = zub(ji,jj) & 320 & + e3u_a(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 371 321 END DO 372 322 END DO 373 323 DO ji = 1, jpi 374 zub(ji,j bdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2)324 zub(ji,jj) = zub(ji,jj) * r1_hu_a(ji,jj) 375 325 END DO 376 326 377 327 DO jk = 1, jpkm1 378 328 DO ji = 1, jpi 379 ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) & 380 & + ua_b(ji,jbdy1:jbdy2)  zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 381 END DO 382 END DO 383 ENDIF 384 ! 385 DO jk = 1, jpkm1 ! Mask domain edges 386 DO ji = 1, jpi 387 ua(ji,nlcj ,jk) = 0._wp 388 va(ji,nlcj1,jk) = 0._wp 389 END DO 390 END DO 329 ua(ji,jj,jk) = ( ua(ji,jj,jk) & 330 & + ua_b(ji,jj)  zub(ji,jj) ) * umask(ji,jj,jk) 331 END DO 332 END DO 333 END DO 391 334 ENDIF 392 335 ! … … 412 355 DO jj=1,jpj 413 356 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 414 ! Specified fluxes:415 357 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 416 358 END DO 417 359 END DO 418 ! Characteristics method (only at boundary point):419 ! istart = 2420 ! iend = 2421 ! DO ji = mi0(istart), mi1(iend)422 ! DO jj=1,jpj423 ! ua_e(ji,jj) = 0.5_wp * ( ubdy(ji,jj) * hur_e(ji,jj) + ua_e(ji+1,jj) &424 ! &  sqrt(grav * hur_e(ji,jj)) * (sshn_e(ji+1,jj)  hbdy(ji,jj)) )425 ! END DO426 ! END DO427 360 ! 428 361 ! East ! … … 441 374 END DO 442 375 END DO 443 ! Characteristics method (only at boundary point):444 ! istart = jpiglo2445 ! iend = jpiglo2446 ! DO ji = mi0(istart), mi1(iend)447 ! DO jj=1,jpj448 ! ua_e(ji,jj) = 0.5_wp * ( ubdy(ji,jj) * hur_e(ji,jj) + ua_e(ji1,jj) &449 ! & + sqrt(grav * hur_e(ji,jj)) * (sshn_e(ji,jj)  hbdy(ji+1,jj)) )450 ! END DO451 ! END DO452 376 ! 453 377 ! South ! … … 457 381 DO ji=1,jpi 458 382 ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 459 ! Specified fluxes:460 383 va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 461 384 END DO 462 385 END DO 463 ! Characteristics method (only at boundary point):464 ! jstart = 2465 ! jend = 2466 ! DO jj = mj0(jstart), mj1(jend)467 ! DO ji=1,jpi468 ! va_e(ji,jj) = 0.5_wp * ( vbdy(ji,jj) * hvr_e(ji,jj) + va_e(ji,jj+1) &469 ! &  sqrt(grav * hvr_e(ji,jj)) * (sshn_e(ji,jj+1)  hbdy(ji,jj)) )470 ! END DO471 ! END DO472 386 ! 473 387 ! North ! … … 486 400 END DO 487 401 END DO 488 ! Characteristics method (only at boundary point):489 ! jstart = jpjglo2490 ! jend = jpjglo2491 ! DO jj = mj0(jstart), mj1(jend)492 ! DO ji=1,jpi493 ! va_e(ji,jj) = 0.5_wp * ( vbdy(ji,jj) * hvr_e(ji,jj) + va_e(ji,jj1) &494 ! & + sqrt(grav * hvr_e(ji,jj)) * (sshn_e(ji,jj)  hbdy(ji,jj+1)) )495 ! END DO496 ! END DO497 402 ! 498 403 END SUBROUTINE Agrif_dyn_ts 499 404 405 SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 406 !! 407 !! *** ROUTINE Agrif_dyn_ts_flux *** 408 !! 409 INTEGER, INTENT(in) :: jn 410 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zu, zv 411 !! 412 INTEGER :: ji, jj 413 INTEGER :: istart, iend, jstart, jend 414 !! 415 ! 416 IF( Agrif_Root() ) RETURN 417 ! 418 ! West ! 419 istart = 2 420 iend = nbghostcells+1 421 DO ji = mi0(istart), mi1(iend) 422 DO jj=1,jpj 423 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 424 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 425 END DO 426 END DO 427 ! 428 ! East ! 429 istart = jpiglonbghostcells 430 iend = jpiglo1 431 DO ji = mi0(istart), mi1(iend) 432 DO jj=1,jpj 433 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 434 END DO 435 END DO 436 istart = jpiglonbghostcells1 437 iend = jpiglo2 438 DO ji = mi0(istart), mi1(iend) 439 DO jj=1,jpj 440 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 441 END DO 442 END DO 443 ! 444 ! South ! 445 jstart = 2 446 jend = nbghostcells+1 447 DO jj = mj0(jstart), mj1(jend) 448 DO ji=1,jpi 449 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 450 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 451 END DO 452 END DO 453 ! 454 ! North ! 455 jstart = jpjglonbghostcells 456 jend = jpjglo1 457 DO jj = mj0(jstart), mj1(jend) 458 DO ji=1,jpi 459 zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 460 END DO 461 END DO 462 jstart = jpjglonbghostcells1 463 jend = jpjglo2 464 DO jj = mj0(jstart), mj1(jend) 465 DO ji=1,jpi 466 zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 467 END DO 468 END DO 469 ! 470 END SUBROUTINE Agrif_dyn_ts_flux 500 471 501 472 SUBROUTINE Agrif_dta_ts( kt ) … … 517 488 ! 518 489 ! Interpolate barotropic fluxes 519 Agrif_SpecialValue =0._wp490 Agrif_SpecialValue = 0._wp 520 491 Agrif_UseSpecialValue = ln_spc_dyn 492 ! 493 ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners) 494 utint_stage(:,:) = 0 495 vtint_stage(:,:) = 0 521 496 ! 522 497 IF( ll_int_cons ) THEN ! Conservative interpolation 523 498 ! order matters here !!!!!! 524 499 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 525 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 526 bdy_tinterp = 1500 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 501 ! 527 502 CALL Agrif_Bc_variable( unb_id , calledweight=1._wp, procname=interpunb ) ! After 528 503 CALL Agrif_Bc_variable( vnb_id , calledweight=1._wp, procname=interpvnb ) 529 bdy_tinterp = 2504 ! 530 505 CALL Agrif_Bc_variable( unb_id , calledweight=0._wp, procname=interpunb ) ! Before 531 506 CALL Agrif_Bc_variable( vnb_id , calledweight=0._wp, procname=interpvnb ) 532 507 ELSE ! Linear interpolation 533 bdy_tinterp = 0508 ! 534 509 ubdy(:,:) = 0._wp ; vbdy(:,:) = 0._wp 535 510 CALL Agrif_Bc_variable( unb_id, procname=interpunb ) … … 671 646 672 647 673 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before , nb, ndir)648 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 674 649 !! 675 650 !! *** ROUTINE interptsn *** … … 678 653 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 679 654 LOGICAL , INTENT(in ) :: before 680 INTEGER , INTENT(in ) :: nb , ndir 681 ! 682 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 683 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 684 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 685 LOGICAL :: western_side, eastern_side,northern_side,southern_side 655 ! 656 INTEGER :: ji, jj, jk, jn ! dummy loop indices 657 INTEGER :: N_in, N_out 686 658 ! vertical interpolation: 687 659 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child … … 689 661 REAL(wp), DIMENSION(k1:k2) :: h_in 690 662 REAL(wp), DIMENSION(1:jpk) :: h_out 691 REAL(wp) :: h_diff692 663 693 664 IF( before ) THEN … … 713 684 ELSE 714 685 715 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2)716 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2)717 718 686 # if defined key_vertical 719 687 DO jj=j1,j2 720 688 DO ji=i1,i2 721 iref = ji722 jref = jj723 if(western_side) iref=MAX(2,ji)724 if(eastern_side) iref=MIN(nlci1,ji)725 if(southern_side) jref=MAX(2,jj)726 if(northern_side) jref=MIN(nlcj1,jj)727 689 N_in = 0 728 690 DO jk=k1,k2 !k2 = jpk of parent grid … … 734 696 N_out = 0 735 697 DO jk=1,jpk ! jpk of child grid 736 IF (tmask( iref,jref,jk) == 0) EXIT698 IF (tmask(ji,jj,jk) == 0) EXIT 737 699 N_out = N_out + 1 738 h_out(jk) = e3t_n( iref,jref,jk)700 h_out(jk) = e3t_n(ji,jj,jk) 739 701 ENDDO 740 702 IF (N_in > 0) THEN … … 753 715 END DO 754 716 755 IF ( .NOT.lk_agrif_clp ) THEN756 !757 imin = i1 ; imax = i2758 jmin = j1 ; jmax = j2759 !760 ! Remove CORNERS761 IF((nbondj == 1).OR.(nbondj == 2)) jmin = 2 + nbghostcells762 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj  nbghostcells  1763 IF((nbondi == 1).OR.(nbondi == 2)) imin = 2 + nbghostcells764 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci  nbghostcells  1765 !766 IF( eastern_side ) THEN767 zrho = Agrif_Rhox()768 z1 = ( zrho  1._wp ) * 0.5_wp769 z3 = ( zrho  1._wp ) / ( zrho + 1._wp )770 z6 = 2._wp * ( zrho  1._wp ) / ( zrho + 1._wp )771 z7 =  ( zrho  1._wp ) / ( zrho + 3._wp )772 z2 = 1._wp  z1 ; z4 = 1._wp  z3 ; z5 = 1._wp  z6  z7773 !774 ibdy = nlcinbghostcells775 DO jn = 1, jpts776 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)777 DO jk = 1, jpkm1778 DO jj = jmin,jmax779 IF( umask(ibdy1,jj,jk) == 0._wp ) THEN780 tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)781 ELSE782 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy1,jj,jk,jn))*tmask(ibdy,jj,jk)783 IF( un(ibdy1,jj,jk) > 0._wp ) THEN784 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &785 + z7*tsa(ibdy2,jj,jk,jn) ) * tmask(ibdy,jj,jk)786 ENDIF787 ENDIF788 END DO789 END DO790 ! Restore ghost points:791 tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)792 END DO793 ENDIF794 !795 IF( northern_side ) THEN796 zrho = Agrif_Rhoy()797 z1 = ( zrho  1._wp ) * 0.5_wp798 z3 = ( zrho  1._wp ) / ( zrho + 1._wp )799 z6 = 2._wp * ( zrho  1._wp ) / ( zrho + 1._wp )800 z7 =  ( zrho  1._wp ) / ( zrho + 3._wp )801 z2 = 1._wp  z1 ; z4 = 1._wp  z3 ; z5 = 1._wp  z6  z7802 !803 jbdy = nlcjnbghostcells804 DO jn = 1, jpts805 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)806 DO jk = 1, jpkm1807 DO ji = imin,imax808 IF( vmask(ji,jbdy1,jk) == 0._wp ) THEN809 tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)810 ELSE811 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy1,jk,jn))*tmask(ji,jbdy,jk)812 IF (vn(ji,jbdy1,jk) > 0._wp ) THEN813 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn) &814 + z7*tsa(ji,jbdy2,jk,jn) ) * tmask(ji,jbdy,jk)815 ENDIF816 ENDIF817 END DO818 END DO819 ! Restore ghost points:820 tsa(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)821 END DO822 ENDIF823 !824 IF( western_side ) THEN825 zrho = Agrif_Rhox()826 z1 = ( zrho  1._wp ) * 0.5_wp827 z3 = ( zrho  1._wp ) / ( zrho + 1._wp )828 z6 = 2._wp * ( zrho  1._wp ) / ( zrho + 1._wp )829 z7 =  ( zrho  1._wp ) / ( zrho + 3._wp )830 z2 = 1._wp  z1 ; z4 = 1._wp  z3 ; z5 = 1._wp  z6  z7831 !832 ibdy = 1+nbghostcells833 DO jn = 1, jpts834 tsa(ibdy1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)835 DO jk = 1, jpkm1836 DO jj = jmin,jmax837 IF( umask(ibdy,jj,jk) == 0._wp ) THEN838 tsa(ibdy,jj,jk,jn) = tsa(ibdy1,jj,jk,jn) * tmask(ibdy,jj,jk)839 ELSE840 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)841 IF( un(ibdy,jj,jk) < 0._wp ) THEN842 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy1,jj,jk,jn) &843 + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)844 ENDIF845 ENDIF846 END DO847 END DO848 ! Restore ghost points:849 tsa(ibdy1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy1,jmin:jmax,1:jpkm1)850 END DO851 ENDIF852 !853 IF( southern_side ) THEN854 zrho = Agrif_Rhoy()855 z1 = ( zrho  1._wp ) * 0.5_wp856 z3 = ( zrho  1._wp ) / ( zrho + 1._wp )857 z6 = 2._wp * ( zrho  1._wp ) / ( zrho + 1._wp )858 z7 =  ( zrho  1._wp ) / ( zrho + 3._wp )859 z2 = 1._wp  z1 ; z4 = 1._wp  z3 ; z5 = 1._wp  z6  z7860 !861 jbdy=1+nbghostcells862 DO jn = 1, jpts863 tsa(imin:imax,jbdy1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)864 DO jk = 1, jpkm1865 DO ji = imin,imax866 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN867 tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy1,jk,jn) * tmask(ji,jbdy,jk)868 ELSE869 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)870 IF( vn(ji,jbdy,jk) < 0._wp ) THEN871 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy1,jk,jn) &872 + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)873 ENDIF874 ENDIF875 END DO876 END DO877 ! Restore ghost points:878 tsa(imin:imax,jbdy1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy1,1:jpkm1,jn) * tmask(imin:imax,jbdy1,1:jpkm1)879 END DO880 ENDIF881 !882 ENDIF883 717 ENDIF 884 718 ! … … 1092 926 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1093 927 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1094 ! Polynomial interpolation coefficients: 1095 IF( bdy_tinterp == 1 ) THEN 1096 ztcoeff = zrhot * ( zt1**2._wp * ( zt1  1._wp) & 1097 &  zt0**2._wp * ( zt0  1._wp) ) 1098 ELSEIF( bdy_tinterp == 2 ) THEN 1099 ztcoeff = zrhot * ( zt1 * ( zt1  1._wp)**2._wp & 1100 &  zt0 * ( zt0  1._wp)**2._wp ) 1101 ELSE 1102 ztcoeff = 1 1103 ENDIF 1104 ! 1105 ubdy(i1:i2,j1:j2) = ubdy(i1:i2,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1106 ! 1107 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1108 ubdy(i1:i2,j1:j2) = ubdy(i1:i2,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1109 ENDIF 1110 ENDIF 928 ! 929 DO ji = i1, i2 930 DO jj = j1, j2 931 IF ( utint_stage(ji,jj) == 1 ) THEN 932 ztcoeff = zrhot * ( zt1**2._wp * ( zt1  1._wp) & 933 &  zt0**2._wp * ( zt0  1._wp) ) 934 ELSEIF( utint_stage(ji,jj) == 2 ) THEN 935 ztcoeff = zrhot * ( zt1 * ( zt1  1._wp)**2._wp & 936 &  zt0 * ( zt0  1._wp)**2._wp ) 937 ELSEIF( utint_stage(ji,jj) == 0 ) THEN 938 ztcoeff = 1._wp 939 ELSE 940 ztcoeff = 0._wp 941 ENDIF 942 ! 943 ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj) 944 ! 945 IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN 946 ubdy(ji,jj) = ubdy(ji,jj) / (zrhoy*e2u(ji,jj)) * umask(ji,jj,1) 947 utint_stage(ji,jj) = 3 948 ELSE 949 utint_stage(ji,jj) = utint_stage(ji,jj) + 1 950 ENDIF 951 END DO 952 END DO 953 END IF 1111 954 ! 1112 955 END SUBROUTINE interpunb … … 1132 975 ! Time indexes bounds for integration 1133 976 zt0 = REAL(Agrif_NbStepint() , wp) / zrhot 1134 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 1135 IF( bdy_tinterp == 1 ) THEN 1136 ztcoeff = zrhot * ( zt1**2._wp * ( zt1  1._wp) & 1137 &  zt0**2._wp * ( zt0  1._wp) ) 1138 ELSEIF( bdy_tinterp == 2 ) THEN 1139 ztcoeff = zrhot * ( zt1 * ( zt1  1._wp)**2._wp & 1140 &  zt0 * ( zt0  1._wp)**2._wp ) 1141 ELSE 1142 ztcoeff = 1 1143 ENDIF 1144 vbdy(i1:i2,j1:j2) = vbdy(i1:i2,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1145 ! 1146 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1147 vbdy(i1:i2,j1:j2) = vbdy(i1:i2,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1148 ENDIF 977 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 978 ! 979 DO ji = i1, i2 980 DO jj = j1, j2 981 IF ( vtint_stage(ji,jj) == 1 ) THEN 982 ztcoeff = zrhot * ( zt1**2._wp * ( zt1  1._wp) & 983 &  zt0**2._wp * ( zt0  1._wp) ) 984 ELSEIF( vtint_stage(ji,jj) == 2 ) THEN 985 ztcoeff = zrhot * ( zt1 * ( zt1  1._wp)**2._wp & 986 &  zt0 * ( zt0  1._wp)**2._wp ) 987 ELSEIF( vtint_stage(ji,jj) == 0 ) THEN 988 ztcoeff = 1._wp 989 ELSE 990 ztcoeff = 0._wp 991 ENDIF 992 ! 993 vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj) 994 ! 995 IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN 996 vbdy(ji,jj) = vbdy(ji,jj) / (zrhox*e1v(ji,jj)) * vmask(ji,jj,1) 997 vtint_stage(ji,jj) = 3 998 ELSE 999 vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1 1000 ENDIF 1001 END DO 1002 END DO 1149 1003 ENDIF 1150 1004 ! … … 1179 1033 ! 1180 1034 ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 1035 ! 1036 ! Update interpolation stage: 1037 utint_stage(i1:i2,j1:j2) = 1 1181 1038 ENDIF 1182 1039 ! … … 1193 1050 ! 1194 1051 INTEGER :: ji,jj 1195 REAL(wp) :: zrhot, zt0, zt1, zat1052 REAL(wp) :: zrhot, zt0, zt1, zat 1196 1053 !! 1197 1054 ! … … 1212 1069 ! 1213 1070 vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 1071 ! 1072 ! update interpolation stage: 1073 vtint_stage(i1:i2,j1:j2) = 1 1214 1074 ENDIF 1215 1075 !
Note: See TracChangeset
for help on using the changeset viewer.