- Timestamp:
- 2020-06-24T09:03:45+02:00 (4 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src
- Files:
-
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/ICE/icedyn_adv_umx.F90
r11081 r13149 48 48 REAL(wp) :: z1_120 = 1._wp / 120._wp ! =1/120 49 49 ! 50 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: imsk_small, jmsk_small 50 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: imsk_small, jmsk_small 51 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zfu_ho , zfv_ho , zpt 52 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zfu_ups, zfv_ups, zt_ups 53 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: ztu1, ztu2, ztu3, ztu4 54 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: ztv1, ztv2, ztv3, ztv4 55 REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: zswitch 56 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zslpy ! tracer slopes 57 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zslpx ! tracer slopes 58 REAL(wp), ALLOCATABLE, DIMENSION(:, : ) :: zbup, zbdo 59 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zbetup, zbetdo, zti_ups, ztj_ups 60 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zt_u, zt_v 61 51 62 ! 52 63 !! * Substitutions … … 93 104 REAL(wp) :: zdt, zvi_cen 94 105 REAL(wp), DIMENSION(1) :: zcflprv, zcflnow ! for global communication 95 REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 96 REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 97 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 98 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 99 REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 100 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 101 ! 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 103 !!---------------------------------------------------------------------- 104 ! 105 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 106 ! REAL(wp), DIMENSION(jpi,jpj) :: zudy, zvdx, zcu_box, zcv_box 107 ! REAL(wp), DIMENSION(jpi,jpj) :: zati1, zati2 108 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zu_cat, zv_cat 109 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zua_ho, zva_ho, zua_ups, zva_ups 110 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: z1_ai , z1_aip, zhvar 111 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zhi_max, zhs_max, zhip_max 112 REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: zudy, zvdx, zcu_box, zcv_box 113 REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: zati1, zati2 114 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zu_cat, zv_cat 115 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zua_ho, zva_ho, zua_ups, zva_ups 116 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: z1_ai , z1_aip, zhvar 117 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zhi_max, zhs_max, zhip_max 118 ! 119 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zuv_ho, zvv_ho, zuv_ups, zvv_ups, z1_vi, z1_vs 120 !!---------------------------------------------------------------------- 121 ! 122 IF( kt == nit000) THEN 123 IF( lwp ) WRITE(numout,*) '-- ice_dyn_adv_umx: Ultimate-Macho advection scheme' 124 ALLOCATE( zudy(jpi,jpj), zvdx(jpi,jpj), zcu_box(jpi,jpj), zcv_box(jpi,jpj) ) 125 ALLOCATE( zati1(jpi,jpj), zati2(jpi,jpj) ) 126 ALLOCATE( zu_cat(jpi,jpj,jpl), zv_cat(jpi,jpj,jpl) ) 127 ALLOCATE( zua_ho(jpi,jpj,jpl), zva_ho(jpi,jpj,jpl), zua_ups(jpi,jpj,jpl), zva_ups(jpi,jpj,jpl) ) 128 ALLOCATE( z1_ai(jpi,jpj,jpl), z1_aip(jpi,jpj,jpl), zhvar(jpi,jpj,jpl) ) 129 ALLOCATE( zhi_max(jpi,jpj,jpl), zhs_max(jpi,jpj,jpl), zhip_max(jpi,jpj,jpl) ) 130 ALLOCATE( zfu_ho(jpi,jpj,jpl), zfv_ho(jpi,jpj,jpl), zpt(jpi,jpj,jpl)) 131 ALLOCATE( zfu_ups(jpi,jpj,jpl), zfv_ups(jpi,jpj,jpl), zt_ups(jpi,jpj,jpl)) 132 ALLOCATE( ztu1(jpi,jpj,jpl), ztu2(jpi,jpj,jpl), ztu3(jpi,jpj,jpl), ztu4(jpi,jpj,jpl)) 133 ALLOCATE( ztv1(jpi,jpj,jpl), ztv2(jpi,jpj,jpl), ztv3(jpi,jpj,jpl), ztv4(jpi,jpj,jpl)) 134 ALLOCATE( zswitch(jpi,jpj)) 135 ALLOCATE( zslpy(jpi,jpj,jpl)) 136 ALLOCATE( zslpx(jpi,jpj,jpl)) 137 ALLOCATE( zbup(jpi,jpj), zbdo(jpi,jpj)) 138 ALLOCATE( zbetup(jpi,jpj,jpl), zbetdo(jpi,jpj,jpl), zti_ups(jpi,jpj,jpl), ztj_ups(jpi,jpj,jpl)) 139 ALLOCATE( zt_u(jpi,jpj,jpl), zt_v(jpi,jpj,jpl)) 140 ENDIF 106 141 ! 107 142 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! … … 421 456 INTEGER :: ji, jj, jl ! dummy loop indices 422 457 REAL(wp) :: ztra ! local scalar 423 424 458 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zfu_ho , zfv_ho , zpt 459 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zfu_ups, zfv_ups, zt_ups 425 460 !!---------------------------------------------------------------------- 426 461 ! … … 537 572 INTEGER :: ji, jj, jl ! dummy loop indices 538 573 REAL(wp) :: ztra ! local scalar 539 574 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zpt 540 575 !!---------------------------------------------------------------------- 541 576 … … 653 688 INTEGER :: ji, jj, jl ! dummy loop indices 654 689 REAL(wp) :: ztra ! local scalar 655 690 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zpt 656 691 !!---------------------------------------------------------------------- 657 692 ! … … 771 806 ! 772 807 INTEGER :: ji, jj, jl ! dummy loop indices 773 808 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zt_u, zt_v, zpt 774 809 !!---------------------------------------------------------------------- 775 810 ! … … 858 893 INTEGER :: ji, jj, jl ! dummy loop indices 859 894 REAL(wp) :: zcu, zdx2, zdx4 ! - - 860 895 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztu1, ztu2, ztu3, ztu4 861 896 !!---------------------------------------------------------------------- 862 897 ! … … 1015 1050 INTEGER :: ji, jj, jl ! dummy loop indices 1016 1051 REAL(wp) :: zcv, zdy2, zdy4 ! - - 1017 1052 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: ztv1, ztv2, ztv3, ztv4 1018 1053 !!---------------------------------------------------------------------- 1019 1054 ! … … 1169 1204 REAL(wp) :: zpos, zneg, zbig, zup, zdo, z1_dt ! local scalars 1170 1205 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zcoef, zzt ! - - 1171 1172 1206 ! REAL(wp), DIMENSION(jpi,jpj ) :: zbup, zbdo 1207 ! REAL(wp), DIMENSION(jpi,jpj,jpl) :: zbetup, zbetdo, zti_ups, ztj_ups 1173 1208 !!---------------------------------------------------------------------- 1174 1209 zbig = 1.e+40_wp … … 1339 1374 REAL(wp) :: Cr, Rjm, Rj, Rjp, uCFL, zpsi, zh3, zlimiter, Rr 1340 1375 INTEGER :: ji, jj, jl ! dummy loop indices 1341 1376 ! REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpx ! tracer slopes 1342 1377 !!---------------------------------------------------------------------- 1343 1378 ! … … 1434 1469 REAL(wp) :: Cr, Rjm, Rj, Rjp, vCFL, zpsi, zh3, zlimiter, Rr 1435 1470 INTEGER :: ji, jj, jl ! dummy loop indices 1436 REAL(wp), DIMENSION (jpi,jpj,jpl) :: zslpy ! tracer slopes1437 1471 !!---------------------------------------------------------------------- 1438 1472 ! … … 1541 1575 INTEGER :: ji, jj, jk, jl ! dummy loop indices 1542 1576 REAL(wp) :: z1_dt, zhip, zhi, zhs, zvs_excess, zfra 1543 1577 ! REAL(wp), DIMENSION(jpi,jpj) :: zswitch 1544 1578 !!------------------------------------------------------------------- 1545 1579 ! -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/DYN/dynldf_lap_blp.F90
r10888 r13149 56 56 REAL(wp) :: zua, zva ! local scalars 57 57 REAL(wp), DIMENSION(jpi,jpj) :: zcur, zdiv 58 ! REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: zcur, zdiv 58 59 !!---------------------------------------------------------------------- 59 60 ! 60 IF( kt == nit000 .AND. lwp ) THEN 61 WRITE(numout,*) 62 WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 63 WRITE(numout,*) '~~~~~~~ ' 61 IF( kt == nit000 ) THEN 62 IF(lwp) THEN 63 WRITE(numout,*) 64 WRITE(numout,*) 'dyn_ldf : iso-level harmonic (laplacian) operator, pass=', kpass 65 WRITE(numout,*) '~~~~~~~ ' 66 ENDIF 67 ! ALLOCATE(zcur(jpi,jpj), zdiv(jpi,jpj)) 64 68 ENDIF 65 69 ! … … 122 126 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pua, pva ! momentum trend 123 127 ! 124 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zulap, zvlap ! laplacian at u- and v-point 128 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zulap, zvlap ! laplacian at u- and v-point 129 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zulap, zvlap 125 130 !!---------------------------------------------------------------------- 126 131 ! … … 129 134 IF(lwp) WRITE(numout,*) 'dyn_ldf_blp : bilaplacian operator momentum ' 130 135 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 136 ALLOCATE(zulap(jpi,jpj,jpk), zvlap(jpi,jpj,jpk)) 131 137 ENDIF 132 138 ! -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/ICB/icbrst.F90
r11539 r13149 200 200 TYPE(point) , POINTER :: pt 201 201 !!---------------------------------------------------------------------- 202 202 RETURN 203 203 ! Following the normal restart procedure, this routine will be called 204 204 ! the timestep before a restart stage as well as the restart timestep. -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/IOM/iom.F90
r13049 r13149 1506 1506 LOGICAL :: llx ! local xios write flag 1507 1507 INTEGER :: ivid ! variable id 1508 1508 RETURN 1509 1509 llx = .FALSE. 1510 1510 IF(PRESENT(ldxios)) llx = ldxios … … 1536 1536 LOGICAL :: llx ! local xios write flag 1537 1537 INTEGER :: ivid ! variable id 1538 1538 RETURN 1539 1539 llx = .FALSE. 1540 1540 IF(PRESENT(ldxios)) llx = ldxios … … 1566 1566 LOGICAL :: llx 1567 1567 INTEGER :: ivid ! variable id 1568 1568 RETURN 1569 1569 llx = .FALSE. 1570 1570 IF(PRESENT(ldxios)) llx = ldxios … … 1596 1596 LOGICAL :: llx ! local xios write flag 1597 1597 INTEGER :: ivid ! variable id 1598 1598 RETURN 1599 1599 llx = .FALSE. 1600 1600 IF(PRESENT(ldxios)) llx = ldxios -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/LDF/ldfslp.F90
r10888 r13149 70 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: vslpml, wslpjml ! j_slope at V- and W-points just below the mixed layer 71 71 72 REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: zslpml_hmlpu, zslpml_hmlpv 73 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zgru, zwz, zdzr 74 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zgrv, zww 75 76 REAL(wp), ALLOCATABLE, DIMENSION(:, :) :: z1_mlbw 77 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :) :: zalbet 78 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :, :) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 79 REAL(wp), ALLOCATABLE, DIMENSION(:, :, :, :) :: zti_mlb, ztj_mlb ! for Griffies operator only 80 81 72 82 REAL(wp) :: repsln = 1.e-25_wp ! tiny value used as minium of di(rho), dj(rho) and dk(rho) 73 83 … … 118 128 REAL(wp) :: zck, zfk, zbw ! - - 119 129 REAL(wp) :: zdepu, zdepv ! - - 120 121 122 130 ! REAL(wp), DIMENSION(jpi,jpj) :: zslpml_hmlpu, zslpml_hmlpv 131 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgru, zwz, zdzr 132 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrv, zww 123 133 !!---------------------------------------------------------------------- 124 134 ! … … 401 411 REAL(wp) :: zdzrho_raw 402 412 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 403 404 405 406 413 ! REAL(wp), DIMENSION(jpi,jpj) :: z1_mlbw 414 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zalbet 415 ! REAL(wp), DIMENSION(jpi,jpj,jpk,0:1) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 416 ! REAL(wp), DIMENSION(jpi,jpj,0:1,0:1) :: zti_mlb, ztj_mlb ! for Griffies operator only 407 417 !!---------------------------------------------------------------------- 408 418 ! … … 750 760 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr ) 751 761 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' ) 762 ALLOCATE(zslpml_hmlpu(jpi,jpj), zslpml_hmlpv(jpi,jpj)) 763 ALLOCATE(zgru(jpi,jpj,jpk), zwz(jpi,jpj,jpk), zdzr(jpi,jpj,jpk)) 764 ALLOCATE(zgrv(jpi,jpj,jpk), zww(jpi,jpj,jpk)) 765 752 766 ! 753 767 IF( ln_traldf_triad ) THEN ! Griffies operator : triad of slopes … … 765 779 & vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr ) 766 780 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 781 782 ALLOCATE(z1_mlbw(jpi,jpj)) 783 ALLOCATE(zalbet(jpi,jpj,jpk)) 784 ALLOCATE(zdxrho(jpi,jpj,jpk,0:1) , zdyrho(jpi,jpj,jpk,0:1), zdzrho(jpi,jpj,jpk,0:1) ) 785 ALLOCATE(zti_mlb(jpi,jpj,0:1,0:1), ztj_mlb(jpi,jpj,0:1,0:1)) 767 786 768 787 ! Direction of lateral diffusion (tracers and/or momentum) -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/LDF/ldftra.F90
r10888 r13149 830 830 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 831 831 ! 832 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 833 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 834 END DO 835 CALL iom_put( "uoce_eiv", zw3d ) 836 ! 837 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 838 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 839 END DO 840 CALL iom_put( "voce_eiv", zw3d ) 841 ! 842 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 843 DO jj = 2, jpjm1 844 DO ji = fs_2, fs_jpim1 ! vector opt. 845 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 846 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) 847 END DO 848 END DO 849 END DO 850 CALL lbc_lnk( 'ldftra', zw3d, 'T', 1. ) ! lateral boundary condition 851 CALL iom_put( "woce_eiv", zw3d ) 832 IF(iom_use("uoce_eiv")) THEN 833 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 834 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * e3u_n(:,:,jk) ) 835 END DO 836 CALL iom_put( "uoce_eiv", zw3d ) 837 ENDIF 838 ! 839 IF(iom_use("voce_eiv")) THEN 840 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 841 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * e3v_n(:,:,jk) ) 842 END DO 843 CALL iom_put( "voce_eiv", zw3d ) 844 ENDIF 845 ! 846 IF(iom_use("woce_eiv")) THEN 847 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 848 DO jj = 2, jpjm1 849 DO ji = fs_2, fs_jpim1 ! vector opt. 850 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 851 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) 852 END DO 853 END DO 854 END DO 855 CALL lbc_lnk( 'ldftra', zw3d, 'T', 1. ) ! lateral boundary condition 856 CALL iom_put( "woce_eiv", zw3d ) 857 ENDIF 852 858 ! 853 859 ! … … 870 876 CALL iom_put( "ueiv_heattr3d", zztmp * zw3d ) ! heat transport in i-direction 871 877 ENDIF 872 zw2d(:,:) = 0._wp 873 zw3d(:,:,:) = 0._wp 874 DO jk = 1, jpkm1 875 DO jj = 2, jpjm1 876 DO ji = fs_2, fs_jpim1 ! vector opt. 877 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 878 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) ) 879 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 880 END DO 881 END DO 882 END DO 883 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 884 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction 885 CALL iom_put( "veiv_heattr", zztmp * zw3d ) ! heat transport in j-direction 878 IF( iom_use('veiv_heattr') ) THEN 879 zw2d(:,:) = 0._wp 880 zw3d(:,:,:) = 0._wp 881 DO jk = 1, jpkm1 882 DO jj = 2, jpjm1 883 DO ji = fs_2, fs_jpim1 ! vector opt. 884 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 885 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) ) 886 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 887 END DO 888 END DO 889 END DO 890 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 891 CALL iom_put( "veiv_heattr", zztmp * zw2d ) ! heat transport in j-direction 892 CALL iom_put( "veiv_heattr", zztmp * zw3d ) ! heat transport in j-direction 893 ENDIF 886 894 ! 887 895 IF( ln_diaptr ) CALL dia_ptr_hst( jp_tem, 'eiv', 0.5 * zw3d ) … … 905 913 CALL iom_put( "ueiv_salttr3d", zztmp * zw3d ) ! salt transport in i-direction 906 914 ENDIF 907 zw2d(:,:) = 0._wp 908 zw3d(:,:,:) = 0._wp 909 DO jk = 1, jpkm1 910 DO jj = 2, jpjm1 911 DO ji = fs_2, fs_jpim1 ! vector opt. 912 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 913 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji,jj+1,jk,jp_sal) ) 914 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 915 END DO 916 END DO 917 END DO 918 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 919 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction 920 CALL iom_put( "veiv_salttr", zztmp * zw3d ) ! salt transport in j-direction 915 IF( iom_use('veiv_salttr') ) THEN 916 zw2d(:,:) = 0._wp 917 zw3d(:,:,:) = 0._wp 918 DO jk = 1, jpkm1 919 DO jj = 2, jpjm1 920 DO ji = fs_2, fs_jpim1 ! vector opt. 921 zw3d(ji,jj,jk) = zw3d(ji,jj,jk) + ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 922 & * ( tsn (ji,jj,jk,jp_sal) + tsn (ji,jj+1,jk,jp_sal) ) 923 zw2d(ji,jj) = zw2d(ji,jj) + zw3d(ji,jj,jk) 924 END DO 925 END DO 926 END DO 927 CALL lbc_lnk( 'ldftra', zw2d, 'V', -1. ) 928 CALL iom_put( "veiv_salttr", zztmp * zw2d ) ! salt transport in j-direction 929 CALL iom_put( "veiv_salttr", zztmp * zw3d ) ! salt transport in j-direction 930 ENDIF 921 931 ! 922 932 IF( ln_diaptr ) CALL dia_ptr_hst( jp_sal, 'eiv', 0.5 * zw3d ) -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/TRA/traadv_fct.F90
r10888 r13149 42 42 INTEGER, PARAMETER :: np_NH = 0 ! Neumann homogeneous boundary condition 43 43 INTEGER, PARAMETER :: np_CEN2 = 1 ! 2nd order centered boundary condition 44 REAL(wp), DIMENSION(:, :, :), ALLOCATABLE :: zbetup, zbetdo, zbup, zbdo 45 REAL(wp), DIMENSION(:, :, :), ALLOCATABLE :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 44 46 45 47 !! * Substitutions … … 84 86 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 85 87 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 86 88 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 87 89 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry 88 90 !!---------------------------------------------------------------------- … … 92 94 IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 93 95 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 96 ALLOCATE (zbetup(jpi,jpj,jpk), zbetdo(jpi,jpj,jpk), zbup(jpi,jpj,jpk), zbdo(jpi,jpj,jpk) ) 97 ALLOCATE (zwi(jpi,jpj,jpk), zwx(jpi,jpj,jpk), zwy(jpi,jpj,jpk), zwz(jpi,jpj,jpk), & 98 ztu(jpi,jpj,jpk), ztv(jpi,jpj,jpk), zltu(jpi,jpj,jpk), zltv(jpi,jpj,jpk), & 99 ztw(jpi,jpj,jpk)) 94 100 ENDIF 95 101 ! … … 349 355 REAL(wp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 350 356 REAL(wp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 351 357 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo 352 358 !!---------------------------------------------------------------------- 353 359 ! -
NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_GPU/src/OCE/TRA/traldf_iso.F90
r10888 r13149 38 38 LOGICAL :: l_ptr ! flag to compute poleward transport 39 39 LOGICAL :: l_hst ! flag to compute heat transport 40 REAL(wp), DIMENSION(:, :) , ALLOCATABLE :: zdkt, zdk1t, z2d 41 REAL(wp), DIMENSION(:, :, :), ALLOCATABLE :: zdit, zdjt, zftu, zftv, ztfw 40 42 41 43 !! * Substitutions … … 109 111 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 110 112 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 111 REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t, z2d112 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw113 ! REAL(wp), DIMENSION(jpi,jpj) :: zdkt, zdk1t, z2d 114 ! REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, zftu, zftv, ztfw 113 115 !!---------------------------------------------------------------------- 114 116 ! … … 120 122 akz (:,:,:) = 0._wp 121 123 ah_wslp2(:,:,:) = 0._wp 124 ALLOCATE(zdit(jpi,jpj,jpk), zdjt(jpi,jpj,jpk), zftu(jpi,jpj,jpk), zftv(jpi,jpj,jpk), ztfw(jpi,jpj,jpk)) 125 ALLOCATE(zdkt(jpi,jpj), zdk1t(jpi,jpj), z2d(jpi,jpj)) 122 126 ENDIF 123 127 !
Note: See TracChangeset
for help on using the changeset viewer.