Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r2715 r3294 27 27 USE oce ! ocean dynamics and tracers 28 28 USE dom_oce ! ocean space and time domain 29 USE dommsk ! ocean mask 29 30 USE dynadv ! momentum advection (use ln_dynadv_vec value) 30 31 USE trdmod ! ocean dynamics trends … … 33 34 USE prtctl ! Print control 34 35 USE in_out_manager ! I/O manager 35 USE lib_mpp 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! Memory Allocation 38 USE timing ! Timing 39 36 40 37 41 IMPLICIT NONE … … 71 75 !! and planetary vorticity trends) ('key_trddyn') 72 76 !!---------------------------------------------------------------------- 73 USE oce, ONLY: ztrdu => ta , ztrdv => sa ! (ta,sa) used as 3D workspace74 !75 77 INTEGER, INTENT( in ) :: kt ! ocean time-step index 76 !!---------------------------------------------------------------------- 78 ! 79 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 80 !!---------------------------------------------------------------------- 81 ! 82 IF( nn_timing == 1 ) CALL timing_start('dyn_vor') 83 ! 84 IF( l_trddyn ) CALL wrk_alloc( jpi,jpj,jpk, ztrdu, ztrdv ) 77 85 ! 78 86 ! ! vorticity term … … 175 183 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 176 184 ! 185 IF( l_trddyn ) CALL wrk_dealloc( jpi,jpj,jpk, ztrdu, ztrdv ) 186 ! 187 IF( nn_timing == 1 ) CALL timing_stop('dyn_vor') 188 ! 177 189 END SUBROUTINE dyn_vor 178 190 … … 204 216 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 205 217 !!---------------------------------------------------------------------- 206 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released207 USE wrk_nemo, ONLY: zwx => wrk_2d_1 , zwy => wrk_2d_2 , zwz => wrk_2d_3 ! 2D workspace208 218 ! 209 219 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 215 225 INTEGER :: ji, jj, jk ! dummy loop indices 216 226 REAL(wp) :: zx1, zy1, zfact2, zx2, zy2 ! local scalars 217 !!---------------------------------------------------------------------- 218 219 IF( wrk_in_use(2, 1,2,3) ) THEN 220 CALL ctl_stop('dyn:vor_ene: requested workspace arrays unavailable') ; RETURN 221 ENDIF 222 227 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz 228 !!---------------------------------------------------------------------- 229 ! 230 IF( nn_timing == 1 ) CALL timing_start('vor_ene') 231 ! 232 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz ) 233 ! 223 234 IF( kt == nit000 ) THEN 224 235 IF(lwp) WRITE(numout,*) … … 284 295 END DO ! End of slab 285 296 ! ! =============== 286 IF( wrk_not_released(2, 1,2,3) ) CALL ctl_stop('dyn:vor_ene: failed to release workspace arrays') 297 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz ) 298 ! 299 IF( nn_timing == 1 ) CALL timing_stop('vor_ene') 287 300 ! 288 301 END SUBROUTINE vor_ene … … 320 333 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 321 334 !!---------------------------------------------------------------------- 322 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released323 USE wrk_nemo, ONLY: zwx => wrk_2d_4 , zwy => wrk_2d_5 , zwz => wrk_2d_6 , zww => wrk_2d_7 ! 2D workspace324 335 ! 325 336 INTEGER, INTENT(in) :: kt ! ocean timestep index … … 328 339 REAL(wp) :: zfact1, zua, zcua, zx1, zy1 ! local scalars 329 340 REAL(wp) :: zfact2, zva, zcva, zx2, zy2 ! - - 330 !!---------------------------------------------------------------------- 331 332 IF( wrk_in_use(2, 4,5,6,7) ) THEN 333 CALL ctl_stop('dyn:vor_mix: requested workspace arrays unavailable') ; RETURN 334 ENDIF 335 341 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww 342 !!---------------------------------------------------------------------- 343 ! 344 IF( nn_timing == 1 ) CALL timing_start('vor_mix') 345 ! 346 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz, zww ) 347 ! 336 348 IF( kt == nit000 ) THEN 337 349 IF(lwp) WRITE(numout,*) … … 404 416 END DO ! End of slab 405 417 ! ! =============== 406 IF( wrk_not_released(2, 4,5,6,7) ) CALL ctl_stop('dyn:vor_mix: failed to release workspace arrays') 418 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz, zww ) 419 ! 420 IF( nn_timing == 1 ) CALL timing_stop('vor_mix') 407 421 ! 408 422 END SUBROUTINE vor_mix … … 435 449 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 436 450 !!---------------------------------------------------------------------- 437 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released438 USE wrk_nemo, ONLY: zwx => wrk_2d_4, zwy => wrk_2d_5, zwz => wrk_2d_6 ! 2D workspace439 451 ! 440 452 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 446 458 INTEGER :: ji, jj, jk ! dummy loop indices 447 459 REAL(wp) :: zfact1, zuav, zvau ! temporary scalars 448 !!---------------------------------------------------------------------- 449 450 IF( wrk_in_use(2, 4,5,6) ) THEN 451 CALL ctl_stop('dyn:vor_ens: requested workspace arrays unavailable') ; RETURN 452 END IF 453 460 REAL(wp), POINTER, DIMENSION(:,:) :: zwx, zwy, zwz, zww 461 !!---------------------------------------------------------------------- 462 ! 463 IF( nn_timing == 1 ) CALL timing_start('vor_ens') 464 ! 465 CALL wrk_alloc( jpi, jpj, zwx, zwy, zwz ) 466 ! 454 467 IF( kt == nit000 ) THEN 455 468 IF(lwp) WRITE(numout,*) … … 523 536 END DO ! End of slab 524 537 ! ! =============== 525 IF( wrk_not_released(2, 4,5,6) ) CALL ctl_stop('dyn:vor_ens: failed to release workspace arrays') 538 CALL wrk_dealloc( jpi, jpj, zwx, zwy, zwz ) 539 ! 540 IF( nn_timing == 1 ) CALL timing_stop('vor_ens') 526 541 ! 527 542 END SUBROUTINE vor_ens … … 547 562 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 548 563 !!---------------------------------------------------------------------- 549 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released550 USE wrk_nemo, ONLY: zwx => wrk_2d_1 , zwy => wrk_2d_2 , zwz => wrk_2d_3 ! 2D workspace551 USE wrk_nemo, ONLY: ztnw => wrk_2d_4 , ztne => wrk_2d_5552 USE wrk_nemo, ONLY: ztsw => wrk_2d_6 , ztse => wrk_2d_7553 #if defined key_vvl554 USE wrk_nemo, ONLY: ze3f => wrk_3d_1 ! 3D workspace (lk_vvl=T)555 #endif556 564 ! 557 565 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 561 569 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 562 570 !! 563 INTEGER :: ji, jj, jk ! dummy loop indices 564 INTEGER :: ierr ! local integer 565 REAL(wp) :: zfac12, zua, zva ! local scalars 571 INTEGER :: ji, jj, jk ! dummy loop indices 572 INTEGER :: ierr ! local integer 573 REAL(wp) :: zfac12, zua, zva ! local scalars 574 ! ! 3D workspace 575 REAL(wp), POINTER , DIMENSION(:,: ) :: zwx, zwy, zwz 576 REAL(wp), POINTER , DIMENSION(:,: ) :: ztnw, ztne, ztsw, ztse 577 #if defined key_vvl 578 REAL(wp), POINTER , DIMENSION(:,:,:) :: ze3f ! 3D workspace (lk_vvl=T) 579 #endif 566 580 #if ! defined key_vvl 567 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE ::ze3f ! lk_vvl=F, ze3f=1/e3f saved one for all581 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: ze3f ! lk_vvl=F, ze3f=1/e3f saved one for all 568 582 #endif 569 583 !!---------------------------------------------------------------------- 570 571 IF( wrk_in_use(2, 1,2,3,4,5,6,7) .OR. wrk_in_use(3, 1) ) THEN 572 CALL ctl_stop('dyn:vor_een: requested workspace arrays unavailable') ; RETURN 573 ENDIF 574 584 ! 585 IF( nn_timing == 1 ) CALL timing_start('vor_een') 586 ! 587 CALL wrk_alloc( jpi, jpj, zwx , zwy , zwz ) 588 CALL wrk_alloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 589 #if defined key_vvl 590 CALL wrk_alloc( jpi, jpj, jpk, ze3f ) 591 #endif 592 ! 575 593 IF( kt == nit000 ) THEN 576 594 IF(lwp) WRITE(numout,*) … … 670 688 END DO ! End of slab 671 689 ! ! =============== 672 IF( wrk_not_released(2, 1,2,3,4,5,6,7) .OR. & 673 wrk_not_released(3, 1) ) CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 690 CALL wrk_dealloc( jpi, jpj, zwx , zwy , zwz ) 691 CALL wrk_dealloc( jpi, jpj, ztnw, ztne, ztsw, ztse ) 692 #if defined key_vvl 693 CALL wrk_dealloc( jpi, jpj, jpk, ze3f ) 694 #endif 695 ! 696 IF( nn_timing == 1 ) CALL timing_stop('vor_een') 674 697 ! 675 698 END SUBROUTINE vor_een … … 684 707 !!---------------------------------------------------------------------- 685 708 INTEGER :: ioptio ! local integer 709 INTEGER :: ji, jj, jk ! dummy loop indices 686 710 !! 687 711 NAMELIST/namdyn_vor/ ln_dynvor_ens, ln_dynvor_ene, ln_dynvor_mix, ln_dynvor_een … … 700 724 WRITE(numout,*) ' mixed enstrophy/energy conserving scheme ln_dynvor_mix = ', ln_dynvor_mix 701 725 WRITE(numout,*) ' enstrophy and energy conserving scheme ln_dynvor_een = ', ln_dynvor_een 726 ENDIF 727 728 ! If energy, enstrophy or mixed advection of momentum in vector form change the value for masks 729 ! at angles with three ocean points and one land point 730 IF( ln_vorlat .AND. ( ln_dynvor_ene .OR. ln_dynvor_ens .OR. ln_dynvor_mix ) ) THEN 731 DO jk = 1, jpk 732 DO jj = 2, jpjm1 733 DO ji = 2, jpim1 734 IF( tmask(ji,jj,jk)+tmask(ji+1,jj,jk)+tmask(ji,jj+1,jk)+tmask(ji+1,jj+1,jk) == 3._wp ) & 735 fmask(ji,jj,jk) = 1._wp 736 END DO 737 END DO 738 END DO 739 ! 740 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 741 ! 702 742 ENDIF 703 743
Note: See TracChangeset
for help on using the changeset viewer.
