Ticket #1362: dynzdf_imp_tam.F90.diff
File dynzdf_imp_tam.F90.diff, 4.8 KB (added by sam, 6 years ago) |
---|
-
dynzdf_imp_tam.F90
old new 79 79 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_imp_tan') 80 80 ! 81 81 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 82 CALL wrk_alloc( jpi,jpj, zavmu, zavmv) 82 83 ! 83 84 IF( kt == nit000 ) THEN 84 85 IF(lwp) WRITE(numout,*) … … 320 321 ENDIF 321 322 ! 322 323 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 324 CALL wrk_dealloc( jpi,jpj, zavmu, zavmv) 323 325 ! 324 326 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp_tan') 325 327 ! … … 352 354 353 355 !! * Local declarations 354 356 !! * Local declarations 355 INTEGER :: ji, jj, jk 357 INTEGER :: ji, jj, jk, ikbu, ikbv ! dummy loop indices 356 358 REAL(wp) :: z1_p2dt, z2dtf, zcoef, zzws, zrhsad ! temporary scalars 357 359 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zws, zwd! temporary workspace arrays 360 REAL(wp), POINTER, DIMENSION(:,:):: zavmu, zavmv ! temporary workspace arrays 358 361 !!---------------------------------------------------------------------- 359 362 ! 360 363 IF( nn_timing == 1 ) CALL timing_start('dyn_zdf_imp_adj') 361 364 ! 362 365 CALL wrk_alloc( jpi,jpj,jpk, zwi, zwd, zws ) 366 CALL wrk_alloc( jpi,jpj, zavmu, zavmv ) 363 367 ! 364 368 IF( kt == nitend ) THEN 365 369 IF(lwp) WRITE(numout,*) … … 371 375 z1_p2dt = 1._wp / p2dt ! inverse of the timestep 372 376 zrhsad = 0.0_wp 373 377 ! 374 !! restore bottom layer avmu(v) 378 ! 379 ! 1. Apply semi-implicit bottom friction 380 ! -------------------------------------- 381 ! Only needed for semi-implicit bottom friction setup. The explicit 382 ! bottom friction has been included in "u(v)a" which act as the R.H.S 383 ! column vector of the tri-diagonal matrix equation 384 ! 375 385 IF( ln_bfrimp ) THEN 376 !# if defined key_vectopt_loop 377 !DO jj = 1, 1 378 !DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 379 !# else 380 !DO jj = 2, jpjm1 381 !DO ji = 2, jpim1 382 !# endif 383 !ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 384 !ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 385 !avmu(ji,jj,ikbu+1) = zavmu(ji,jj) 386 !avmv(ji,jj,ikbv+1) = zavmv(ji,jj) 387 !END DO 388 !END DO 386 # if defined key_vectopt_loop 387 DO jj = 1, 1 388 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 389 # else 390 DO jj = 2, jpjm1 391 DO ji = 2, jpim1 392 # endif 393 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 394 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 395 zavmu(ji,jj) = avmu(ji,jj,ikbu+1) 396 zavmv(ji,jj) = avmv(ji,jj,ikbv+1) 397 avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 398 avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 399 END DO 400 END DO 389 401 ENDIF 390 402 ! 391 403 ! 2. Vertical diffusion on v … … 577 589 ua_ad(ji,jj,1) = p2dt * ua_ad(ji,jj,1) 578 590 END DO 579 591 END DO 580 ! 581 ! 1. Apply semi-implicit bottom friction 582 ! -------------------------------------- 583 ! Only needed for semi-implicit bottom friction setup. The explicit 584 ! bottom friction has been included in "u(v)a" which act as the R.H.S 585 ! column vector of the tri-diagonal matrix equation 586 ! 592 !! restore bottom layer avmu(v) 587 593 IF( ln_bfrimp ) THEN 588 !# if defined key_vectopt_loop 589 !DO jj = 1, 1 590 !DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 591 !# else 592 !DO jj = 2, jpjm1 593 !DO ji = 2, jpim1 594 !# endif 595 !ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 596 !ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 597 !zavmu(ji,jj) = avmu(ji,jj,ikbu+1) 598 !zavmv(ji,jj) = avmv(ji,jj,ikbv+1) 599 !avmu(ji,jj,ikbu+1) = -bfrua(ji,jj) * fse3uw(ji,jj,ikbu+1) 600 !avmv(ji,jj,ikbv+1) = -bfrva(ji,jj) * fse3vw(ji,jj,ikbv+1) 601 !END DO 602 !END DO 594 # if defined key_vectopt_loop 595 DO jj = 1, 1 596 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 597 # else 598 DO jj = 2, jpjm1 599 DO ji = 2, jpim1 600 # endif 601 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 602 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 603 avmu(ji,jj,ikbu+1) = zavmu(ji,jj) 604 avmv(ji,jj,ikbv+1) = zavmv(ji,jj) 605 END DO 606 END DO 603 607 ENDIF 604 608 ! 605 609 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwd, zws) 610 CALL wrk_dealloc( jpi,jpj, zavmu, zavmv) 606 611 ! 607 612 IF( nn_timing == 1 ) CALL timing_stop('dyn_zdf_imp_adj') 608 613 !