- Timestamp:
- 2014-02-06T17:47:57+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r4486 r4491 145 145 END DO 146 146 ELSE 147 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 148 ! Add asselin part 149 DO jn = n1,n2 150 DO jk=k1,k2 151 DO jj=j1,j2 152 DO ji=i1,i2 153 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 154 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 155 & + atfp * ( tabres(ji,jj,jk,jn) & 156 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 157 ENDIF 158 ENDDO 159 ENDDO 160 ENDDO 161 ENDDO 162 ENDIF 163 147 164 DO jn = n1,n2 148 165 DO jk=k1,k2 … … 150 167 DO ji=i1,i2 151 168 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 152 169 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 153 170 END IF 154 171 END DO … … 179 196 DO ji=i1,i2 180 197 tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 181 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u (ji,jj,jk)198 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 182 199 END DO 183 200 END DO … … 188 205 DO jj=j1,j2 189 206 DO ji=i1,i2 190 un(ji,jj,jk) = tabres(ji,jj,jk) / (e2u(ji,jj)) 191 un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 192 un(ji,jj,jk) = un(ji,jj,jk) / fse3u(ji,jj,jk) 207 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk) 208 ! 209 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 210 ub(ji,jj,jk) = ub(ji,jj,jk) & 211 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 212 ENDIF 213 ! 214 un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) 193 215 END DO 194 216 END DO … … 217 239 DO ji=i1,i2 218 240 tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 219 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v (ji,jj,jk)241 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 220 242 END DO 221 243 END DO … … 226 248 DO jj=j1,j2 227 249 DO ji=i1,i2 228 vn(ji,jj,jk) = tabres(ji,jj,jk) / (e1v(ji,jj)) 229 vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 230 vn(ji,jj,jk) = vn(ji,jj,jk) / fse3v(ji,jj,jk) 250 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk) 251 ! 252 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 253 vb(ji,jj,jk) = vb(ji,jj,jk) & 254 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 255 ENDIF 256 ! 257 vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) 231 258 END DO 232 259 END DO … … 248 275 INTEGER :: ji, jj, jk 249 276 REAL(wp) :: zrhoy 250 REAL(wp) :: z hinv277 REAL(wp) :: zcorr 251 278 252 279 IF (before) THEN … … 261 288 DO jj=j1,j2 262 289 DO ji=i1,i2 263 IF(umask(ji,jj,1) .NE. 0.) THEN 264 spgu(ji,jj) = 0.e0 265 DO jk=1,jpk 266 spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * un(ji,jj,jk) 267 END DO 268 spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj) 269 zhinv = (tabres(ji,jj)-spgu(ji,jj))/(hu(ji,jj)*e2u(ji,jj)) 270 Do jk=1,jpk 271 un(ji,jj,jk) = un(ji,jj,jk) + zhinv 272 un(ji,jj,jk) = un(ji,jj,jk) * umask(ji,jj,jk) 273 END DO 274 ENDIF 290 tabres(ji,jj) = tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 291 ! 292 ! Update "now" 3d velocities: 293 spgu(ji,jj) = 0.e0 294 DO jk=1,jpkm1 295 spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 296 END DO 297 spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj) 298 ! 299 zcorr = tabres(ji,jj) - spgu(ji,jj) 300 DO jk=1,jpkm1 301 un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk) 302 END DO 303 ! 275 304 ! Update barotropic velocities: 276 un_b(ji,jj) = tabres(ji,jj) * hur(ji,jj) / e2u(ji,jj) 305 #if defined key_dynspg_ts 306 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 307 zcorr = tabres(ji,jj) - un_b(ji,jj) 308 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 309 END IF 310 #endif 311 un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 312 ! 313 ! Correct "before" velocities to hold correct bt component: 314 spgu(ji,jj) = 0.e0 315 DO jk=1,jpkm1 316 spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 317 END DO 318 spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj) 319 ! 320 zcorr = ub_b(ji,jj) - spgu(ji,jj) 321 DO jk=1,jpkm1 322 ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk) 323 END DO 324 ! 277 325 END DO 278 326 END DO … … 292 340 INTEGER :: ji, jj, jk 293 341 REAL(wp) :: zrhox 294 REAL(wp) :: z hinv342 REAL(wp) :: zcorr 295 343 296 344 IF (before) THEN … … 305 353 DO jj=j1,j2 306 354 DO ji=i1,i2 307 IF(vmask(ji,jj,1) .NE. 0.) THEN 308 spgv(ji,jj) = 0. 309 DO jk=1,jpk 310 spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * vn(ji,jj,jk) 311 END DO 312 spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj) 313 zhinv = (tabres(ji,jj)-spgv(ji,jj))/(hv(ji,jj)*e1v(ji,jj)) 314 DO jk=1,jpk 315 vn(ji,jj,jk) = vn(ji,jj,jk) + zhinv 316 vn(ji,jj,jk) = vn(ji,jj,jk) * vmask(ji,jj,jk) 317 END DO 318 ENDIF 355 tabres(ji,jj) = tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 356 ! 357 ! Update "now" 3d velocities: 358 spgv(ji,jj) = 0.e0 359 DO jk=1,jpkm1 360 spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 361 END DO 362 spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj) 363 ! 364 zcorr = tabres(ji,jj) - spgv(ji,jj) 365 DO jk=1,jpkm1 366 vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk) 367 END DO 368 ! 319 369 ! Update barotropic velocities: 320 vn_b(ji,jj) = tabres(ji,jj) * hvr(ji,jj) / e1v(ji,jj) 370 #if defined key_dynspg_ts 371 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 372 zcorr = tabres(ji,jj) - vn_b(ji,jj) 373 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 374 END IF 375 #endif 376 vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 377 ! 378 ! Correct "before" velocities to hold correct bt component: 379 spgv(ji,jj) = 0.e0 380 DO jk=1,jpkm1 381 spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 382 END DO 383 spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj) 384 ! 385 zcorr = vb_b(ji,jj) - spgv(ji,jj) 386 DO jk=1,jpkm1 387 vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk) 388 END DO 389 ! 321 390 END DO 322 391 END DO … … 344 413 END DO 345 414 ELSE 415 416 #if ! defined key_dynspg_ts 417 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 418 DO jj=j1,j2 419 DO ji=i1,i2 420 sshb(ji,jj) = sshb(ji,jj) & 421 & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 422 END DO 423 END DO 424 ENDIF 425 #endif 346 426 DO jj=j1,j2 347 427 DO ji=i1,i2
Note: See TracChangeset
for help on using the changeset viewer.
