- Timestamp:
- 2020-09-24T20:32:14+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE
- Files:
-
- 8 edited
-
DYN/dynhpg.F90 (modified) (1 diff)
-
LDF/ldftra.F90 (modified) (6 diffs)
-
TRA/eosbn2.F90 (modified) (18 diffs)
-
TRA/traldf.F90 (modified) (3 diffs)
-
TRA/traldf_iso.F90 (modified) (11 diffs)
-
TRA/traldf_lap_blp.F90 (modified) (8 diffs)
-
TRA/traldf_triad.F90 (modified) (13 diffs)
-
TRA/zpshde.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/DYN/dynhpg.F90
r13295 r13515 302 302 INTEGER :: iku, ikv ! temporary integers 303 303 REAL(wp) :: zcoef0, zcoef1, zcoef2, zcoef3 ! temporary scalars 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 305 REAL(wp), DIMENSION(jpi,jpj) :: zgtsu, zgtsv, zgru, zgrv 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zhpi, zhpj 305 REAL(wp), DIMENSION(jpi,jpj,1) :: zgtsu, zgtsv 306 REAL(wp), DIMENSION(jpi,jpj) :: zgru, zgrv 306 307 !!---------------------------------------------------------------------- 307 308 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/LDF/ldftra.F90
r13295 r13515 726 726 !! ** Action : pu, pv increased by the eiv transport 727 727 !!---------------------------------------------------------------------- 728 INTEGER 729 INTEGER 730 INTEGER 731 CHARACTER(len=3) 732 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pu! in : 3 ocean transport components [m3/s]733 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pv! out: 3 ocean transport components [m3/s]734 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: pw! increased by the eiv [m3/s]728 INTEGER , INTENT(in ) :: kt ! ocean time-step index 729 INTEGER , INTENT(in ) :: kit000 ! first time step index 730 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 731 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 732 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pu ! in : 3 ocean transport components [m3/s] 733 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pv ! out: 3 ocean transport components [m3/s] 734 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: pw ! increased by the eiv [m3/s] 735 735 !! 736 736 INTEGER :: ji, jj, jk ! dummy loop indices 737 737 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 738 738 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 739 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 740 !!---------------------------------------------------------------------- 741 ! 742 IF( kt == kit000 ) THEN 743 IF(lwp) WRITE(numout,*) 744 IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 745 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 739 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zpsi_uw, zpsi_vw 740 !!---------------------------------------------------------------------- 741 ! 742 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 743 IF( kt == kit000 ) THEN 744 IF(lwp) WRITE(numout,*) 745 IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 746 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 747 ENDIF 746 748 ENDIF 747 749 … … 782 784 !! 783 785 !!---------------------------------------------------------------------- 784 REAL(wp), DIMENSION( jpi,jpj,jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s]785 INTEGER 786 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s] 787 INTEGER , INTENT(in ) :: Kmm ! ocean time level indices 786 788 ! 787 789 INTEGER :: ji, jj, jk ! dummy loop indices 788 790 REAL(wp) :: zztmp ! local scalar 789 REAL(wp), DIMENSION( jpi,jpj) :: zw2d ! 2D workspace790 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zw3d ! 3D workspace791 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zw2d ! 2D workspace 792 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zw3d ! 3D workspace 791 793 !!---------------------------------------------------------------------- 792 794 ! … … 803 805 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 804 806 ! 805 DO jk = 1, jpkm1! e2u e3u u_eiv = -dk[psi_uw]806 zw3d( :,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u(:,:,jk,Kmm) )807 END DO807 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! e2u e3u u_eiv = -dk[psi_uw] 808 zw3d(ji,jj,jk) = ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) ) 809 END_3D 808 810 CALL iom_put( "uoce_eiv", zw3d ) 809 811 ! 810 DO jk = 1, jpkm1! e1v e3v v_eiv = -dk[psi_vw]811 zw3d( :,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v(:,:,jk,Kmm) )812 END DO812 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) ! e1v e3v v_eiv = -dk[psi_vw] 813 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) ) 814 END_3D 813 815 CALL iom_put( "voce_eiv", zw3d ) 814 816 ! … … 821 823 ! 822 824 IF( iom_use('weiv_masstr') ) THEN ! vertical mass transport & its square value 823 zw2d(:,:) = rho0 * e1e2t(:,:) 825 DO_2D( 1, 1, 1, 1 ) 826 zw2d(ji,jj) = rho0 * e1e2t(ji,jj) 827 END_2D 824 828 DO jk = 1, jpk 825 829 zw3d(:,:,jk) = zw3d(:,:,jk) * zw2d(:,:) … … 867 871 END_3D 868 872 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 869 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction 870 CALL iom_put( "veiv_heattr", zztmp * zw3d ) ! heat transport in j-direction 873 CALL lbc_lnk( 'ldftra', zw3d, 'V', -1. ) 874 CALL iom_put( "veiv_heattr" , zztmp * zw2d ) ! heat transport in j-direction 875 CALL iom_put( "veiv_heattr3d", zztmp * zw3d ) ! heat transport in j-direction 871 876 ! 872 877 IF( iom_use( 'sophteiv' ) ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) … … 894 899 END_3D 895 900 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1.0_wp ) 896 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction 897 CALL iom_put( "veiv_salttr", zztmp * zw3d ) ! salt transport in j-direction 901 CALL lbc_lnk( 'ldftra', zw3d, 'V', -1. ) 902 CALL iom_put( "veiv_salttr" , zztmp * zw2d ) ! salt transport in j-direction 903 CALL iom_put( "veiv_salttr3d", zztmp * zw3d ) ! salt transport in j-direction 898 904 ! 899 905 IF( iom_use( 'sopsteiv' ) ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/eosbn2.F90
r13295 r13515 39 39 !!---------------------------------------------------------------------- 40 40 USE dom_oce ! ocean space and time domain 41 USE domutl, ONLY : is_tile 41 42 USE phycst ! physical constants 42 43 USE stopar ! Stochastic T/S fluctuations … … 189 190 190 191 SUBROUTINE eos_insitu( pts, prd, pdep ) 192 !! 193 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 194 ! ! 2 : salinity [psu] 195 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 196 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 197 !! 198 CALL eos_insitu_t( pts, is_tile(pts), prd, is_tile(prd), pdep, is_tile(pdep) ) 199 END SUBROUTINE eos_insitu 200 201 SUBROUTINE eos_insitu_t( pts, ktts, prd, ktrd, pdep, ktdep ) 191 202 !!---------------------------------------------------------------------- 192 203 !! *** ROUTINE eos_insitu *** … … 222 233 !! TEOS-10 Manual, 2010 223 234 !!---------------------------------------------------------------------- 224 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 225 ! ! 2 : salinity [psu] 226 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 227 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 235 INTEGER , INTENT(in ) :: ktts, ktrd, ktdep 236 REAL(wp), DIMENSION(ST_2DT(ktts) ,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 237 ! ! 2 : salinity [psu] 238 REAL(wp), DIMENSION(ST_2DT(ktrd) ,jpk ), INTENT( out) :: prd ! in situ density [-] 239 REAL(wp), DIMENSION(ST_2DT(ktdep),jpk ), INTENT(in ) :: pdep ! depth [m] 228 240 ! 229 241 INTEGER :: ji, jj, jk ! dummy loop indices … … 293 305 IF( ln_timing ) CALL timing_stop('eos-insitu') 294 306 ! 295 END SUBROUTINE eos_insitu 307 END SUBROUTINE eos_insitu_t 296 308 297 309 298 310 SUBROUTINE eos_insitu_pot( pts, prd, prhop, pdep ) 311 !! 312 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 313 ! ! 2 : salinity [psu] 314 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prd ! in situ density [-] 315 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: prhop ! potential density (surface referenced) 316 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pdep ! depth [m] 317 !! 318 CALL eos_insitu_pot_t( pts, is_tile(pts), prd, is_tile(prd), prhop, is_tile(prhop), pdep, is_tile(pdep) ) 319 END SUBROUTINE eos_insitu_pot 320 321 322 SUBROUTINE eos_insitu_pot_t( pts, ktts, prd, ktrd, prhop, ktrhop, pdep, ktdep ) 299 323 !!---------------------------------------------------------------------- 300 324 !! *** ROUTINE eos_insitu_pot *** … … 309 333 !! 310 334 !!---------------------------------------------------------------------- 311 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 312 ! ! 2 : salinity [psu] 313 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 335 INTEGER , INTENT(in ) :: ktts, ktrd, ktrhop, ktdep 336 REAL(wp), DIMENSION(ST_2DT(ktts) ,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 337 ! ! 2 : salinity [psu] 338 REAL(wp), DIMENSION(ST_2DT(ktrd) ,jpk ), INTENT( out) :: prd ! in situ density [-] 339 REAL(wp), DIMENSION(ST_2DT(ktrhop),jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 340 REAL(wp), DIMENSION(ST_2DT(ktdep) ,jpk ), INTENT(in ) :: pdep ! depth [m] 316 341 ! 317 342 INTEGER :: ji, jj, jk, jsmp ! dummy loop indices … … 444 469 END SELECT 445 470 ! 446 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 471 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', & 472 & tab3d_2=prhop, clinfo2=' pot : ', kdim=jpk ) 447 473 ! 448 474 IF( ln_timing ) CALL timing_stop('eos-pot') 449 475 ! 450 END SUBROUTINE eos_insitu_pot 476 END SUBROUTINE eos_insitu_pot_t 451 477 452 478 453 479 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 480 !! 481 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 482 ! ! 2 : salinity [psu] 483 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 484 REAL(wp), DIMENSION(:,:) , INTENT( out) :: prd ! in situ density 485 !! 486 CALL eos_insitu_2d_t( pts, is_tile(pts), pdep, is_tile(pdep), prd, is_tile(prd) ) 487 END SUBROUTINE eos_insitu_2d 488 489 490 SUBROUTINE eos_insitu_2d_t( pts, ktts, pdep, ktdep, prd, ktrd ) 454 491 !!---------------------------------------------------------------------- 455 492 !! *** ROUTINE eos_insitu_2d *** … … 462 499 !! 463 500 !!---------------------------------------------------------------------- 464 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 465 ! ! 2 : salinity [psu] 466 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 467 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 501 INTEGER , INTENT(in ) :: ktts, ktdep, ktrd 502 REAL(wp), DIMENSION(ST_2DT(ktts),jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 503 ! ! 2 : salinity [psu] 504 REAL(wp), DIMENSION(ST_2DT(ktdep) ), INTENT(in ) :: pdep ! depth [m] 505 REAL(wp), DIMENSION(ST_2DT(ktrd) ), INTENT( out) :: prd ! in situ density 468 506 ! 469 507 INTEGER :: ji, jj, jk ! dummy loop indices … … 535 573 IF( ln_timing ) CALL timing_stop('eos2d') 536 574 ! 537 END SUBROUTINE eos_insitu_2d 575 END SUBROUTINE eos_insitu_2d_t 538 576 539 577 540 578 SUBROUTINE rab_3d( pts, pab, Kmm ) 579 !! 580 INTEGER , INTENT(in ) :: Kmm ! time level index 581 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 582 REAL(wp), DIMENSION(:,:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 583 !! 584 CALL rab_3d_t( pts, is_tile(pts), pab, is_tile(pab), Kmm ) 585 END SUBROUTINE rab_3d 586 587 588 SUBROUTINE rab_3d_t( pts, ktts, pab, ktab, Kmm ) 541 589 !!---------------------------------------------------------------------- 542 590 !! *** ROUTINE rab_3d *** … … 548 596 !! ** Action : - pab : thermal/haline expansion ratio at T-points 549 597 !!---------------------------------------------------------------------- 550 INTEGER , INTENT(in ) :: Kmm ! time level index 551 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 552 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 598 INTEGER , INTENT(in ) :: Kmm ! time level index 599 INTEGER , INTENT(in ) :: ktts, ktab 600 REAL(wp), DIMENSION(ST_2DT(ktts),jpk,jpts), INTENT(in ) :: pts ! pot. temperature & salinity 601 REAL(wp), DIMENSION(ST_2DT(ktab),jpk,jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 553 602 ! 554 603 INTEGER :: ji, jj, jk ! dummy loop indices … … 641 690 IF( ln_timing ) CALL timing_stop('rab_3d') 642 691 ! 643 END SUBROUTINE rab_3d 692 END SUBROUTINE rab_3d_t 644 693 645 694 646 695 SUBROUTINE rab_2d( pts, pdep, pab, Kmm ) 696 !! 697 INTEGER , INTENT(in ) :: Kmm ! time level index 698 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: pts ! pot. temperature & salinity 699 REAL(wp), DIMENSION(:,:) , INTENT(in ) :: pdep ! depth [m] 700 REAL(wp), DIMENSION(:,:,:), INTENT( out) :: pab ! thermal/haline expansion ratio 701 !! 702 CALL rab_2d_t(pts, is_tile(pts), pdep, is_tile(pdep), pab, is_tile(pab), Kmm) 703 END SUBROUTINE rab_2d 704 705 706 SUBROUTINE rab_2d_t( pts, ktts, pdep, ktdep, pab, ktab, Kmm ) 647 707 !!---------------------------------------------------------------------- 648 708 !! *** ROUTINE rab_2d *** … … 652 712 !! ** Action : - pab : thermal/haline expansion ratio at T-points 653 713 !!---------------------------------------------------------------------- 654 INTEGER , INTENT(in ) :: Kmm ! time level index 655 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT(in ) :: pts ! pot. temperature & salinity 656 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 657 REAL(wp), DIMENSION(jpi,jpj,jpts) , INTENT( out) :: pab ! thermal/haline expansion ratio 714 INTEGER , INTENT(in ) :: Kmm ! time level index 715 INTEGER , INTENT(in ) :: ktts, ktdep, ktab 716 REAL(wp), DIMENSION(ST_2DT(ktts),jpts), INTENT(in ) :: pts ! pot. temperature & salinity 717 REAL(wp), DIMENSION(ST_2DT(ktdep) ), INTENT(in ) :: pdep ! depth [m] 718 REAL(wp), DIMENSION(ST_2DT(ktab),jpts), INTENT( out) :: pab ! thermal/haline expansion ratio 658 719 ! 659 720 INTEGER :: ji, jj, jk ! dummy loop indices … … 748 809 IF( ln_timing ) CALL timing_stop('rab_2d') 749 810 ! 750 END SUBROUTINE rab_2d 811 END SUBROUTINE rab_2d_t 751 812 752 813 … … 849 910 850 911 SUBROUTINE bn2( pts, pab, pn2, Kmm ) 912 !! 913 INTEGER , INTENT(in ) :: Kmm ! time level index 914 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 915 REAL(wp), DIMENSION(:,:,:,:) , INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 916 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 917 !! 918 CALL bn2_t( pts, pab, is_tile(pab), pn2, is_tile(pn2), Kmm ) 919 END SUBROUTINE bn2 920 921 922 SUBROUTINE bn2_t( pts, pab, ktab, pn2, ktn2, Kmm ) 851 923 !!---------------------------------------------------------------------- 852 924 !! *** ROUTINE bn2 *** … … 862 934 !! 863 935 !!---------------------------------------------------------------------- 864 INTEGER , INTENT(in ) :: Kmm ! time level index 865 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 866 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 867 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 936 INTEGER , INTENT(in ) :: Kmm ! time level index 937 INTEGER , INTENT(in ) :: ktab, ktn2 938 REAL(wp), DIMENSION(jpi,jpj, jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 939 REAL(wp), DIMENSION(ST_2DT(ktab),jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 940 REAL(wp), DIMENSION(ST_2DT(ktn2),jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 868 941 ! 869 942 INTEGER :: ji, jj, jk ! dummy loop indices … … 889 962 IF( ln_timing ) CALL timing_stop('bn2') 890 963 ! 891 END SUBROUTINE bn2 964 END SUBROUTINE bn2_t 892 965 893 966 … … 949 1022 950 1023 951 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1024 SUBROUTINE eos_fzp_2d( psal, ptf, pdep ) 1025 !! 1026 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1027 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1028 REAL(wp), DIMENSION(:,:) , INTENT(out ) :: ptf ! freezing temperature [Celsius] 1029 !! 1030 CALL eos_fzp_2d_t( psal, ptf, is_tile(ptf), pdep ) 1031 END SUBROUTINE eos_fzp_2d 1032 1033 1034 SUBROUTINE eos_fzp_2d_t( psal, ptf, kttf, pdep ) 952 1035 !!---------------------------------------------------------------------- 953 1036 !! *** ROUTINE eos_fzp *** … … 961 1044 !! Reference : UNESCO tech. papers in the marine science no. 28. 1978 962 1045 !!---------------------------------------------------------------------- 963 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 964 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 965 REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1046 INTEGER , INTENT(in ) :: kttf 1047 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: psal ! salinity [psu] 1048 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ), OPTIONAL :: pdep ! depth [m] 1049 REAL(wp), DIMENSION(ST_2DT(kttf)), INTENT(out ) :: ptf ! freezing temperature [Celsius] 966 1050 ! 967 1051 INTEGER :: ji, jj ! dummy loop indices … … 996 1080 END SELECT 997 1081 ! 998 END SUBROUTINE eos_fzp_2d 1082 END SUBROUTINE eos_fzp_2d_t 999 1083 1000 1084 -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf.F90
r12377 r13515 17 17 USE oce ! ocean dynamics and tracers 18 18 USE dom_oce ! ocean space and time domain 19 ! TEMP: This change not necessary after trd_tra is tiled 20 USE domain, ONLY : dom_tile 19 21 USE phycst ! physical constants 20 22 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. … … 37 39 PUBLIC tra_ldf ! called by step.F90 38 40 PUBLIC tra_ldf_init ! called by nemogcm.F90 39 41 42 !! * Substitutions 43 # include "do_loop_substitute.h90" 40 44 !!---------------------------------------------------------------------- 41 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 55 59 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 56 60 !! 57 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds 61 ! TEMP: This change not necessary after trd_tra is tiled 62 INTEGER :: itile 63 INTEGER :: ji, jj, jk ! dummy loop indices 64 ! TEMP: This change not necessary after trd_tra is tiled 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ztrdt, ztrds 66 ! TEMP: This change not necessary after extra haloes development 67 LOGICAL :: lskip 58 68 !!---------------------------------------------------------------------- 59 69 ! 60 70 IF( ln_timing ) CALL timing_start('tra_ldf') 61 71 ! 62 IF( l_trdtra ) THEN !* Save ta and sa trends 63 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 64 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 65 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 72 lskip = .FALSE. 73 74 IF( l_trdtra ) THEN 75 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 76 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 77 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 78 ENDIF 66 79 ENDIF 67 ! 68 SELECT CASE ( nldf_tra ) !* compute lateral mixing trend and add it to the general trend 69 CASE ( np_lap ) ! laplacian: iso-level operator 70 CALL tra_ldf_lap ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 71 CASE ( np_lap_i ) ! laplacian: standard iso-neutral operator (Madec) 72 CALL tra_ldf_iso ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 73 CASE ( np_lap_it ) ! laplacian: triad iso-neutral operator (griffies) 74 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 75 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 76 CALL tra_ldf_blp ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, nldf_tra ) 77 END SELECT 78 ! 79 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 80 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 81 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 82 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 83 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 84 DEALLOCATE( ztrdt, ztrds ) 80 81 ! TEMP: These changes not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 82 IF( nldf_tra == np_blp .OR. nldf_tra == np_blp_i .OR. nldf_tra == np_blp_it ) THEN 83 IF( ln_tile ) THEN 84 IF( ntile == 1 ) THEN 85 CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 86 ELSE 87 lskip = .TRUE. 88 ENDIF 89 ENDIF 90 ENDIF 91 IF( .NOT. lskip ) THEN 92 93 ! TEMP: This change not necessary after trd_tra is tiled 94 itile = ntile 95 96 IF( l_trdtra ) THEN !* Save ta and sa trends 97 DO_3D( 0, 0, 0, 0, 1, jpk ) 98 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) 99 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) 100 END_3D 101 ENDIF 102 ! 103 SELECT CASE ( nldf_tra ) !* compute lateral mixing trend and add it to the general trend 104 CASE ( np_lap ) ! laplacian: iso-level operator 105 CALL tra_ldf_lap ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 106 CASE ( np_lap_i ) ! laplacian: standard iso-neutral operator (Madec) 107 CALL tra_ldf_iso ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 108 CASE ( np_lap_it ) ! laplacian: triad iso-neutral operator (griffies) 109 CALL tra_ldf_triad( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, 1 ) 110 CASE ( np_blp , np_blp_i , np_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 111 CALL tra_ldf_blp ( kt, Kmm, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, nldf_tra ) 112 END SELECT 113 ! 114 ! TEMP: These changes not necessary after trd_tra is tiled 115 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 116 DO_3D( 0, 0, 0, 0, 1, jpk ) 117 ztrdt(ji,jj,jk) = pts(ji,jj,jk,jp_tem,Krhs) - ztrdt(ji,jj,jk) 118 ztrds(ji,jj,jk) = pts(ji,jj,jk,jp_sal,Krhs) - ztrds(ji,jj,jk) 119 END_3D 120 121 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 122 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 123 124 ! TODO: TO BE TILED- trd_tra 125 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_ldf, ztrdt ) 126 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_ldf, ztrds ) 127 DEALLOCATE( ztrdt, ztrds ) 128 129 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 130 ENDIF 131 ENDIF 132 133 ! TEMP: This change not necessary after extra haloes development (lbc_lnk removed from tra_ldf_blp, zps_hde*) 134 IF( ln_tile .AND. ntile == 0 ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 1 ) 135 85 136 ENDIF 86 137 ! !* print mean trends (used for debugging) 87 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf - Ta: ', mask1=tmask, 138 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' ldf - Ta: ', mask1=tmask, & 88 139 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 89 140 ! -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_iso.F90
r13295 r13515 19 19 USE oce ! ocean dynamics and active tracers 20 20 USE dom_oce ! ocean space and time domain 21 USE domutl, ONLY : is_tile 21 22 USE trc_oce ! share passive tracers/Ocean variables 22 23 USE zdf_oce ! ocean vertical physics … … 49 50 CONTAINS 50 51 51 SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv, & 52 & pgu , pgv , pgui, pgvi, & 53 & pt , pt2 , pt_rhs , kjpt , kpass ) 52 SUBROUTINE tra_ldf_iso( kt, Kmm, kit000, cdtype, pahu, pahv, & 53 & pgu , pgv , pgui, pgvi, & 54 & pt, pt2, pt_rhs, kjpt, kpass ) 55 !! 56 INTEGER , INTENT(in ) :: kt ! ocean time-step index 57 INTEGER , INTENT(in ) :: kit000 ! first time step index 58 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 59 INTEGER , INTENT(in ) :: kjpt ! number of tracers 60 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 61 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 62 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 63 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 64 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 65 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 66 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 67 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend 68 !! 69 CALL tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), & 70 & pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), & 71 & pt, is_tile(pt), pt2, is_tile(pt2), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 72 END SUBROUTINE tra_ldf_iso 73 74 75 SUBROUTINE tra_ldf_iso_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah, & 76 & pgu , pgv , ktg , pgui, pgvi, ktgi, & 77 & pt, ktt, pt2, ktt2, pt_rhs, ktt_rhs, kjpt, kpass ) 54 78 !!---------------------------------------------------------------------- 55 79 !! *** ROUTINE tra_ldf_iso *** … … 92 116 !! ** Action : Update pt_rhs arrays with the before rotated diffusion 93 117 !!---------------------------------------------------------------------- 94 INTEGER , INTENT(in ) :: kt ! ocean time-step index 95 INTEGER , INTENT(in ) :: kit000 ! first time step index 96 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 97 INTEGER , INTENT(in ) :: kjpt ! number of tracers 98 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 99 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 100 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 101 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 102 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 103 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 104 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 105 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 118 INTEGER , INTENT(in ) :: kt ! ocean time-step index 119 INTEGER , INTENT(in ) :: kit000 ! first time step index 120 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 121 INTEGER , INTENT(in ) :: kjpt ! number of tracers 122 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 123 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 124 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 125 REAL(wp), DIMENSION(ST_2DT(ktah) ,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 126 REAL(wp), DIMENSION(ST_2DT(ktg) ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 127 REAL(wp), DIMENSION(ST_2DT(ktgi) ,kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 128 REAL(wp), DIMENSION(ST_2DT(ktt) ,jpk,kjpt), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 129 REAL(wp), DIMENSION(ST_2DT(ktt2) ,jpk,kjpt), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 130 REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 106 131 ! 107 132 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 111 136 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 112 137 REAL(wp) :: zcoef0, ze3w_2, zsign ! - - 113 REAL(wp), DIMENSION( jpi,jpj) :: zdkt, zdk1t, z2d114 REAL(wp), DIMENSION( jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw138 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zdkt, zdk1t, z2d 139 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zdit, zdjt, zftu, zftv, ztfw 115 140 !!---------------------------------------------------------------------- 116 141 ! 117 142 IF( kpass == 1 .AND. kt == kit000 ) THEN 118 IF(lwp) WRITE(numout,*) 119 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 120 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 121 ! 122 akz (:,:,:) = 0._wp 123 ah_wslp2(:,:,:) = 0._wp 143 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 144 IF(lwp) WRITE(numout,*) 145 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 146 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 147 ENDIF 148 ! 149 DO_3D( 0, 0, 0, 0, 1, jpk ) 150 akz (ji,jj,jk) = 0._wp 151 ah_wslp2(ji,jj,jk) = 0._wp 152 END_3D 124 153 ENDIF 125 ! 126 l_hst = .FALSE. 127 l_ptr = .FALSE. 128 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 129 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 130 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 154 ! 155 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 156 l_hst = .FALSE. 157 l_ptr = .FALSE. 158 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 159 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 160 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 161 ENDIF 131 162 ! 132 163 ! … … 167 198 ! 168 199 IF( ln_traldf_blp ) THEN ! bilaplacian operator 169 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 170 akz(ji,jj,jk) = 16._wp & 171 & * ah_wslp2 (ji,jj,jk) & 172 & * ( akz (ji,jj,jk) & 173 & + ah_wslp2(ji,jj,jk) & 174 & / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 200 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 201 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 202 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 175 203 END_3D 176 204 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 177 DO_3D( 1, 0, 1, 0, 2, jpkm1 )205 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 178 206 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 179 207 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 183 211 ! 184 212 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 185 akz(:,:,:) = ah_wslp2(:,:,:) 213 DO_3D( 0, 0, 0, 0, 1, jpk ) 214 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 215 END_3D 186 216 ENDIF 187 217 ENDIF … … 195 225 !!---------------------------------------------------------------------- 196 226 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 197 zdit ( 1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp198 zdjt ( 1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp227 zdit (ntsi-nn_hls,:,:) = 0._wp ; zdit (ntei+nn_hls,:,:) = 0._wp 228 zdjt (ntsi-nn_hls,:,:) = 0._wp ; zdjt (ntei+nn_hls,:,:) = 0._wp 199 229 !!end 200 230 … … 204 234 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 205 235 END_3D 236 ! TODO: NOT TESTED- requires zps 206 237 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 207 238 DO_2D( 1, 0, 1, 0 ) … … 209 240 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 210 241 END_2D 242 ! TODO: NOT TESTED- requires isf 211 243 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 212 244 DO_2D( 1, 0, 1, 0 ) … … 223 255 DO jk = 1, jpkm1 ! Horizontal slab 224 256 ! 225 ! !== Vertical tracer gradient 226 zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1 227 ! 228 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 229 ELSE ; zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 230 ENDIF 257 DO_2D( 1, 1, 1, 1 ) 258 ! !== Vertical tracer gradient 259 zdk1t(ji,jj) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) ! level jk+1 260 ! 261 IF( jk == 1 ) THEN ; zdkt(ji,jj) = zdk1t(ji,jj) ! surface: zdkt(jk=1)=zdkt(jk=2) 262 ELSE ; zdkt(ji,jj) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 263 ENDIF 264 END_2D 265 ! 231 266 DO_2D( 1, 0, 1, 0 ) 232 267 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 330 365 END DO ! end tracer loop 331 366 ! 332 END SUBROUTINE tra_ldf_iso 367 END SUBROUTINE tra_ldf_iso_t 333 368 334 369 !!============================================================================== -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_lap_blp.F90
r13295 r13515 13 13 USE oce ! ocean dynamics and active tracers 14 14 USE dom_oce ! ocean space and time domain 15 USE domutl, ONLY : is_tile 15 16 USE ldftra ! lateral physics: eddy diffusivity 16 17 USE traldf_iso ! iso-neutral lateral diffusion (standard operator) (tra_ldf_iso routine) … … 46 47 CONTAINS 47 48 48 SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv , & 49 & pgu , pgv , pgui, pgvi, & 50 & pt , pt_rhs, kjpt, kpass ) 49 SUBROUTINE tra_ldf_lap( kt, Kmm, kit000, cdtype, pahu, pahv, & 50 & pgu , pgv , pgui, pgvi, & 51 & pt, pt_rhs, kjpt, kpass ) 52 !! 53 INTEGER , INTENT(in ) :: kt ! ocean time-step index 54 INTEGER , INTENT(in ) :: kit000 ! first time step index 55 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 56 INTEGER , INTENT(in ) :: kjpt ! number of tracers 57 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 58 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 59 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 60 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 61 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 62 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! before tracer fields 63 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend 64 !! 65 CALL tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), & 66 & pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), & 67 & pt, is_tile(pt), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 68 END SUBROUTINE tra_ldf_lap 69 70 71 SUBROUTINE tra_ldf_lap_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah, & 72 & pgu , pgv , ktg , pgui, pgvi, ktgi, & 73 & pt, ktt, pt_rhs, ktt_rhs, kjpt, kpass ) 51 74 !!---------------------------------------------------------------------- 52 75 !! *** ROUTINE tra_ldf_lap *** … … 72 95 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 73 96 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 74 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 75 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 76 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before tracer fields 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 97 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt_rhs 98 REAL(wp), DIMENSION(ST_2DT(ktah), jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 99 REAL(wp), DIMENSION(ST_2DT(ktg), kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 100 REAL(wp), DIMENSION(ST_2DT(ktgi), kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 101 REAL(wp), DIMENSION(ST_2DT(ktt), jpk,kjpt), INTENT(in ) :: pt ! before tracer fields 102 REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 79 103 ! 80 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 105 REAL(wp) :: zsign ! local scalars 82 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu, ztv, zaheeu, zaheev 83 !!---------------------------------------------------------------------- 84 ! 85 IF( kt == nit000 .AND. lwp ) THEN 86 WRITE(numout,*) 87 WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 88 WRITE(numout,*) '~~~~~~~~~~~ ' 89 ENDIF 90 ! 91 l_hst = .FALSE. 92 l_ptr = .FALSE. 93 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 94 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 95 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 106 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: ztu, ztv, zaheeu, zaheev 107 !!---------------------------------------------------------------------- 108 ! 109 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 110 IF( kt == nit000 .AND. lwp ) THEN 111 WRITE(numout,*) 112 WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 113 WRITE(numout,*) '~~~~~~~~~~~ ' 114 ENDIF 115 ! 116 l_hst = .FALSE. 117 l_ptr = .FALSE. 118 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf' ) ) ) l_ptr = .TRUE. 119 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 120 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 121 ENDIF 96 122 ! 97 123 ! !== Initialization of metric arrays used for all tracers ==! … … 112 138 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 113 139 END_3D 140 ! TODO: NOT TESTED- requires zps 114 141 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 115 142 DO_2D( 1, 0, 1, 0 ) … … 117 144 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 118 145 END_2D 146 ! TODO: NOT TESTED- requires isf 119 147 IF( ln_isfcav ) THEN ! top in ocean cavities only 120 148 DO_2D( 1, 0, 1, 0 ) … … 142 170 ! ! ================== 143 171 ! 144 END SUBROUTINE tra_ldf_lap 172 END SUBROUTINE tra_ldf_lap_t 145 173 146 174 … … 173 201 ! 174 202 INTEGER :: ji, jj, jk, jn ! dummy loop indices 175 REAL(wp), DIMENSION( jpi,jpj,jpk,kjpt) :: zlap ! laplacian at t-point176 REAL(wp), DIMENSION( jpi,jpj, kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points)177 REAL(wp), DIMENSION( jpi,jpj, kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points)203 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk,kjpt) :: zlap ! laplacian at t-point 204 REAL(wp), DIMENSION(ST_2D(nn_hls), kjpt) :: zglu, zglv ! bottom GRADh of the laplacian (u- and v-points) 205 REAL(wp), DIMENSION(ST_2D(nn_hls), kjpt) :: zgui, zgvi ! top GRADh of the laplacian (u- and v-points) 178 206 !!--------------------------------------------------------------------- 179 207 ! 180 IF( kt == kit000 .AND. lwp ) THEN 181 WRITE(numout,*) 182 SELECT CASE ( kldf ) 183 CASE ( np_blp ) ; WRITE(numout,*) 'tra_ldf_blp : iso-level bilaplacian operator on ', cdtype 184 CASE ( np_blp_i ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)' 185 CASE ( np_blp_it ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)' 186 END SELECT 187 WRITE(numout,*) '~~~~~~~~~~~' 208 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 209 IF( kt == kit000 .AND. lwp ) THEN 210 WRITE(numout,*) 211 SELECT CASE ( kldf ) 212 CASE ( np_blp ) ; WRITE(numout,*) 'tra_ldf_blp : iso-level bilaplacian operator on ', cdtype 213 CASE ( np_blp_i ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (Standard)' 214 CASE ( np_blp_it ) ; WRITE(numout,*) 'tra_ldf_blp : iso-neutral bilaplacian operator on ', cdtype, ' (triad)' 215 END SELECT 216 WRITE(numout,*) '~~~~~~~~~~~' 217 ENDIF 188 218 ENDIF 189 219 … … 202 232 CALL lbc_lnk( 'traldf_lap_blp', zlap(:,:,:,:) , 'T', 1.0_wp ) ! Lateral boundary conditions (unchanged sign) 203 233 ! ! Partial top/bottom cell: GRADh( zlap ) 234 ! TODO: NOT TESTED- requires zps and isf 204 235 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, Kmm, kjpt, zlap, zglu, zglv, zgui, zgvi ) ! both top & bottom 205 236 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, Kmm, kjpt, zlap, zglu, zglv ) ! only bottom -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traldf_triad.F90
r13295 r13515 13 13 USE oce ! ocean dynamics and active tracers 14 14 USE dom_oce ! ocean space and time domain 15 ! TEMP: This change not necessary if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 16 USE domain, ONLY : dom_tile 17 USE domutl, ONLY : is_tile 15 18 USE phycst ! physical constants 16 19 USE trc_oce ! share passive tracers/Ocean variables … … 33 36 PUBLIC tra_ldf_triad ! routine called by traldf.F90 34 37 35 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels36 37 38 LOGICAL :: l_ptr ! flag to compute poleward transport 38 39 LOGICAL :: l_hst ! flag to compute heat transport … … 49 50 CONTAINS 50 51 51 SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, & 52 & pgu , pgv , pgui, pgvi , & 53 & pt , pt2, pt_rhs, kjpt, kpass ) 52 SUBROUTINE tra_ldf_triad( kt, Kmm, kit000, cdtype, pahu, pahv, & 53 & pgu , pgv , pgui, pgvi, & 54 & pt, pt2, pt_rhs, kjpt, kpass ) 55 !! 56 INTEGER , INTENT(in ) :: kt ! ocean time-step index 57 INTEGER , INTENT(in ) :: kit000 ! first time step index 58 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 59 INTEGER , INTENT(in ) :: kjpt ! number of tracers 60 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 61 INTEGER , INTENT(in ) :: Kmm ! ocean time level indices 62 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 63 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 64 REAL(wp), DIMENSION(:,:,:) , INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 65 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 66 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 67 REAL(wp), DIMENSION(:,:,:,:), INTENT(inout) :: pt_rhs ! tracer trend 68 !! 69 CALL tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, is_tile(pahu), & 70 & pgu , pgv , is_tile(pgu) , pgui, pgvi, is_tile(pgui), & 71 & pt, is_tile(pt), pt2, is_tile(pt2), pt_rhs, is_tile(pt_rhs), kjpt, kpass ) 72 END SUBROUTINE tra_ldf_triad 73 74 75 SUBROUTINE tra_ldf_triad_t( kt, Kmm, kit000, cdtype, pahu, pahv, ktah, & 76 & pgu , pgv , ktg , pgui, pgvi, ktgi, & 77 & pt, ktt, pt2, ktt2, pt_rhs, ktt_rhs, kjpt, kpass ) 54 78 !!---------------------------------------------------------------------- 55 79 !! *** ROUTINE tra_ldf_triad *** … … 77 101 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 78 102 INTEGER , INTENT(in) :: Kmm ! ocean time level indices 79 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 80 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 81 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 82 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 103 INTEGER , INTENT(in ) :: ktah, ktg, ktgi, ktt, ktt2, ktt_rhs 104 REAL(wp), DIMENSION(ST_2DT(ktah), jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 105 REAL(wp), DIMENSION(ST_2DT(ktg), kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 106 REAL(wp), DIMENSION(ST_2DT(ktgi), kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 107 REAL(wp), DIMENSION(ST_2DT(ktt), jpk,kjpt), INTENT(in ) :: pt ! tracer (kpass=1) or laplacian of tracer (kpass=2) 108 REAL(wp), DIMENSION(ST_2DT(ktt2), jpk,kjpt), INTENT(in ) :: pt2 ! tracer (only used in kpass=2) 109 REAL(wp), DIMENSION(ST_2DT(ktt_rhs),jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 85 110 ! 86 111 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 94 119 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 95 120 REAL(wp) :: zah, zah_slp, zaei_slp 96 REAL(wp), DIMENSION(jpi,jpj ) :: z2d ! 2D workspace 97 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - 121 REAL(wp), DIMENSION(ST_2D(nn_hls),0:1) :: zdkt3d ! vertical tracer gradient at 2 levels 122 REAL(wp), DIMENSION(ST_2D(nn_hls) ) :: z2d ! 2D workspace 123 REAL(wp), DIMENSION(ST_2D(nn_hls) ,jpk) :: zdit, zdjt, zftu, zftv, ztfw ! 3D - 124 ! TEMP: This can be ST_2D(nn_hls) if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 125 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpsi_uw, zpsi_vw 98 126 !!---------------------------------------------------------------------- 99 127 ! 100 IF( .NOT.ALLOCATED(zdkt3d) ) THEN 101 ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr ) 102 CALL mpp_sum ( 'traldf_triad', ierr ) 103 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays') 104 ENDIF 105 ! 106 IF( kpass == 1 .AND. kt == kit000 ) THEN 107 IF(lwp) WRITE(numout,*) 108 IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 109 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 110 ENDIF 111 ! 112 l_hst = .FALSE. 113 l_ptr = .FALSE. 114 IF( cdtype == 'TRA' ) THEN 115 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf') ) l_ptr = .TRUE. 116 IF( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 117 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) l_hst = .TRUE. 128 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 129 IF( kpass == 1 .AND. kt == kit000 ) THEN 130 IF(lwp) WRITE(numout,*) 131 IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 132 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 133 ENDIF 134 ! 135 l_hst = .FALSE. 136 l_ptr = .FALSE. 137 IF( cdtype == 'TRA' ) THEN 138 IF( iom_use( 'sophtldf' ) .OR. iom_use( 'sopstldf') ) l_ptr = .TRUE. 139 IF( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 140 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) l_hst = .TRUE. 141 ENDIF 118 142 ENDIF 119 143 ! … … 128 152 IF( kpass == 1 ) THEN !== first pass only and whatever the tracer is ==! 129 153 ! 130 akz (:,:,:) = 0._wp 131 ah_wslp2(:,:,:) = 0._wp 132 IF( ln_ldfeiv_dia ) THEN 133 zpsi_uw(:,:,:) = 0._wp 134 zpsi_vw(:,:,:) = 0._wp 135 ENDIF 154 DO_3D( 0, 0, 0, 0, 1, jpk ) 155 akz (ji,jj,jk) = 0._wp 156 ah_wslp2(ji,jj,jk) = 0._wp 157 END_3D 136 158 ! 137 159 DO ip = 0, 1 ! i-k triads 138 160 DO kp = 0, 1 139 DO_3D( 1, 0, 1, 0, 1, jpkm1 )140 ze3wr = 1._wp / e3w(ji +ip,jj,jk+kp,Kmm)141 zbu = e1e2u(ji ,jj) * e3u(ji,jj,jk,Kmm)142 zah = 0.25_wp * pahu(ji ,jj,jk)143 zslope_skew = triadi_g(ji +ip,jj,jk,1-ip,kp)161 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 162 ze3wr = 1._wp / e3w(ji,jj,jk+kp,Kmm) 163 zbu = e1e2u(ji-ip,jj) * e3u(ji-ip,jj,jk,Kmm) 164 zah = 0.25_wp * pahu(ji-ip,jj,jk) 165 zslope_skew = triadi_g(ji,jj,jk,1-ip,kp) 144 166 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 145 zslope2 = zslope_skew + ( gdept(ji +1,jj,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)167 zslope2 = zslope_skew + ( gdept(ji-ip+1,jj,jk,Kmm) - gdept(ji-ip,jj,jk,Kmm) ) * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 146 168 zslope2 = zslope2 *zslope2 147 ah_wslp2(ji +ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2148 akz (ji +ip,jj,jk+kp) = akz (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj) &149 & * r1_e1u(ji ,jj) * umask(ji,jj,jk+kp)169 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji,jj) * zslope2 170 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + zah * r1_e1u(ji-ip,jj) & 171 & * r1_e1u(ji-ip,jj) * umask(ji-ip,jj,jk+kp) 150 172 ! 151 IF( ln_ldfeiv_dia ) zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) &152 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew153 173 END_3D 154 174 END DO … … 157 177 DO jp = 0, 1 ! j-k triads 158 178 DO kp = 0, 1 159 DO_3D( 1, 0, 1, 0, 1, jpkm1 )160 ze3wr = 1.0_wp / e3w(ji,jj +jp,jk+kp,Kmm)161 zbv = e1e2v(ji,jj ) * e3v(ji,jj,jk,Kmm)162 zah = 0.25_wp * pahv(ji,jj ,jk)163 zslope_skew = triadj_g(ji,jj +jp,jk,1-jp,kp)179 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 180 ze3wr = 1.0_wp / e3w(ji,jj,jk+kp,Kmm) 181 zbv = e1e2v(ji,jj-jp) * e3v(ji,jj-jp,jk,Kmm) 182 zah = 0.25_wp * pahv(ji,jj-jp,jk) 183 zslope_skew = triadj_g(ji,jj,jk,1-jp,kp) 164 184 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 165 185 ! (do this by *adding* gradient of depth) 166 zslope2 = zslope_skew + ( gdept(ji,jj +1,jk,Kmm) - gdept(ji,jj,jk,Kmm) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)186 zslope2 = zslope_skew + ( gdept(ji,jj-jp+1,jk,Kmm) - gdept(ji,jj-jp,jk,Kmm) ) * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 167 187 zslope2 = zslope2 * zslope2 168 ah_wslp2(ji,jj +jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2169 akz (ji,jj +jp,jk+kp) = akz (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj) &170 & * r1_e2v(ji,jj ) * vmask(ji,jj,jk+kp)188 ah_wslp2(ji,jj,jk+kp) = ah_wslp2(ji,jj,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj) * zslope2 189 akz (ji,jj,jk+kp) = akz (ji,jj,jk+kp) + zah * r1_e2v(ji,jj-jp) & 190 & * r1_e2v(ji,jj-jp) * vmask(ji,jj-jp,jk+kp) 171 191 ! 172 IF( ln_ldfeiv_dia ) zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) &173 & + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew174 192 END_3D 175 193 END DO … … 179 197 ! 180 198 IF( ln_traldf_blp ) THEN ! bilaplacian operator 181 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) 182 akz(ji,jj,jk) = 16._wp & 183 & * ah_wslp2 (ji,jj,jk) & 184 & * ( akz (ji,jj,jk) & 185 & + ah_wslp2(ji,jj,jk) & 186 & / ( e3w (ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 199 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 200 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 201 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) ) ) 187 202 END_3D 188 203 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 189 DO_3D( 1, 0, 1, 0, 2, jpkm1 )204 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 190 205 ze3w_2 = e3w(ji,jj,jk,Kmm) * e3w(ji,jj,jk,Kmm) 191 206 zcoef0 = rDt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) … … 195 210 ! 196 211 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 197 akz(:,:,:) = ah_wslp2(:,:,:) 198 ENDIF 199 ! 200 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 212 DO_3D( 0, 0, 0, 0, 1, jpk ) 213 akz(ji,jj,jk) = ah_wslp2(ji,jj,jk) 214 END_3D 215 ENDIF 216 ! 217 ! TEMP: These changes not necessary if lbc_lnk is removed from ldf_eiv_dia and XIOS has subdomain support 218 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 219 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) THEN 220 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) 221 222 zpsi_uw(:,:,:) = 0._wp 223 zpsi_vw(:,:,:) = 0._wp 224 225 DO jp = 0, 1 226 DO kp = 0, 1 227 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 228 zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 229 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * triadi_g(ji+jp,jj,jk,1-jp,kp) 230 zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 231 & + 0.25_wp * aeiv(ji,jj,jk) * e1v(ji,jj) * triadj_g(ji,jj+jp,jk,1-jp,kp) 232 END_3D 233 END DO 234 END DO 235 CALL ldf_eiv_dia( zpsi_uw, zpsi_vw, Kmm ) 236 237 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = nijtile ) 238 ENDIF 239 ENDIF 201 240 ! 202 241 ENDIF !== end 1st pass only ==! … … 215 254 zdjt(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 216 255 END_3D 256 ! TODO: NOT TESTED- requires zps 217 257 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 218 258 DO_2D( 1, 0, 1, 0 ) … … 220 260 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 221 261 END_2D 262 ! TODO: NOT TESTED- requires isf 222 263 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 223 264 DO_2D( 1, 0, 1, 0 ) … … 234 275 DO jk = 1, jpkm1 235 276 ! !== Vertical tracer gradient at level jk and jk+1 236 zdkt3d(:,:,1) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 277 DO_2D( 1, 1, 1, 1 ) 278 zdkt3d(ji,jj,1) = ( pt(ji,jj,jk,jn) - pt(ji,jj,jk+1,jn) ) * tmask(ji,jj,jk+1) 279 END_2D 237 280 ! 238 281 ! ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 239 282 IF( jk == 1 ) THEN ; zdkt3d(:,:,0) = zdkt3d(:,:,1) 240 ELSE ; zdkt3d(:,:,0) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk) 283 ELSE 284 DO_2D( 1, 1, 1, 1 ) 285 zdkt3d(ji,jj,0) = ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 286 END_2D 241 287 ENDIF 242 288 ! … … 380 426 END DO ! end tracer loop 381 427 ! ! =============== 382 END SUBROUTINE tra_ldf_triad 428 END SUBROUTINE tra_ldf_triad_t 383 429 384 430 !!============================================================================== -
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/zpshde.F90
r13295 r13515 17 17 USE oce ! ocean: dynamics and tracers variables 18 18 USE dom_oce ! domain: ocean variables 19 USE domutl, ONLY : is_tile 19 20 USE phycst ! physical constants 20 21 USE eosbn2 ! ocean equation of state … … 40 41 CONTAINS 41 42 42 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 43 & prd, pgru, pgrv ) 43 ! TODO: NOT TESTED- requires zps 44 SUBROUTINE zps_hde( kt, Kmm, kjpt, pta, pgtu, pgtv, & 45 & prd, pgru, pgrv ) 46 !! 47 INTEGER , INTENT(in ) :: kt ! ocean time-step index 48 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 49 INTEGER , INTENT(in ) :: kjpt ! number of tracers 50 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields 51 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 52 REAL(wp), DIMENSION(:,:,:) , INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 53 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 54 ! 55 INTEGER :: itrd, itgr 56 !! 57 IF( PRESENT(prd) ) THEN ; itrd = is_tile(prd) ; ELSE ; itrd = 0 ; ENDIF 58 IF( PRESENT(pgru) ) THEN ; itgr = is_tile(pgru) ; ELSE ; itgr = 0 ; ENDIF 59 60 CALL zps_hde_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), & 61 & prd, itrd, pgru, pgrv, itgr ) 62 END SUBROUTINE zps_hde 63 64 65 SUBROUTINE zps_hde_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt, & 66 & prd, ktrd, pgru, pgrv, ktgr ) 44 67 !!---------------------------------------------------------------------- 45 68 !! *** ROUTINE zps_hde *** … … 85 108 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 86 109 !!---------------------------------------------------------------------- 87 INTEGER , INTENT(in ) :: kt ! ocean time-step index 88 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 91 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 92 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 93 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 110 INTEGER , INTENT(in ) :: kt ! ocean time-step index 111 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 112 INTEGER , INTENT(in ) :: kjpt ! number of tracers 113 INTEGER , INTENT(in ) :: ktta, ktgt, ktrd, ktgr 114 REAL(wp), DIMENSION(ST_2DT(ktta),jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 115 REAL(wp), DIMENSION(ST_2DT(ktgt) ,kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 116 REAL(wp), DIMENSION(ST_2DT(ktrd),jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 117 REAL(wp), DIMENSION(ST_2DT(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 94 118 ! 95 119 INTEGER :: ji, jj, jn ! Dummy loop indices 96 120 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 97 121 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars 98 REAL(wp), DIMENSION( jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos99 REAL(wp), DIMENSION( jpi,jpj,kjpt) :: zti, ztj !122 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 123 REAL(wp), DIMENSION(ST_2D(nn_hls),kjpt) :: zti, ztj ! 100 124 !!---------------------------------------------------------------------- 101 125 ! … … 185 209 IF( ln_timing ) CALL timing_stop( 'zps_hde') 186 210 ! 187 END SUBROUTINE zps_hde 188 189 211 END SUBROUTINE zps_hde_t 212 213 214 ! TODO: NOT TESTED- requires zps 190 215 SUBROUTINE zps_hde_isf( kt, Kmm, kjpt, pta, pgtu, pgtv, pgtui, pgtvi, & 191 & prd, pgru, pgrv, pgrui, pgrvi ) 216 & prd, pgru, pgrv, pgrui, pgrvi ) 217 !! 218 INTEGER , INTENT(in ) :: kt ! ocean time-step index 219 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 220 INTEGER , INTENT(in ) :: kjpt ! number of tracers 221 REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) :: pta ! 4D tracers fields 222 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 223 REAL(wp), DIMENSION(:,:,:) , INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 224 REAL(wp), DIMENSION(:,:,:) , INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 225 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 226 REAL(wp), DIMENSION(:,:) , INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 227 ! 228 INTEGER :: itrd, itgr, itgri 229 !! 230 IF( PRESENT(prd) ) THEN ; itrd = is_tile(prd) ; ELSE ; itrd = 0 ; ENDIF 231 IF( PRESENT(pgru) ) THEN ; itgr = is_tile(pgru) ; ELSE ; itgr = 0 ; ENDIF 232 IF( PRESENT(pgrui) ) THEN ; itgri = is_tile(pgrui) ; ELSE ; itgri = 0 ; ENDIF 233 234 CALL zps_hde_isf_t( kt, Kmm, kjpt, pta, is_tile(pta), pgtu, pgtv, is_tile(pgtu), pgtui, pgtvi, is_tile(pgtui), & 235 & prd, itrd, pgru, pgrv, itgr, pgrui, pgrvi, itgri ) 236 END SUBROUTINE zps_hde_isf 237 238 239 SUBROUTINE zps_hde_isf_t( kt, Kmm, kjpt, pta, ktta, pgtu, pgtv, ktgt, pgtui, pgtvi, ktgti, & 240 & prd, ktrd, pgru, pgrv, ktgr, pgrui, pgrvi, ktgri ) 192 241 !!---------------------------------------------------------------------- 193 242 !! *** ROUTINE zps_hde_isf *** … … 236 285 !! - pgru, pgrv, pgrui, pgtvi: horizontal gradient of rho (if present) at u- & v-points 237 286 !!---------------------------------------------------------------------- 238 INTEGER , INTENT(in ) :: kt ! ocean time-step index 239 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 240 INTEGER , INTENT(in ) :: kjpt ! number of tracers 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 242 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 243 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 244 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 245 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 246 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 287 INTEGER , INTENT(in ) :: kt ! ocean time-step index 288 INTEGER , INTENT(in ) :: Kmm ! ocean time level index 289 INTEGER , INTENT(in ) :: kjpt ! number of tracers 290 INTEGER , INTENT(in ) :: ktta, ktgt, ktgti, ktrd, ktgr, ktgri 291 REAL(wp), DIMENSION(ST_2DT(ktta),jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 292 REAL(wp), DIMENSION(ST_2DT(ktgt) ,kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 293 REAL(wp), DIMENSION(ST_2DT(ktgti) ,kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 294 REAL(wp), DIMENSION(ST_2DT(ktrd),jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 295 REAL(wp), DIMENSION(ST_2DT(ktgr) ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 296 REAL(wp), DIMENSION(ST_2DT(ktgri) ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 247 297 ! 248 298 INTEGER :: ji, jj, jn ! Dummy loop indices 249 299 INTEGER :: iku, ikv, ikum1, ikvm1,ikup1, ikvp1 ! partial step level (ocean bottom level) at u- and v-points 250 300 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 251 REAL(wp), DIMENSION( jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos252 REAL(wp), DIMENSION( jpi,jpj,kjpt) :: zti, ztj !301 REAL(wp), DIMENSION(ST_2D(nn_hls)) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 302 REAL(wp), DIMENSION(ST_2D(nn_hls),kjpt) :: zti, ztj ! 253 303 !!---------------------------------------------------------------------- 254 304 ! … … 440 490 IF( ln_timing ) CALL timing_stop( 'zps_hde_isf') 441 491 ! 442 END SUBROUTINE zps_hde_isf 492 END SUBROUTINE zps_hde_isf_t 443 493 444 494 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
