Changeset 5758
- Timestamp:
- 2015-09-24T08:31:40+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
- Files:
-
- 2 added
- 13 deleted
- 43 edited
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r5215 r5758 18 18 19 19 !!---------------------------------------------------------------------- 20 !! 'key_asminc' : Switch on the assimilation increment interface21 !!----------------------------------------------------------------------22 20 !! asm_bkg_wri : Write out the background state 23 21 !! asm_trj_wri : Write out the model state trajectory (used with 4D-Var) … … 27 25 USE zdf_oce ! Vertical mixing variables 28 26 USE zdfddm ! Double diffusion mixing parameterization 29 USE ldftra _oce ! Lateral tracer mixing coefficient defined in memory30 USE ldfslp ! Slopes of neutral surfaces27 USE ldftra ! Lateral diffusion: eddy diffusivity coefficients 28 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 31 29 USE tradmp ! Tracer damping 32 30 #if defined key_zdftke … … 41 39 USE asmpar ! Parameters for the assmilation interface 42 40 USE zdfmxl ! mixed layer depth 43 #if defined key_traldf_c2d44 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)45 #endif46 41 #if defined key_lim2 47 42 USE ice_2 … … 155 150 CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn ) 156 151 #if defined key_lim2 || defined key_lim3 157 IF( ( nn_ice == 2 ) .OR. ( nn_ice == 3 )) THEN158 IF(ALLOCATED(frld)) THEN159 CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1. 0- frld(:,:) )152 IF( nn_ice == 2 .OR. nn_ice == 3 ) THEN 153 IF( ALLOCATED(frld) ) THEN 154 CALL iom_rstput( kt, nitdin_r, inum, 'iceconc', 1._wp - frld(:,:) ) 160 155 ELSE 161 CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep')162 ENDIF156 CALL ctl_warn('Ice concentration not written to background as ice variable frld not allocated on this timestep') 157 ENDIF 163 158 ENDIF 164 159 #endif -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r5412 r5758 82 82 IF( lk_zdftke ) CALL zdf_tke( kstp ) ! TKE closure scheme for Kz 83 83 IF( lk_zdfgls ) CALL zdf_gls( kstp ) ! GLS closure scheme for Kz 84 IF( lk_zdfkpp ) CALL zdf_kpp( kstp ) ! KPP closure scheme for Kz85 84 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) 86 85 avt (:,:,:) = rn_avt0 * tmask(:,:,:) … … 93 92 ENDIF 94 93 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity 95 96 94 IF( lk_zdftmx ) CALL zdf_tmx( kstp ) ! tidal vertical mixing 97 98 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 99 & CALL zdf_ddm( kstp ) ! double diffusive mixing 100 95 IF( lk_zdfddm ) CALL zdf_ddm( kstp ) ! double diffusive mixing 101 96 CALL zdf_mxl( kstp ) ! mixed layer depth 102 97 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsfld.F90
r5217 r5758 11 11 !! other variables needed to be passed to TOP 12 12 !!---------------------------------------------------------------------- 13 USE oce ! ocean dynamics and tracers14 USE dom_oce ! ocean space and time domain15 USE ldftra_oce ! ocean active tracers: lateral physics16 USE sbc_oce ! Surface boundary condition: ocean fields17 USE zdf_oce ! vertical physics: ocean fields18 USE zdfddm ! vertical physics: double diffusion19 USE lbclnk ! ocean lateral boundary conditions (or mpp link)20 USE in_out_manager ! I/O manager21 USE timing ! preformance summary22 USE wrk_nemo ! working array23 13 USE crs 24 14 USE crsdom 25 15 USE crslbclnk 26 USE iom 16 USE oce ! ocean dynamics and tracers 17 USE dom_oce ! ocean space and time domain 18 USE sbc_oce ! Surface boundary condition: ocean fields 19 USE zdf_oce ! vertical physics: ocean fields 20 USE ldftra ! ocean active tracers: lateral diffusivity & EIV coefficients 21 USE zdfddm ! vertical physics: double diffusion 22 ! 23 USE in_out_manager ! I/O manager 24 USE iom ! 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE timing ! preformance summary 27 USE wrk_nemo ! working array 27 28 28 29 IMPLICIT NONE … … 30 31 31 32 PUBLIC crs_fld ! routines called by step.F90 32 33 33 34 34 !! * Substitutions … … 37 37 # include "vectopt_loop_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)39 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 40 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 56 56 !! ** Method : 57 57 !!---------------------------------------------------------------------- 58 !! 59 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 !! 62 INTEGER :: ji, jj, jk ! dummy loop indices 63 !! 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zs 66 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_crs, zs_crs ! 67 REAL(wp) :: z2dcrsu, z2dcrsv 68 !! 69 !!---------------------------------------------------------------------- 58 INTEGER, INTENT(in) :: kt ! ocean time-step index 59 ! 60 INTEGER :: ji, jj, jk ! dummy loop indices 61 REAL(wp) :: z2dcrsu, z2dcrsv ! local scalars 62 ! 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zfse3t, zfse3u, zfse3v, zfse3w ! 3D workspace for e3 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt, zt_crs 65 REAL(wp), POINTER, DIMENSION(:,:,:) :: zs, zs_crs 66 !!---------------------------------------------------------------------- 70 67 ! 71 72 68 IF( nn_timing == 1 ) CALL timing_start('crs_fld') 73 69 74 70 ! Initialize arrays 75 CALL wrk_alloc( jpi, jpj, jpk,zfse3t, zfse3w )76 CALL wrk_alloc( jpi, jpj, jpk,zfse3u, zfse3v )77 CALL wrk_alloc( jpi, jpj, jpk, zt, zs)71 CALL wrk_alloc( jpi,jpj,jpk, zfse3t, zfse3w ) 72 CALL wrk_alloc( jpi,jpj,jpk, zfse3u, zfse3v ) 73 CALL wrk_alloc( jpi,jpj,jpk, zt , zs ) 78 74 ! 79 75 CALL wrk_alloc( jpi_crs, jpj_crs, jpk, zt_crs, zs_crs ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/CRS/crsini.F90
r5215 r5758 7 7 !!---------------------------------------------------------------------- 8 8 9 USE timing ! Timing 9 !!---------------------------------------------------------------------- 10 !! crs_init : 11 !!---------------------------------------------------------------------- 12 USE par_kind, ONLY: wp 10 13 USE par_oce ! For parameter jpi,jpj,jphgr_msh 11 14 USE dom_oce ! For parameters in par_oce (jperio, lk_vvl) 12 USE crs ! Coarse grid domain15 USE crs ! Coarse grid domain 13 16 USE phycst, ONLY: omega, rad ! physical constants 14 USE wrk_nemo15 USE in_out_manager16 USE par_kind, ONLY: wp17 USE iom18 17 USE crsdom 19 18 USE crsdomwri 20 19 USE crslbclnk 20 ! 21 USE iom 22 USE in_out_manager 21 23 USE lib_mpp 24 USE wrk_nemo 25 USE timing ! Timing 22 26 23 27 IMPLICIT NONE 24 28 PRIVATE 25 29 26 PUBLIC crs_init30 PUBLIC crs_init ! called by nemogcm.F90 module 27 31 28 32 !! * Substitutions 29 33 # include "domzgr_substitute.h90" 30 34 !!---------------------------------------------------------------------- 31 35 !! $Id$ 36 !!---------------------------------------------------------------------- 32 37 CONTAINS 33 38 … … 65 70 !! - Read in pertinent data ? 66 71 !!------------------------------------------------------------------- 67 !! Local variables68 72 INTEGER :: ji,jj,jk ! dummy indices 69 73 INTEGER :: ierr ! allocation error status … … 183 187 184 188 ! 185 CALL wrk_alloc( jpi, jpj, jpk,zfse3t, zfse3u, zfse3v, zfse3w )189 CALL wrk_alloc( jpi,jpj,jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 186 190 ! 187 191 zfse3t(:,:,:) = fse3t(:,:,:) … … 200 204 ! 3.d.3 Vertical scale factors 201 205 ! 202 203 204 206 CALL crs_dom_e3( e1t, e2t, zfse3t, e1e2w_crs, 'T', tmask, e3t_crs, e3t_max_crs) 205 207 CALL crs_dom_e3( e1u, e2u, zfse3u, e2e3u_crs, 'U', umask, e3u_crs, e3u_max_crs) … … 207 209 CALL crs_dom_e3( e1t, e2t, zfse3w, e1e2w_crs, 'W', tmask, e3w_crs, e3w_max_crs) 208 210 209 ! Re set 0 toe3t_0 or e3w_0211 ! Replace 0 by e3t_0 or e3w_0 210 212 DO jk = 1, jpk 211 213 DO ji = 1, jpi_crs … … 247 249 ENDIF 248 250 249 !--------------------------------------------------------- 250 ! 7. Finish and clean-up 251 !--------------------------------------------------------- 252 CALL wrk_dealloc(jpi, jpj, jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 253 254 251 !--------------------------------------------------------- 252 ! 7. Finish and clean-up 253 !--------------------------------------------------------- 254 CALL wrk_dealloc( jpi,jpj,jpk, zfse3t, zfse3u, zfse3v, zfse3w ) 255 ! 255 256 END SUBROUTINE crs_init 256 257 257 258 !!====================================================================== 258 259 259 END MODULE crsini -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5737 r5758 17 17 !! ! 2005-11 (V. Garnier) Surface pressure gradient organization 18 18 !! 3.2 ! 2008-11 (B. Lemaire) creation from old diawri 19 !! 3.7 ! 2014-01 (G. Madec) remove eddy induced velocity from no-IOM output 20 !! ! change name of output variables in dia_wri_state 19 21 !!---------------------------------------------------------------------- 20 22 … … 27 29 USE dynadv, ONLY: ln_dynadv_vec 28 30 USE zdf_oce ! ocean vertical physics 29 USE ldftra _oce! ocean active tracers: lateral physics31 USE ldftra ! ocean active tracers: lateral physics 30 32 USE ldfdyn_oce ! ocean dynamics: lateral physics 31 USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv32 33 USE sol_oce ! solver variables 33 34 USE sbc_oce ! Surface boundary condition: ocean fields … … 248 249 DO ji = fs_2, fs_jpim1 ! vector opt. 249 250 zztmp = tsn(ji,jj,1,jp_tem) 250 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) * r1_e1u(ji-1,jj)251 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1)251 zztmpx = ( tsn(ji+1,jj,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) * r1_e1u(ji-1,jj) 252 zztmpy = ( tsn(ji,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) * r1_e2v(ji,jj-1) 252 253 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 253 254 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) … … 412 413 INTEGER :: jn, ierror ! local integers 413 414 REAL(wp) :: zsto, zout, zmax, zjulian, zdt ! local scalars 414 ! !415 ! 415 416 REAL(wp), POINTER, DIMENSION(:,:) :: zw2d ! 2D workspace 416 417 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace … … 419 420 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 420 421 ! 421 CALL wrk_alloc( jpi ,jpj , zw2d )422 IF ( ln_traldf_gdia .OR. lk_vvl ) call wrk_alloc( jpi , jpj ,jpk , zw3d )422 CALL wrk_alloc( jpi,jpj , zw2d ) 423 IF( lk_vvl ) CALL wrk_alloc( jpi,jpj,jpk , zw3d ) 423 424 ! 424 425 ! Output the initial state and forcings … … 682 683 CALL histdef( nid_U, "vozocrtx", "Zonal Current" , "m/s" , & ! un 683 684 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout ) 684 IF( ln_traldf_gdia ) THEN685 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv686 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )687 ELSE688 #if defined key_diaeiv689 CALL histdef( nid_U, "vozoeivu", "Zonal EIV Current" , "m/s" , & ! u_eiv690 & jpi, jpj, nh_U, ipk, 1, ipk, nz_U, 32, clop, zsto, zout )691 #endif692 END IF693 685 ! !!! nid_U : 2D 694 686 CALL histdef( nid_U, "sozotaux", "Wind Stress along i-axis" , "N/m2" , & ! utau … … 700 692 CALL histdef( nid_V, "vomecrty", "Meridional Current" , "m/s" , & ! vn 701 693 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout ) 702 IF( ln_traldf_gdia ) THEN703 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv704 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )705 ELSE706 #if defined key_diaeiv707 CALL histdef( nid_V, "vomeeivv", "Meridional EIV Current" , "m/s" , & ! v_eiv708 & jpi, jpj, nh_V, ipk, 1, ipk, nz_V, 32, clop, zsto, zout )709 #endif710 END IF711 694 ! !!! nid_V : 2D 712 695 CALL histdef( nid_V, "sometauy", "Wind Stress along j-axis" , "N/m2" , & ! vtau … … 718 701 CALL histdef( nid_W, "vovecrtz", "Vertical Velocity" , "m/s" , & ! wn 719 702 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) 720 IF( ln_traldf_gdia ) THEN721 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv722 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )723 ELSE724 #if defined key_diaeiv725 CALL histdef( nid_W, "voveeivw", "Vertical EIV Velocity" , "m/s" , & ! w_eiv726 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout )727 #endif728 END IF729 703 CALL histdef( nid_W, "votkeavt", "Vertical Eddy Diffusivity" , "m2/s" , & ! avt 730 704 & jpi, jpj, nh_W, ipk, 1, ipk, nz_W, 32, clop, zsto, zout ) … … 737 711 ENDIF 738 712 ! !!! nid_W : 2D 739 #if defined key_traldf_c2d740 CALL histdef( nid_W, "soleahtw", "lateral eddy diffusivity" , "m2/s" , & ! ahtw741 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )742 # if defined key_traldf_eiv743 CALL histdef( nid_W, "soleaeiw", "eddy induced vel. coeff. at w-point", "m2/s", & ! aeiw744 & jpi, jpj, nh_W, 1 , 1, 1 , - 99, 32, clop, zsto, zout )745 # endif746 #endif747 748 713 CALL histend( nid_W, snc4chunks=snc4set ) 749 714 … … 853 818 854 819 CALL histwrite( nid_U, "vozocrtx", it, un , ndim_U , ndex_U ) ! i-current 855 IF( ln_traldf_gdia ) THEN856 IF (.not. ALLOCATED(psix_eiv))THEN857 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr )858 IF( lk_mpp ) CALL mpp_sum ( ierr )859 IF( ierr > 0 ) CALL ctl_stop('STOP', 'diawri: unable to allocate psi{x,y}_eiv')860 psix_eiv(:,:,:) = 0.0_wp861 psiy_eiv(:,:,:) = 0.0_wp862 ENDIF863 DO jk=1,jpkm1864 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz865 END DO866 zw3d(:,:,jpk) = 0._wp867 CALL histwrite( nid_U, "vozoeivu", it, zw3d, ndim_U , ndex_U ) ! i-eiv current868 ELSE869 #if defined key_diaeiv870 CALL histwrite( nid_U, "vozoeivu", it, u_eiv, ndim_U , ndex_U ) ! i-eiv current871 #endif872 ENDIF873 820 CALL histwrite( nid_U, "sozotaux", it, utau , ndim_hU, ndex_hU ) ! i-wind stress 874 821 875 822 CALL histwrite( nid_V, "vomecrty", it, vn , ndim_V , ndex_V ) ! j-current 876 IF( ln_traldf_gdia ) THEN877 DO jk=1,jpk-1878 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz879 END DO880 zw3d(:,:,jpk) = 0._wp881 CALL histwrite( nid_V, "vomeeivv", it, zw3d, ndim_V , ndex_V ) ! j-eiv current882 ELSE883 #if defined key_diaeiv884 CALL histwrite( nid_V, "vomeeivv", it, v_eiv, ndim_V , ndex_V ) ! j-eiv current885 #endif886 ENDIF887 823 CALL histwrite( nid_V, "sometauy", it, vtau , ndim_hV, ndex_hV ) ! j-wind stress 888 824 889 825 CALL histwrite( nid_W, "vovecrtz", it, wn , ndim_T, ndex_T ) ! vert. current 890 IF( ln_traldf_gdia ) THEN891 DO jk=1,jpk-1892 DO jj = 2, jpjm1893 DO ji = fs_2, fs_jpim1 ! vector opt.894 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))*r1_e2v(ji,jj) + &895 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))*r1_e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx896 END DO897 END DO898 END DO899 zw3d(:,:,jpk) = 0._wp900 CALL histwrite( nid_W, "voveeivw", it, zw3d , ndim_T, ndex_T ) ! vert. eiv current901 ELSE902 # if defined key_diaeiv903 CALL histwrite( nid_W, "voveeivw", it, w_eiv , ndim_T, ndex_T ) ! vert. eiv current904 # endif905 ENDIF906 826 CALL histwrite( nid_W, "votkeavt", it, avt , ndim_T, ndex_T ) ! T vert. eddy diff. coef. 907 827 CALL histwrite( nid_W, "votkeavm", it, avmu , ndim_T, ndex_T ) ! T vert. eddy visc. coef. … … 909 829 CALL histwrite( nid_W, "voddmavs", it, fsavs(:,:,:), ndim_T, ndex_T ) ! S vert. eddy diff. coef. 910 830 ENDIF 911 #if defined key_traldf_c2d912 CALL histwrite( nid_W, "soleahtw", it, ahtw , ndim_hT, ndex_hT ) ! lateral eddy diff. coef.913 # if defined key_traldf_eiv914 CALL histwrite( nid_W, "soleaeiw", it, aeiw , ndim_hT, ndex_hT ) ! EIV coefficient at w-point915 # endif916 #endif917 831 918 832 ! 3. Close all files … … 925 839 ENDIF 926 840 ! 927 CALL wrk_dealloc( jpi , jpj, zw2d )928 IF ( ln_traldf_gdia .OR. lk_vvl ) callwrk_dealloc( jpi , jpj , jpk , zw3d )841 CALL wrk_dealloc( jpi , jpj , zw2d ) 842 IF( lk_vvl ) CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 929 843 ! 930 844 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') … … 1018 932 CALL histdef( id_i, "vovvldep", "T point depth" , "m" , & ! t-point depth 1019 933 & jpi, jpj, nh_i, jpk, 1, jpk, nz_i, 32, clop, zsto, zout ) 1020 END 934 ENDIF 1021 935 1022 936 #if defined key_lim2 … … 1042 956 CALL histwrite( id_i, "vomecrty", kt, vn , jpi*jpj*jpk, idex ) ! now j-velocity 1043 957 CALL histwrite( id_i, "vovecrtz", kt, wn , jpi*jpj*jpk, idex ) ! now k-velocity 1044 CALL histwrite( id_i, "sowaflup", kt, (emp-rnf ), jpi*jpj , idex ) ! freshwater budget958 CALL histwrite( id_i, "sowaflup", kt, emp-rnf , jpi*jpj , idex ) ! freshwater budget 1045 959 CALL histwrite( id_i, "sohefldo", kt, qsr + qns , jpi*jpj , idex ) ! total heat flux 1046 960 CALL histwrite( id_i, "soshfldo", kt, qsr , jpi*jpj , idex ) ! solar heat flux … … 1063 977 ! IF( nn_timing == 1 ) CALL timing_stop('dia_wri_state') ! not sure this works for routines not called in first timestep 1064 978 ! 1065 1066 979 END SUBROUTINE dia_wri_state 1067 980 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5755 r5758 14 14 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 15 15 !! - ! 2004-05 (A. Koch-Larrouy) Add Gyre configuration 16 !! 3.7 ! 2015-09 (G. Madec ) add cell surface and their inverse16 !! 3.7 ! 2015-09 (G. Madec, S. Flavoni) add cell surface and their inverse 17 17 !! add optional read of e1e2u & e1e2v 18 18 !!---------------------------------------------------------------------- … … 126 126 ENDIF 127 127 ! 128 ie1e2u_v = 0 ! set to unread e1e2u and e1e2v129 128 ! 130 129 SELECT CASE( jphgr_msh ) ! type of horizontal mesh … … 135 134 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in "coordinate" file' 136 135 ! 137 CALL hgr_read( ie1e2u_v ) 136 ie1e2u_v = 0 ! set to unread e1e2u and e1e2v 137 ! 138 CALL hgr_read( ie1e2u_v ) ! read the coordinate.nc file 138 139 ! 139 140 IF( ie1e2u_v == 0 ) THEN ! e1e2u and e1e2v have not been read: compute them … … 141 142 e1e2u (:,:) = e1u(:,:) * e2u(:,:) 142 143 e1e2v (:,:) = e1v(:,:) * e2v(:,:) 143 144 !145 ! ! =====================146 IF( ie1e2u_v == 0 ) CALL dom_wri_coordinate147 !148 !149 144 ENDIF 150 151 152 !153 ! N.B. : General case, lat and long function of both i and j indices:154 ! e1t(ji,jj) = ra * rad * SQRT( ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2 &155 ! + ( fsdiph( zti, ztj ) )**2 )156 ! e1u(ji,jj) = ra * rad * SQRT( ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2 &157 ! + ( fsdiph( zui, zuj ) )**2 )158 ! e1v(ji,jj) = ra * rad * SQRT( ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2 &159 ! + ( fsdiph( zvi, zvj ) )**2 )160 ! e1f(ji,jj) = ra * rad * SQRT( ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2 &161 ! + ( fsdiph( zfi, zfj ) )**2 )162 !163 ! e2t(ji,jj) = ra * rad * SQRT( ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2 &164 ! + ( fsdjph( zti, ztj ) )**2 )165 ! e2u(ji,jj) = ra * rad * SQRT( ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2 &166 ! + ( fsdjph( zui, zuj ) )**2 )167 ! e2v(ji,jj) = ra * rad * SQRT( ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2 &168 ! + ( fsdjph( zvi, zvj ) )**2 )169 ! e2f(ji,jj) = ra * rad * SQRT( ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2 &170 ! + ( fsdjph( zfi, zfj ) )**2 )171 !172 145 ! 173 146 CASE ( 1 ) !== geographical mesh on the sphere with regular (in degree) grid-spacing ==! … … 214 187 ! Position coordinates (in kilometers) 215 188 ! ========== 216 glam0 = 0. e0189 glam0 = 0._wp 217 190 gphi0 = - ppe2_m * 1.e-3 218 191 ! … … 309 282 ze1 = 106000. / REAL( jp_cfg , wp ) 310 283 ! benchmark: forced the resolution to be about 100 km 311 IF( nbench /= 0 ) ze1 = 106000. e0284 IF( nbench /= 0 ) ze1 = 106000._wp 312 285 zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 313 286 zcos_alpha = SQRT( 2._wp ) * 0.5_wp … … 444 417 ! 445 418 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 446 zphi0 = 15. e0! latitude of the first row F-points419 zphi0 = 15._wp ! latitude of the first row F-points 447 420 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 448 421 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90
r5332 r5758 29 29 USE daymod ! calendar 30 30 USE eosbn2 ! eq. of state, Brunt Vaisala frequency (eos routine) 31 USE ldftra _oce! ocean active tracers: lateral physics31 USE ldftra ! ocean active tracers: lateral physics 32 32 USE zdf_oce ! ocean vertical physics 33 33 USE phycst ! physical constants -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r4990 r5758 15 15 USE phycst ! physical constants 16 16 USE ldfdyn_oce ! ocean dynamics lateral physics 17 USE ldftra _oce! ocean tracers lateral physics17 USE ldftra ! ocean tracers lateral physics 18 18 USE ldfslp ! lateral mixing: slopes of mixing orientation 19 19 USE dynldf_bilapg ! lateral mixing (dyn_ldf_bilapg routine) … … 73 73 CASE ( 1 ) ; CALL dyn_ldf_iso ( kt ) ! rotated laplacian (except dk[ dk[.] ] part) 74 74 CASE ( 2 ) ; CALL dyn_ldf_bilap ( kt ) ! iso-level bilaplacian 75 75 !!gm CASE ( 3 ) ; CALL dyn_ldf_bilapg ( kt ) ! s-coord. horizontal bilaplacian 76 76 CASE ( 4 ) ! iso-level laplacian + bilaplacian 77 77 CALL dyn_ldf_lap ( kt ) … … 79 79 CASE ( 5 ) ! rotated laplacian + bilaplacian (s-coord) 80 80 CALL dyn_ldf_iso ( kt ) 81 CALL dyn_ldf_bilapg ( kt )81 !!gm CALL dyn_ldf_bilapg ( kt ) 82 82 ! 83 83 CASE ( -1 ) ! esopa: test all possibility with control print … … 91 91 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf2 - Ua: ', mask1=umask, & 92 92 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 93 CALL dyn_ldf_bilapg ( kt )93 !!gm CALL dyn_ldf_bilapg ( kt ) 94 94 CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf3 - Ua: ', mask1=umask, & 95 95 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) … … 215 215 IF( ierr == 1 ) CALL ctl_stop( 'iso-level in z-coordinate - partial step, not allowed' ) 216 216 IF( ierr == 2 ) CALL ctl_stop( 'isoneutral bilaplacian operator does not exist' ) 217 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 218 IF( .NOT.lk_ldfslp ) CALL ctl_stop( 'the rotation of the diffusive tensor require key_ldfslp' ) 219 ENDIF 217 IF( nldf == 1 .OR. nldf == 3 ) l_ldfslp = .TRUE. ! the rotation needs slope computation 220 218 221 219 IF(lwp) THEN -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r4990 r5758 1 1 MODULE dynldf_bilapg 2 !!====================================================================== 3 !! *** MODULE dynldf_bilapg *** 4 !! Ocean dynamics: lateral viscosity trend 5 !!====================================================================== 6 !! History : OPA ! 1997-07 (G. Madec) Original code 7 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2004-08 (C. Talandier) New trends organization 9 !!---------------------------------------------------------------------- 10 #if defined key_ldfslp || defined key_esopa 11 !!---------------------------------------------------------------------- 12 !! 'key_ldfslp' Rotation of mixing tensor 13 !!---------------------------------------------------------------------- 14 !! dyn_ldf_bilapg : update the momentum trend with the horizontal part 15 !! of the horizontal s-coord. bilaplacian diffusion 16 !! ldfguv : 17 !!---------------------------------------------------------------------- 18 USE oce ! ocean dynamics and tracers 19 USE dom_oce ! ocean space and time domain 20 USE ldfdyn_oce ! ocean dynamics lateral physics 21 USE zdf_oce ! ocean vertical physics 22 USE ldfslp ! iso-neutral slopes available 23 USE ldftra_oce, ONLY: ln_traldf_iso 24 ! 25 USE in_out_manager ! I/O manager 26 USE lib_mpp ! MPP library 27 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 28 USE prtctl ! Print control 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 2 !!============================================================================== 3 4 5 !! ====>>> Empty TO BE REMOVED 6 31 7 32 IMPLICIT NONE 33 PRIVATE 8 !!============================================================================== 34 9 35 PUBLIC dyn_ldf_bilapg ! called by step.F9036 37 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zfuw, zfvw , zdiu, zdiv ! 2D workspace (ldfguv)38 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdju, zdj1u, zdjv, zdj1v ! 2D workspace (ldfguv)39 40 !! * Substitutions41 # include "domzgr_substitute.h90"42 # include "ldfdyn_substitute.h90"43 !!----------------------------------------------------------------------44 !! NEMO/OPA 3.3 , NEMO Consortium (2010)45 !! $Id$46 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)47 !!----------------------------------------------------------------------48 CONTAINS49 50 INTEGER FUNCTION dyn_ldf_bilapg_alloc()51 !!----------------------------------------------------------------------52 !! *** ROUTINE dyn_ldf_bilapg_alloc ***53 !!----------------------------------------------------------------------54 ALLOCATE( zfuw(jpi,jpk) , zfvw (jpi,jpk) , zdiu(jpi,jpk) , zdiv (jpi,jpk) , &55 & zdju(jpi,jpk) , zdj1u(jpi,jpk) , zdjv(jpi,jpk) , zdj1v(jpi,jpk) , STAT=dyn_ldf_bilapg_alloc )56 !57 IF( dyn_ldf_bilapg_alloc /= 0 ) CALL ctl_warn('dyn_ldf_bilapg_alloc: failed to allocate arrays')58 END FUNCTION dyn_ldf_bilapg_alloc59 60 61 SUBROUTINE dyn_ldf_bilapg( kt )62 !!----------------------------------------------------------------------63 !! *** ROUTINE dyn_ldf_bilapg ***64 !!65 !! ** Purpose : Compute the before trend of the horizontal momentum66 !! diffusion and add it to the general trend of momentum equation.67 !!68 !! ** Method : The lateral momentum diffusive trends is provided by a69 !! a 4th order operator rotated along geopotential surfaces. It is70 !! computed using before fields (forward in time) and geopotential71 !! slopes computed in routine inildf.72 !! -1- compute the geopotential harmonic operator applied to73 !! (ub,vb) and multiply it by the eddy diffusivity coefficient74 !! (done by a call to ldfgpu and ldfgpv routines) The result is in75 !! (zwk1,zwk2) arrays. Applied the domain lateral boundary conditions76 !! by call to lbc_lnk.77 !! -2- applied to (zwk1,zwk2) the geopotential harmonic operator78 !! by a second call to ldfgpu and ldfgpv routines respectively. The79 !! result is in (zwk3,zwk4) arrays.80 !! -3- Add this trend to the general trend (ta,sa):81 !! (ua,va) = (ua,va) + (zwk3,zwk4)82 !!83 !! ** Action : - Update (ua,va) arrays with the before geopotential84 !! biharmonic mixing trend.85 !!----------------------------------------------------------------------86 INTEGER, INTENT( in ) :: kt ! ocean time-step index87 !88 INTEGER :: ji, jj, jk ! dummy loop indices89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwk1, zwk2, zwk3, zwk490 !!----------------------------------------------------------------------91 !92 IF( nn_timing == 1 ) CALL timing_start('dyn_ldf_bilapg')93 !94 CALL wrk_alloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )95 !96 IF( kt == nit000 ) THEN97 IF(lwp) WRITE(numout,*)98 IF(lwp) WRITE(numout,*) 'dyn_ldf_bilapg : horizontal biharmonic operator in s-coordinate'99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~'100 ! ! allocate dyn_ldf_bilapg arrays101 IF( dyn_ldf_bilapg_alloc() /= 0 ) CALL ctl_stop('STOP', 'dyn_ldf_bilapg: failed to allocate arrays')102 ENDIF103 104 ! s-coordinate: Iso-level diffusion on tracer, but geopotential level diffusion on momentum105 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN106 !107 DO jk = 1, jpk ! set the slopes of iso-level108 DO jj = 2, jpjm1109 DO ji = 2, jpim1110 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)111 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)112 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5113 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5114 END DO115 END DO116 END DO117 ! Lateral boundary conditions on the slopes118 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. )119 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. )120 121 !!bug122 IF( kt == nit000 ) then123 IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)), &124 & ' wi', sqrt(MAXVAL(wslpi)) , ' wj', sqrt(MAXVAL(wslpj))125 endif126 !!end127 ENDIF128 129 zwk1(:,:,:) = 0.e0 ; zwk3(:,:,:) = 0.e0130 zwk2(:,:,:) = 0.e0 ; zwk4(:,:,:) = 0.e0131 132 ! Laplacian of (ub,vb) multiplied by ahm133 ! --------------------------------------134 CALL ldfguv( ub, vb, zwk1, zwk2, 1 ) ! rotated harmonic operator applied to (ub,vb)135 ! ! and multiply by ahmu, ahmv (output in (zwk1,zwk2) )136 CALL lbc_lnk( zwk1, 'U', -1. ) ; CALL lbc_lnk( zwk2, 'V', -1. ) ! Lateral boundary conditions137 138 ! Bilaplacian of (ub,vb)139 ! ----------------------140 CALL ldfguv( zwk1, zwk2, zwk3, zwk4, 2 ) ! rotated harmonic operator applied to (zwk1,zwk2)141 ! ! (output in (zwk3,zwk4) )142 143 ! Update the momentum trends144 ! --------------------------145 DO jj = 2, jpjm1 ! add the diffusive trend to the general momentum trends146 DO jk = 1, jpkm1147 DO ji = 2, jpim1148 ua(ji,jj,jk) = ua(ji,jj,jk) + zwk3(ji,jj,jk)149 va(ji,jj,jk) = va(ji,jj,jk) + zwk4(ji,jj,jk)150 END DO151 END DO152 END DO153 !154 CALL wrk_dealloc( jpi, jpj, jpk, zwk1, zwk2, zwk3, zwk4 )155 !156 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_bilapg')157 !158 END SUBROUTINE dyn_ldf_bilapg159 160 161 SUBROUTINE ldfguv( pu, pv, plu, plv, kahm )162 !!----------------------------------------------------------------------163 !! *** ROUTINE ldfguv ***164 !!165 !! ** Purpose : Apply a geopotential harmonic operator to (pu,pv)166 !! (defined at u- and v-points) and multiply it by the eddy167 !! viscosity coefficient (if kahm=1).168 !!169 !! ** Method : The harmonic operator rotated along geopotential170 !! surfaces is applied to (pu,pv) using the slopes of geopotential171 !! surfaces computed in inildf routine. The result is provided in172 !! (plu,plv) arrays. It is computed in 2 stepv:173 !!174 !! First step: horizontal part of the operator. It is computed on175 !! ========== pu as follows (idem on pv)176 !! horizontal fluxes :177 !! zftu = e2u*e3u/e1u di[ pu ] - e2u*uslp dk[ mi(mk(pu)) ]178 !! zftv = e1v*e3v/e2v dj[ pu ] - e1v*vslp dk[ mj(mk(pu)) ]179 !! take the horizontal divergence of the fluxes (no divided by180 !! the volume element :181 !! plu = di-1[ zftu ] + dj-1[ zftv ]182 !!183 !! Second step: vertical part of the operator. It is computed on184 !! =========== pu as follows (idem on pv)185 !! vertical fluxes :186 !! zftw = e1t*e2t/e3w * (wslpi^2+wslpj^2) dk-1[ pu ]187 !! - e2t * wslpi di[ mi(mk(pu)) ]188 !! - e1t * wslpj dj[ mj(mk(pu)) ]189 !! take the vertical divergence of the fluxes add it to the hori-190 !! zontal component, divide the result by the volume element and191 !! if kahm=1, multiply by the eddy diffusivity coefficient:192 !! plu = aht / (e1t*e2t*e3t) { plu + dk[ zftw ] }193 !! else:194 !! plu = 1 / (e1t*e2t*e3t) { plu + dk[ zftw ] }195 !!196 !! ** Action :197 !! plu, plv : partial harmonic operator applied to198 !! pu and pv (all the components except199 !! second order vertical derivative term)200 !!----------------------------------------------------------------------201 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu , pv ! 1st call: before horizontal velocity202 ! ! 2nd call: ahm x these fields203 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: plu, plv ! partial harmonic operator applied to204 ! ! pu and pv (all the components except205 ! ! second order vertical derivative term)206 INTEGER , INTENT(in ) :: kahm ! =1 1st call ; =2 2nd call207 !208 INTEGER :: ji, jj, jk ! dummy loop indices209 REAL(wp) :: zabe1 , zabe2 , zcof1 , zcof2 ! local scalar210 REAL(wp) :: zcoef0, zcoef3, zcoef4 ! - -211 REAL(wp) :: zbur, zbvr, zmkt, zmkf, zuav, zvav ! - -212 REAL(wp) :: zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - -213 !214 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v215 !!----------------------------------------------------------------------216 !217 IF( nn_timing == 1 ) CALL timing_start('ldfguv')218 !219 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )220 !221 ! ! ********** ! ! ===============222 DO jk = 1, jpkm1 ! First step ! ! Horizontal slab223 ! ! ********** ! ! ===============224 225 ! I.1 Vertical gradient of pu and pv at level jk and jk+1226 ! -------------------------------------------------------227 ! surface boundary condition: zdku(jk=1)=zdku(jk=2)228 ! zdkv(jk=1)=zdkv(jk=2)229 230 zdk1u(:,:) = ( pu(:,:,jk) - pu(:,:,jk+1) ) * umask(:,:,jk+1)231 zdk1v(:,:) = ( pv(:,:,jk) - pv(:,:,jk+1) ) * vmask(:,:,jk+1)232 233 IF( jk == 1 ) THEN234 zdku(:,:) = zdk1u(:,:)235 zdkv(:,:) = zdk1v(:,:)236 ELSE237 zdku(:,:) = ( pu(:,:,jk-1) - pu(:,:,jk) ) * umask(:,:,jk)238 zdkv(:,:) = ( pv(:,:,jk-1) - pv(:,:,jk) ) * vmask(:,:,jk)239 ENDIF240 241 ! -----f-----242 ! I.2 Horizontal fluxes on U |243 ! ------------------------=== t u t244 ! |245 ! i-flux at t-point -----f-----246 DO jj = 1, jpjm1247 DO ji = 2, jpi248 zabe1 = e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)249 250 zmkt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) &251 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. )252 253 zcof1 = -e2t(ji,jj) * zmkt &254 * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )255 256 ziut(ji,jj) = tmask(ji,jj,jk) * &257 ( zabe1 * ( pu(ji,jj,jk) - pu(ji-1,jj,jk) ) &258 + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj) &259 +zdk1u(ji,jj) + zdku (ji-1,jj) ) )260 END DO261 END DO262 263 ! j-flux at f-point264 DO jj = 1, jpjm1265 DO ji = 1, jpim1266 zabe2 = e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)267 268 zmkf = 1./MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) &269 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. )270 271 zcof2 = -e1f(ji,jj) * zmkf &272 * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )273 274 zjuf(ji,jj) = fmask(ji,jj,jk) * &275 ( zabe2 * ( pu(ji,jj+1,jk) - pu(ji,jj,jk) ) &276 + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj) &277 +zdk1u(ji,jj+1) + zdku (ji,jj) ) )278 END DO279 END DO280 281 ! | t |282 ! I.3 Horizontal fluxes on V | |283 ! ------------------------=== f---v---f284 ! | |285 ! i-flux at f-point | t |286 DO jj = 1, jpjm1287 DO ji = 1, jpim1288 zabe1 = e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)289 290 zmkf = 1./MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) &291 + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. )292 293 zcof1 = -e2f(ji,jj) * zmkf &294 * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )295 296 zivf(ji,jj) = fmask(ji,jj,jk) * &297 ( zabe1 * ( pu(ji+1,jj,jk) - pu(ji,jj,jk) ) &298 + zcof1 * ( zdku (ji,jj) + zdk1u(ji+1,jj) &299 +zdk1u(ji,jj) + zdku (ji+1,jj) ) )300 END DO301 END DO302 303 ! j-flux at t-point304 DO jj = 2, jpj305 DO ji = 1, jpim1306 zabe2 = e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)307 308 zmkt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) &309 + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. )310 311 zcof2 = -e1t(ji,jj) * zmkt &312 * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )313 314 zjvt(ji,jj) = tmask(ji,jj,jk) * &315 ( zabe2 * ( pu(ji,jj,jk) - pu(ji,jj-1,jk) ) &316 + zcof2 * ( zdku (ji,jj-1) + zdk1u(ji,jj) &317 +zdk1u(ji,jj-1) + zdku (ji,jj) ) )318 END DO319 END DO320 321 322 ! I.4 Second derivative (divergence) (not divided by the volume)323 ! ---------------------324 325 DO jj = 2, jpjm1326 DO ji = 2, jpim1327 plu(ji,jj,jk) = ziut (ji+1,jj) - ziut (ji,jj ) &328 + zjuf (ji ,jj) - zjuf (ji,jj-1)329 plv(ji,jj,jk) = zivf (ji,jj ) - zivf (ji-1,jj) &330 + zjvt (ji,jj+1) - zjvt (ji,jj )331 END DO332 END DO333 334 ! ! ===============335 END DO ! End of slab336 ! ! ===============337 338 !,,,,,,,,,,,,,,,,,,,,,,,,,,,,,synchro,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,339 340 ! ! ************ ! ! ===============341 DO jj = 2, jpjm1 ! Second step ! ! Horizontal slab342 ! ! ************ ! ! ===============343 344 ! II.1 horizontal (pu,pv) gradients345 ! ---------------------------------346 347 DO jk = 1, jpk348 DO ji = 2, jpi349 ! i-gradient of u at jj350 zdiu (ji,jk) = tmask(ji,jj ,jk) * ( pu(ji,jj ,jk) - pu(ji-1,jj ,jk) )351 ! j-gradient of u and v at jj352 zdju (ji,jk) = fmask(ji,jj ,jk) * ( pu(ji,jj+1,jk) - pu(ji ,jj ,jk) )353 zdjv (ji,jk) = tmask(ji,jj ,jk) * ( pv(ji,jj ,jk) - pv(ji ,jj-1,jk) )354 ! j-gradient of u and v at jj+1355 zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( pu(ji,jj ,jk) - pu(ji ,jj-1,jk) )356 zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pv(ji,jj+1,jk) - pv(ji ,jj ,jk) )357 END DO358 END DO359 DO jk = 1, jpk360 DO ji = 1, jpim1361 ! i-gradient of v at jj362 zdiv (ji,jk) = fmask(ji,jj ,jk) * ( pv(ji+1,jj,jk) - pv(ji ,jj ,jk) )363 END DO364 END DO365 366 367 ! II.2 Vertical fluxes368 ! --------------------369 370 ! Surface and bottom vertical fluxes set to zero371 372 zfuw(:, 1 ) = 0.e0373 zfvw(:, 1 ) = 0.e0374 zfuw(:,jpk) = 0.e0375 zfvw(:,jpk) = 0.e0376 377 ! interior (2=<jk=<jpk-1) on pu field378 379 DO jk = 2, jpkm1380 DO ji = 2, jpim1381 ! i- and j-slopes at uw-point382 zuwslpi = 0.5 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) )383 zuwslpj = 0.5 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) )384 ! coef. for the vertical dirative385 zcoef0 = e1u(ji,jj) * e2u(ji,jj) / fse3u(ji,jj,jk) &386 * ( zuwslpi * zuwslpi + zuwslpj * zuwslpj )387 ! weights for the i-k, j-k averaging at t- and f-points, resp.388 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) &389 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. )390 zmkf = 1./MAX( fmask(ji,jj-1,jk-1)+fmask(ji,jj,jk-1) &391 + fmask(ji,jj-1,jk )+fmask(ji,jj,jk ), 1. )392 ! coef. for the horitontal derivative393 zcoef3 = - e2u(ji,jj) * zmkt * zuwslpi394 zcoef4 = - e1u(ji,jj) * zmkf * zuwslpj395 ! vertical flux on u field396 zfuw(ji,jk) = umask(ji,jj,jk) * &397 ( zcoef0 * ( pu (ji,jj,jk-1) - pu (ji,jj,jk) ) &398 + zcoef3 * ( zdiu (ji,jk-1) + zdiu (ji+1,jk-1) &399 +zdiu (ji,jk ) + zdiu (ji+1,jk ) ) &400 + zcoef4 * ( zdj1u(ji,jk-1) + zdju (ji ,jk-1) &401 +zdj1u(ji,jk ) + zdju (ji ,jk ) ) )402 END DO403 END DO404 405 ! interior (2=<jk=<jpk-1) on pv field406 407 DO jk = 2, jpkm1408 DO ji = 2, jpim1409 ! i- and j-slopes at vw-point410 zvwslpi = 0.5 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) )411 zvwslpj = 0.5 * ( wslpj(ji,jj+1,jk) + wslpj(ji,jj,jk) )412 ! coef. for the vertical derivative413 zcoef0 = e1v(ji,jj) * e2v(ji,jj) / fse3v(ji,jj,jk) &414 * ( zvwslpi * zvwslpi + zvwslpj * zvwslpj )415 ! weights for the i-k, j-k averaging at f- and t-points, resp.416 zmkf = 1./MAX( fmask(ji-1,jj,jk-1)+fmask(ji,jj,jk-1) &417 + fmask(ji-1,jj,jk )+fmask(ji,jj,jk ), 1. )418 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji,jj+1,jk-1) &419 + tmask(ji,jj,jk )+tmask(ji,jj+1,jk ), 1. )420 ! coef. for the horizontal derivatives421 zcoef3 = - e2v(ji,jj) * zmkf * zvwslpi422 zcoef4 = - e1v(ji,jj) * zmkt * zvwslpj423 ! vertical flux on pv field424 zfvw(ji,jk) = vmask(ji,jj,jk) * &425 ( zcoef0 * ( pv (ji,jj,jk-1) - pv (ji,jj,jk) ) &426 + zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1) &427 +zdiv (ji,jk ) + zdiv (ji-1,jk ) ) &428 + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1) &429 +zdjv (ji,jk ) + zdj1v(ji ,jk ) ) )430 END DO431 END DO432 433 434 ! II.3 Divergence of vertical fluxes added to the horizontal divergence435 ! ---------------------------------------------------------------------436 IF( (kahm -nkahm_smag) ==1 ) THEN437 ! multiply the laplacian by the eddy viscosity coefficient438 DO jk = 1, jpkm1439 DO ji = 2, jpim1440 ! eddy coef. divided by the volume element441 zbur = fsahmu(ji,jj,jk) / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )442 zbvr = fsahmv(ji,jj,jk) / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )443 ! vertical divergence444 zuav = zfuw(ji,jk) - zfuw(ji,jk+1)445 zvav = zfvw(ji,jk) - zfvw(ji,jk+1)446 ! harmonic operator applied to (pu,pv) and multiply by ahm447 plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur448 plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr449 END DO450 END DO451 ELSEIF( (kahm +nkahm_smag ) == 2 ) THEN452 ! second call, no multiplication453 DO jk = 1, jpkm1454 DO ji = 2, jpim1455 ! inverse of the volume element456 zbur = 1. / ( e1u(ji,jj)*e2u(ji,jj)*fse3u(ji,jj,jk) )457 zbvr = 1. / ( e1v(ji,jj)*e2v(ji,jj)*fse3v(ji,jj,jk) )458 ! vertical divergence459 zuav = zfuw(ji,jk) - zfuw(ji,jk+1)460 zvav = zfvw(ji,jk) - zfvw(ji,jk+1)461 ! harmonic operator applied to (pu,pv)462 plu(ji,jj,jk) = ( plu(ji,jj,jk) + zuav ) * zbur463 plv(ji,jj,jk) = ( plv(ji,jj,jk) + zvav ) * zbvr464 END DO465 END DO466 ELSE467 IF(lwp)WRITE(numout,*) ' ldfguv: kahm= 1 or 2, here =', kahm468 IF(lwp)WRITE(numout,*) ' We stop'469 STOP 'ldfguv'470 ENDIF471 ! ! ===============472 END DO ! End of slab473 ! ! ===============474 475 CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v )476 !477 IF( nn_timing == 1 ) CALL timing_stop('ldfguv')478 !479 END SUBROUTINE ldfguv480 481 #else482 !!----------------------------------------------------------------------483 !! Dummy module : NO rotation of mixing tensor484 !!----------------------------------------------------------------------485 CONTAINS486 SUBROUTINE dyn_ldf_bilapg( kt ) ! Dummy routine487 INTEGER, INTENT(in) :: kt488 WRITE(*,*) 'dyn_ldf_bilapg: You should not have seen this print! error?', kt489 END SUBROUTINE dyn_ldf_bilapg490 #endif491 492 !!======================================================================493 10 END MODULE dynldf_bilapg -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r4990 r5758 9 9 !! 2.0 ! 2005-11 (G. Madec) s-coordinate: horizontal diffusion 10 10 !!---------------------------------------------------------------------- 11 #if defined key_ldfslp || defined key_esopa 12 !!---------------------------------------------------------------------- 13 !! 'key_ldfslp' slopes of the direction of mixing 11 14 12 !!---------------------------------------------------------------------- 15 13 !! dyn_ldf_iso : update the momentum trend with the horizontal part … … 20 18 USE dom_oce ! ocean space and time domain 21 19 USE ldfdyn_oce ! ocean dynamics lateral physics 22 USE ldftra _oce ! ocean tracer lateral physics20 USE ldftra ! lateral physics: eddy diffusivity & EIV coefficients 23 21 USE zdf_oce ! ocean vertical physics 24 22 USE ldfslp ! iso-neutral slopes … … 106 104 !! of the rotated operator in dynzdf module 107 105 !!---------------------------------------------------------------------- 108 !109 106 INTEGER, INTENT( in ) :: kt ! ocean time-step index 110 107 ! … … 189 186 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 190 187 191 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )188 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 192 189 193 190 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & … … 204 201 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 205 202 206 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )203 zcof1 = - rn_aht_0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 207 204 208 205 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & … … 221 218 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 222 219 223 zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )220 zcof2 = - rn_aht_0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 224 221 225 222 zjuf(ji,jj) = ( zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) ) & … … 242 239 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 243 240 244 zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )241 zcof1 = - rn_aht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 245 242 246 243 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) & … … 259 256 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 260 257 261 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )258 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 262 259 263 260 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & … … 274 271 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 275 272 276 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )273 zcof2 = - rn_aht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 277 274 278 275 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & … … 358 355 DO jk = 2, jpkm1 359 356 DO ji = 2, jpim1 360 zcoef0= 0.5 * aht0 * umask(ji,jj,jk)361 357 zcoef0= 0.5 * rn_aht_0 * umask(ji,jj,jk) 358 ! 362 359 zuwslpi = zcoef0 * ( wslpi(ji+1,jj,jk) + wslpi(ji,jj,jk) ) 363 360 zuwslpj = zcoef0 * ( wslpj(ji+1,jj,jk) + wslpj(ji,jj,jk) ) 364 361 ! 365 362 zmkt = 1./MAX( tmask(ji,jj,jk-1)+tmask(ji+1,jj,jk-1) & 366 363 + tmask(ji,jj,jk )+tmask(ji+1,jj,jk ), 1. ) … … 376 373 +zdj1u(ji,jk ) + zdju (ji ,jk ) ) 377 374 ! update avmu (add isopycnal vertical coefficient to avmu) 378 ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0379 avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / aht0375 ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 376 avmu(ji,jj,jk) = avmu(ji,jj,jk) + ( zuwslpi * zuwslpi + zuwslpj * zuwslpj ) / rn_aht_0 380 377 END DO 381 378 END DO … … 384 381 DO jk = 2, jpkm1 385 382 DO ji = 2, jpim1 386 zcoef0 = 0.5 * aht0 * vmask(ji,jj,jk)383 zcoef0 = 0.5 * rn_aht_0 * vmask(ji,jj,jk) 387 384 388 385 zvwslpi = zcoef0 * ( wslpi(ji,jj+1,jk) + wslpi(ji,jj,jk) ) … … 398 395 ! vertical flux on v field 399 396 zfvw(ji,jk) = zcoef3 * ( zdiv (ji,jk-1) + zdiv (ji-1,jk-1) & 400 401 402 397 & +zdiv (ji,jk ) + zdiv (ji-1,jk ) ) & 398 & + zcoef4 * ( zdjv (ji,jk-1) + zdj1v(ji ,jk-1) & 399 & +zdjv (ji,jk ) + zdj1v(ji ,jk ) ) 403 400 ! update avmv (add isopycnal vertical coefficient to avmv) 404 ! Caution: zcoef0 include aht0, so divided by aht0 to obtain slp^2 * aht0405 avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / aht0401 ! Caution: zcoef0 include rn_aht_0, so divided by rn_aht_0 to obtain slp^2 * rn_aht_0 402 avmv(ji,jj,jk) = avmv(ji,jj,jk) + ( zvwslpi * zvwslpi + zvwslpj * zvwslpj ) / rn_aht_0 406 403 END DO 407 404 END DO … … 413 410 DO ji = 2, jpim1 414 411 ! volume elements 415 zbu = e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk)416 zbv = e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk)412 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 413 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 417 414 ! part of the k-component of isopycnal momentum diffusive trends 418 415 zuav = ( zfuw(ji,jk) - zfuw(ji,jk+1) ) / zbu … … 432 429 END SUBROUTINE dyn_ldf_iso 433 430 434 # else435 !!----------------------------------------------------------------------436 !! Dummy module NO rotation of mixing tensor437 !!----------------------------------------------------------------------438 CONTAINS439 SUBROUTINE dyn_ldf_iso( kt ) ! Empty routine440 INTEGER, INTENT(in) :: kt441 WRITE(*,*) 'dyn_ldf_iso: You should not have seen this print! error?', kt442 END SUBROUTINE dyn_ldf_iso443 #endif444 445 431 !!====================================================================== 446 432 END MODULE dynldf_iso -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
r5400 r5758 139 139 !! 140 140 !!---------------------------------------------------------------------- 141 USE ldftra _oce, ONLY: aht0141 USE ldftra, ONLY: rn_aht_0 142 142 USE iom 143 143 ! … … 254 254 ! symmetric in the south hemisphere) 255 255 256 zahmeq = aht0256 zahmeq = rn_aht_0 257 257 258 258 DO jj = 1, jpj … … 336 336 !! 337 337 !!---------------------------------------------------------------------- 338 USE ldftra _oce, ONLY: aht0338 USE ldftra, ONLY: rn_aht_0 339 339 USE iom 340 340 ! … … 452 452 ! symmetric in the south hemisphere) 453 453 454 zahmeq = aht0454 zahmeq = rn_aht_0 455 455 zam20s = ahm0*COS( rad * 20. ) 456 456 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
r5400 r5758 26 26 !! ??? explanation of the default is missing 27 27 !!---------------------------------------------------------------------- 28 USE ldftra _oce, ONLY : aht028 USE ldftra, ONLY : rn_aht_0 29 29 USE iom 30 30 !! … … 193 193 !! ** Method : blah blah blah .... 194 194 !!---------------------------------------------------------------------- 195 USE ldftra _oce, ONLY: aht0195 USE ldftra, ONLY: rn_aht_0 196 196 USE iom 197 197 !! … … 248 248 249 249 IF( jp_cfg == 4 ) THEN 250 zahmeq = 5.0 * aht0250 zahmeq = 5.0 * rn_aht_0 251 251 zahmm = min( 160000.0, ahm0) 252 252 zemax = MAXVAL ( e1t(:,:) * e2t(:,:), tmask(:,:,1) .GE. 0.5 ) … … 273 273 274 274 IF( jp_cfg == 2 ) THEN 275 zahmeq = aht0275 zahmeq = rn_aht_0 276 276 zahmm = ahm0 277 277 zahm0(:,:) = ahm0 … … 279 279 280 280 IF( jp_cfg == 1 ) THEN 281 zahmeq = aht0 ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required281 zahmeq = rn_aht_0 ! reduced to aht0 on equator; set to ahm0 if no tropical reduction is required 282 282 zahmm = ahm0 283 283 zahm0(:,:) = ahm0 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5737 r5758 11 11 !! 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec) add Griffies operator 12 12 !! - ! 2010-11 (F. Dupond, G. Madec) bug correction in slopes just below the ML 13 !! 3.7 ! 2013-12 (F. Lemarie, G. Madec) add limiter on triad slopes 13 14 !!---------------------------------------------------------------------- 14 #if defined key_ldfslp || defined key_esopa 15 15 16 !!---------------------------------------------------------------------- 16 !! 'key_ldfslp' Rotation of lateral mixing tensor17 !!----------------------------------------------------------------------18 !! ldf_slp_grif : calculates the triads of isoneutral slopes (Griffies operator)19 17 !! ldf_slp : calculates the slopes of neutral surface (Madec operator) 18 !! ldf_slp_triad : calculates the triads of isoneutral slopes (Griffies operator) 20 19 !! ldf_slp_mxl : calculates the slopes at the base of the mixed layer (Madec operator) 21 20 !! ldf_slp_init : initialization of the slopes computation … … 23 22 USE oce ! ocean dynamics and tracers 24 23 USE dom_oce ! ocean space and time domain 25 USE ldftra_oce ! lateral diffusion: traceur 26 USE ldfdyn_oce ! lateral diffusion: dynamics 24 !!gm 25 ! USE ldfdyn ! lateral diffusion: eddy viscosity coef. 26 !!gm to be removed 27 USE ldfdyn_oce ! lateral diffusion: eddy viscosity coef. 28 !!gm 27 29 USE phycst ! physical constants 28 30 USE zdfmxl ! mixed layer depth … … 30 32 ! 31 33 USE in_out_manager ! I/O manager 34 USE prtctl ! Print control 32 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE prtctl ! Print control 36 USE lib_mpp ! distribued memory computing library 37 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 38 USE wrk_nemo ! work arrays 35 39 USE timing ! Timing 36 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)37 40 38 41 IMPLICIT NONE 39 42 PRIVATE 40 43 41 PUBLIC ldf_slp ! routine called by step.F90 42 PUBLIC ldf_slp_grif ! routine called by step.F90 43 PUBLIC ldf_slp_init ! routine called by opa.F90 44 45 LOGICAL , PUBLIC, PARAMETER :: lk_ldfslp = .TRUE. !: slopes flag 46 ! !! Madec operator 47 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 44 PUBLIC ldf_slp ! routine called by step.F90 45 PUBLIC ldf_slp_triad ! routine called by step.F90 46 PUBLIC ldf_slp_init ! routine called by nemogcm.F90 47 48 LOGICAL , PUBLIC :: l_ldfslp = .FALSE. !: slopes flag 49 50 LOGICAL , PUBLIC :: ln_traldf_iso = .TRUE. !: iso-neutral direction 51 LOGICAL , PUBLIC :: ln_traldf_triad = .FALSE. !: griffies triad scheme 52 53 LOGICAL , PUBLIC :: ln_triad_iso = .FALSE. !: pure horizontal mixing in ML 54 LOGICAL , PUBLIC :: ln_botmix_triad = .FALSE. !: mixing on bottom 55 REAL(wp), PUBLIC :: rn_sw_triad = 1._wp !: =1 switching triads ; =0 all four triads used 56 REAL(wp), PUBLIC :: rn_slpmax = 0.01_wp !: slope limit 57 58 LOGICAL , PUBLIC :: l_grad_zps = .FALSE. !: special treatment for Horz Tgradients w partial steps (triad operator) 59 60 ! !! Classic operator (Madec) 48 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp, wslpi !: i_slope at U- and W-points 49 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp, wslpj !: j-slope at V- and W-points 50 ! !! Griffies operator63 ! !! triad operator (Griffies) 51 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslp2 !: wslp**2 from Griffies quarter cells 52 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi_g, triadj_g !: skew flux slopes relative to geopotentials 53 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) :: triadi , triadj !: isoneutral slopes relative to model-coordinate 54 55 ! !! Madec operator 56 ! Arrays allocated in ldf_slp_init() routine once we know whether we're using the Griffies or Madec operator 67 ! !! both operators 68 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ah_wslp2 !: ah * slope^2 at w-point 69 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akz !: stabilizing vertical diffusivity 70 71 ! !! Madec operator 57 72 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: omlmask ! mask of the surface mixed layer at T-pt 58 73 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: uslpml, wslpiml ! i_slope at U- and W-points just below the mixed layer … … 63 78 !! * Substitutions 64 79 # include "domzgr_substitute.h90" 65 # include "ldftra_substitute.h90"66 # include "ldfeiv_substitute.h90"67 80 # include "vectopt_loop_substitute.h90" 68 81 !!---------------------------------------------------------------------- 69 !! NEMO/OPA 4.0 , NEMO Consortium (201 1)82 !! NEMO/OPA 4.0 , NEMO Consortium (2014) 70 83 !! $Id$ 71 84 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 105 118 INTEGER :: ii0, ii1, iku ! temporary integer 106 119 INTEGER :: ij0, ij1, ikv ! temporary integer 107 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw ! local scalars120 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_16, zcofw, z1_slpmax ! local scalars 108 121 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 109 122 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 110 123 REAL(wp) :: zck, zfk, zbw ! - - 111 REAL(wp) :: zdepv, zdepu ! - -112 124 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 113 125 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr 114 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv 115 REAL(wp), POINTER, DIMENSION(:,: ) :: zhmlpu, zhmlpv116 127 !!---------------------------------------------------------------------- 117 128 ! … … 119 130 ! 120 131 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 121 CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv ) 122 123 IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN 124 125 zeps = 1.e-20_wp !== Local constant initialization ==! 126 z1_16 = 1.0_wp / 16._wp 127 zm1_g = -1.0_wp / grav 128 zm1_2g = -0.5_wp / grav 129 ! 130 zww(:,:,:) = 0._wp 131 zwz(:,:,:) = 0._wp 132 ! 133 DO jk = 1, jpk !== i- & j-gradient of density ==! 134 DO jj = 1, jpjm1 135 DO ji = 1, fs_jpim1 ! vector opt. 136 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 137 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 138 END DO 139 END DO 140 END DO 141 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 142 DO jj = 1, jpjm1 143 DO ji = 1, jpim1 144 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 145 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 146 END DO 147 END DO 148 ENDIF 149 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 150 DO jj = 1, jpjm1 151 DO ji = 1, jpim1 152 IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 153 IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 154 END DO 155 END DO 156 ENDIF 157 ! 158 !== Local vertical density gradient at T-point == ! (evaluated from N^2) 159 ! interior value 160 DO jk = 2, jpkm1 161 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 162 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 163 ! ! else tmask(ik+1) = 0 => pn2(ik+1) = 0 => zdzr divides by 1 164 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 165 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 166 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 167 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 168 END DO 169 ! surface initialisation 170 zdzr(:,:,1) = 0._wp 171 IF ( ln_isfcav ) THEN 172 ! if isf need to overwrite the interior value at at the first ocean point 173 DO jj = 1, jpjm1 174 DO ji = 1, jpim1 175 zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 176 END DO 177 END DO 178 END IF 179 ! 180 ! !== Slopes just below the mixed layer ==! 181 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr ) ! output: uslpml, vslpml, wslpiml, wslpjml 182 183 184 ! I. slopes at u and v point | uslp = d/di( prd ) / d/dz( prd ) 185 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 186 ! 187 IF ( ln_isfcav ) THEN 188 DO jj = 2, jpjm1 189 DO ji = fs_2, fs_jpim1 ! vector opt. 190 IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp) 191 IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj ), 5._wp) 192 IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji+1,jj ), 5._wp) 193 IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp) 194 IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj+1), 5._wp) 195 IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji ,jj+1), 5._wp) 196 ENDDO 197 ENDDO 198 ELSE 199 DO jj = 2, jpjm1 200 DO ji = fs_2, fs_jpim1 ! vector opt. 201 zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 202 zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) 203 ENDDO 204 ENDDO 205 END IF 206 DO jk = 2, jpkm1 !* Slopes at u and v points 207 DO jj = 2, jpjm1 208 DO ji = fs_2, fs_jpim1 ! vector opt. 209 ! ! horizontal and vertical density gradient at u- and v-points 210 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 211 zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 212 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 213 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) 214 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 215 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 216 zbu = MIN( zbu, -100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau ) ) 217 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 218 ! ! uslp and vslp output in zwz and zww, resp. 219 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj ,jk) ) 220 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji ,jj+1,jk) ) 221 ! thickness of water column between surface and level k at u/v point 222 zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) & 223 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) - fse3u(ji,jj,miku(ji,jj)) ) 224 zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) & 225 - 2 * MAX( risfdep(ji,jj), risfdep(ji ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) ) 226 ! 227 zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) & 228 & + zfi * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj) 229 zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk) 230 zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) & 231 & + zfj * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj) 232 zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk) 233 234 132 133 zeps = 1.e-20_wp !== Local constant initialization ==! 134 z1_16 = 1.0_wp / 16._wp 135 zm1_g = -1.0_wp / grav 136 zm1_2g = -0.5_wp / grav 137 z1_slpmax = 1._wp / rn_slpmax 138 ! 139 zww(:,:,:) = 0._wp 140 zwz(:,:,:) = 0._wp 141 ! 142 DO jk = 1, jpk !== i- & j-gradient of density ==! 143 DO jj = 1, jpjm1 144 DO ji = 1, fs_jpim1 ! vector opt. 145 zgru(ji,jj,jk) = umask(ji,jj,jk) * ( prd(ji+1,jj ,jk) - prd(ji,jj,jk) ) 146 zgrv(ji,jj,jk) = vmask(ji,jj,jk) * ( prd(ji ,jj+1,jk) - prd(ji,jj,jk) ) 147 END DO 148 END DO 149 END DO 150 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 151 DO jj = 1, jpjm1 152 DO ji = 1, jpim1 153 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 154 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) 155 END DO 156 END DO 157 ENDIF 158 ! 159 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 160 DO jk = 2, jpkm1 161 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 162 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 163 ! ! else tmask(ik+1) = 0 => pn2(ik+1) = 0 => zdzr divides by 1 164 ! ! umask(ik+1) /= 0 => all pn2 /= 0 => zdzr divides by 2 165 ! ! NB: 1/(tmask+1) = (1-.5*tmask) substitute a / by a * ==> faster 166 zdzr(:,:,jk) = zm1_g * ( prd(:,:,jk) + 1._wp ) & 167 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 168 END DO 169 ! 170 ! !== Slopes just below the mixed layer ==! 171 CALL ldf_slp_mxl( prd, pn2, zgru, zgrv, zdzr ) ! output: uslpml, vslpml, wslpiml, wslpjml 172 173 174 ! I. slopes at u and v point | uslp = d/di( prd ) / d/dz( prd ) 175 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 176 ! 177 DO jk = 2, jpkm1 !* Slopes at u and v points 178 DO jj = 2, jpjm1 179 DO ji = fs_2, fs_jpim1 ! vector opt. 180 ! ! horizontal and vertical density gradient at u- and v-points 181 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 182 zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 183 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 184 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) 185 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0 186 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 187 zbu = MIN( zbu, - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,jk)* ABS( zau ) ) 188 zbv = MIN( zbv, - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 189 ! ! uslp and vslp output in zwz and zww, resp. 190 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 191 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 192 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 193 & + zfi * uslpml(ji,jj) & 194 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 195 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 196 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 197 & + zfj * vslpml(ji,jj) & 198 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 199 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 235 200 !!gm modif to suppress omlmask.... (as in Griffies case) 236 ! 237 ! 238 ! 239 ! 240 ! 241 ! 242 ! 201 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. 202 ! zfi = REAL( 1 - 1/(1 + jk / MAX( nmln(ji+1,jj), nmln(ji,jj) ) ), wp ) 203 ! zfj = REAL( 1 - 1/(1 + jk / MAX( nmln(ji,jj+1), nmln(ji,jj) ) ), wp ) 204 ! zci = 0.5 * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 10. ) ) 205 ! zcj = 0.5 * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk) ) / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 10. ) ) 206 ! zwz(ji,jj,jk) = ( zfi * zai / ( zbi - zeps ) + ( 1._wp - zfi ) * wslpiml(ji,jj) * zci ) * tmask(ji,jj,jk) 207 ! zww(ji,jj,jk) = ( zfj * zaj / ( zbj - zeps ) + ( 1._wp - zfj ) * wslpjml(ji,jj) * zcj ) * tmask(ji,jj,jk) 243 208 !!gm end modif 244 END DO 245 END DO 246 END DO 247 CALL lbc_lnk( zwz, 'U', -1. ) ; CALL lbc_lnk( zww, 'V', -1. ) ! lateral boundary conditions 248 ! 249 ! !* horizontal Shapiro filter 250 DO jk = 2, jpkm1 251 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 252 DO ji = 2, jpim1 253 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 254 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 255 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 256 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 257 & + 4.* zwz(ji ,jj ,jk) ) 258 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 259 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 260 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 261 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 262 & + 4.* zww(ji,jj ,jk) ) 263 END DO 264 END DO 265 DO jj = 3, jpj-2 ! other rows 266 DO ji = fs_2, fs_jpim1 ! vector opt. 267 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 268 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 269 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 270 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 271 & + 4.* zwz(ji ,jj ,jk) ) 272 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 273 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 274 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 275 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 276 & + 4.* zww(ji,jj ,jk) ) 277 END DO 278 END DO 279 ! !* decrease along coastal boundaries 280 DO jj = 2, jpjm1 281 DO ji = fs_2, fs_jpim1 ! vector opt. 282 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 283 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp & 284 & * umask(ji,jj,jk-1) 285 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 286 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp & 287 & * vmask(ji,jj,jk-1) 288 END DO 289 END DO 290 END DO 291 292 293 ! II. slopes at w point | wslpi = mij( d/di( prd ) / d/dz( prd ) 294 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 295 ! 296 DO jk = 2, jpkm1 297 DO jj = 2, jpjm1 298 DO ji = fs_2, fs_jpim1 ! vector opt. 299 ! !* Local vertical density gradient evaluated from N^2 300 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk) 301 ! !* Slopes at w point 302 ! ! i- & j-gradient of density at w-points 303 zci = MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk ) & 304 & + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps ) * e1t(ji,jj) 305 zcj = MAX( vmask(ji,jj-1,jk ) + vmask(ji,jj,jk-1) & 306 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 307 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 308 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci 309 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 310 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj 311 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 312 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 313 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai ) ) 314 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 315 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 316 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 317 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 318 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 319 & + zck * wslpiml(ji,jj) * zfk ) * wmask(ji,jj,jk) 320 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 321 & + zck * wslpjml(ji,jj) * zfk ) * wmask(ji,jj,jk) 209 END DO 210 END DO 211 END DO 212 CALL lbc_lnk( zwz, 'U', -1. ) ; CALL lbc_lnk( zww, 'V', -1. ) ! lateral boundary conditions 213 ! 214 ! !* horizontal Shapiro filter 215 DO jk = 2, jpkm1 216 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 217 DO ji = 2, jpim1 218 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 219 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 220 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 221 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 222 & + 4.* zwz(ji ,jj ,jk) ) 223 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 224 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 225 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 226 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 227 & + 4.* zww(ji,jj ,jk) ) 228 END DO 229 END DO 230 DO jj = 3, jpj-2 ! other rows 231 DO ji = fs_2, fs_jpim1 ! vector opt. 232 uslp(ji,jj,jk) = z1_16 * ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 233 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 234 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 235 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 236 & + 4.* zwz(ji ,jj ,jk) ) 237 vslp(ji,jj,jk) = z1_16 * ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 238 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 239 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 240 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 241 & + 4.* zww(ji,jj ,jk) ) 242 END DO 243 END DO 244 ! !* decrease along coastal boundaries 245 DO jj = 2, jpjm1 246 DO ji = fs_2, fs_jpim1 ! vector opt. 247 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 248 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp 249 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 250 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp 251 END DO 252 END DO 253 END DO 254 255 256 ! II. slopes at w point | wslpi = mij( d/di( prd ) / d/dz( prd ) 257 ! =========================== | wslpj = mij( d/dj( prd ) / d/dz( prd ) 258 ! 259 DO jk = 2, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 ! !* Local vertical density gradient evaluated from N^2 263 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 264 ! !* Slopes at w point 265 ! ! i- & j-gradient of density at w-points 266 zci = MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk ) & 267 & + umask(ji-1,jj,jk-1) + umask(ji,jj,jk-1) , zeps ) * e1t(ji,jj) 268 zcj = MAX( vmask(ji,jj-1,jk ) + vmask(ji,jj,jk-1) & 269 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 270 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 271 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk) 272 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 273 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk) 274 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 275 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 276 zbi = MIN( zbw ,- 100._wp* ABS( zai ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zai ) ) 277 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 278 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 279 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 280 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 281 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 282 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 322 283 323 284 !!gm modif to suppress omlmask.... (as in Griffies operator) 324 ! 325 ! 326 ! 327 ! 328 ! 285 ! ! ! jk must be >= ML level for zfk=1. otherwise zfk=0. 286 ! zfk = REAL( 1 - 1/(1 + jk / nmln(ji+1,jj)), wp ) 287 ! zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10. ) 288 ! zwz(ji,jj,jk) = ( zfk * zai / ( zbi - zeps ) + ( 1._wp - zfk ) * wslpiml(ji,jj) * zck ) * tmask(ji,jj,jk) 289 ! zww(ji,jj,jk) = ( zfk * zaj / ( zbj - zeps ) + ( 1._wp - zfk ) * wslpjml(ji,jj) * zck ) * tmask(ji,jj,jk) 329 290 !!gm end modif 330 END DO 331 END DO 332 END DO 333 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 334 ! 335 ! !* horizontal Shapiro filter 336 DO jk = 2, jpkm1 337 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 338 DO ji = 2, jpim1 339 zcofw = tmask(ji,jj,jk) * z1_16 340 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 341 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 342 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 343 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 344 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 345 346 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 347 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 348 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 349 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 350 & + 4.* zww(ji ,jj ,jk) ) * zcofw 351 END DO 352 END DO 353 DO jj = 3, jpj-2 ! other rows 354 DO ji = fs_2, fs_jpim1 ! vector opt. 355 zcofw = tmask(ji,jj,jk) * z1_16 356 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 357 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 358 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 359 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 360 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 361 362 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 363 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 364 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 365 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 366 & + 4.* zww(ji ,jj ,jk) ) * zcofw 367 END DO 368 END DO 369 ! !* decrease along coastal boundaries 370 DO jj = 2, jpjm1 371 DO ji = fs_2, fs_jpim1 ! vector opt. 372 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 373 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 374 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk) 375 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk) 376 END DO 377 END DO 378 END DO 379 380 ! III. Specific grid points 381 ! =========================== 382 ! 383 IF( cp_cfg == "orca" .AND. jp_cfg == 4 ) THEN ! ORCA_R4 configuration: horizontal diffusion in specific area 384 ! ! Gibraltar Strait 385 ij0 = 50 ; ij1 = 53 386 ii0 = 69 ; ii1 = 71 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 387 ij0 = 51 ; ij1 = 53 388 ii0 = 68 ; ii1 = 71 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 389 ii0 = 69 ; ii1 = 71 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 390 ii0 = 69 ; ii1 = 71 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 391 ! 392 ! ! Mediterrannean Sea 393 ij0 = 49 ; ij1 = 56 394 ii0 = 71 ; ii1 = 90 ; uslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 395 ij0 = 50 ; ij1 = 56 396 ii0 = 70 ; ii1 = 90 ; vslp ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 397 ii0 = 71 ; ii1 = 90 ; wslpi( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 398 ii0 = 71 ; ii1 = 90 ; wslpj( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , : ) = 0._wp 399 ENDIF 400 401 402 ! IV. Lateral boundary conditions 403 ! =============================== 404 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 405 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 406 407 408 IF(ln_ctl) THEN 409 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 410 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 411 ENDIF 412 ! 413 414 ELSEIF ( lk_vvl ) THEN 415 416 IF(lwp) THEN 417 WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 418 ENDIF 419 420 ! geopotential diffusion in s-coordinates on tracers and/or momentum 421 ! The slopes of s-surfaces are computed at each time step due to vvl 422 ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 423 424 ! set the slope of diffusion to the slope of s-surfaces 425 ! ( c a u t i o n : minus sign as fsdep has positive value ) 426 DO jj = 2, jpjm1 427 DO ji = fs_2, fs_jpim1 ! vector opt. 428 uslp (ji,jj,1) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1) 429 vslp (ji,jj,1) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1) 430 wslpi(ji,jj,1) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5 431 wslpj(ji,jj,1) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5 432 END DO 433 END DO 434 435 DO jk = 2, jpk 436 DO jj = 2, jpjm1 437 DO ji = fs_2, fs_jpim1 ! vector opt. 438 uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 439 vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 440 wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 441 wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 442 END DO 443 END DO 444 END DO 445 446 ! Lateral boundary conditions on the slopes 447 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 448 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 449 450 if( kt == nit000 ) then 451 IF(lwp) WRITE(numout,*) ' max slop: u',SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)), & 452 & ' wi', sqrt(MAXVAL(wslpi)), ' wj', sqrt(MAXVAL(wslpj)) 453 endif 454 455 IF(ln_ctl) THEN 456 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 457 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 458 ENDIF 459 291 END DO 292 END DO 293 END DO 294 CALL lbc_lnk( zwz, 'T', -1. ) ; CALL lbc_lnk( zww, 'T', -1. ) ! lateral boundary conditions 295 ! 296 ! !* horizontal Shapiro filter 297 DO jk = 2, jpkm1 298 DO jj = 2, jpjm1, MAX(1, jpj-3) ! rows jj=2 and =jpjm1 only 299 DO ji = 2, jpim1 300 zcofw = wmask(ji,jj,jk) * z1_16 301 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 302 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 303 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 304 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 305 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 306 307 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 308 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 309 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 310 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 311 & + 4.* zww(ji ,jj ,jk) ) * zcofw 312 END DO 313 END DO 314 DO jj = 3, jpj-2 ! other rows 315 DO ji = fs_2, fs_jpim1 ! vector opt. 316 zcofw = wmask(ji,jj,jk) * z1_16 317 wslpi(ji,jj,jk) = ( zwz(ji-1,jj-1,jk) + zwz(ji+1,jj-1,jk) & 318 & + zwz(ji-1,jj+1,jk) + zwz(ji+1,jj+1,jk) & 319 & + 2.*( zwz(ji ,jj-1,jk) + zwz(ji-1,jj ,jk) & 320 & + zwz(ji+1,jj ,jk) + zwz(ji ,jj+1,jk) ) & 321 & + 4.* zwz(ji ,jj ,jk) ) * zcofw 322 323 wslpj(ji,jj,jk) = ( zww(ji-1,jj-1,jk) + zww(ji+1,jj-1,jk) & 324 & + zww(ji-1,jj+1,jk) + zww(ji+1,jj+1,jk) & 325 & + 2.*( zww(ji ,jj-1,jk) + zww(ji-1,jj ,jk) & 326 & + zww(ji+1,jj ,jk) + zww(ji ,jj+1,jk) ) & 327 & + 4.* zww(ji ,jj ,jk) ) * zcofw 328 END DO 329 END DO 330 ! !* decrease in vicinity of topography 331 DO jj = 2, jpjm1 332 DO ji = fs_2, fs_jpim1 ! vector opt. 333 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 334 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 335 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 336 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 337 END DO 338 END DO 339 END DO 340 341 ! IV. Lateral boundary conditions 342 ! =============================== 343 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 344 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 345 346 347 IF(ln_ctl) THEN 348 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 349 CALL prt_ctl(tab3d_1=wslpi, clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 460 350 ENDIF 461 351 ! 462 352 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 463 CALL wrk_dealloc( jpi,jpj, zhmlpu, zhmlpv)464 353 ! 465 354 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 468 357 469 358 470 SUBROUTINE ldf_slp_ grif( kt )471 !!---------------------------------------------------------------------- 472 !! *** ROUTINE ldf_slp_ grif***359 SUBROUTINE ldf_slp_triad ( kt ) 360 !!---------------------------------------------------------------------- 361 !! *** ROUTINE ldf_slp_triad *** 473 362 !! 474 363 !! ** Purpose : Compute the squared slopes of neutral surfaces (slope 475 !! of iso-pycnal surfaces referenced locally) (ln_traldf_ grif=T)364 !! of iso-pycnal surfaces referenced locally) (ln_traldf_triad=T) 476 365 !! at W-points using the Griffies quarter-cells. 477 366 !! … … 488 377 REAL(wp) :: zfacti, zfactj ! local scalars 489 378 REAL(wp) :: znot_thru_surface ! local scalars 490 REAL(wp) :: zdit, zdis, zdjt, zdjs, zdkt, zdks, zbu, zbv, zbti, zbtj 379 REAL(wp) :: zdit, zdis, zdkt, zbu, zbti, zisw 380 REAL(wp) :: zdjt, zdjs, zdks, zbv, zbtj, zjsw 491 381 REAL(wp) :: zdxrho_raw, zti_coord, zti_raw, zti_lim, zti_g_raw, zti_g_lim 492 382 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 493 383 REAL(wp) :: zdzrho_raw 384 REAL(wp) :: zbeta0, ze3_e1, ze3_e2 494 385 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 386 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet 495 387 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 496 388 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only 497 389 !!---------------------------------------------------------------------- 498 390 ! 499 IF( nn_timing == 1 ) CALL timing_start('ldf_slp_ grif')391 IF( nn_timing == 1 ) CALL timing_start('ldf_slp_triad') 500 392 ! 501 393 CALL wrk_alloc( jpi,jpj, z1_mlbw ) 394 CALL wrk_alloc( jpi,jpj,jpk, zalbet ) 502 395 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 503 396 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 519 412 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj) 520 413 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj) 521 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw) ! keep the sign522 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw)414 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 415 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 523 416 END DO 524 417 END DO … … 552 445 zdks = 0._wp 553 446 ENDIF 554 zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) *zdks ) / fse3w(ji,jj,jk+kp)555 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln447 zdzrho_raw = ( - zalbet(ji,jj,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp) 448 zdzrho(ji,jj,jk,kp) = - MIN( - repsln , zdzrho_raw ) ! force zdzrho >= repsln 556 449 END DO 557 450 END DO … … 586 479 ! 587 480 jk = nmln(ji+ip,jj) + 1 588 IF( jk .GT. mbkt(ji+ip,jj) ) THEN !ML reaches bottom 589 zti_mlb(ji+ip,jj ,1-ip,kp) = 0.0_wp 590 ELSE 591 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 592 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 593 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 594 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 481 IF( jk > mbkt(ji+ip,jj) ) THEN ! ML reaches bottom 482 zti_mlb(ji+ip,jj ,1-ip,kp) = 0.0_wp 483 ELSE 484 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 485 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 486 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 487 ze3_e1 = fse3w(ji+ip,jj,jk-kp) * r1_e1u(ji,jj) 488 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1 , ABS( zti_g_raw ) ), zti_g_raw ) 595 489 ENDIF 596 490 ! 597 491 jk = nmln(ji,jj+jp) + 1 598 492 IF( jk .GT. mbkt(ji,jj+jp) ) THEN !ML reaches bottom 599 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp493 ztj_mlb(ji ,jj+jp,1-jp,kp) = 0.0_wp 600 494 ELSE 601 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 602 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e2v(ji,jj) ) * vmask(ji,jj,jk) 603 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 495 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 496 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) / e2v(ji,jj) ) * vmask(ji,jj,jk) 497 ze3_e2 = fse3w(ji,jj+jp,jk-kp) / e2v(ji,jj) 498 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2 , ABS( ztj_g_raw ) ), ztj_g_raw ) 604 499 ENDIF 605 500 END DO … … 628 523 ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti) 629 524 ! 630 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) 525 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) ! unmasked 631 526 ztj_raw = zdyrho(ji ,jj+jp,jk,1-jp) / zdzrho(ji ,jj+jp,jk,kp) 632 527 ! 633 528 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 634 529 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) … … 636 531 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 637 532 ztj_g_raw = ztj_raw - ztj_coord 638 zti_g_lim = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 639 ztj_g_lim = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 533 ! additional limit required in bilaplacian case 534 ze3_e1 = fse3w(ji+ip,jj ,jk+kp) * r1_e1u(ji,jj) 535 ze3_e2 = fse3w(ji ,jj+jp,jk+kp) * r1_e2v(ji,jj) 536 ! NB: hard coded factor 5 (can be a namelist parameter...) 537 zti_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e1, ABS( zti_g_raw ) ), zti_g_raw ) 538 ztj_g_lim = SIGN( MIN( rn_slpmax, 5.0_wp * ze3_e2, ABS( ztj_g_raw ) ), ztj_g_raw ) 640 539 ! 641 540 ! Below ML use limited zti_g as is & mask … … 666 565 ! 667 566 IF( ln_triad_iso ) THEN 668 zti_raw = zti_lim* *2/ zti_raw669 ztj_raw = ztj_lim* *2/ ztj_raw567 zti_raw = zti_lim*zti_lim / zti_raw 568 ztj_raw = ztj_lim*ztj_lim / ztj_raw 670 569 zti_raw = SIGN( MIN( ABS(zti_lim), ABS( zti_raw ) ), zti_raw ) 671 570 ztj_raw = SIGN( MIN( ABS(ztj_lim), ABS( ztj_raw ) ), ztj_raw ) 672 zti_lim = zfacti * zti_lim & 673 & + ( 1._wp - zfacti ) * zti_raw 674 ztj_lim = zfactj * ztj_lim & 675 & + ( 1._wp - zfactj ) * ztj_raw 571 zti_lim = zfacti * zti_lim + ( 1._wp - zfacti ) * zti_raw 572 ztj_lim = zfactj * ztj_lim + ( 1._wp - zfactj ) * ztj_raw 676 573 ENDIF 677 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim 678 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim 679 ! 680 zbu = e1e2u(ji ,jj) * fse3u(ji ,jj,jk ) 681 zbv = e1e2v(ji ,jj) * fse3v(ji ,jj,jk ) 682 zbti = e1e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 683 zbtj = e1e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 684 ! 685 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked 686 wslp2 (ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim**2 ! masked 687 wslp2 (ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim**2 574 ! ! switching triad scheme 575 zisw = (rn_sw_triad - 1._wp ) + rn_sw_triad & 576 & * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - ip ) * SIGN( 1._wp , zdxrho(ji+ip,jj,jk,1-ip) ) ) 577 zjsw = (rn_sw_triad - 1._wp ) + rn_sw_triad & 578 & * 2._wp * ABS( 0.5_wp - kp - ( 0.5_wp - jp ) * SIGN( 1._wp , zdyrho(ji,jj+jp,jk,1-jp) ) ) 579 ! 580 triadi(ji+ip,jj ,jk,1-ip,kp) = zti_lim * zisw 581 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim * zjsw 582 ! 583 zbu = e1e2u(ji ,jj ) * fse3u(ji ,jj ,jk ) 584 zbv = e1e2v(ji ,jj ) * fse3v(ji ,jj ,jk ) 585 zbti = e1e2t(ji+ip,jj ) * fse3w(ji+ip,jj ,jk+kp) 586 zbtj = e1e2t(ji ,jj+jp) * fse3w(ji ,jj+jp,jk+kp) 587 ! 588 wslp2(ji+ip,jj,jk+kp) = wslp2(ji+ip,jj,jk+kp) + 0.25_wp * zbu / zbti * zti_g_lim*zti_g_lim ! masked 589 wslp2(ji,jj+jp,jk+kp) = wslp2(ji,jj+jp,jk+kp) + 0.25_wp * zbv / zbtj * ztj_g_lim*ztj_g_lim 688 590 END DO 689 591 END DO … … 697 599 ! 698 600 CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 601 CALL wrk_dealloc( jpi,jpj,jpk, zalbet ) 699 602 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 700 603 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) 701 604 ! 702 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp_ grif')703 ! 704 END SUBROUTINE ldf_slp_ grif605 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp_triad') 606 ! 607 END SUBROUTINE ldf_slp_triad 705 608 706 609 … … 728 631 INTEGER :: ji , jj , jk ! dummy loop indices 729 632 INTEGER :: iku, ikv, ik, ikm1 ! local integers 730 REAL(wp) :: zeps, zm1_g, zm1_2g 633 REAL(wp) :: zeps, zm1_g, zm1_2g, z1_slpmax ! local scalars 731 634 REAL(wp) :: zci, zfi, zau, zbu, zai, zbi ! - - 732 635 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - … … 739 642 zm1_g = -1.0_wp / grav 740 643 zm1_2g = -0.5_wp / grav 644 z1_slpmax = 1._wp / rn_slpmax 741 645 ! 742 646 uslpml (1,:) = 0._wp ; uslpml (jpi,:) = 0._wp … … 750 654 DO ji = 1, jpi 751 655 ik = nmln(ji,jj) - 1 752 IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN 753 omlmask(ji,jj,jk) = 1._wp 754 ELSE 755 omlmask(ji,jj,jk) = 0._wp 656 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp 657 ELSE ; omlmask(ji,jj,jk) = 0._wp 756 658 ENDIF 757 659 END DO … … 775 677 ! 776 678 ! !- vertical density gradient for u- and v-slopes (from dzr at T-point) 777 iku = MIN( MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1)778 ikv = MIN( MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) !679 iku = MIN( MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1) 680 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 779 681 zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj ,iku) ) 780 682 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) … … 784 686 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 785 687 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) 786 zbu = MIN( zbu , - 100._wp* ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau ) )787 zbv = MIN( zbv , - 100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav ) )688 zbu = MIN( zbu , - z1_slpmax * ABS( zau ) , -7.e+3_wp/fse3u(ji,jj,iku)* ABS( zau ) ) 689 zbv = MIN( zbv , - z1_slpmax * ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,ikv)* ABS( zav ) ) 788 690 ! !- Slope at u- & v-points (uslpml, vslpml) 789 691 uslpml(ji,jj) = zau / ( zbu - zeps ) * umask(ji,jj,iku) … … 810 712 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj ) ) 811 713 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 812 wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik)813 wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik)714 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik) 715 wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik) 814 716 END DO 815 717 END DO … … 829 731 !! ** Purpose : Initialization for the isopycnal slopes computation 830 732 !! 831 !! ** Method : read the nammbf namelist and check the parameter 832 !! values called by tra_dmp at the first timestep (nit000) 733 !! ** Method : 833 734 !!---------------------------------------------------------------------- 834 735 INTEGER :: ji, jj, jk ! dummy loop indices … … 843 744 WRITE(numout,*) '~~~~~~~~~~~~' 844 745 ENDIF 845 846 IF( ln_traldf_grif ) THEN ! Griffies operator : triad of slopes 847 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , wslp2(jpi,jpj,jpk) , STAT=ierr ) 848 ALLOCATE( triadi (jpi,jpj,jpk,0:1,0:1) , triadj (jpi,jpj,jpk,0:1,0:1) , STAT=ierr ) 849 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 850 ! 746 ! 747 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , akz(jpi,jpj,jpk) , STAT=ierr ) 748 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate ah_slp2 or akz' ) 749 ! 750 IF( ln_traldf_triad ) THEN ! Griffies operator : triad of slopes 751 IF(lwp) WRITE(numout,*) ' Griffies (triad) operator initialisation' 752 ALLOCATE( triadi_g(jpi,jpj,jpk,0:1,0:1) , triadj_g(jpi,jpj,jpk,0:1,0:1) , & 753 & triadi (jpi,jpj,jpk,0:1,0:1) , triadj (jpi,jpj,jpk,0:1,0:1) , & 754 & wslp2 (jpi,jpj,jpk) , STAT=ierr ) 755 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Griffies operator slope' ) 851 756 IF( ln_dynldf_iso ) CALL ctl_stop( 'ldf_slp_init: Griffies operator on momentum not supported' ) 852 757 ! 853 758 ELSE ! Madec operator : slopes at u-, v-, and w-points 854 ALLOCATE( uslp(jpi,jpj,jpk) , vslp(jpi,jpj,jpk) , wslpi(jpi,jpj,jpk) , wslpj(jpi,jpj,jpk) , & 855 & omlmask(jpi,jpj,jpk) , uslpml(jpi,jpj) , vslpml(jpi,jpj) , wslpiml(jpi,jpj) , wslpjml(jpi,jpj) , STAT=ierr ) 759 IF(lwp) WRITE(numout,*) ' Madec operator initialisation' 760 ALLOCATE( omlmask(jpi,jpj,jpk) , & 761 & uslp(jpi,jpj,jpk) , uslpml(jpi,jpj) , wslpi(jpi,jpj,jpk) , wslpiml(jpi,jpj) , & 762 & vslp(jpi,jpj,jpk) , vslpml(jpi,jpj) , wslpj(jpi,jpj,jpk) , wslpjml(jpi,jpj) , STAT=ierr ) 856 763 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'ldf_slp_init : unable to allocate Madec operator slope ' ) 857 764 … … 863 770 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 864 771 865 IF(ln_sco .AND. (ln_traldf_hor .OR. ln_dynldf_hor )) THEN 866 IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 867 868 ! geopotential diffusion in s-coordinates on tracers and/or momentum 869 ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 870 ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 871 872 ! set the slope of diffusion to the slope of s-surfaces 873 ! ( c a u t i o n : minus sign as fsdep has positive value ) 874 DO jk = 1, jpk 875 DO jj = 2, jpjm1 876 DO ji = fs_2, fs_jpim1 ! vector opt. 877 uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 878 vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 879 wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 880 wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 881 END DO 882 END DO 883 END DO 884 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) ! Lateral boundary conditions 885 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 886 ENDIF 772 !!gm I no longer understand this..... 773 !!gm IF( (ln_traldf_hor .OR. ln_dynldf_hor) .AND. .NOT. (lk_vvl .AND. ln_rstart) ) THEN 774 ! IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 775 ! 776 ! ! geopotential diffusion in s-coordinates on tracers and/or momentum 777 ! ! The slopes of s-surfaces are computed once (no call to ldfslp in step) 778 ! ! The slopes for momentum diffusion are i- or j- averaged of those on tracers 779 ! 780 ! ! set the slope of diffusion to the slope of s-surfaces 781 ! ! ( c a u t i o n : minus sign as fsdep has positive value ) 782 ! DO jk = 1, jpk 783 ! DO jj = 2, jpjm1 784 ! DO ji = fs_2, fs_jpim1 ! vector opt. 785 ! uslp (ji,jj,jk) = - ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 786 ! vslp (ji,jj,jk) = - ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 787 ! wslpi(ji,jj,jk) = - ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * r1_e1t(ji,jj) * wmask(ji,jj,jk) * 0.5 788 ! wslpj(ji,jj,jk) = - ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * r1_e2t(ji,jj) * wmask(ji,jj,jk) * 0.5 789 ! END DO 790 ! END DO 791 ! END DO 792 ! CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) ! Lateral boundary conditions 793 ! CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 794 !!gm ENDIF 887 795 ENDIF 888 796 ! … … 890 798 ! 891 799 END SUBROUTINE ldf_slp_init 892 893 #else894 !!------------------------------------------------------------------------895 !! Dummy module : NO Rotation of lateral mixing tensor896 !!------------------------------------------------------------------------897 LOGICAL, PUBLIC, PARAMETER :: lk_ldfslp = .FALSE. !: slopes flag898 CONTAINS899 SUBROUTINE ldf_slp( kt, prd, pn2 ) ! Dummy routine900 INTEGER, INTENT(in) :: kt901 REAL, DIMENSION(:,:,:), INTENT(in) :: prd, pn2902 WRITE(*,*) 'ldf_slp: You should not have seen this print! error?', kt, prd(1,1,1), pn2(1,1,1)903 END SUBROUTINE ldf_slp904 SUBROUTINE ldf_slp_grif( kt ) ! Dummy routine905 INTEGER, INTENT(in) :: kt906 WRITE(*,*) 'ldf_slp_grif: You should not have seen this print! error?', kt907 END SUBROUTINE ldf_slp_grif908 SUBROUTINE ldf_slp_init ! Dummy routine909 END SUBROUTINE ldf_slp_init910 #endif911 800 912 801 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra.F90
r4624 r5758 2 2 !!====================================================================== 3 3 !! *** MODULE ldftra *** 4 !! Ocean physics: lateral diffusivity coefficient 4 !! Ocean physics: lateral diffusivity coefficients 5 5 !!===================================================================== 6 !! History : ! 1997-07 (G. Madec) from inimix.F split in 2 routines 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2005-11 (G. Madec) 6 !! History : ! 1997-07 (G. Madec) from inimix.F split in 2 routines 7 !! NEMO 1.0 ! 2002-09 (G. Madec) F90: Free form and module 8 !! 2.0 ! 2005-11 (G. Madec) 9 !! 3.7 ! 2013-12 (F. Lemarie, G. Madec) restructuration/simplification of aht/aeiv specification, 10 !! ! add velocity dependent coefficient and optional read in file 9 11 !!---------------------------------------------------------------------- 10 12 11 13 !!---------------------------------------------------------------------- 12 14 !! ldf_tra_init : initialization, namelist read, and parameters control 13 !! ldf_tra_c3d : 3D eddy viscosity coefficient initialization 14 !! ldf_tra_c2d : 2D eddy viscosity coefficient initialization 15 !! ldf_tra_c1d : 1D eddy viscosity coefficient initialization 15 !! ldf_tra : update lateral eddy diffusivity coefficients at each time step 16 !! ldf_eiv_init : initialization of the eiv coeff. from namelist choices 17 !! ldf_eiv : time evolution of the eiv coefficients (function of the growth rate of baroclinic instability) 18 !! ldf_eiv_trp : add to the input ocean transport the contribution of the EIV parametrization 19 !! ldf_eiv_dia : diagnose the eddy induced velocity from the eiv streamfunction 16 20 !!---------------------------------------------------------------------- 17 21 USE oce ! ocean dynamics and tracers 18 22 USE dom_oce ! ocean space and time domain 19 23 USE phycst ! physical constants 20 USE ldftra_oce ! ocean tracer lateral physics 21 USE ldfslp ! ??? 24 USE ldfslp ! lateral diffusion: slope of iso-neutral surfaces 25 USE ldfc1d_c2d ! lateral diffusion: 1D & 2D cases 26 USE diaar5, ONLY: lk_diaar5 27 ! 22 28 USE in_out_manager ! I/O manager 23 USE io ipsl29 USE iom ! I/O module for ehanced bottom friction file 24 30 USE lib_mpp ! distribued memory computing library 25 31 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 32 USE wrk_nemo ! work arrays 33 USE timing ! timing 26 34 27 35 IMPLICIT NONE 28 36 PRIVATE 29 37 30 PUBLIC ldf_tra_init ! called by opa.F90 38 PUBLIC ldf_tra_init ! called by nemogcm.F90 39 PUBLIC ldf_tra ! called by step.F90 40 PUBLIC ldf_eiv_init ! called by nemogcm.F90 41 PUBLIC ldf_eiv ! called by step.F90 42 PUBLIC ldf_eiv_trp ! called by traadv.F90 43 PUBLIC ldf_eiv_dia ! called by traldf_iso and traldf_iso_triad.F90 44 45 ! !!* Namelist namtra_ldf : lateral mixing on tracers * 46 ! != Operator type =! 47 LOGICAL , PUBLIC :: ln_traldf_lap !: laplacian operator 48 LOGICAL , PUBLIC :: ln_traldf_blp !: bilaplacian operator 49 ! != Direction of action =! 50 LOGICAL , PUBLIC :: ln_traldf_lev !: iso-level direction 51 LOGICAL , PUBLIC :: ln_traldf_hor !: horizontal (geopotential) direction 52 ! LOGICAL , PUBLIC :: ln_traldf_iso !: iso-neutral direction (see ldfslp) 53 ! LOGICAL , PUBLIC :: ln_traldf_triad !: griffies triad scheme (see ldfslp) 54 LOGICAL , PUBLIC :: ln_traldf_msc !: Method of Stabilizing Correction 55 ! LOGICAL , PUBLIC :: ln_triad_iso !: pure horizontal mixing in ML (see ldfslp) 56 ! LOGICAL , PUBLIC :: ln_botmix_triad !: mixing on bottom (see ldfslp) 57 ! REAL(wp), PUBLIC :: rn_sw_triad !: =1/0 switching triad / all 4 triads used (see ldfslp) 58 ! REAL(wp), PUBLIC :: rn_slpmax !: slope limit (see ldfslp) 59 ! != Coefficients =! 60 INTEGER , PUBLIC :: nn_aht_ijk_t !: ?????? !!gm 61 REAL(wp), PUBLIC :: rn_aht_0 !: laplacian lateral eddy diffusivity [m2/s] 62 REAL(wp), PUBLIC :: rn_bht_0 !: bilaplacian lateral eddy diffusivity [m4/s] 63 64 ! !!* Namelist namtra_ldfeiv : eddy induced velocity param. * 65 ! != Use/diagnose eiv =! 66 LOGICAL , PUBLIC :: ln_ldfeiv !: eddy induced velocity flag 67 LOGICAL , PUBLIC :: ln_ldfeiv_dia !: diagnose & output eiv streamfunction and velocity (IOM) 68 ! != Coefficients =! 69 INTEGER , PUBLIC :: nn_aei_ijk_t !: choice of time/space variation of the eiv coeff. 70 REAL(wp), PUBLIC :: rn_aeiv_0 !: eddy induced velocity coefficient [m2/s] 71 72 LOGICAL , PUBLIC :: l_ldftra_time = .FALSE. !: flag for time variation of the lateral eddy diffusivity coef. 73 LOGICAL , PUBLIC :: l_ldfeiv_time = .FALSE. ! flag for time variation of the eiv coef. 74 75 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ahtu, ahtv !: eddy diffusivity coef. at U- and V-points [m2/s] 76 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aeiu, aeiv !: eddy induced velocity coeff. [m2/s] 77 78 REAL(wp) :: r1_4 = 0.25_wp ! =1/4 79 REAL(wp) :: r1_12 = 1._wp / 12._wp ! =1/12 31 80 32 81 !! * Substitutions … … 34 83 # include "vectopt_loop_substitute.h90" 35 84 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)85 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 37 86 !! $Id$ 38 87 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 46 95 !! ** Purpose : initializations of the tracer lateral mixing coeff. 47 96 !! 48 !! ** Method : the Eddy diffusivity and eddy induced velocity ceoff. 49 !! are defined as follows: 50 !! default option : constant coef. aht0, aeiv0 (namelist) 51 !! 'key_traldf_c1d': depth dependent coef. defined in 52 !! in ldf_tra_c1d routine 53 !! 'key_traldf_c2d': latitude and longitude dependent coef. 54 !! defined in ldf_tra_c2d routine 55 !! 'key_traldf_c3d': latitude, longitude, depth dependent coef. 56 !! defined in ldf_tra_c3d routine 57 !! 58 !! N.B. User defined include files. By default, 3d and 2d coef. 59 !! are set to a constant value given in the namelist and the 1d 60 !! coefficients are initialized to a hyperbolic tangent vertical 61 !! profile. 62 !!---------------------------------------------------------------------- 63 INTEGER :: ioptio ! temporary integer 64 INTEGER :: ios ! temporary integer 65 LOGICAL :: ll_print = .FALSE. ! =T print eddy coef. in numout 66 !! 67 NAMELIST/namtra_ldf/ ln_traldf_lap , ln_traldf_bilap, & 68 & ln_traldf_level, ln_traldf_hor , ln_traldf_iso, & 69 & ln_traldf_grif , ln_traldf_gdia , & 70 & ln_triad_iso , ln_botmix_grif , & 71 & rn_aht_0 , rn_ahtb_0 , rn_aeiv_0, & 72 & rn_slpmax , rn_chsmag , rn_smsh, & 73 & rn_aht_m 74 !!---------------------------------------------------------------------- 75 76 ! Define the lateral tracer physics parameters 77 ! ============================================= 78 79 97 !! ** Method : * the eddy diffusivity coef. specification depends on: 98 !! 99 !! ln_traldf_lap = T laplacian operator 100 !! ln_traldf_blp = T bilaplacian operator 101 !! 102 !! nn_aht_ijk_t = 0 => = constant 103 !! ! 104 !! = 10 => = F(z) : constant with a reduction of 1/4 with depth 105 !! ! 106 !! =-20 => = F(i,j) = shape read in 'eddy_diffusivity.nc' file 107 !! = 20 = F(i,j) = F(e1,e2) or F(e1^3,e2^3) (lap or bilap case) 108 !! = 21 = F(i,j,t) = F(growth rate of baroclinic instability) 109 !! ! 110 !! =-30 => = F(i,j,k) = shape read in 'eddy_diffusivity.nc' file 111 !! = 30 = F(i,j,k) = 2D (case 20) + decrease with depth (case 10) 112 !! = 31 = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 113 !! or |u|e^3/12 bilaplacian operator ) 114 !! * initialisation of the eddy induced velocity coefficient by a call to ldf_eiv_init 115 !! 116 !! ** action : ahtu, ahtv initialized once for all or l_ldftra_time set to true 117 !! aeiu, aeiv initialized once for all or l_ldfeiv_time set to true 118 !!---------------------------------------------------------------------- 119 INTEGER :: jk ! dummy loop indices 120 INTEGER :: ierr, inum, ios ! local integer 121 REAL(wp) :: zah0 ! local scalar 122 ! 123 NAMELIST/namtra_ldf/ ln_traldf_lap, ln_traldf_blp , & ! type of operator 124 & ln_traldf_lev, ln_traldf_hor , ln_traldf_triad, & ! acting direction of the operator 125 & ln_traldf_iso, ln_traldf_msc , rn_slpmax , & ! option for iso-neutral operator 126 & ln_triad_iso , ln_botmix_triad, rn_sw_triad , & ! option for triad operator 127 & rn_aht_0 , rn_bht_0 , nn_aht_ijk_t ! lateral eddy coefficient 128 !!---------------------------------------------------------------------- 129 ! 130 ! Choice of lateral tracer physics 131 ! ================================= 132 ! 80 133 REWIND( numnam_ref ) ! Namelist namtra_ldf in reference namelist : Lateral physics on tracers 81 134 READ ( numnam_ref, namtra_ldf, IOSTAT = ios, ERR = 901) 82 135 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in reference namelist', lwp ) 83 136 ! 84 137 REWIND( numnam_cfg ) ! Namelist namtra_ldf in configuration namelist : Lateral physics on tracers 85 138 READ ( numnam_cfg, namtra_ldf, IOSTAT = ios, ERR = 902 ) 86 139 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldf in configuration namelist', lwp ) 87 140 IF(lwm) WRITE ( numond, namtra_ldf ) 88 141 ! 89 142 IF(lwp) THEN ! control print 90 143 WRITE(numout,*) … … 92 145 WRITE(numout,*) '~~~~~~~~~~~~ ' 93 146 WRITE(numout,*) ' Namelist namtra_ldf : lateral mixing parameters (type, direction, coefficients)' 94 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 95 WRITE(numout,*) ' bilaplacian operator ln_traldf_bilap = ', ln_traldf_bilap 96 WRITE(numout,*) ' iso-level ln_traldf_level = ', ln_traldf_level 97 WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor 98 WRITE(numout,*) ' iso-neutral ln_traldf_iso = ', ln_traldf_iso 99 WRITE(numout,*) ' iso-neutral (Griffies) ln_traldf_grif = ', ln_traldf_grif 100 WRITE(numout,*) ' Griffies strmfn diagnostics ln_traldf_gdia = ', ln_traldf_gdia 101 WRITE(numout,*) ' lateral eddy diffusivity rn_aht_0 = ', rn_aht_0 102 WRITE(numout,*) ' background hor. diffusivity rn_ahtb_0 = ', rn_ahtb_0 103 WRITE(numout,*) ' eddy induced velocity coef. rn_aeiv_0 = ', rn_aeiv_0 104 WRITE(numout,*) ' maximum isoppycnal slope rn_slpmax = ', rn_slpmax 105 WRITE(numout,*) ' pure lateral mixing in ML ln_triad_iso = ', ln_triad_iso 106 WRITE(numout,*) ' lateral mixing on bottom ln_botmix_grif = ', ln_botmix_grif 147 ! 148 WRITE(numout,*) ' type :' 149 WRITE(numout,*) ' laplacian operator ln_traldf_lap = ', ln_traldf_lap 150 WRITE(numout,*) ' bilaplacian operator ln_traldf_blp = ', ln_traldf_blp 151 ! 152 WRITE(numout,*) ' direction of action :' 153 WRITE(numout,*) ' iso-level ln_traldf_lev = ', ln_traldf_lev 154 WRITE(numout,*) ' horizontal (geopotential) ln_traldf_hor = ', ln_traldf_hor 155 WRITE(numout,*) ' iso-neutral Madec operator ln_traldf_iso = ', ln_traldf_iso 156 WRITE(numout,*) ' iso-neutral triad operator ln_traldf_triad = ', ln_traldf_triad 157 WRITE(numout,*) ' iso-neutral (Method of Stab. Corr.) ln_traldf_msc = ', ln_traldf_msc 158 WRITE(numout,*) ' maximum isoppycnal slope rn_slpmax = ', rn_slpmax 159 WRITE(numout,*) ' pure lateral mixing in ML ln_triad_iso = ', ln_triad_iso 160 WRITE(numout,*) ' switching triad or not rn_sw_triad = ', rn_sw_triad 161 WRITE(numout,*) ' lateral mixing on bottom ln_botmix_triad = ', ln_botmix_triad 162 ! 163 WRITE(numout,*) ' coefficients :' 164 WRITE(numout,*) ' lateral eddy diffusivity (lap case) rn_aht_0 = ', rn_aht_0 165 WRITE(numout,*) ' lateral eddy diffusivity (bilap case) rn_bht_0 = ', rn_bht_0 166 WRITE(numout,*) ' type of time-space variation nn_aht_ijk_t = ', nn_aht_ijk_t 167 ENDIF 168 ! 169 ! ! Parameter control 170 ! 171 IF( ln_traldf_blp .AND. ( ln_traldf_iso .OR. ln_traldf_triad) ) THEN ! iso-neutral bilaplacian need MSC 172 IF( .NOT.ln_traldf_msc ) CALL ctl_stop( 'tra_ldf_init: iso-neutral bilaplacian requires ln_traldf_msc=.true.' ) 173 ENDIF 174 ! 175 ! 176 ! Space/time variation of eddy coefficients 177 ! =========================================== 178 ! ! allocate the aht arrays 179 ALLOCATE( ahtu(jpi,jpj,jpk) , ahtv(jpi,jpj,jpk) , STAT=ierr ) 180 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_tra_init: failed to allocate arrays') 181 ! 182 ahtu(:,:,jpk) = 0._wp ! last level always 0 183 ahtv(:,:,jpk) = 0._wp 184 ! 185 ! ! value of eddy mixing coef. 186 IF ( ln_traldf_lap ) THEN ; zah0 = rn_aht_0 ! laplacian operator 187 ELSEIF( ln_traldf_blp ) THEN ; zah0 = ABS( rn_bht_0 ) ! bilaplacian operator 188 ELSE ! NO diffusion/viscosity operator 189 CALL ctl_warn( 'ldf_tra_init: No lateral diffusive operator used ' ) 190 ENDIF 191 ! 192 l_ldftra_time = .FALSE. ! no time variation except in case defined below 193 ! 194 IF( ln_traldf_lap .OR. ln_traldf_blp ) THEN ! only if a lateral diffusion operator is used 195 ! 196 SELECT CASE( nn_aht_ijk_t ) ! Specification of space time variations of ehtu, ahtv 197 ! 198 CASE( 0 ) !== constant ==! 199 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant = ', rn_aht_0 200 ahtu(:,:,:) = zah0 * umask(:,:,:) 201 ahtv(:,:,:) = zah0 * vmask(:,:,:) 202 ! 203 CASE( 10 ) !== fixed profile ==! 204 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 205 ahtu(:,:,1) = zah0 * umask(:,:,1) ! constant surface value 206 ahtv(:,:,1) = zah0 * vmask(:,:,1) 207 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 208 ! 209 CASE ( -20 ) !== fixed horizontal shape read in file ==! 210 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j) read in eddy_diffusivity.nc file' 211 CALL iom_open( 'eddy_diffusivity.nc', inum ) 212 CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 213 CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 214 CALL iom_close( inum ) 215 DO jk = 2, jpkm1 216 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 217 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 218 END DO 219 ! 220 CASE( 20 ) !== fixed horizontal shape ==! 221 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or blp case)' 222 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 223 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 224 ! 225 CASE( 21 ) !== time varying 2D field ==! 226 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, time )' 227 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 228 IF(lwp) WRITE(numout,*) ' min value = 0.1 * rn_aht_0' 229 IF(lwp) WRITE(numout,*) ' max value = rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21)' 230 IF(lwp) WRITE(numout,*) ' increased to rn_aht_0 within 20N-20S' 231 ! 232 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 233 ! 234 IF( ln_traldf_blp ) THEN 235 CALL ctl_stop( 'ldf_tra_init: aht=F(growth rate of baroc. insta.) incompatible with bilaplacian operator' ) 236 ENDIF 237 ! 238 CASE( -30 ) !== fixed 3D shape read in file ==! 239 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j,k) read in eddy_diffusivity.nc file' 240 CALL iom_open( 'eddy_diffusivity.nc', inum ) 241 CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 242 CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 243 CALL iom_close( inum ) 244 DO jk = 1, jpkm1 245 ahtu(:,:,jk) = ahtu(:,:,jk) * umask(:,:,jk) 246 ahtv(:,:,jk) = ahtv(:,:,jk) * vmask(:,:,jk) 247 END DO 248 ! 249 CASE( 30 ) !== fixed 3D shape ==! 250 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth )' 251 IF( ln_traldf_lap ) CALL ldf_c2d( 'TRA', 'LAP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 252 IF( ln_traldf_blp ) CALL ldf_c2d( 'TRA', 'BLP', zah0, ahtu, ahtv ) ! surface value proportional to scale factor 253 ! ! reduction with depth 254 CALL ldf_c1d( 'TRA', r1_4, ahtu(:,:,1), ahtv(:,:,1), ahtu, ahtv ) 255 ! 256 CASE( 31 ) !== time varying 3D field ==! 257 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth , time )' 258 IF(lwp) WRITE(numout,*) ' proportional to the velocity : |u|e/12 or |u|e^3/12' 259 ! 260 l_ldftra_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 261 ! 262 CASE DEFAULT 263 CALL ctl_stop('ldf_tra_init: wrong choice for nn_aht_ijk_t, the type of space-time variation of aht') 264 END SELECT 265 ! 266 IF( ln_traldf_blp .AND. .NOT. l_ldftra_time ) THEN 267 ahtu(:,:,:) = SQRT( ahtu(:,:,:) ) 268 ahtv(:,:,:) = SQRT( ahtv(:,:,:) ) 269 ENDIF 270 ! 271 ENDIF 272 ! 273 END SUBROUTINE ldf_tra_init 274 275 276 SUBROUTINE ldf_tra( kt ) 277 !!---------------------------------------------------------------------- 278 !! *** ROUTINE ldf_tra *** 279 !! 280 !! ** Purpose : update at kt the tracer lateral mixing coeff. (aht and aeiv) 281 !! 282 !! ** Method : time varying eddy diffusivity coefficients: 283 !! 284 !! nn_aei_ijk_t = 21 aeiu, aeiv = F(i,j, t) = F(growth rate of baroclinic instability) 285 !! with a reduction to 0 in vicinity of the Equator 286 !! nn_aht_ijk_t = 21 ahtu, ahtv = F(i,j, t) = F(growth rate of baroclinic instability) 287 !! 288 !! = 31 ahtu, ahtv = F(i,j,k,t) = F(local velocity) ( |u|e /12 laplacian operator 289 !! or |u|e^3/12 bilaplacian operator ) 290 !! 291 !! ** action : ahtu, ahtv update at each time step 292 !! aeiu, aeiv - - - - (if ln_ldfeiv=T) 293 !!---------------------------------------------------------------------- 294 INTEGER, INTENT(in) :: kt ! time step 295 ! 296 INTEGER :: ji, jj, jk ! dummy loop indices 297 REAL(wp) :: zaht, zaht_min, z1_f20 ! local scalar 298 !!---------------------------------------------------------------------- 299 ! 300 IF( nn_aei_ijk_t == 21 ) THEN ! eddy induced velocity coefficients 301 ! ! =F(growth rate of baroclinic instability) 302 ! ! max value rn_aeiv_0 ; decreased to 0 within 20N-20S 303 CALL ldf_eiv( kt, rn_aeiv_0, aeiu, aeiv ) 304 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ldf_eiv appel', kt 305 ENDIF 306 ! 307 SELECT CASE( nn_aht_ijk_t ) ! Eddy diffusivity coefficients 308 ! 309 CASE( 21 ) !== time varying 2D field ==! = F( growth rate of baroclinic instability ) 310 ! ! min value rn_aht_0 / 10 311 ! ! max value rn_aht_0 (rn_aeiv_0 if nn_aei_ijk_t=21) 312 ! ! increase to rn_aht_0 within 20N-20S 313 314 315 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt ,nn_aei_ijk_t, aeiuv max', kt, & 316 & nn_aei_ijk_t, MAXVAL( aeiu(:,:,1) ), MAXVAL( aeiv(:,:,1) ) 317 318 319 IF( nn_aei_ijk_t /= 21 ) THEN 320 CALL ldf_eiv( kt, rn_aht_0, ahtu, ahtv ) 321 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ldf_eiv appel 2', kt 322 ELSE 323 ahtu(:,:,1) = aeiu(:,:,1) 324 ahtv(:,:,1) = aeiv(:,:,1) 325 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ahtu=aeiu', kt 326 ENDIF 327 328 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , ahtuv max ', kt, MAXVAL( ahtu(:,:,1) ), MAXVAL( ahtv(:,:,1) ) 329 330 ! 331 z1_f20 = 1._wp / ( 2._wp * omega * SIN( rad * 20._wp ) ) ! 1 / ff(20 degrees) 332 zaht_min = 0.2_wp * rn_aht_0 ! minimum value for aht 333 334 IF(lwp .AND. kt<=nit000+20 ) WRITE(numout,*) ' kt , aht0 et ahtmin', kt, rn_aht_0, zaht_min 335 336 DO jj = 1, jpj 337 DO ji = 1, jpi 338 zaht = ( 1._wp - MIN( 1._wp , ABS( ff(ji,jj) * z1_f20 ) ) ) * ( rn_aht_0 - zaht_min ) 339 ahtu(ji,jj,1) = ( MAX( zaht_min, ahtu(ji,jj,1) ) + zaht ) * umask(ji,jj,1) ! min value zaht_min 340 ahtv(ji,jj,1) = ( MAX( zaht_min, ahtv(ji,jj,1) ) + zaht ) * vmask(ji,jj,1) ! increase within 20S-20N 341 END DO 342 END DO 343 DO jk = 2, jpkm1 ! deeper value = surface value 344 ahtu(:,:,jk) = ahtu(:,:,1) * umask(:,:,jk) 345 ahtv(:,:,jk) = ahtv(:,:,1) * vmask(:,:,jk) 346 END DO 347 ! 348 CASE( 31 ) !== time varying 3D field ==! = F( local velocity ) 349 IF( ln_traldf_lap ) THEN ! laplacian operator |u| e /12 350 DO jk = 1, jpkm1 351 ahtu(:,:,jk) = ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 352 ahtv(:,:,jk) = ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 353 END DO 354 ELSEIF( ln_traldf_blp ) THEN ! bilaplacian operator sqrt( |u| e^3 /12 ) = sqrt( |u| e /12 ) * e 355 DO jk = 1, jpkm1 356 ahtu(:,:,jk) = SQRT( ABS( ub(:,:,jk) ) * e1u(:,:) * r1_12 ) * e1u(:,:) 357 ahtv(:,:,jk) = SQRT( ABS( vb(:,:,jk) ) * e2v(:,:) * r1_12 ) * e2v(:,:) 358 END DO 359 ENDIF 360 ! 361 END SELECT 362 ! 363 CALL iom_put( "ahtu_2d", ahtu(:,:,1) ) ! surface u-eddy diffusivity coeff. 364 CALL iom_put( "ahtv_2d", ahtv(:,:,1) ) ! surface v-eddy diffusivity coeff. 365 CALL iom_put( "ahtu_3d", ahtu(:,:,:) ) ! 3D u-eddy diffusivity coeff. 366 CALL iom_put( "ahtv_3d", ahtv(:,:,:) ) ! 3D v-eddy diffusivity coeff. 367 ! 368 !!gm : THE IF below is to be checked (comes from Seb) 369 IF( ln_ldfeiv ) THEN 370 CALL iom_put( "aeiu_2d", aeiu(:,:,1) ) ! surface u-EIV coeff. 371 CALL iom_put( "aeiv_2d", aeiv(:,:,1) ) ! surface v-EIV coeff. 372 CALL iom_put( "aeiu_3d", aeiu(:,:,:) ) ! 3D u-EIV coeff. 373 CALL iom_put( "aeiv_3d", aeiv(:,:,:) ) ! 3D v-EIV coeff. 374 ENDIF 375 ! 376 END SUBROUTINE ldf_tra 377 378 379 SUBROUTINE ldf_eiv_init 380 !!---------------------------------------------------------------------- 381 !! *** ROUTINE ldf_eiv_init *** 382 !! 383 !! ** Purpose : initialization of the eiv coeff. from namelist choices. 384 !! 385 !! ** Method : 386 !! 387 !! ** Action : aeiu , aeiv : EIV coeff. at u- & v-points 388 !! l_ldfeiv_time : =T if EIV coefficients vary with time 389 !!---------------------------------------------------------------------- 390 INTEGER :: jk ! dummy loop indices 391 INTEGER :: ierr, inum, ios ! local integer 392 ! 393 NAMELIST/namtra_ldfeiv/ ln_ldfeiv , ln_ldfeiv_dia, & ! eddy induced velocity (eiv) 394 & nn_aei_ijk_t, rn_aeiv_0 ! eiv coefficient 395 !!---------------------------------------------------------------------- 396 ! 397 REWIND( numnam_ref ) ! Namelist namtra_ldfeiv in reference namelist : eddy induced velocity param. 398 READ ( numnam_ref, namtra_ldfeiv, IOSTAT = ios, ERR = 901) 399 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in reference namelist', lwp ) 400 ! 401 REWIND( numnam_cfg ) ! Namelist namtra_ldfeiv in configuration namelist : eddy induced velocity param. 402 READ ( numnam_cfg, namtra_ldfeiv, IOSTAT = ios, ERR = 902 ) 403 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_ldfeiv in configuration namelist', lwp ) 404 WRITE ( numond, namtra_ldfeiv ) 405 406 IF(lwp) THEN ! control print 107 407 WRITE(numout,*) 108 ENDIF 109 110 ! ! convert DOCTOR namelist names into OLD names 111 aht0 = rn_aht_0 112 ahtb0 = rn_ahtb_0 113 aeiv0 = rn_aeiv_0 114 115 ! ! Parameter control 116 117 ! ... Check consistency for type and direction : 118 ! ==> will be done in traldf module 119 120 ! ... Space variation of eddy coefficients 121 ioptio = 0 122 #if defined key_traldf_c3d 123 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth)' 124 ioptio = ioptio + 1 125 #endif 126 #if defined key_traldf_c2d 127 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude)' 128 ioptio = ioptio + 1 129 #endif 130 #if defined key_traldf_c1d 131 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( depth )' 132 ioptio = ioptio + 1 133 IF( .NOT. ln_zco ) CALL ctl_stop( 'key_traldf_c1d can only be used in z-coordinate - full step' ) 134 #endif 135 IF( ioptio == 0 ) THEN 136 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = constant (default option)' 137 ELSEIF( ioptio > 1 ) THEN 138 CALL ctl_stop(' use only one of the following keys:', & 139 & ' key_traldf_c3d, key_traldf_c2d, key_traldf_c1d' ) 140 ENDIF 141 142 IF( ln_traldf_bilap ) THEN 143 IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion' 144 IF( aht0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. aht0 must be negative' ) 408 WRITE(numout,*) 'ldf_eiv_init : eddy induced velocity parametrization' 409 WRITE(numout,*) '~~~~~~~~~~~~ ' 410 WRITE(numout,*) ' Namelist namtra_ldfeiv : ' 411 WRITE(numout,*) ' Eddy Induced Velocity (eiv) param. ln_ldfeiv = ', ln_ldfeiv 412 WRITE(numout,*) ' eiv streamfunction & velocity diag. ln_ldfeiv_dia = ', ln_ldfeiv_dia 413 WRITE(numout,*) ' eddy induced velocity coef. rn_aeiv_0 = ', rn_aeiv_0 414 WRITE(numout,*) ' type of time-space variation nn_aei_ijk_t = ', nn_aei_ijk_t 415 WRITE(numout,*) 416 ENDIF 417 ! 418 IF( ln_ldfeiv .AND. ln_traldf_blp ) CALL ctl_stop( 'ldf_eiv_init: eddy induced velocity ONLY with laplacian diffusivity' ) 419 420 ! ! Parameter control 421 l_ldfeiv_time = .FALSE. 422 ! 423 IF( ln_ldfeiv ) THEN ! allocate the aei arrays 424 ALLOCATE( aeiu(jpi,jpj,jpk), aeiv(jpi,jpj,jpk), STAT=ierr ) 425 IF( ierr /= 0 ) CALL ctl_stop('STOP', 'ldf_eiv: failed to allocate arrays') 426 ! 427 SELECT CASE( nn_aei_ijk_t ) ! Specification of space time variations of eaiu, aeiv 428 ! 429 CASE( 0 ) !== constant ==! 430 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = constant = ', rn_aeiv_0 431 aeiu(:,:,:) = rn_aeiv_0 432 aeiv(:,:,:) = rn_aeiv_0 433 ! 434 CASE( 10 ) !== fixed profile ==! 435 IF(lwp) WRITE(numout,*) ' eddy induced velocity coef. = F( depth )' 436 aeiu(:,:,1) = rn_aeiv_0 ! constant surface value 437 aeiv(:,:,1) = rn_aeiv_0 438 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 439 ! 440 CASE ( -20 ) !== fixed horizontal shape read in file ==! 441 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 442 CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 443 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 444 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 445 CALL iom_close( inum ) 446 DO jk = 2, jpk 447 aeiu(:,:,jk) = aeiu(:,:,1) 448 aeiv(:,:,jk) = aeiv(:,:,1) 449 END DO 450 ! 451 CASE( 20 ) !== fixed horizontal shape ==! 452 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( e1, e2 ) or F( e1^3, e2^3 ) (lap or bilap case)' 453 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 454 ! 455 CASE( 21 ) !== time varying 2D field ==! 456 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, time )' 457 IF(lwp) WRITE(numout,*) ' = F( growth rate of baroclinic instability )' 458 ! 459 l_ldfeiv_time = .TRUE. ! will be calculated by call to ldf_tra routine in step.F90 460 ! 461 CASE( -30 ) !== fixed 3D shape read in file ==! 462 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 463 CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 464 CALL iom_get ( inum, jpdom_data, 'aeiu', aeiu ) 465 CALL iom_get ( inum, jpdom_data, 'aeiv', aeiv ) 466 CALL iom_close( inum ) 467 ! 468 CASE( 30 ) !== fixed 3D shape ==! 469 IF(lwp) WRITE(numout,*) ' tracer mixing coef. = F( latitude, longitude, depth )' 470 CALL ldf_c2d( 'TRA', 'LAP', rn_aeiv_0, aeiu, aeiv ) ! surface value proportional to scale factor 471 ! ! reduction with depth 472 CALL ldf_c1d( 'TRA', r1_4, aeiu(:,:,1), aeiv(:,:,1), aeiu, aeiv ) 473 ! 474 CASE DEFAULT 475 CALL ctl_stop('ldf_tra_init: wrong choice for nn_aei_ijk_t, the type of space-time variation of aei') 476 END SELECT 477 ! 145 478 ELSE 146 IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)' 147 IF( aht0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. aht0 must be positive' ) 148 ENDIF 149 150 151 ! Lateral eddy diffusivity and eddy induced velocity coefficients 152 ! ================================================================ 153 #if defined key_traldf_c3d 154 CALL ldf_tra_c3d( ll_print ) ! aht = 3D coef. = F( longitude, latitude, depth ) 155 #elif defined key_traldf_c2d 156 CALL ldf_tra_c2d( ll_print ) ! aht = 2D coef. = F( longitude, latitude ) 157 #elif defined key_traldf_c1d 158 CALL ldf_tra_c1d( ll_print ) ! aht = 1D coef. = F( depth ) 159 #else 160 ! Constant coefficients 161 IF(lwp)WRITE(numout,*) 162 IF(lwp)WRITE(numout,*) ' constant eddy diffusivity coef. ahtu = ahtv = ahtw = aht0 = ', aht0 163 IF( lk_traldf_eiv ) THEN 164 IF(lwp)WRITE(numout,*) ' constant eddy induced velocity coef. aeiu = aeiv = aeiw = aeiv0 = ', aeiv0 479 IF(lwp) WRITE(numout,*) ' eddy induced velocity param is NOT used neither diagnosed' 480 ln_ldfeiv_dia = .FALSE. 481 ENDIF 482 ! 483 END SUBROUTINE ldf_eiv_init 484 485 486 SUBROUTINE ldf_eiv( kt, paei0, paeiu, paeiv ) 487 !!---------------------------------------------------------------------- 488 !! *** ROUTINE ldf_eiv *** 489 !! 490 !! ** Purpose : Compute the eddy induced velocity coefficient from the 491 !! growth rate of baroclinic instability. 492 !! 493 !! ** Method : coefficient function of the growth rate of baroclinic instability 494 !! 495 !! Reference : Treguier et al. JPO 1997 ; Held and Larichev JAS 1996 496 !!---------------------------------------------------------------------- 497 INTEGER , INTENT(in ) :: kt ! ocean time-step index 498 REAL(wp) , INTENT(inout) :: paei0 ! max value [m2/s] 499 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: paeiu, paeiv ! eiv coefficient [m2/s] 500 ! 501 INTEGER :: ji, jj, jk ! dummy loop indices 502 REAL(wp) :: zfw, ze3w, zn2, z1_f20, zaht, zaht_min, zzaei ! local scalars 503 REAL(wp), DIMENSION(:,:), POINTER :: zn, zah, zhw, zross, zaeiw ! 2D workspace 504 !!---------------------------------------------------------------------- 505 ! 506 IF( nn_timing == 1 ) CALL timing_start('ldf_eiv') 507 ! 508 CALL wrk_alloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 509 ! 510 zn (:,:) = 0._wp ! Local initialization 511 zhw (:,:) = 5._wp 512 zah (:,:) = 0._wp 513 zross(:,:) = 0._wp 514 ! ! Compute lateral diffusive coefficient at T-point 515 IF( ln_traldf_triad ) THEN 516 DO jk = 1, jpk 517 DO jj = 2, jpjm1 518 DO ji = 2, jpim1 519 ! Take the max of N^2 and zero then take the vertical sum 520 ! of the square root of the resulting N^2 ( required to compute 521 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 522 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 523 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 524 ! Compute elements required for the inverse time scale of baroclinic 525 ! eddies using the isopycnal slopes calculated in ldfslp.F : 526 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 527 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 528 zah(ji,jj) = zah(ji,jj) + zn2 * wslp2(ji,jj,jk) * ze3w 529 zhw(ji,jj) = zhw(ji,jj) + ze3w 530 END DO 531 END DO 532 END DO 533 ELSE 534 DO jk = 1, jpk 535 DO jj = 2, jpjm1 536 DO ji = 2, jpim1 537 ! Take the max of N^2 and zero then take the vertical sum 538 ! of the square root of the resulting N^2 ( required to compute 539 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f 540 zn2 = MAX( rn2b(ji,jj,jk), 0._wp ) 541 zn(ji,jj) = zn(ji,jj) + SQRT( zn2 ) * fse3w(ji,jj,jk) 542 ! Compute elements required for the inverse time scale of baroclinic 543 ! eddies using the isopycnal slopes calculated in ldfslp.F : 544 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w)) 545 ze3w = fse3w(ji,jj,jk) * tmask(ji,jj,jk) 546 zah(ji,jj) = zah(ji,jj) + zn2 * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 547 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) * ze3w 548 zhw(ji,jj) = zhw(ji,jj) + ze3w 549 END DO 550 END DO 551 END DO 552 END IF 553 554 DO jj = 2, jpjm1 555 DO ji = fs_2, fs_jpim1 ! vector opt. 556 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) 557 ! Rossby radius at w-point taken < 40km and > 2km 558 zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 559 ! Compute aeiw by multiplying Ro^2 and T^-1 560 zaeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1) 561 END DO 562 END DO 563 564 !!gm IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 565 !!gm DO jj = 2, jpjm1 566 !!gm DO ji = fs_2, fs_jpim1 ! vector opt. 567 !!gm ! Take the minimum between aeiw and 1000 m2/s over shelves (depth shallower than 650 m) 568 !!gm IF( mbkt(ji,jj) <= 20 ) zaeiw(ji,jj) = MIN( zaeiw(ji,jj), 1000. ) 569 !!gm END DO 570 !!gm END DO 571 !!gm ENDIF 572 573 ! !== Bound on eiv coeff. ==! 574 z1_f20 = 1._wp / ( 2._wp * omega * sin( rad * 20._wp ) ) 575 DO jj = 2, jpjm1 576 DO ji = fs_2, fs_jpim1 ! vector opt. 577 zzaei = MIN( 1._wp, ABS( ff(ji,jj) * z1_f20 ) ) * zaeiw(ji,jj) ! tropical decrease 578 zaeiw(ji,jj) = MIN( zzaei , paei0 ) ! Max value = paei0 579 END DO 580 END DO 581 CALL lbc_lnk( zaeiw(:,:), 'W', 1. ) ! lateral boundary condition 582 ! 583 DO jj = 2, jpjm1 !== aei at u- and v-points ==! 584 DO ji = fs_2, fs_jpim1 ! vector opt. 585 paeiu(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji+1,jj ) ) * umask(ji,jj,1) 586 paeiv(ji,jj,1) = 0.5_wp * ( zaeiw(ji,jj) + zaeiw(ji ,jj+1) ) * vmask(ji,jj,1) 587 END DO 588 END DO 589 CALL lbc_lnk( paeiu(:,:,1), 'U', 1. ) ; CALL lbc_lnk( paeiv(:,:,1), 'V', 1. ) ! lateral boundary condition 590 591 DO jk = 2, jpkm1 !== deeper values equal the surface one ==! 592 paeiu(:,:,jk) = paeiu(:,:,1) * umask(:,:,jk) 593 paeiv(:,:,jk) = paeiv(:,:,1) * vmask(:,:,jk) 594 END DO 595 ! 596 CALL wrk_dealloc( jpi,jpj, zn, zah, zhw, zross, zaeiw ) 597 ! 598 IF( nn_timing == 1 ) CALL timing_stop('ldf_eiv') 599 ! 600 END SUBROUTINE ldf_eiv 601 602 603 SUBROUTINE ldf_eiv_trp( kt, kit000, pun, pvn, pwn, cdtype ) 604 !!---------------------------------------------------------------------- 605 !! *** ROUTINE ldf_eiv_trp *** 606 !! 607 !! ** Purpose : add to the input ocean transport the contribution of 608 !! the eddy induced velocity parametrization. 609 !! 610 !! ** Method : The eddy induced transport is computed from a flux stream- 611 !! function which depends on the slope of iso-neutral surfaces 612 !! (see ldf_slp). For example, in the i-k plan : 613 !! psi_uw = mk(aeiu) e2u mi(wslpi) [in m3/s] 614 !! Utr_eiv = - dk[psi_uw] 615 !! Vtr_eiv = + di[psi_uw] 616 !! ln_ldfeiv_dia = T : output the associated streamfunction, 617 !! velocity and heat transport (call ldf_eiv_dia) 618 !! 619 !! ** Action : pun, pvn increased by the eiv transport 620 !!---------------------------------------------------------------------- 621 INTEGER , INTENT(in ) :: kt ! ocean time-step index 622 INTEGER , INTENT(in ) :: kit000 ! first time step index 623 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 624 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pun ! in : 3 ocean transport components [m3/s] 625 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvn ! out: 3 ocean transport components [m3/s] 626 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pwn ! increased by the eiv [m3/s] 627 !! 628 INTEGER :: ji, jj, jk ! dummy loop indices 629 REAL(wp) :: zuwk, zuwk1, zuwi, zuwi1 ! local scalars 630 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! - - 631 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpsi_uw, zpsi_vw 632 !!---------------------------------------------------------------------- 633 ! 634 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_trp') 635 ! 636 CALL wrk_alloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw ) 637 638 IF( kt == kit000 ) THEN 639 IF(lwp) WRITE(numout,*) 640 IF(lwp) WRITE(numout,*) 'ldf_eiv_trp : eddy induced advection on ', cdtype,' :' 641 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 642 ENDIF 643 165 644 166 ENDIF 167 #endif 168 169 #if defined key_traldf_smag && ! defined key_traldf_c3d 170 CALL ctl_stop( 'key_traldf_smag can only be used with key_traldf_c3d' ) 171 #endif 172 #if defined key_traldf_smag 173 IF(lwp) WRITE(numout,*)' SMAGORINSKY DIFFUSION' 174 IF(lwp .AND. rn_smsh < 1) WRITE(numout,*)' only shear is used ' 175 IF(lwp.and.ln_traldf_bilap) CALL ctl_stop(' SMAGORINSKY + BILAPLACIAN - UNSTABLE OR NON_CONSERVATIVE' ) 176 #endif 177 178 ! 179 END SUBROUTINE ldf_tra_init 180 181 #if defined key_traldf_c3d 182 # include "ldftra_c3d.h90" 183 #elif defined key_traldf_c2d 184 # include "ldftra_c2d.h90" 185 #elif defined key_traldf_c1d 186 # include "ldftra_c1d.h90" 187 #endif 645 zpsi_uw(:,:, 1 ) = 0._wp ; zpsi_vw(:,:, 1 ) = 0._wp 646 zpsi_uw(:,:,jpk) = 0._wp ; zpsi_vw(:,:,jpk) = 0._wp 647 ! 648 DO jk = 2, jpkm1 649 DO jj = 1, jpjm1 650 DO ji = 1, fs_jpim1 ! vector opt. 651 zpsi_uw(ji,jj,jk) = - 0.25_wp * e2u(ji,jj) * ( wslpi(ji,jj,jk ) + wslpi(ji+1,jj,jk) ) & 652 & * ( aeiu (ji,jj,jk-1) + aeiu (ji ,jj,jk) ) * umask(ji,jj,jk) 653 zpsi_vw(ji,jj,jk) = - 0.25_wp * e1v(ji,jj) * ( wslpj(ji,jj,jk ) + wslpj(ji,jj+1,jk) ) & 654 & * ( aeiv (ji,jj,jk-1) + aeiv (ji,jj ,jk) ) * vmask(ji,jj,jk) 655 END DO 656 END DO 657 END DO 658 ! 659 DO jk = 1, jpkm1 660 DO jj = 1, jpjm1 661 DO ji = 1, fs_jpim1 ! vector opt. 662 pun(ji,jj,jk) = pun(ji,jj,jk) - ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji,jj,jk+1) ) 663 pvn(ji,jj,jk) = pvn(ji,jj,jk) - ( zpsi_vw(ji,jj,jk) - zpsi_vw(ji,jj,jk+1) ) 664 END DO 665 END DO 666 END DO 667 DO jk = 1, jpkm1 668 DO jj = 2, jpjm1 669 DO ji = fs_2, fs_jpim1 ! vector opt. 670 pwn(ji,jj,jk) = pwn(ji,jj,jk) + ( zpsi_uw(ji,jj,jk) - zpsi_uw(ji-1,jj ,jk) & 671 & + zpsi_vw(ji,jj,jk) - zpsi_vw(ji ,jj-1,jk) ) 672 END DO 673 END DO 674 END DO 675 ! 676 ! ! diagnose the eddy induced velocity and associated heat transport 677 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 678 ! 679 CALL wrk_alloc( jpi,jpj,jpk, zpsi_uw, zpsi_vw ) 680 ! 681 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_trp') 682 ! 683 END SUBROUTINE ldf_eiv_trp 684 685 686 SUBROUTINE ldf_eiv_dia( psi_uw, psi_vw ) 687 !!---------------------------------------------------------------------- 688 !! *** ROUTINE ldf_eiv_dia *** 689 !! 690 !! ** Purpose : diagnose the eddy induced velocity and its associated 691 !! vertically integrated heat transport. 692 !! 693 !! ** Method : 694 !! 695 !!---------------------------------------------------------------------- 696 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: psi_uw, psi_vw ! streamfunction [m3/s] 697 ! 698 INTEGER :: ji, jj, jk ! dummy loop indices 699 REAL(wp) :: zztmp ! local scalar 700 REAL(wp), DIMENSION(:,:) , POINTER :: zw2d ! 2D workspace 701 REAL(wp), DIMENSION(:,:,:), POINTER :: zw3d ! 3D workspace 702 !!---------------------------------------------------------------------- 703 ! 704 IF( nn_timing == 1 ) CALL timing_start( 'ldf_eiv_dia') 705 ! 706 ! !== eiv stream function: output ==! 707 CALL lbc_lnk( psi_uw, 'U', -1. ) ! lateral boundary condition 708 CALL lbc_lnk( psi_vw, 'V', -1. ) 709 ! 710 !!gm CALL iom_put( "psi_eiv_uw", psi_uw ) ! output 711 !!gm CALL iom_put( "psi_eiv_vw", psi_vw ) 712 ! 713 ! !== eiv velocities: calculate and output ==! 714 CALL wrk_alloc( jpi,jpj,jpk, zw3d ) 715 ! 716 zw3d(:,:,jpk) = 0._wp ! bottom value always 0 717 ! 718 DO jk = 1, jpkm1 ! e2u e3u u_eiv = -dk[psi_uw] 719 zw3d(:,:,jk) = ( psi_uw(:,:,jk+1) - psi_uw(:,:,jk) ) / ( e2u(:,:) * fse3u(:,:,jk) ) 720 END DO 721 CALL iom_put( "uoce_eiv", zw3d ) 722 ! 723 DO jk = 1, jpkm1 ! e1v e3v v_eiv = -dk[psi_vw] 724 zw3d(:,:,jk) = ( psi_vw(:,:,jk+1) - psi_vw(:,:,jk) ) / ( e1v(:,:) * fse3v(:,:,jk) ) 725 END DO 726 CALL iom_put( "voce_eiv", zw3d ) 727 ! 728 DO jk = 1, jpkm1 ! e1 e2 w_eiv = dk[psix] + dk[psix] 729 DO jj = 2, jpjm1 730 DO ji = fs_2, fs_jpim1 ! vector opt. 731 zw3d(ji,jj,jk) = ( psi_vw(ji,jj,jk) - psi_vw(ji ,jj-1,jk) & 732 & + psi_uw(ji,jj,jk) - psi_uw(ji-1,jj ,jk) ) / e1e2t(ji,jj) 733 END DO 734 END DO 735 END DO 736 CALL lbc_lnk( zw3d, 'T', 1. ) ! lateral boundary condition 737 CALL iom_put( "woce_eiv", zw3d ) 738 ! 739 CALL wrk_dealloc( jpi,jpj,jpk, zw3d ) 740 ! 741 ! 742 IF( lk_diaar5 ) THEN !== eiv heat transport: calculate and output ==! 743 CALL wrk_alloc( jpi,jpj, zw2d ) 744 ! 745 zztmp = 0.5_wp * rau0 * rcp 746 zw2d(:,:) = 0._wp 747 DO jk = 1, jpkm1 748 DO jj = 2, jpjm1 749 DO ji = fs_2, fs_jpim1 ! vector opt. 750 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_uw(ji,jj,jk+1) - psi_uw(ji,jj,jk) ) & 751 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji+1,jj,jk,jp_tem) ) 752 END DO 753 END DO 754 END DO 755 CALL lbc_lnk( zw2d, 'U', -1. ) 756 CALL iom_put( "ueiv_heattr", zw2d ) ! heat transport in i-direction 757 zw2d(:,:) = 0._wp 758 DO jk = 1, jpkm1 759 DO jj = 2, jpjm1 760 DO ji = fs_2, fs_jpim1 ! vector opt. 761 zw2d(ji,jj) = zw2d(ji,jj) + zztmp * ( psi_vw(ji,jj,jk+1) - psi_vw(ji,jj,jk) ) & 762 & * ( tsn (ji,jj,jk,jp_tem) + tsn (ji,jj+1,jk,jp_tem) ) 763 END DO 764 END DO 765 END DO 766 CALL lbc_lnk( zw2d, 'V', -1. ) 767 CALL iom_put( "veiv_heattr", zw2d ) ! heat transport in i-direction 768 ! 769 CALL wrk_dealloc( jpi,jpj, zw2d ) 770 ENDIF 771 ! 772 IF( nn_timing == 1 ) CALL timing_stop( 'ldf_eiv_dia') 773 ! 774 END SUBROUTINE ldf_eiv_dia 188 775 189 776 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r5643 r5758 28 28 USE sbcdcy ! surface boundary condition: diurnal cycle 29 29 USE sbcssm ! surface boundary condition: sea-surface mean variables 30 USE sbcapr ! surface boundary condition: atmospheric pressure31 30 USE sbcana ! surface boundary condition: analytical formulation 32 31 USE sbcflx ! surface boundary condition: flux formulation … … 344 343 ! ! forcing field computation ! 345 344 ! ! ---------------------------------------- ! 346 !347 IF ( .NOT. lk_bdy ) then348 IF( ln_apr_dyn ) CALL sbc_apr( kt ) ! atmospheric pressure provided at kt+0.5*nn_fsbc349 ENDIF350 ! (caution called before sbc_ssm)351 345 ! 352 346 IF( nn_components /= jp_iam_sas ) CALL sbc_ssm( kt ) ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r5147 r5758 6 6 !! History : 2.0 ! 2005-11 (G. Madec) Original code 7 7 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 8 !! 4.0 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation 8 !! 3.6 ! 2011-06 (G. Madec) Addition of Mixed Layer Eddy parameterisation 9 !! 4.0 ! 2014-05 (G. Madec) Add 2nd/4th order cases for CEN and FCT schemes 10 !! - ! 2014-12 (G. Madec) suppression of cross land advection option 9 11 !!---------------------------------------------------------------------- 10 12 … … 22 24 USE traadv_ubs ! UBS scheme (tra_adv_ubs routine) 23 25 USE traadv_qck ! QUICKEST scheme (tra_adv_qck routine) 24 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine)25 26 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 26 27 USE cla ! cross land advection (cla_traadv routine) 27 USE ldftra_oce ! lateral diffusion coefficient on tracers 28 USE ldftra ! lateral diffusion coefficient on tracers 29 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 28 30 ! 29 31 USE in_out_manager ! I/O manager … … 74 76 !! ** Method : - Update (ua,va) with the advection term following nadv 75 77 !!---------------------------------------------------------------------- 76 !77 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index 78 79 ! … … 84 85 ! 85 86 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 87 ! 86 88 ! ! set time step 87 89 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 95 97 ! !== effective transport ==! 96 98 DO jk = 1, jpkm1 97 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only98 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk)99 zwn(:,:,jk) = e1 t(:,:) * e2t(:,:)* wn(:,:,jk)99 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only 100 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 101 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 100 102 END DO 101 103 ! … … 109 111 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 110 112 ! 111 IF( l k_traldf_eiv .AND. .NOT. ln_traldf_grif) &112 & CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)113 ! 114 IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) 115 ! 116 CALL iom_put( "uocetr_eff", zun ) 113 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 114 & CALL ldf_eiv_trp( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 115 ! 116 IF( ln_mle ) CALL tra_adv_mle( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the mle transport (if necessary) 117 ! 118 CALL iom_put( "uocetr_eff", zun ) ! output effective transport 117 119 CALL iom_put( "vocetr_eff", zvn ) 118 120 CALL iom_put( "wocetr_eff", zwn ) 119 121 ! 120 IF( ln_diaptr ) CALL dia_ptr( zvn ) 122 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 121 123 ! 122 124 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r5120 r5758 4 4 !! Ocean Active tracers : lateral diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 3.7 ! 2013-12 (G. Madec) remove the optional computation from T & S anomaly profiles and traldf_bilapg 9 !! - ! 2013-12 (F. Lemarie, G. Madec) triad operator (Griffies) + Method of Stabilizing Correction 10 !! - ! 2014-01 (G. Madec, S. Masson) restructuration/simplification of lateral diffusive operators 8 11 !!---------------------------------------------------------------------- 9 12 … … 11 14 !! tra_ldf : update the tracer trend with the lateral diffusion 12 15 !! tra_ldf_init : initialization, namelist read, and parameters control 13 !! ldf_ano : compute lateral diffusion for constant T-S profiles 14 !!---------------------------------------------------------------------- 15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE ldftra_oce ! ocean tracer lateral physics 19 USE ldfslp ! ??? 20 USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) 21 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 22 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 23 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 24 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 25 USE trd_oce ! trends: ocean variables 26 USE trdtra ! trends manager: tracers 16 !!---------------------------------------------------------------------- 17 USE oce ! ocean dynamics and tracers 18 USE dom_oce ! ocean space and time domain 19 USE phycst ! physical constants 20 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 21 USE ldfslp ! lateral diffusion: iso-neutral slope 22 USE traldf_lap ! lateral diffusion: laplacian iso-level operator (tra_ldf_lap routine) 23 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) 24 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_triad routine) 25 USE traldf_blp ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap routine) 26 USE trd_oce ! trends: ocean variables 27 USE trdtra ! ocean active tracers trends 27 28 ! 28 USE prtctl 29 USE in_out_manager 30 USE lib_mpp 31 USE lbclnk 32 USE wrk_nemo 33 USE timing 29 USE prtctl ! Print control 30 USE in_out_manager ! I/O manager 31 USE lib_mpp ! distribued memory computing library 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 33 USE wrk_nemo ! Memory allocation 34 USE timing ! Timing 34 35 35 36 IMPLICIT NONE … … 37 38 38 39 PUBLIC tra_ldf ! called by step.F90 39 PUBLIC tra_ldf_init ! called by opa.F9040 PUBLIC tra_ldf_init ! called by nemogcm.F90 40 41 ! 41 42 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_traldf_... namlist logicals) 42 43 REAL, SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: t0_ldf, s0_ldf !: lateral diffusion trends of T & S for a cst profile 44 ! ! (key_traldf_ano only) 45 43 46 44 !! * Substitutions 47 45 # include "domzgr_substitute.h90" 48 46 # include "vectopt_loop_substitute.h90" 49 47 !!---------------------------------------------------------------------- 50 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)48 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 51 49 !! $Id$ 52 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 65 63 !!---------------------------------------------------------------------- 66 64 ! 67 IF( nn_timing == 1 ) CALL timing_start('tra_ldf') 68 ! 69 rldf = 1 ! For active tracers the 70 65 IF( nn_timing == 1 ) CALL timing_start('tra_ldf') 66 ! 71 67 IF( l_trdtra ) THEN !* Save ta and sa trends 72 CALL wrk_alloc( jpi, jpj, jpk,ztrdt, ztrds )68 CALL wrk_alloc( jpi,jpj,jpk, ztrdt, ztrds ) 73 69 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 74 70 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 75 71 ENDIF 76 77 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 78 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 79 & tsb, tsa, jpts ) ! iso-level laplacian 80 CASE ( 1 ) ! rotated laplacian 81 IF( ln_traldf_grif ) THEN 82 CALL tra_ldf_iso_grif( kt, nit000,'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! Griffies operator 83 ELSE 84 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 85 & tsb, tsa, jpts, ahtb0 ) ! Madec operator 86 ENDIF 87 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 88 & tsb, tsa, jpts ) ! iso-level bilaplacian 89 CASE ( 3 ) ; CALL tra_ldf_bilapg ( kt, nit000, 'TRA', tsb, tsa, jpts ) ! s-coord. geopot. bilap. 72 ! 73 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend 74 ! 75 CASE ( n_lap ) ! laplacian: iso-level operator 76 CALL tra_ldf_lap ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsa, jpts, 1 ) 90 77 ! 91 CASE ( -1 ) ! esopa: test all possibility with control print 92 CALL tra_ldf_lap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 93 & tsb, tsa, jpts ) 94 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 95 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 96 IF( ln_traldf_grif ) THEN 97 CALL tra_ldf_iso_grif( kt, nit000, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 98 ELSE 99 CALL tra_ldf_iso ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 100 & tsb, tsa, jpts, ahtb0 ) 101 ENDIF 102 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 103 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 104 CALL tra_ldf_bilap ( kt, nit000, 'TRA', gtsu, gtsv, gtui, gtvi, & 105 & tsb, tsa, jpts ) 106 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 107 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 108 CALL tra_ldf_bilapg( kt, nit000, 'TRA', tsb, tsa, jpts ) 109 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 110 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 78 CASE ( n_lap_i ) ! laplacian: standard iso-neutral operator (Madec) 79 CALL tra_ldf_iso ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts, 1 ) 80 ! 81 CASE ( n_lap_it ) ! laplacian: triad iso-neutral operator (griffies) 82 CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts, 1 ) 83 ! 84 CASE ( n_blp , n_blp_i , n_blp_it ) ! bilaplacian: iso-level & iso-neutral operators 85 CALL tra_ldf_blp ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb , tsa, jpts, nldf ) 111 86 END SELECT 112 87 113 #if defined key_traldf_ano 114 tsa(:,:,:,jp_tem) = tsa(:,:,:,jp_tem) - t0_ldf(:,:,:) ! anomaly: substract the reference diffusivity 115 tsa(:,:,:,jp_sal) = tsa(:,:,:,jp_sal) - s0_ldf(:,:,:) 116 #endif 117 118 IF( l_trdtra ) THEN ! save the horizontal diffusive trends for further diagnostics 88 IF( l_trdtra ) THEN !* save the horizontal diffusive trends for further diagnostics 119 89 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 120 90 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 121 91 CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 122 92 CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 123 CALL wrk_dealloc( jpi, jpj, jpk,ztrdt, ztrds )124 ENDIF 125 ! !print mean trends (used for debugging)93 CALL wrk_dealloc( jpi,jpj,jpk, ztrdt, ztrds ) 94 ENDIF 95 ! !* print mean trends (used for debugging) 126 96 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf - Ta: ', mask1=tmask, & 127 97 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 128 98 ! 129 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf')99 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf') 130 100 ! 131 101 END SUBROUTINE tra_ldf … … 139 109 !! 140 110 !! ** Method : set nldf from the namtra_ldf logicals 141 !! nldf == -1 ESOPA test: ALL operators are used 142 !! nldf == 0 laplacian operator 143 !! nldf == 1 Rotated laplacian operator 144 !! nldf == 2 bilaplacian operator 145 !! nldf == 3 Rotated bilaplacian 146 !!---------------------------------------------------------------------- 147 INTEGER :: ioptio, ierr ! temporary integers 148 !!---------------------------------------------------------------------- 149 150 ! Define the lateral mixing oparator for tracers 151 ! =============================================== 152 153 IF(lwp) THEN ! Namelist print 111 !!---------------------------------------------------------------------- 112 INTEGER :: ioptio, ierr ! temporary integers 113 !!---------------------------------------------------------------------- 114 ! 115 IF(lwp) THEN ! Namelist print 154 116 WRITE(numout,*) 155 117 WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' … … 159 121 WRITE(numout,*) 160 122 ENDIF 161 162 ! ! control the input 123 ! ! control the input 163 124 ioptio = 0 164 IF( ln_traldf_lap 165 IF( ln_traldf_b ilap ) ioptio = ioptio + 1166 IF( ioptio > 1 ) CALL ctl_stop( 'use ONE or NONE of the 2 lap/bilap operator type on tracer' )167 IF( ioptio == 0 ) nldf = -2! No lateral diffusion125 IF( ln_traldf_lap ) ioptio = ioptio + 1 126 IF( ln_traldf_blp ) ioptio = ioptio + 1 127 IF( ioptio > 1 ) CALL ctl_stop( 'tra_ldf_init: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 128 IF( ioptio == 0 ) nldf = n_no_ldf ! No lateral diffusion 168 129 ioptio = 0 169 IF( ln_traldf_level ) ioptio = ioptio + 1 170 IF( ln_traldf_hor ) ioptio = ioptio + 1 171 IF( ln_traldf_iso ) ioptio = ioptio + 1 172 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 173 174 ! defined the type of lateral diffusion from ln_traldf_... logicals 175 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 130 IF( ln_traldf_lev ) ioptio = ioptio + 1 131 IF( ln_traldf_hor ) ioptio = ioptio + 1 132 IF( ln_traldf_iso ) ioptio = ioptio + 1 133 IF( ioptio > 1 ) CALL ctl_stop( 'tra_ldf_init: use only ONE direction (level/hor/iso)' ) 134 ! 135 ! ! defined the type of lateral diffusion from ln_traldf_... logicals 176 136 ierr = 0 177 IF( ln_traldf_lap ) THEN ! laplacian operator 178 IF ( ln_zco ) THEN ! z-coordinate 179 IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) 180 IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) 181 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 182 ENDIF 183 IF ( ln_zps ) THEN ! zps-coordinate 184 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 185 IF ( ln_traldf_hor ) nldf = 0 ! horizontal (no rotation) 186 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 187 ENDIF 188 IF ( ln_sco ) THEN ! s-coordinate 189 IF ( ln_traldf_level ) nldf = 0 ! iso-level (no rotation) 190 IF ( ln_traldf_hor ) nldf = 1 ! horizontal ( rotation) 191 IF ( ln_traldf_iso ) nldf = 1 ! isoneutral ( rotation) 192 ENDIF 193 ENDIF 194 195 IF( ln_traldf_bilap ) THEN ! bilaplacian operator 196 IF ( ln_zco ) THEN ! z-coordinate 197 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 198 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 199 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 200 ENDIF 201 IF ( ln_zps ) THEN ! zps-coordinate 202 IF ( ln_traldf_level ) ierr = 1 ! iso-level not allowed 203 IF ( ln_traldf_hor ) nldf = 2 ! horizontal (no rotation) 204 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 205 ENDIF 206 IF ( ln_sco ) THEN ! s-coordinate 207 IF ( ln_traldf_level ) nldf = 2 ! iso-level (no rotation) 208 IF ( ln_traldf_hor ) nldf = 3 ! horizontal ( rotation) 209 IF ( ln_traldf_iso ) ierr = 2 ! isoneutral ( rotation) 210 ENDIF 211 ENDIF 212 213 IF( nldf == 3 ) CALL ctl_warn( 'geopotential bilaplacian tracer diffusion in s-coords not thoroughly tested' ) 137 IF( ln_traldf_lap ) THEN ! laplacian operator 138 IF ( ln_zco ) THEN ! z-coordinate 139 IF ( ln_traldf_lev ) nldf = n_lap ! iso-level = horizontal (no rotation) 140 IF ( ln_traldf_hor ) nldf = n_lap ! iso-level = horizontal (no rotation) 141 IF ( ln_traldf_iso ) nldf = n_lap_i ! iso-neutral: standard ( rotation) 142 IF ( ln_traldf_triad ) nldf = n_lap_it ! iso-neutral: triad ( rotation) 143 ENDIF 144 IF ( ln_zps ) THEN ! z-coordinate with partial step 145 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 146 IF ( ln_traldf_hor ) nldf = n_lap ! horizontal (no rotation) 147 IF ( ln_traldf_iso ) nldf = n_lap_i ! iso-neutral: standard (rotation) 148 IF ( ln_traldf_triad ) nldf = n_lap_it ! iso-neutral: triad (rotation) 149 ENDIF 150 IF ( ln_sco ) THEN ! s-coordinate 151 IF ( ln_traldf_lev ) nldf = n_lap ! iso-level (no rotation) 152 IF ( ln_traldf_hor ) nldf = n_lap_it ! horizontal ( rotation) !!gm a checker.... 153 IF ( ln_traldf_iso ) nldf = n_lap_i ! iso-neutral: standard (rotation) 154 IF ( ln_traldf_triad ) nldf = n_lap_it ! iso-neutral: triad (rotation) 155 ENDIF 156 ENDIF 157 ! 158 IF( ln_traldf_blp ) THEN ! bilaplacian operator 159 IF ( ln_zco ) THEN ! z-coordinate 160 IF ( ln_traldf_lev ) nldf = n_blp ! iso-level = horizontal (no rotation) 161 IF ( ln_traldf_hor ) nldf = n_blp ! iso-level = horizontal (no rotation) 162 IF ( ln_traldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 163 IF ( ln_traldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 164 ENDIF 165 IF ( ln_zps ) THEN ! z-coordinate with partial step 166 IF ( ln_traldf_lev ) ierr = 1 ! iso-level not allowed 167 IF ( ln_traldf_hor ) nldf = n_blp ! horizontal (no rotation) 168 IF ( ln_traldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 169 IF ( ln_traldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 170 ENDIF 171 IF ( ln_sco ) THEN ! s-coordinate 172 IF ( ln_traldf_lev ) nldf = n_blp ! iso-level (no rotation) 173 IF ( ln_traldf_hor ) nldf = n_blp_it ! horizontal ( rotation) !!gm a checker.... 174 IF ( ln_traldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 175 IF ( ln_traldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 176 ENDIF 177 ENDIF 178 ! 214 179 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 215 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 216 IF( lk_traldf_eiv .AND. .NOT.ln_traldf_iso ) & 217 CALL ctl_stop( ' eddy induced velocity on tracers', & 218 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 219 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 220 IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) 221 l_traldf_rot = .TRUE. ! needed for trazdf_imp 222 ENDIF 223 224 IF( lk_esopa ) THEN 225 IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' 226 nldf = -1 227 ENDIF 228 180 IF( ln_ldfeiv .AND. .NOT.( ln_traldf_iso .OR. ln_traldf_triad ) ) & 181 & CALL ctl_stop( ' eddy induced velocity on tracers requires isopycnal', & 182 & ' laplacian diffusion' ) 183 IF( nldf == n_lap_i .OR. nldf == n_lap_it .OR. & 184 & nldf == n_blp_i .OR. nldf == n_blp_it ) l_ldfslp = .TRUE. ! slope of neutral surfaces required 185 ! 229 186 IF(lwp) THEN 230 187 WRITE(numout,*) 231 IF( nldf == -2 ) WRITE(numout,*) ' NO lateral diffusion' 232 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 233 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 234 IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator' 235 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 236 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 237 ENDIF 238 239 ! Reference T & S diffusivity (if necessary) 240 ! =========================== 241 CALL ldf_ano 188 IF( nldf == n_no_ldf ) WRITE(numout,*) ' NO lateral diffusion' 189 IF( nldf == n_lap ) WRITE(numout,*) ' laplacian iso-level operator' 190 IF( nldf == n_lap_i ) WRITE(numout,*) ' Rotated laplacian operator (standard)' 191 IF( nldf == n_lap_it ) WRITE(numout,*) ' Rotated laplacian operator (triad)' 192 IF( nldf == n_blp ) WRITE(numout,*) ' bilaplacian iso-level operator' 193 IF( nldf == n_blp_i ) WRITE(numout,*) ' Rotated bilaplacian operator (standard)' 194 IF( nldf == n_blp_it ) WRITE(numout,*) ' Rotated bilaplacian operator (triad)' 195 ENDIF 242 196 ! 243 197 END SUBROUTINE tra_ldf_init 244 245 #if defined key_traldf_ano246 !!----------------------------------------------------------------------247 !! 'key_traldf_ano' T & S lateral diffusion on anomalies248 !!----------------------------------------------------------------------249 250 SUBROUTINE ldf_ano251 !!----------------------------------------------------------------------252 !! *** ROUTINE ldf_ano ***253 !!254 !! ** Purpose : initializations of255 !!----------------------------------------------------------------------256 !257 USE zdf_oce ! vertical mixing258 USE trazdf ! vertical mixing: double diffusion259 USE zdfddm ! vertical mixing: double diffusion260 !261 INTEGER :: jk ! Dummy loop indice262 INTEGER :: ierr ! local integer263 LOGICAL :: llsave ! local logical264 REAL(wp) :: zt0, zs0, z12 ! local scalar265 REAL(wp), POINTER, DIMENSION(:,:,:) :: zt_ref, zs_ref, ztb, zsb, zavt266 !!----------------------------------------------------------------------267 !268 IF( nn_timing == 1 ) CALL timing_start('ldf_ano')269 !270 CALL wrk_alloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )271 !272 273 IF(lwp) THEN274 WRITE(numout,*)275 WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on anomalies'276 WRITE(numout,*) '~~~~~~~~~~~'277 ENDIF278 279 ! ! allocate trabbl arrays280 ALLOCATE( t0_ldf(jpi,jpj,jpk) , s0_ldf(jpi,jpj,jpk) , STAT=ierr )281 IF( lk_mpp ) CALL mpp_sum( ierr )282 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'ldf_ano: unable to allocate arrays' )283 284 ! defined the T & S reference profiles285 ! ------------------------------------286 zt0 =10.e0 ! homogeneous ocean287 zs0 =35.e0288 zt_ref(:,:,:) = 10.0 * tmask(:,:,:)289 zs_ref(:,:,:) = 35.0 * tmask(:,:,:)290 IF(lwp) WRITE(numout,*) ' homogeneous ocean T = ', zt0, ' S = ',zs0291 292 ! Initialisation of gtui/gtvi in case of no cavity293 IF ( .NOT. ln_isfcav ) THEN294 gtui(:,:,:) = 0.0_wp295 gtvi(:,:,:) = 0.0_wp296 END IF297 ! ! T & S profile (to be coded +namelist parameter298 299 ! prepare the ldf computation300 ! ---------------------------301 llsave = l_trdtra302 l_trdtra = .false. ! desactivate trend computation303 t0_ldf(:,:,:) = 0.e0304 s0_ldf(:,:,:) = 0.e0305 ztb (:,:,:) = tsb (:,:,:,jp_tem)306 zsb (:,:,:) = tsb (:,:,:,jp_sal)307 ua (:,:,:) = tsa (:,:,:,jp_tem)308 va (:,:,:) = tsa (:,:,:,jp_sal)309 zavt (:,:,:) = avt(:,:,:)310 IF( lk_zdfddm ) THEN CALL ctl_stop( ' key_traldf_ano with key_zdfddm not implemented' )311 ! set tb, sb to reference values and avr to zero312 tsb (:,:,:,jp_tem) = zt_ref(:,:,:)313 tsb (:,:,:,jp_sal) = zs_ref(:,:,:)314 tsa (:,:,:,jp_tem) = 0.e0315 tsa (:,:,:,jp_sal) = 0.e0316 avt(:,:,:) = 0.e0317 318 ! Compute the ldf trends319 ! ----------------------320 CALL tra_ldf( nit000 + 1 ) ! horizontal components (+1: no more init)321 CALL tra_zdf( nit000 ) ! vertical component (if necessary nit000 to performed the init)322 323 ! finalise the computation and recover all arrays324 ! -----------------------------------------------325 l_trdtra = llsave326 z12 = 2.e0327 IF( neuler == 1) z12 = 1.e0328 IF( ln_zdfexp ) THEN ! ta,sa are the trends329 t0_ldf(:,:,:) = tsa(:,:,:,jp_tem)330 s0_ldf(:,:,:) = tsa(:,:,:,jp_sal)331 ELSE332 DO jk = 1, jpkm1333 t0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / ( z12 *rdttra(jk) )334 s0_ldf(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / ( z12 *rdttra(jk) )335 END DO336 ENDIF337 tsb(:,:,:,jp_tem) = ztb (:,:,:)338 tsb(:,:,:,jp_sal) = zsb (:,:,:)339 tsa(:,:,:,jp_tem) = ua (:,:,:)340 tsa(:,:,:,jp_sal) = va (:,:,:)341 avt(:,:,:) = zavt(:,:,:)342 !343 CALL wrk_dealloc( jpi, jpj, jpk, zt_ref, zs_ref, ztb, zsb, zavt )344 !345 IF( nn_timing == 1 ) CALL timing_stop('ldf_ano')346 !347 END SUBROUTINE ldf_ano348 349 #else350 !!----------------------------------------------------------------------351 !! default option : Dummy code NO T & S background profiles352 !!----------------------------------------------------------------------353 SUBROUTINE ldf_ano354 IF(lwp) THEN355 WRITE(numout,*)356 WRITE(numout,*) 'tra:ldf_ano : lateral diffusion acting on the full fields'357 WRITE(numout,*) '~~~~~~~~~~~'358 ENDIF359 END SUBROUTINE ldf_ano360 #endif361 198 362 199 !!====================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5737 r5758 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!====================================================================== 6 !! History : OPA ! 1994-08 (G. Madec, M. Imbard) 7 !! 8.0 ! 1997-05 (G. Madec) split into traldf and trazdf 8 !! NEMO ! 2002-08 (G. Madec) Free form, F90 9 !! 1.0 ! 2005-11 (G. Madec) merge traldf and trazdf :-) 10 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 6 !! History : OPA ! 1994-08 (G. Madec, M. Imbard) 7 !! 8.0 ! 1997-05 (G. Madec) split into traldf and trazdf 8 !! NEMO ! 2002-08 (G. Madec) Free form, F90 9 !! 1.0 ! 2005-11 (G. Madec) merge traldf and trazdf :-) 10 !! 3.3 ! 2010-09 (C. Ethe, G. Madec) Merge TRA-TRC 11 !! 3.7 ! 2014-01 (G. Madec, S. Masson) restructuration/simplification of aht/aeiv specification 12 !! - ! 2014-02 (F. Lemarie, G. Madec) triad operator (Griffies) + Method of Stabilizing Correction 11 13 !!---------------------------------------------------------------------- 12 #if defined key_ldfslp || defined key_esopa 14 13 15 !!---------------------------------------------------------------------- 14 !! 'key_ldfslp' slope of the lateral diffusive direction 15 !!---------------------------------------------------------------------- 16 !! tra_ldf_iso : update the tracer trend with the horizontal 17 !! component of a iso-neutral laplacian operator 18 !! and with the vertical part of 19 !! the isopycnal or geopotential s-coord. operator 16 !! tra_ldf_iso : update the tracer trend with the horizontal component of a iso-neutral laplacian operator 17 !! and with the vertical part of the isopycnal or geopotential s-coord. operator 20 18 !!---------------------------------------------------------------------- 21 19 USE oce ! ocean dynamics and active tracers … … 23 21 USE trc_oce ! share passive tracers/Ocean variables 24 22 USE zdf_oce ! ocean vertical physics 25 USE ldftra _oce ! ocean active tracers: lateral physics23 USE ldftra ! lateral diffusion: tracer eddy coefficients 26 24 USE ldfslp ! iso-neutral slopes 27 25 USE diaptr ! poleward transport diagnostics 26 ! 28 27 USE in_out_manager ! I/O manager 29 28 USE iom ! I/O library … … 40 39 !! * Substitutions 41 40 # include "domzgr_substitute.h90" 42 # include "ldftra_substitute.h90"43 41 # include "vectopt_loop_substitute.h90" 44 42 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)43 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 46 44 !! $Id$ 47 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 49 47 CONTAINS 50 48 51 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pgu, pgv,&52 & pgui, pgvi,&53 & ptb, pta, kjpt, pahtb0)49 SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 50 & pgui, pgvi, & 51 & ptb , ptbb, pta , kjpt, kpass ) 54 52 !!---------------------------------------------------------------------- 55 53 !! *** ROUTINE tra_ldf_iso *** … … 66 64 !! 67 65 !! 1st part : masked horizontal derivative of T ( di[ t ] ) 68 !! ======== with partial cell update if ln_zps=T. 66 !! ======== with partial cell update if ln_zps=T 67 !! with top cell update if ln_isfcav 69 68 !! 70 69 !! 2nd part : horizontal fluxes of the lateral mixing operator 71 70 !! ======== 72 !! zftu = (aht+ahtb0)e2u*e3u/e1u di[ tb ]73 !! - ahte2u*uslp dk[ mi(mk(tb)) ]74 !! zftv = (aht+ahtb0)e1v*e3v/e2v dj[ tb ]75 !! - ahte2u*vslp dk[ mj(mk(tb)) ]71 !! zftu = pahu e2u*e3u/e1u di[ tb ] 72 !! - pahu e2u*uslp dk[ mi(mk(tb)) ] 73 !! zftv = pahv e1v*e3v/e2v dj[ tb ] 74 !! - pahv e2u*vslp dk[ mj(mk(tb)) ] 76 75 !! take the horizontal divergence of the fluxes: 77 !! difft = 1/(e1 t*e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] }76 !! difft = 1/(e1e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] } 78 77 !! Add this trend to the general trend (ta,sa): 79 78 !! ta = ta + difft … … 82 81 !! ======== (excluding the vertical flux proportional to dk[t] ) 83 82 !! vertical fluxes associated with the rotated lateral mixing: 84 !! zftw = -aht {e2t*wslpi di[ mi(mk(tb)) ]85 !! +e1t*wslpj dj[ mj(mk(tb)) ] }83 !! zftw = - { mi(mk(pahu)) * e2t*wslpi di[ mi(mk(tb)) ] 84 !! + mj(mk(pahv)) * e1t*wslpj dj[ mj(mk(tb)) ] } 86 85 !! take the horizontal divergence of the fluxes: 87 !! difft = 1/(e1 t*e2t*e3t) dk[ zftw ]86 !! difft = 1/(e1e2t*e3t) dk[ zftw ] 88 87 !! Add this trend to the general trend (ta,sa): 89 88 !! pta = pta + difft … … 91 90 !! ** Action : Update pta arrays with the before rotated diffusion 92 91 !!---------------------------------------------------------------------- 93 USE oce , ONLY: zftu => ua , zftv => va ! (ua,va) used as workspace94 !95 92 INTEGER , INTENT(in ) :: kt ! ocean time-step index 96 INTEGER , INTENT(in ) :: kit000 93 INTEGER , INTENT(in ) :: kit000 ! first time step index 97 94 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 98 95 INTEGER , INTENT(in ) :: kjpt ! number of tracers 99 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu , pgv ! tracer gradient at pstep levels 100 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at pstep levels 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 102 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 103 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 96 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 97 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 98 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 99 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 100 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptbb ! tracer (only used in kpass=2) 102 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 104 103 ! 105 104 INTEGER :: ji, jj, jk, jn ! dummy loop indices 106 INTEGER :: ikt 107 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 108 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 109 REAL(wp) :: zcoef0, zbtr, ztra ! - - 110 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdkt, zdk1t, zdit, zdjt, ztfw 105 INTEGER :: ierr ! local integer 106 REAL(wp) :: zmsku, zahu_w, zabe1, zcof1, zcoef3 ! local scalars 107 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 108 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 109 #if defined key_diaar5 110 REAL(wp) :: zztmp ! local scalar 111 #endif 112 REAL(wp), POINTER, DIMENSION(:,:) :: zdkt, zdk1t, z2d 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw 112 114 !!---------------------------------------------------------------------- 113 115 ! 114 116 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso') 115 117 ! 116 CALL wrk_alloc( jpi, jpj, z2d ) 117 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 118 ! 119 118 CALL wrk_alloc( jpi,jpj, zdkt, zdk1t, z2d ) 119 CALL wrk_alloc( jpi,jpj,jpk, zdit, zdjt , zftu, zftv, ztfw ) 120 ! 120 121 IF( kt == kit000 ) THEN 121 122 IF(lwp) WRITE(numout,*) 122 123 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 123 124 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 125 ! 126 akz (:,:,:) = 0._wp 127 ah_wslp2(:,:,:) = 0._wp 128 ENDIF 129 ! 130 ! ! set time step size (Euler/Leapfrog) 131 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdttra(1) ! at nit000 (Euler) 132 ELSE ; z2dt = 2.* rdttra(1) ! (Leapfrog) 133 ENDIF 134 z1_2dt = 1._wp / z2dt 135 ! 136 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 137 ELSE ; zsign = -1._wp 138 ENDIF 139 140 141 !!---------------------------------------------------------------------- 142 !! 0 - calculate ah_wslp2 and akz 143 !!---------------------------------------------------------------------- 144 ! 145 IF( kpass == 1 ) THEN !== first pass only ==! 146 ! 147 DO jk = 2, jpkm1 148 DO jj = 2, jpjm1 149 DO ji = fs_2, fs_jpim1 ! vector opt. 150 ! 151 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 152 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk) , 1._wp ) 153 zmskv = tmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 154 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 155 ! 156 zahu_w = ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 157 & + pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) ) * zmsku 158 zahv_w = ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 159 & + pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) ) * zmskv 160 ! 161 ah_wslp2(ji,jj,jk) = zahu_w * wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 162 & + zahv_w * wslpj(ji,jj,jk) * wslpj(ji,jj,jk) 163 END DO 164 END DO 165 END DO 166 ! 167 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 168 DO jk = 2, jpkm1 169 DO jj = 2, jpjm1 170 DO ji = fs_2, fs_jpim1 171 akz(ji,jj,jk) = 0.25_wp * ( & 172 & ( pahu(ji ,jj,jk) + pahu(ji ,jj,jk-1) ) / ( e1u(ji ,jj) * e1u(ji ,jj) ) & 173 & + ( pahu(ji-1,jj,jk) + pahu(ji-1,jj,jk-1) ) / ( e1u(ji-1,jj) * e1u(ji-1,jj) ) & 174 & + ( pahv(ji,jj ,jk) + pahv(ji,jj ,jk-1) ) / ( e2v(ji,jj ) * e2v(ji,jj ) ) & 175 & + ( pahv(ji,jj-1,jk) + pahv(ji,jj-1,jk-1) ) / ( e2v(ji,jj-1) * e2v(ji,jj-1) ) ) 176 END DO 177 END DO 178 END DO 179 ! 180 IF( ln_traldf_blp ) THEN ! bilaplacian operator 181 DO jk = 2, jpkm1 182 DO jj = 1, jpjm1 183 DO ji = 1, fs_jpim1 184 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 185 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) ) 186 END DO 187 END DO 188 END DO 189 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 190 DO jk = 2, jpkm1 191 DO jj = 1, jpjm1 192 DO ji = 1, fs_jpim1 193 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 194 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 195 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 196 END DO 197 END DO 198 END DO 199 ENDIF 200 ! 201 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 202 akz(:,:,:) = ah_wslp2(:,:,:) 203 ENDIF 124 204 ENDIF 125 205 ! … … 131 211 !! I - masked horizontal derivative 132 212 !!---------------------------------------------------------------------- 133 !!bug ajout.... why? (1,jpj,:) and (jpi,1,:) should be sufficient....134 zdit (1,:,:) = 0. e0 ; zdit (jpi,:,:) = 0.e0135 zdjt (1,:,:) = 0. e0 ; zdjt (jpi,:,:) = 0.e0213 !!gm : bug.... why (x,:,:)? (1,jpj,:) and (jpi,1,:) should be sufficient.... 214 zdit (1,:,:) = 0._wp ; zdit (jpi,:,:) = 0._wp 215 zdjt (1,:,:) = 0._wp ; zdjt (jpi,:,:) = 0._wp 136 216 !!end 137 217 … … 145 225 END DO 146 226 END DO 147 148 ! partial cell correction 149 IF( ln_zps ) THEN ! partial steps correction at the last ocean level 150 DO jj = 1, jpjm1 227 IF( ln_zps ) THEN ! botton and surface ocean correction of the horizontal gradient 228 DO jj = 1, jpjm1 ! bottom correction (partial bottom cell) 151 229 DO ji = 1, fs_jpim1 ! vector opt. 152 ! IF useless if zpshde defines pgu everywhere230 !!gm the following anonymous remark is to considered: ! IF useless if zpshde defines pgu everywhere 153 231 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 154 232 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 155 233 END DO 156 234 END DO 235 IF( ln_isfcav ) THEN ! first wet level beneath a cavity 236 DO jj = 1, jpjm1 237 DO ji = 1, fs_jpim1 ! vector opt. 238 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 239 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 240 END DO 241 END DO 242 ENDIF 157 243 ENDIF 158 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the first wet level beneath a cavity 159 DO jj = 1, jpjm1 244 245 !!---------------------------------------------------------------------- 246 !! II - horizontal trend (full) 247 !!---------------------------------------------------------------------- 248 ! 249 DO jk = 1, jpkm1 ! Horizontal slab 250 ! 251 ! !== Vertical tracer gradient 252 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1) ! level jk+1 253 ! 254 IF( jk == 1 ) THEN ; zdkt(:,:) = zdk1t(:,:) ! surface: zdkt(jk=1)=zdkt(jk=2) 255 ELSE ; zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 256 ENDIF 257 !!gm I don't understand why we should need this.... since wmask is used instead of tmask 258 ! IF ( ln_isfcav ) THEN 259 ! DO jj = 1, jpj 260 ! DO ji = 1, jpi ! vector opt. 261 ! ikt = mikt(ji,jj) ! surface level 262 ! zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 263 ! zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 264 ! END DO 265 ! END DO 266 ! END IF 267 !!gm 268 269 DO jj = 1 , jpjm1 !== Horizontal fluxes 160 270 DO ji = 1, fs_jpim1 ! vector opt. 161 IF (miku(ji,jj) > 1) zdit(ji,jj,miku(ji,jj)) = pgui(ji,jj,jn) 162 IF (mikv(ji,jj) > 1) zdjt(ji,jj,mikv(ji,jj)) = pgvi(ji,jj,jn) 163 END DO 164 END DO 165 END IF 166 167 !!---------------------------------------------------------------------- 168 !! II - horizontal trend (full) 169 !!---------------------------------------------------------------------- 170 !!!!!!!!!!CDIR PARALLEL DO PRIVATE( zdk1t ) 171 ! 1. Vertical tracer gradient at level jk and jk+1 172 ! ------------------------------------------------ 173 ! 174 ! interior value 175 DO jk = 2, jpkm1 176 DO jj = 1, jpj 177 DO ji = 1, jpi ! vector opt. 178 zdk1t(ji,jj,jk) = ( ptb(ji,jj,jk,jn ) - ptb(ji,jj,jk+1,jn) ) * wmask(ji,jj,jk+1) 179 ! 180 zdkt(ji,jj,jk) = ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn ) ) * wmask(ji,jj,jk) 181 END DO 182 END DO 183 END DO 184 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 185 zdk1t(:,:,1) = ( ptb(:,:,1,jn ) - ptb(:,:,2,jn) ) * wmask(:,:,2) 186 zdkt (:,:,1) = zdk1t(:,:,1) 187 IF ( ln_isfcav ) THEN 188 DO jj = 1, jpj 189 DO ji = 1, jpi ! vector opt. 190 ikt = mikt(ji,jj) ! surface level 191 zdk1t(ji,jj,ikt) = ( ptb(ji,jj,ikt,jn ) - ptb(ji,jj,ikt+1,jn) ) * wmask(ji,jj,ikt+1) 192 zdkt (ji,jj,ikt) = zdk1t(ji,jj,ikt) 193 END DO 194 END DO 195 END IF 196 197 ! 2. Horizontal fluxes 198 ! -------------------- 199 DO jk = 1, jpkm1 200 DO jj = 1 , jpjm1 201 DO ji = 1, fs_jpim1 ! vector opt. 202 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 203 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 271 zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 272 zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 204 273 ! 205 274 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & … … 209 278 & + tmask(ji,jj+1,jk+1) + tmask(ji,jj,jk ), 1. ) 210 279 ! 211 zcof1 = - fsahtu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku212 zcof2 = - fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv280 zcof1 = - pahu(ji,jj,jk) * e2u(ji,jj) * uslp(ji,jj,jk) * zmsku 281 zcof2 = - pahv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 213 282 ! 214 283 zftu(ji,jj,jk ) = ( zabe1 * zdit(ji,jj,jk) & 215 & + zcof1 * ( zdkt (ji+1,jj,jk) + zdk1t(ji,jj,jk) &216 & + zdk1t(ji+1,jj,jk) + zdkt (ji,jj,jk) ) ) * umask(ji,jj,jk)284 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 285 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk) 217 286 zftv(ji,jj,jk) = ( zabe2 * zdjt(ji,jj,jk) & 218 & + zcof2 * ( zdkt (ji,jj+1,jk) + zdk1t(ji,jj,jk) & 219 & + zdk1t(ji,jj+1,jk) + zdkt (ji,jj,jk) ) ) * vmask(ji,jj,jk) 220 END DO 221 END DO 222 223 ! II.4 Second derivative (divergence) and add to the general trend 224 ! ---------------------------------------------------------------- 225 DO jj = 2 , jpjm1 287 & + zcof2 * ( zdkt (ji,jj+1) + zdk1t(ji,jj) & 288 & + zdk1t(ji,jj+1) + zdkt (ji,jj) ) ) * vmask(ji,jj,jk) 289 END DO 290 END DO 291 ! 292 DO jj = 2 , jpjm1 !== horizontal divergence and add to pta 226 293 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 228 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 230 END DO 231 END DO 232 ! ! =============== 294 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) & 295 & + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) & 296 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 297 END DO 298 END DO 233 299 END DO ! End of slab 234 ! ! =============== 235 ! 236 ! "Poleward" diffusive heat or salt transports (T-S case only) 237 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 238 ! note sign is reversed to give down-gradient diffusive transports (#1043) 239 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 240 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 241 ENDIF 242 243 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 244 ! 245 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 246 z2d(:,:) = 0._wp 247 DO jk = 1, jpkm1 248 DO jj = 2, jpjm1 249 DO ji = fs_2, fs_jpim1 ! vector opt. 250 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 251 END DO 252 END DO 253 END DO 254 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 255 CALL lbc_lnk( z2d, 'U', -1. ) 256 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 257 ! 258 z2d(:,:) = 0._wp 259 DO jk = 1, jpkm1 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 263 END DO 264 END DO 265 END DO 266 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 267 CALL lbc_lnk( z2d, 'V', -1. ) 268 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 269 END IF 270 ! 271 ENDIF 272 273 !!---------------------------------------------------------------------- 274 !! III - vertical trend of T & S (extra diagonal terms only) 275 !!---------------------------------------------------------------------- 276 277 ! Local constant initialization 278 ! ----------------------------- 279 ztfw(1,:,:) = 0.e0 ; ztfw(jpi,:,:) = 0.e0 300 301 302 !!---------------------------------------------------------------------- 303 !! III - vertical trend (full) 304 !!---------------------------------------------------------------------- 305 306 ztfw(1,:,:) = 0._wp ; ztfw(jpi,:,:) = 0._wp 280 307 281 308 ! Vertical fluxes … … 283 310 284 311 ! Surface and bottom vertical fluxes set to zero 285 ztfw(:,:, 1 ) = 0. e0 ; ztfw(:,:,jpk) = 0.e0312 ztfw(:,:, 1 ) = 0._wp ; ztfw(:,:,jpk) = 0._wp 286 313 287 314 ! interior (2=<jk=<jpk-1) … … 289 316 DO jj = 2, jpjm1 290 317 DO ji = fs_2, fs_jpim1 ! vector opt. 291 zcoef0 = - fsahtw(ji,jj,jk) * wmask(ji,jj,jk) 292 ! 293 zmsku = 1./MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 294 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk), 1. ) 295 zmskv = 1./MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 296 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk), 1. ) 297 ! 298 zcoef3 = zcoef0 * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) 299 zcoef4 = zcoef0 * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 318 ! 319 zmsku = tmask(ji,jj,jk) / MAX( umask(ji ,jj,jk-1) + umask(ji-1,jj,jk) & 320 & + umask(ji-1,jj,jk-1) + umask(ji ,jj,jk) , 1._wp ) 321 zmskv = tmask(ji,jj,jk) / MAX( vmask(ji,jj ,jk-1) + vmask(ji,jj-1,jk) & 322 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj ,jk) , 1._wp ) 323 ! 324 zahu_w = ( pahu(ji ,jj,jk-1) + pahu(ji-1,jj,jk) & 325 & + pahu(ji-1,jj,jk-1) + pahu(ji ,jj,jk) ) * zmsku 326 zahv_w = ( pahv(ji,jj ,jk-1) + pahv(ji,jj-1,jk) & 327 & + pahv(ji,jj-1,jk-1) + pahv(ji,jj ,jk) ) * zmskv 328 ! 329 zcoef3 = - zahu_w * e2t(ji,jj) * zmsku * wslpi (ji,jj,jk) !wslpi & j are already w-masked 330 zcoef4 = - zahv_w * e1t(ji,jj) * zmskv * wslpj (ji,jj,jk) 300 331 ! 301 332 ztfw(ji,jj,jk) = zcoef3 * ( zdit(ji ,jj ,jk-1) + zdit(ji-1,jj ,jk) & … … 306 337 END DO 307 338 END DO 308 309 310 ! I.5 Divergence of vertical fluxes added to the general tracer trend 311 ! ------------------------------------------------------------------- 312 DO jk = 1, jpkm1 339 ! 340 ! !== add the vertical 33 flux ==! 341 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 342 DO jk = 2, jpkm1 343 DO jj = 1, jpjm1 344 DO ji = fs_2, fs_jpim1 345 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 346 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 347 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 348 END DO 349 END DO 350 END DO 351 ! 352 ELSE ! bilaplacian 353 SELECT CASE( kpass ) 354 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 355 DO jk = 2, jpkm1 356 DO jj = 1, jpjm1 357 DO ji = fs_2, fs_jpim1 358 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) & 359 & + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj) & 360 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) * tmask(ji,jj,jk) / fse3w(ji,jj,jk) 361 END DO 362 END DO 363 END DO 364 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 365 DO jk = 2, jpkm1 366 DO jj = 1, jpjm1 367 DO ji = fs_2, fs_jpim1 368 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 369 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 370 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) 371 END DO 372 END DO 373 END DO 374 END SELECT 375 ENDIF 376 ! 377 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 313 378 DO jj = 2, jpjm1 314 379 DO ji = fs_2, fs_jpim1 ! vector opt. 315 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 316 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 317 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 380 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1) ) & 381 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 318 382 END DO 319 383 END DO 320 384 END DO 321 385 ! 322 END DO 323 ! 324 CALL wrk_dealloc( jpi, jpj, z2d ) 325 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw, zdkt, zdk1t ) 386 IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR. & !== first pass only ( laplacian) ==! 387 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==! 388 ! 389 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 390 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 391 ! note sign is reversed to give down-gradient diffusive transports (#1043) 392 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 393 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 394 ENDIF 395 ! 396 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 397 ! 398 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 399 z2d(:,:) = zftu(ji,jj,1) 400 DO jk = 2, jpkm1 401 DO jj = 2, jpjm1 402 DO ji = fs_2, fs_jpim1 ! vector opt. 403 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 404 END DO 405 END DO 406 END DO 407 !!gm CAUTION I think there is an error of sign when using BLP operator.... 408 !!gm a multiplication by zsign is required (to be checked twice !) 409 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 410 CALL lbc_lnk( z2d, 'U', -1. ) 411 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 412 ! 413 z2d(:,:) = zftv(ji,jj,1) 414 DO jk = 2, jpkm1 415 DO jj = 2, jpjm1 416 DO ji = fs_2, fs_jpim1 ! vector opt. 417 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 418 END DO 419 END DO 420 END DO 421 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 422 CALL lbc_lnk( z2d, 'V', -1. ) 423 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 424 END IF 425 ! 426 ENDIF 427 ! 428 ENDIF !== end pass selection ==! 429 ! 430 ! ! =============== 431 END DO ! end tracer loop 432 ! ! =============== 433 ! 434 CALL wrk_dealloc( jpi, jpj, zdkt, zdk1t, z2d ) 435 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt , zftu, zftv, ztfw ) 326 436 ! 327 437 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso') 328 438 ! 329 439 END SUBROUTINE tra_ldf_iso 330 331 #else332 !!----------------------------------------------------------------------333 !! default option : Dummy code NO rotation of the diffusive tensor334 !!----------------------------------------------------------------------335 CONTAINS336 SUBROUTINE tra_ldf_iso( kt, kit000,cdtype, pgu, pgv, pgui, pgvi, ptb, pta, kjpt, pahtb0 ) ! Empty routine337 INTEGER:: kt, kit000338 CHARACTER(len=3) :: cdtype339 REAL, DIMENSION(:,:,:) :: pgu, pgv, pgui, pgvi ! tracer gradient at pstep levels340 REAL, DIMENSION(:,:,:,:) :: ptb, pta341 WRITE(*,*) 'tra_ldf_iso: You should not have seen this print! error?', kt, kit000, cdtype, &342 & pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0343 END SUBROUTINE tra_ldf_iso344 #endif345 440 346 441 !!============================================================================== -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5737 r5758 2 2 !!============================================================================== 3 3 !! *** MODULE traldf_lap *** 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend4 !! Ocean tracers: lateral diffusivity trend (laplacian and bilaplacian) 5 5 !!============================================================================== 6 !! History : OPA ! 87-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 91-11 (G. Madec) 8 !! ! 95-11 (G. Madec) suppress volumetric scale factors 9 !! ! 96-01 (G. Madec) statement function for e3 10 !! NEMO ! 02-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 04-08 (C. Talandier) New trends organization 12 !! ! 05-11 (G. Madec) add zps case 13 !! 3.0 ! 10-06 (C. Ethe, G. Madec) Merge TRA-TRC 6 !! History : OPA ! 1987-06 (P. Andrich, D. L Hostis) Original code 7 !! ! 1991-11 (G. Madec) 8 !! ! 1995-11 (G. Madec) suppress volumetric scale factors 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! NEMO ! 2002-06 (G. Madec) F90: Free form and module 11 !! 1.0 ! 2004-08 (C. Talandier) New trends organization 12 !! ! 2005-11 (G. Madec) add zps case 13 !! 3.0 ! 2010-06 (C. Ethe, G. Madec) Merge TRA-TRC 14 !! 3.7 ! 2014-01 (G. Madec, S. Masson) re-entrant laplacian 14 15 !!---------------------------------------------------------------------- 15 16 16 17 !!---------------------------------------------------------------------- 17 !! tra_ldf_lap : update the tracer trend with the horizontal diffusion18 !! using a iso-level harmonic (laplacien) operator.18 !! tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator 19 !! tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator 19 20 !!---------------------------------------------------------------------- 20 21 USE oce ! ocean dynamics and active tracers 21 22 USE dom_oce ! ocean space and time domain 22 USE ldftra_oce ! ocean active tracers: lateral physics 23 USE in_out_manager ! I/O manager 23 USE ldftra ! lateral physics: eddy diffusivity 24 24 USE diaptr ! poleward transport diagnostics 25 25 USE trc_oce ! share passive tracers/Ocean variables 26 USE lib_mpp ! MPP library 26 USE zpshde ! partial step: hor. derivative (zps_hde routine) 27 ! 28 USE in_out_manager ! I/O manager 29 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 30 USE lib_mpp ! distribued memory computing library 27 31 USE timing ! Timing 32 USE wrk_nemo ! Memory allocation 28 33 29 34 IMPLICIT NONE 30 35 PRIVATE 31 36 32 PUBLIC tra_ldf_lap ! routine called by step.F9037 PUBLIC tra_ldf_lap ! routine called by traldf.F90 33 38 34 39 !! * Substitutions 35 40 # include "domzgr_substitute.h90" 36 # include "ldftra_substitute.h90"37 41 # include "vectopt_loop_substitute.h90" 38 42 !!---------------------------------------------------------------------- 39 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)43 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 40 44 !! $Id$ 41 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 43 47 CONTAINS 44 48 45 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, p gu , pgv ,&46 & pgui, pgvi,&47 & ptb, pta, kjpt)49 SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 50 & pgui, pgvi, & 51 & ptb , pta , kjpt, kpass ) 48 52 !!---------------------------------------------------------------------- 49 53 !! *** ROUTINE tra_ldf_lap *** … … 55 59 !! fields (forward time scheme). The horizontal diffusive trends of 56 60 !! the tracer is given by: 57 !! difft = 1/(e1 t*e2t*e3t) { di-1[ ahte2u*e3u/e1u di(tb) ]58 !! + dj-1[ ahte1v*e3v/e2v dj(tb) ] }61 !! difft = 1/(e1e2t*e3t) { di-1[ pahu e2u*e3u/e1u di(tb) ] 62 !! + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 59 63 !! Add this trend to the general tracer trend pta : 60 64 !! pta = pta + difft … … 63 67 !! harmonic mixing trend. 64 68 !!---------------------------------------------------------------------- 65 USE oce, ONLY: ztu => ua , ztv => va ! (ua,va) used as workspace66 !67 69 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 INTEGER , INTENT(in ) :: kit000 70 INTEGER , INTENT(in ) :: kit000 ! first time step index 69 71 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 70 72 INTEGER , INTENT(in ) :: kjpt ! number of tracers 73 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 74 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 71 75 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 72 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels76 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 73 77 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 74 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 75 79 ! 76 INTEGER :: ji, jj, jk, jn 77 INTEGER :: iku, ikv, ierr ! local integers78 REAL(wp) :: zabe1, zabe2, zbtr ! local scalars80 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 REAL(wp) :: zsign ! local scalars 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, ztv, zaheeu, zaheev 79 83 !!---------------------------------------------------------------------- 80 84 ! 81 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')85 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap') 82 86 ! 83 IF( kt == kit000) THEN84 IF(lwp)WRITE(numout,*)85 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype86 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ '87 IF( kt == nit000 .AND. lwp ) THEN 88 WRITE(numout,*) 89 WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass 90 WRITE(numout,*) '~~~~~~~~~~~ ' 87 91 ENDIF 88 89 ! ! =========== ! 90 DO jn = 1, kjpt ! tracer loop ! 91 ! ! =========== ! 92 DO jk = 1, jpkm1 ! slab loop 93 ! 94 ! 1. First derivative (gradient) 95 ! ------------------- 92 ! 93 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 94 ! 95 ! !== Initialization of metric arrays used for all tracers ==! 96 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 97 ELSE ; zsign = -1._wp 98 ENDIF 99 DO jk = 1, jpkm1 100 DO jj = 1, jpjm1 101 DO ji = 1, fs_jpim1 ! vector opt. 102 zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) !!gm * umask(ji,jj,jk) pah masked! 103 zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) !!gm * vmask(ji,jj,jk) 104 END DO 105 END DO 106 END DO 107 ! 108 ! ! =========== ! 109 DO jn = 1, kjpt ! tracer loop ! 110 ! ! =========== ! 111 ! 112 DO jk = 1, jpkm1 !== First derivative (gradient) ==! 96 113 DO jj = 1, jpjm1 97 DO ji = 1, fs_jpim1 ! vector opt. 98 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 99 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 100 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 101 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 114 DO ji = 1, fs_jpim1 115 ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 116 ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 102 117 END DO 103 118 END DO 104 IF( ln_zps ) THEN ! set gradient at partial step level for the last ocean cell 119 END DO 120 IF( ln_zps ) THEN ! set gradient at bottom/top ocean level 121 DO jj = 1, jpjm1 ! bottom 122 DO ji = 1, fs_jpim1 123 ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn) 124 ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn) 125 END DO 126 END DO 127 IF( ln_isfcav ) THEN ! top in ocean cavities only 105 128 DO jj = 1, jpjm1 106 129 DO ji = 1, fs_jpim1 ! vector opt. 107 ! last level 108 iku = mbku(ji,jj) 109 ikv = mbkv(ji,jj) 110 IF( iku == jk ) THEN 111 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 112 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 113 ENDIF 114 IF( ikv == jk ) THEN 115 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 116 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 117 ENDIF 130 IF( miku(ji,jj) > 1 ) ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 131 IF( mikv(ji,jj) > 1 ) ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 118 132 END DO 119 133 END DO 120 134 ENDIF 121 ! (ISH) 122 IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level for the first ocean cell 123 ! into a cavity 124 DO jj = 1, jpjm1 125 DO ji = 1, fs_jpim1 ! vector opt. 126 ! ice shelf level level MAX(2,jk) => only where ice shelf 127 iku = miku(ji,jj) 128 ikv = mikv(ji,jj) 129 IF( iku == MAX(2,jk) ) THEN 130 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 131 ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 132 ENDIF 133 IF( ikv == MAX(2,jk) ) THEN 134 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 135 ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 136 END IF 137 END DO 138 END DO 139 ENDIF 140 141 142 ! 2. Second derivative (divergence) added to the general tracer trends 143 ! --------------------------------------------------------------------- 135 ENDIF 136 ! 137 DO jk = 1, jpkm1 !== Second derivative (divergence) added to the general tracer trends ==! 144 138 DO jj = 2, jpjm1 145 DO ji = fs_2, fs_jpim1 ! vector opt. 146 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 147 ! horizontal diffusive trends added to the general tracer trends 148 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 149 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 139 DO ji = fs_2, fs_jpim1 140 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 141 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 142 & / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 150 143 END DO 151 144 END DO 152 ! 153 END DO ! End of slab 145 END DO 154 146 ! 155 ! "Poleward" diffusive heat or salt transports 156 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 157 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( ztv(:,:,:) ) 158 IF( jn == jp_sal) str_ldf(:) = ptr_sj( ztv(:,:,:) ) 147 ! !== "Poleward" diffusive heat or salt transports ==! 148 IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==! 149 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==! 150 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 151 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 152 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 153 ENDIF 159 154 ENDIF 160 ! ! ================== 161 END DO ! end of tracer loop 162 ! ! ================== 163 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 155 ! ! ================== 156 END DO ! end of tracer loop 157 ! ! ================== 158 ! 159 CALL wrk_dealloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 160 ! 161 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap') 164 162 ! 165 163 END SUBROUTINE tra_ldf_lap 166 164 167 165 !!============================================================================== 168 166 END MODULE traldf_lap -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r5722 r5758 1 MODULE traldf_ iso_grif1 MODULE traldf_triad 2 2 !!====================================================================== 3 !! *** MODULE traldf_ iso_grif***3 !! *** MODULE traldf_triad *** 4 4 !! Ocean tracers: horizontal component of the lateral tracer mixing trend 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec)7 !! ! Griffies operator version adapted from traldf_iso.F906 !! History : 3.3 ! 2010-10 (G. Nurser, C. Harris, G. Madec) Griffies operator (original code) 7 !! 3.7 ! 2013-12 (F. Lemarie, G. Madec) triad operator (Griffies) + Method of Stabilizing Correction 8 8 !!---------------------------------------------------------------------- 9 #if defined key_ldfslp || defined key_esopa 9 10 10 !!---------------------------------------------------------------------- 11 !! 'key_ldfslp' slope of the lateral diffusive direction 12 !!---------------------------------------------------------------------- 13 !! tra_ldf_iso_grif : update the tracer trend with the horizontal component 14 !! of the Griffies iso-neutral laplacian operator 11 !! tra_ldf_triad : update the tracer trend with the iso-neutral laplacian triad-operator 15 12 !!---------------------------------------------------------------------- 16 13 USE oce ! ocean dynamics and active tracers … … 19 16 USE trc_oce ! share passive tracers/Ocean variables 20 17 USE zdf_oce ! ocean vertical physics 21 USE ldftra_oce ! ocean active tracers: lateral physics 22 USE ldfslp ! iso-neutral slopes 18 USE ldftra ! lateral physics: eddy diffusivity 19 USE ldfslp ! lateral physics: iso-neutral slopes 20 USE traldf_iso ! lateral diffusion (Madec operator) (tra_ldf_iso routine) 23 21 USE diaptr ! poleward transport diagnostics 22 USE zpshde ! partial step: hor. derivative (zps_hde routine) 23 ! 24 24 USE in_out_manager ! I/O manager 25 25 USE iom ! I/O library … … 29 29 USE timing ! Timing 30 30 31 32 31 IMPLICIT NONE 33 32 PRIVATE 34 33 35 PUBLIC tra_ldf_iso_grif ! routine called by traldf.F90 36 37 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: psix_eiv, psiy_eiv !: eiv stream function (diag only) 38 REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ah_wslp2 !: aeiv*w-slope^2 39 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels 34 PUBLIC tra_ldf_triad ! routine called by traldf.F90 35 36 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels 40 37 41 38 !! * Substitutions 42 39 # include "domzgr_substitute.h90" 43 # include "ldftra_substitute.h90"44 40 # include "vectopt_loop_substitute.h90" 45 # include "ldfeiv_substitute.h90"46 41 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)42 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 48 43 !! $Id$ 49 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 46 CONTAINS 52 47 53 SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv, & 54 & ptb, pta, kjpt, pahtb0 ) 48 SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv , & 49 & pgui, pgvi, & 50 & ptb , ptbb, pta , kjpt, kpass ) 55 51 !!---------------------------------------------------------------------- 56 !! *** ROUTINE tra_ldf_ iso_grif***52 !! *** ROUTINE tra_ldf_triad *** 57 53 !! 58 54 !! ** Purpose : Compute the before horizontal tracer (t & s) diffusive … … 66 62 !! nal or geopotential slopes computed in routine ldfslp. 67 63 !! 68 !! 1st part : masked horizontal derivative of T ( di[ t ] ) 69 !! ======== with partial cell update if ln_zps=T. 64 !! see documentation for the desciption 70 65 !! 71 !! 2nd part : horizontal fluxes of the lateral mixing operator 72 !! ======== 73 !! zftu = (aht+ahtb0) e2u*e3u/e1u di[ tb ] 74 !! - aht e2u*uslp dk[ mi(mk(tb)) ] 75 !! zftv = (aht+ahtb0) e1v*e3v/e2v dj[ tb ] 76 !! - aht e2u*vslp dk[ mj(mk(tb)) ] 77 !! take the horizontal divergence of the fluxes: 78 !! difft = 1/(e1t*e2t*e3t) { di-1[ zftu ] + dj-1[ zftv ] } 79 !! Add this trend to the general trend (ta,sa): 80 !! ta = ta + difft 81 !! 82 !! 3rd part: vertical trends of the lateral mixing operator 83 !! ======== (excluding the vertical flux proportional to dk[t] ) 84 !! vertical fluxes associated with the rotated lateral mixing: 85 !! zftw =-aht { e2t*wslpi di[ mi(mk(tb)) ] 86 !! + e1t*wslpj dj[ mj(mk(tb)) ] } 87 !! take the horizontal divergence of the fluxes: 88 !! difft = 1/(e1t*e2t*e3t) dk[ zftw ] 89 !! Add this trend to the general trend (ta,sa): 90 !! pta = pta + difft 91 !! 92 !! ** Action : Update pta arrays with the before rotated diffusion 66 !! ** Action : pta updated with the before rotated diffusion 67 !! ah_wslp2 .... 68 !! akz stabilizing vertical diffusivity coefficient (used in trazdf_imp) 93 69 !!---------------------------------------------------------------------- 94 USE oce , ONLY: zftu => ua , zftv => va ! (ua,va) used as 3D workspace95 !96 70 INTEGER , INTENT(in ) :: kt ! ocean time-step index 97 71 INTEGER , INTENT(in ) :: kit000 ! first time step index 98 72 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 73 INTEGER , INTENT(in ) :: kjpt ! number of tracers 74 INTEGER , INTENT(in ) :: kpass ! =1/2 first or second passage 75 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pahu, pahv ! eddy diffusivity at u- and v-points [m2/s] 100 76 REAL(wp), DIMENSION(jpi,jpj ,kjpt), INTENT(in ) :: pgu, pgv ! tracer gradient at pstep levels 101 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 77 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT(in ) :: pgui, pgvi ! tracer gradient at top levels 78 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! tracer (kpass=1) or laplacian of tracer (kpass=2) 79 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptbb ! tracer (only used in kpass=2) 102 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 103 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 104 ! 105 INTEGER :: ji, jj, jk,jn ! dummy loop indices 106 INTEGER :: ip,jp,kp ! dummy loop indices 107 INTEGER :: ierr ! temporary integer 108 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 109 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 110 REAL(wp) :: zcoef0, zbtr ! - - 81 ! 82 INTEGER :: ji, jj, jk, jn ! dummy loop indices 83 INTEGER :: ip,jp,kp ! dummy loop indices 84 INTEGER :: ierr ! local integer 85 REAL(wp) :: zmsku, zabe1, zcof1, zcoef3 ! local scalars 86 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4 ! - - 87 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 111 88 ! 112 89 REAL(wp) :: zslope_skew, zslope_iso, zslope2, zbu, zbv 113 REAL(wp) :: ze1ur, z dxt, ze2vr, ze3wr, zdyt, zdzt90 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 114 91 REAL(wp) :: zah, zah_slp, zaei_slp 115 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d 116 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, ztfw 117 REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d ! 3D workspace 92 #if defined key_diaar5 93 REAL(wp) :: zztmp ! local scalar 94 #endif 95 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d ! 2D workspace 96 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - 118 97 !!---------------------------------------------------------------------- 119 98 ! 120 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_iso_grif') 121 ! 122 CALL wrk_alloc( jpi, jpj, z2d ) 123 CALL wrk_alloc( jpi, jpj, jpk, zdit, zdjt, ztfw ) 124 ! 125 126 IF( kt == kit000 .AND. .NOT.ALLOCATED(ah_wslp2) ) THEN 99 IF( nn_timing == 1 ) CALL timing_start('tra_ldf_triad') 100 ! 101 CALL wrk_alloc( jpi,jpj, z2d ) 102 CALL wrk_alloc( jpi,jpj,jpk, zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ) 103 ! 104 IF( .NOT.ALLOCATED(zdkt3d) ) THEN 105 ALLOCATE( zdkt3d(jpi,jpj,0:1) , STAT=ierr ) 106 IF( lk_mpp ) CALL mpp_sum ( ierr ) 107 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_triad: unable to allocate arrays') 108 ENDIF 109 ! 110 IF( kpass == 1 .AND. kt == kit000 ) THEN 127 111 IF(lwp) WRITE(numout,*) 128 IF(lwp) WRITE(numout,*) 'tra_ldf_iso_grif : rotated laplacian diffusion operator on ', cdtype 129 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 130 ALLOCATE( ah_wslp2(jpi,jpj,jpk) , zdkt3d(jpi,jpj,0:1), STAT=ierr ) 131 IF( lk_mpp ) CALL mpp_sum ( ierr ) 132 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate arrays') 133 IF( ln_traldf_gdia ) THEN 134 IF (.NOT. ALLOCATED(psix_eiv))THEN 135 ALLOCATE( psix_eiv(jpi,jpj,jpk) , psiy_eiv(jpi,jpj,jpk) , STAT=ierr ) 136 IF( lk_mpp ) CALL mpp_sum ( ierr ) 137 IF( ierr > 0 ) CALL ctl_stop('STOP', 'tra_ldf_iso_grif: unable to allocate diagnostics') 138 ENDIF 112 IF(lwp) WRITE(numout,*) 'tra_ldf_triad : rotated laplacian diffusion operator on ', cdtype 113 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 114 ENDIF 115 ! 116 ! ! set time step size (Euler/Leapfrog) 117 IF( neuler == 0 .AND. kt == kit000 ) THEN ; z2dt = rdttra(1) ! at nit000 (Euler) 118 ELSE ; z2dt = 2.* rdttra(1) ! (Leapfrog) 119 ENDIF 120 z1_2dt = 1._wp / z2dt 121 ! 122 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) 123 ELSE ; zsign = -1._wp 124 ENDIF 125 126 !!---------------------------------------------------------------------- 127 !! 0 - calculate ah_wslp2, akz, and optionally zpsi_uw, zpsi_vw 128 !!---------------------------------------------------------------------- 129 ! 130 IF( kpass == 1 ) THEN !== first pass only and whatever the tracer is ==! 131 ! 132 akz (:,:,:) = 0._wp 133 ah_wslp2(:,:,:) = 0._wp 134 IF( ln_ldfeiv_dia ) THEN 135 zpsi_uw(:,:,:) = 0._wp 136 zpsi_vw(:,:,:) = 0._wp 139 137 ENDIF 140 ENDIF 141 142 !!---------------------------------------------------------------------- 143 !! 0 - calculate ah_wslp2, psix_eiv, psiy_eiv 144 !!---------------------------------------------------------------------- 145 146 !!gm Future development: consider using Ah defined at T-points and attached to the 4 t-point triads 147 148 ah_wslp2(:,:,:) = 0._wp 149 IF( ln_traldf_gdia ) THEN 150 psix_eiv(:,:,:) = 0._wp 151 psiy_eiv(:,:,:) = 0._wp 152 ENDIF 153 154 DO ip = 0, 1 155 DO kp = 0, 1 156 DO jk = 1, jpkm1 157 DO jj = 1, jpjm1 158 DO ji = 1, fs_jpim1 159 ze1ur = 1._wp / e1u(ji,jj) 160 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 161 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 162 zah = fsahtu(ji,jj,jk) ! fsaht(ji+ip,jj,jk) 163 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 164 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 165 ! (do this by *adding* gradient of depth) 166 zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * ze1ur * umask(ji,jj,jk+kp) 167 zslope2 = zslope2 *zslope2 168 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) & 169 & + zah * ( zbu * ze3wr / ( e1t(ji+ip,jj) * e2t(ji+ip,jj) ) ) * zslope2 170 IF( ln_traldf_gdia ) THEN 171 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew 172 psix_eiv(ji,jj,jk+kp) = psix_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 173 ENDIF 138 ! 139 DO ip = 0, 1 ! i-k triads 140 DO kp = 0, 1 141 DO jk = 1, jpkm1 142 DO jj = 1, jpjm1 143 DO ji = 1, fs_jpim1 144 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 145 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 146 zah = 0.25_wp * pahu(ji,jj,jk) 147 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 148 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 149 zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 150 zslope2 = zslope2 *zslope2 151 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 152 akz (ji+ip,jj,jk+kp) = akz (ji+ip,jj,jk+kp) + zah * r1_e1u(ji,jj) & 153 & * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 154 ! 155 IF( ln_ldfeiv_dia ) zpsi_uw(ji,jj,jk+kp) = zpsi_uw(ji,jj,jk+kp) & 156 & + 0.25_wp * aeiu(ji,jj,jk) * e2u(ji,jj) * zslope_skew 157 END DO 174 158 END DO 175 159 END DO 176 160 END DO 177 161 END DO 178 END DO 179 ! 180 DO jp = 0, 1 181 DO kp = 0, 1 182 DO jk = 1, jpkm1 183 DO jj = 1, jpjm1 184 DO ji=1,fs_jpim1 185 ze2vr = 1._wp / e2v(ji,jj) 186 ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 187 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 188 zah = fsahtv(ji,jj,jk) ! fsaht(ji,jj+jp,jk) 189 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 190 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 191 ! (do this by *adding* gradient of depth) 192 zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * ze2vr * vmask(ji,jj,jk+kp) 193 zslope2 = zslope2 * zslope2 194 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) & 195 & + zah * ( zbv * ze3wr / ( e1t(ji,jj+jp) * e2t(ji,jj+jp) ) ) * zslope2 196 IF( ln_traldf_gdia ) THEN 197 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 198 psiy_eiv(ji,jj,jk+kp) = psiy_eiv(ji,jj,jk+kp) + 0.25_wp * zaei_slp 199 ENDIF 162 ! 163 DO jp = 0, 1 ! j-k triads 164 DO kp = 0, 1 165 DO jk = 1, jpkm1 166 DO jj = 1, jpjm1 167 DO ji = 1, fs_jpim1 168 ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp) 169 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 170 zah = 0.25_wp * pahv(ji,jj,jk) 171 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 172 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 173 ! (do this by *adding* gradient of depth) 174 zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 175 zslope2 = zslope2 * zslope2 176 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 177 akz (ji,jj+jp,jk+kp) = akz (ji,jj+jp,jk+kp) + zah * r1_e2v(ji,jj) & 178 & * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 179 ! 180 IF( ln_ldfeiv_dia ) zpsi_vw(ji,jj,jk+kp) = zpsi_vw(ji,jj,jk+kp) & 181 & + 0.25 * aeiv(ji,jj,jk) * e1v(ji,jj) * zslope_skew 182 END DO 200 183 END DO 201 184 END DO 202 185 END DO 203 186 END DO 204 END DO 205 ! 206 IF( iom_use("uoce_eiv") .OR. iom_use("voce_eiv") .OR. iom_use("woce_eiv") ) THEN 207 ! 208 IF( ln_traldf_gdia .AND. cdtype == 'TRA' ) THEN 209 CALL wrk_alloc( jpi , jpj , jpk , zw3d ) 210 DO jk=1,jpkm1 211 zw3d(:,:,jk) = (psix_eiv(:,:,jk+1) - psix_eiv(:,:,jk))/fse3u(:,:,jk) ! u_eiv = -dpsix/dz 212 END DO 213 zw3d(:,:,jpk) = 0._wp 214 CALL iom_put( "uoce_eiv", zw3d ) ! i-eiv current 215 216 DO jk=1,jpk-1 217 zw3d(:,:,jk) = (psiy_eiv(:,:,jk+1) - psiy_eiv(:,:,jk))/fse3v(:,:,jk) ! v_eiv = -dpsiy/dz 218 END DO 219 zw3d(:,:,jpk) = 0._wp 220 CALL iom_put( "voce_eiv", zw3d ) ! j-eiv current 221 222 DO jk=1,jpk-1 223 DO jj = 2, jpjm1 224 DO ji = fs_2, fs_jpim1 ! vector opt. 225 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))/e2t(ji,jj) + & 226 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))/e1t(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 227 END DO 228 END DO 229 END DO 230 zw3d(:,:,jpk) = 0._wp 231 CALL iom_put( "woce_eiv", zw3d ) ! vert. eiv current 232 CALL wrk_dealloc( jpi , jpj , jpk , zw3d ) 187 ! 188 IF( ln_traldf_msc ) THEN ! stabilizing vertical diffusivity coefficient 189 ! 190 IF( ln_traldf_blp ) THEN ! bilaplacian operator 191 DO jk = 2, jpkm1 192 DO jj = 1, jpjm1 193 DO ji = 1, fs_jpim1 194 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 195 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) ) 196 END DO 197 END DO 198 END DO 199 ELSEIF( ln_traldf_lap ) THEN ! laplacian operator 200 DO jk = 2, jpkm1 201 DO jj = 1, jpjm1 202 DO ji = 1, fs_jpim1 203 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 204 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 205 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 206 END DO 207 END DO 208 END DO 209 ENDIF 210 ! 211 ELSE ! 33 flux set to zero with akz=ah_wslp2 ==>> computed in full implicit 212 akz(:,:,:) = ah_wslp2(:,:,:) 233 213 ENDIF 234 214 ! 235 ENDIF 236 ! ! =========== 237 DO jn = 1, kjpt ! tracer loop 238 ! ! =========== 215 IF( ln_ldfeiv_dia .AND. cdtype == 'TRA' ) CALL ldf_eiv_dia( zpsi_uw, zpsi_vw ) 216 ! 217 ENDIF !== end 1st pass only ==! 218 ! 219 ! ! =========== 220 DO jn = 1, kjpt ! tracer loop 221 ! ! =========== 239 222 ! Zero fluxes for each tracer 223 !!gm this should probably be done outside the jn loop 240 224 ztfw(:,:,:) = 0._wp 241 225 zftu(:,:,:) = 0._wp 242 226 zftv(:,:,:) = 0._wp 243 227 ! 244 DO jk = 1, jpkm1 228 DO jk = 1, jpkm1 !== before lateral T & S gradients at T-level jk ==! 245 229 DO jj = 1, jpjm1 246 230 DO ji = 1, fs_jpim1 ! vector opt. … … 250 234 END DO 251 235 END DO 252 IF( ln_zps .and.l_grad_zps ) THEN ! partial steps: correction at the lastlevel253 DO jj = 1, jpjm1 254 DO ji = 1, jpim1236 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction at top/bottom ocean level 237 DO jj = 1, jpjm1 ! bottom level 238 DO ji = 1, fs_jpim1 ! vector opt. 255 239 zdit(ji,jj,mbku(ji,jj)) = pgu(ji,jj,jn) 256 240 zdjt(ji,jj,mbkv(ji,jj)) = pgv(ji,jj,jn) 257 241 END DO 258 242 END DO 243 IF( ln_isfcav ) THEN ! top level (ocean cavities only) 244 DO jj = 1, jpjm1 245 DO ji = 1, fs_jpim1 ! vector opt. 246 IF( miku(ji,jj) > 1 ) zdit(ji,jj,miku(ji,jj) ) = pgui(ji,jj,jn) 247 IF( mikv(ji,jj) > 1 ) zdjt(ji,jj,mikv(ji,jj) ) = pgvi(ji,jj,jn) 248 END DO 249 END DO 250 ENDIF 259 251 ENDIF 260 252 … … 272 264 ELSE ; zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 273 265 ENDIF 274 275 276 IF (ln_botmix_grif) THEN 266 ! 267 zaei_slp = 0._wp 268 ! 269 IF( ln_botmix_triad ) THEN 277 270 DO ip = 0, 1 !== Horizontal & vertical fluxes 278 271 DO kp = 0, 1 279 272 DO jj = 1, jpjm1 280 273 DO ji = 1, fs_jpim1 281 ze1ur = 1._wp / e1u(ji,jj) 274 ze1ur = r1_e1u(ji,jj) 275 zdxt = zdit(ji,jj,jk) * ze1ur 276 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 277 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 278 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 279 zslope_iso = triadi (ji+ip,jj,jk,1-ip,kp) 280 281 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 282 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 283 zah = pahu(ji,jj,jk) 284 zah_slp = zah * zslope_iso 285 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew 286 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 287 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - ( zah_slp + zaei_slp) * zdxt * zbu * ze3wr 288 END DO 289 END DO 290 END DO 291 END DO 292 293 DO jp = 0, 1 294 DO kp = 0, 1 295 DO jj = 1, jpjm1 296 DO ji = 1, fs_jpim1 297 ze2vr = r1_e2v(ji,jj) 298 zdyt = zdjt(ji,jj,jk) * ze2vr 299 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 300 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 301 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 302 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 303 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 304 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahv is masked... 305 zah = pahv(ji,jj,jk) 306 zah_slp = zah * zslope_iso 307 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew 308 zftv(ji,jj ,jk ) = zftv(ji,jj ,jk ) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 309 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - ( zah_slp + zaei_slp ) * zdyt * zbv * ze3wr 310 END DO 311 END DO 312 END DO 313 END DO 314 315 ELSE 316 317 DO ip = 0, 1 !== Horizontal & vertical fluxes 318 DO kp = 0, 1 319 DO jj = 1, jpjm1 320 DO ji = 1, fs_jpim1 321 ze1ur = r1_e1u(ji,jj) 282 322 zdxt = zdit(ji,jj,jk) * ze1ur 283 323 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) … … 286 326 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 287 327 288 zbu = 0.25_wp * e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk)289 ! ln_botmix_ grif is .T. don'tmask zah for bottom half cells290 zah = fsahtu(ji,jj,jk) !*umask(ji,jj,jk+kp) !fsaht(ji+ip,jj,jk)===>> ????328 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk) 329 ! ln_botmix_triad is .F. mask zah for bottom half cells 330 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? 291 331 zah_slp = zah * zslope_iso 292 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew !fsaeit(ji+ip,jj,jk)*zslope_skew293 zftu(ji ,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur332 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew 333 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 294 334 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 295 335 END DO … … 302 342 DO jj = 1, jpjm1 303 343 DO ji = 1, fs_jpim1 304 ze2vr = 1._wp /e2v(ji,jj)344 ze2vr = r1_e2v(ji,jj) 305 345 zdyt = zdjt(ji,jj,jk) * ze2vr 306 346 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) … … 308 348 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 309 349 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 310 zbv = 0.25_wp * e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk)311 ! ln_botmix_ grif is .T. don'tmask zah for bottom half cells312 zah = fsahtv(ji,jj,jk) !*vmask(ji,jj,jk+kp) ! fsaht(ji,jj+jp,jk)350 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk) 351 ! ln_botmix_triad is .F. mask zah for bottom half cells 352 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? 313 353 zah_slp = zah * zslope_iso 314 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew354 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 315 355 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 316 356 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr … … 319 359 END DO 320 360 END DO 321 ELSE 322 DO ip = 0, 1 !== Horizontal & vertical fluxes 323 DO kp = 0, 1 324 DO jj = 1, jpjm1 325 DO ji = 1, fs_jpim1 326 ze1ur = 1._wp / e1u(ji,jj) 327 zdxt = zdit(ji,jj,jk) * ze1ur 328 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp) 329 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 330 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 331 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 332 333 zbu = 0.25_wp * e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) 334 ! ln_botmix_grif is .F. mask zah for bottom half cells 335 zah = fsahtu(ji,jj,jk) * umask(ji,jj,jk+kp) ! fsaht(ji+ip,jj,jk) ===>> ???? 336 zah_slp = zah * zslope_iso 337 zaei_slp = fsaeiw(ji+ip,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew 338 zftu(ji,jj,jk) = zftu(ji,jj,jk) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 339 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr 340 END DO 341 END DO 342 END DO 343 END DO 344 345 DO jp = 0, 1 346 DO kp = 0, 1 347 DO jj = 1, jpjm1 348 DO ji = 1, fs_jpim1 349 ze2vr = 1._wp / e2v(ji,jj) 350 zdyt = zdjt(ji,jj,jk) * ze2vr 351 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp) 352 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 353 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 354 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 355 zbv = 0.25_wp * e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) 356 ! ln_botmix_grif is .F. mask zah for bottom half cells 357 zah = fsahtv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! fsaht(ji,jj+jp,jk) 358 zah_slp = zah * zslope_iso 359 zaei_slp = fsaeiw(ji,jj+jp,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew 360 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 361 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr 362 END DO 363 END DO 364 END DO 365 END DO 366 END IF 367 ! !== divergence and add to the general trend ==! 361 ENDIF 362 ! !== horizontal divergence and add to the general trend ==! 368 363 DO jj = 2 , jpjm1 369 364 DO ji = fs_2, fs_jpim1 ! vector opt. 370 zbtr = 1._wp / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )371 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) &372 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk))365 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) & 366 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk) ) & 367 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 373 368 END DO 374 369 END DO … … 376 371 END DO 377 372 ! 378 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to the general tracer trend 373 ! !== add the vertical 33 flux ==! 374 IF( ln_traldf_lap ) THEN ! laplacian case: eddy coef = ah_wslp2 - akz 375 DO jk = 2, jpkm1 376 DO jj = 1, jpjm1 377 DO ji = fs_2, fs_jpim1 378 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 379 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 380 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 381 END DO 382 END DO 383 END DO 384 ELSE ! bilaplacian 385 SELECT CASE( kpass ) 386 CASE( 1 ) ! 1st pass : eddy coef = ah_wslp2 387 DO jk = 2, jpkm1 388 DO jj = 1, jpjm1 389 DO ji = fs_2, fs_jpim1 390 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 391 & * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 392 END DO 393 END DO 394 END DO 395 CASE( 2 ) ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb and ptbb gradients, resp. 396 DO jk = 2, jpkm1 397 DO jj = 1, jpjm1 398 DO ji = fs_2, fs_jpim1 399 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) & 400 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 401 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) 402 END DO 403 END DO 404 END DO 405 END SELECT 406 ENDIF 407 ! 408 DO jk = 1, jpkm1 !== Divergence of vertical fluxes added to pta ==! 379 409 DO jj = 2, jpjm1 380 410 DO ji = fs_2, fs_jpim1 ! vector opt. 381 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) &382 & / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )411 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 412 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 383 413 END DO 384 414 END DO 385 415 END DO 386 416 ! 387 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 388 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 389 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 390 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 391 ENDIF 392 393 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 394 ! 395 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 396 z2d(:,:) = 0._wp 397 DO jk = 1, jpkm1 398 DO jj = 2, jpjm1 399 DO ji = fs_2, fs_jpim1 ! vector opt. 400 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 401 END DO 402 END DO 403 END DO 404 z2d(:,:) = rau0_rcp * z2d(:,:) 405 CALL lbc_lnk( z2d, 'U', -1. ) 406 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 417 IF( ( kpass == 1 .AND. ln_traldf_lap ) .OR. & !== first pass only ( laplacian) ==! 418 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass (bilaplacian) ==! 419 ! 420 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 421 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 422 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 423 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 424 ENDIF 425 ! 426 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 427 ! 428 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 429 z2d(:,:) = zftu(ji,jj,1) 430 DO jk = 2, jpkm1 431 DO jj = 2, jpjm1 432 DO ji = fs_2, fs_jpim1 ! vector opt. 433 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 434 END DO 435 END DO 436 END DO 437 z2d(:,:) = rau0_rcp * z2d(:,:) 438 CALL lbc_lnk( z2d, 'U', -1. ) 439 CALL iom_put( "udiff_heattr", z2d ) ! heat i-transport 440 ! 441 z2d(:,:) = zftv(ji,jj,1) 442 DO jk = 2, jpkm1 443 DO jj = 2, jpjm1 444 DO ji = fs_2, fs_jpim1 ! vector opt. 445 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 446 END DO 447 END DO 448 END DO 449 z2d(:,:) = rau0_rcp * z2d(:,:) 450 CALL lbc_lnk( z2d, 'V', -1. ) 451 CALL iom_put( "vdiff_heattr", z2d ) ! heat j-transport 452 ENDIF 407 453 ! 408 z2d(:,:) = 0._wp 409 DO jk = 1, jpkm1 410 DO jj = 2, jpjm1 411 DO ji = fs_2, fs_jpim1 ! vector opt. 412 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 413 END DO 414 END DO 415 END DO 416 z2d(:,:) = rau0_rcp * z2d(:,:) 417 CALL lbc_lnk( z2d, 'V', -1. ) 418 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 419 END IF 420 ! 421 ENDIF 422 ! 423 END DO 424 ! 425 CALL wrk_dealloc( jpi, jpj, z2d ) 426 CALL wrk_dealloc( jpi, jpj, jpk, zdit, zdjt, ztfw ) 427 ! 428 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_iso_grif') 429 ! 430 END SUBROUTINE tra_ldf_iso_grif 431 432 #else 433 !!---------------------------------------------------------------------- 434 !! default option : Dummy code NO rotation of the diffusive tensor 435 !!---------------------------------------------------------------------- 436 REAL, PUBLIC, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: psix_eiv, psiy_eiv !: eiv stream function (diag only) 437 CONTAINS 438 SUBROUTINE tra_ldf_iso_grif( kt, kit000, cdtype, pgu, pgv, & 439 & ptb, pta, kjpt, pahtb0 ) 440 CHARACTER(len=3) :: cdtype 441 INTEGER :: kit000 ! first time step index 442 REAL, DIMENSION(:,:,:) :: pgu, pgv ! tracer gradient at pstep levels 443 REAL, DIMENSION(:,:,:,:) :: ptb, pta 444 WRITE(*,*) 'tra_ldf_iso_grif: You should not have seen this print! error?', kt, cdtype, & 445 & pgu(1,1,1), pgv(1,1,1), ptb(1,1,1,1), pta(1,1,1,1), kjpt, pahtb0 446 END SUBROUTINE tra_ldf_iso_grif 447 #endif 454 ENDIF 455 ! 456 ENDIF !== end pass selection ==! 457 ! 458 ! ! =============== 459 END DO ! end tracer loop 460 ! ! =============== 461 ! 462 CALL wrk_dealloc( jpi,jpj, z2d ) 463 CALL wrk_dealloc( jpi,jpj,jpk, zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ) 464 ! 465 IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_triad') 466 ! 467 END SUBROUTINE tra_ldf_triad 448 468 449 469 !!============================================================================== 450 END MODULE traldf_ iso_grif470 END MODULE traldf_triad -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r5656 r5758 37 37 USE traqsr ! penetrative solar radiation (needed for nksr) 38 38 USE phycst ! physical constant 39 USE ldftra_oce ! lateral physics on tracers 39 USE ldftra ! lateral physics on tracers 40 USE ldfslp 40 41 USE bdy_oce ! BDY open boundary condition variables 41 42 USE bdytra ! open boundary condition (bdy_tra routine) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r5385 r5758 19 19 USE sbc_oce ! surface boundary condition: ocean 20 20 USE dynspg_oce 21 ! 22 USE ldftra ! lateral diffusion: eddy diffusivity 23 USE ldfslp ! lateral diffusion: iso-neutral slope 21 24 USE trazdf_exp ! vertical diffusion: explicit (tra_zdf_exp routine) 22 25 USE trazdf_imp ! vertical diffusion: implicit (tra_zdf_imp routine) 23 USE ldftra_oce ! ocean active tracers: lateral physics26 ! 24 27 USE trd_oce ! trends: ocean variables 25 28 USE trdtra ! trends manager: tracers … … 45 48 # include "vectopt_loop_substitute.h90" 46 49 !!---------------------------------------------------------------------- 47 !! NEMO/OPA 3.7 , NEMO Consortium (201 4)50 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 48 51 !! $Id$ 49 52 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 88 91 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 89 92 END SELECT 93 !!gm WHY here ! and I don't like that ! 90 94 ! DRAKKAR SSS control { 91 95 ! JMM avoid negative salinities near river outlet ! Ugly fix 92 96 ! JMM : restore negative salinities to small salinities: 93 97 WHERE ( tsa(:,:,:,jp_sal) < 0._wp ) tsa(:,:,:,jp_sal) = 0.1_wp 98 !!gm 94 99 95 100 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics … … 98 103 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dtra(jk) ) - ztrds(:,:,jk) 99 104 END DO 105 !!gm this should be moved in trdtra.F90 and done on all trends 100 106 CALL lbc_lnk( ztrdt, 'T', 1. ) 101 107 CALL lbc_lnk( ztrds, 'T', 1. ) 108 !!gm 102 109 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdf, ztrdt ) 103 110 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdf, ztrds ) … … 123 130 !! nzdf = 0 explicit (time-splitting) scheme (ln_zdfexp=T) 124 131 !! = 1 implicit (euler backward) scheme (ln_zdfexp=F) 125 !! NB: rotation of lateral mixing operator or TKE or KPP scheme,126 !! theimplicit scheme is required.132 !! NB: rotation of lateral mixing operator or TKE & GLS schemes, 133 !! an implicit scheme is required. 127 134 !!---------------------------------------------------------------------- 128 135 USE zdftke 129 136 USE zdfgls 130 USE zdfkpp131 137 !!---------------------------------------------------------------------- 132 138 … … 137 143 138 144 ! Force implicit schemes 139 IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) nzdf = 1 ! TKE, GLS or KPPphysics140 IF( ln_traldf_iso ) nzdf = 1! iso-neutral lateral physics141 IF( ln_traldf_hor .AND. ln_sco ) nzdf = 1! horizontal lateral physics in s-coordinate145 IF( lk_zdftke .OR. lk_zdfgls ) nzdf = 1 ! TKE, or GLS physics 146 IF( ln_traldf_iso ) nzdf = 1 ! iso-neutral lateral physics 147 IF( ln_traldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 142 148 IF( ln_zdfexp .AND. nzdf == 1 ) CALL ctl_stop( 'tra_zdf : If using the rotation of lateral mixing operator', & 143 & ' TKE or KPPscheme, the implicit scheme is required, set ln_zdfexp = .false.' )149 & ' GLS or TKE scheme, the implicit scheme is required, set ln_zdfexp = .false.' ) 144 150 145 151 ! Test: esopa -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r5120 r5758 19 19 20 20 !!---------------------------------------------------------------------- 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical 22 !! part of the mixing tensor. 23 !!---------------------------------------------------------------------- 24 USE oce ! ocean dynamics and tracers variables 25 USE dom_oce ! ocean space and time domain variables 26 USE zdf_oce ! ocean vertical physics variables 27 USE trc_oce ! share passive tracers/ocean variables 28 USE domvvl ! variable volume 29 USE ldftra_oce ! ocean active tracers: lateral physics 30 USE ldftra ! lateral mixing type 31 USE ldfslp ! lateral physics: slope of diffusion 32 USE zdfddm ! ocean vertical physics: double diffusion 33 USE traldf_iso_grif ! active tracers: Griffies operator 34 USE in_out_manager ! I/O manager 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 USE lib_mpp ! MPP library 37 USE wrk_nemo ! Memory Allocation 38 USE timing ! Timing 21 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical part of the mixing tensor. 22 !!---------------------------------------------------------------------- 23 USE oce ! ocean dynamics and tracers variables 24 USE dom_oce ! ocean space and time domain variables 25 USE zdf_oce ! ocean vertical physics variables 26 USE trc_oce ! share passive tracers/ocean variables 27 USE domvvl ! variable volume 28 USE ldftra ! lateral mixing type 29 USE ldfslp ! lateral physics: slope of diffusion 30 USE zdfddm ! ocean vertical physics: double diffusion 31 USE traldf_iso_triad ! active tracers: Method of Stabilizing Correction 32 ! 33 USE in_out_manager ! I/O manager 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 USE lib_mpp ! MPP library 36 USE wrk_nemo ! Memory Allocation 37 USE timing ! Timing 39 38 40 39 IMPLICIT NONE … … 47 46 !! * Substitutions 48 47 # include "domzgr_substitute.h90" 49 # include "ldftra_substitute.h90"50 48 # include "zdfddm_substitute.h90" 51 49 # include "vectopt_loop_substitute.h90" 52 50 !!---------------------------------------------------------------------- 53 !! NEMO/OPA 3. 3 , NEMO Consortium (2010)51 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 54 52 !! $Id$ 55 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 120 118 ELSE ; zwt(:,:,2:jpk) = fsavs(:,:,2:jpk) 121 119 ENDIF 122 DO jj=1, jpj 123 DO ji=1, jpi 124 zwt(ji,jj,1) = 0._wp 125 END DO 126 END DO 127 ! 128 #if defined key_ldfslp 129 ! isoneutral diffusion: add the contribution 130 IF( ln_traldf_grif ) THEN ! Griffies isoneutral diff 131 DO jk = 2, jpkm1 132 DO jj = 2, jpjm1 133 DO ji = fs_2, fs_jpim1 ! vector opt. 134 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 120 zwt(:,:,1) = 0._wp 121 ! 122 IF( l_ldfslp ) THEN ! isoneutral diffusion: add the contribution 123 IF( ln_traldf_msc ) THEN ! MSC iso-neutral operator 124 DO jk = 2, jpkm1 125 DO jj = 2, jpjm1 126 DO ji = fs_2, fs_jpim1 ! vector opt. 127 zwt(ji,jj,jk) = zwt(ji,jj,jk) + akz(ji,jj,jk) 128 END DO 135 129 END DO 136 130 END DO 137 END DO 138 ELSE IF( l_traldf_rot ) THEN ! standard isoneutral diff 139 DO jk = 2, jpkm1 140 DO jj = 2, jpjm1 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 zwt(ji,jj,jk) = zwt(ji,jj,jk) + fsahtw(ji,jj,jk) & 143 & * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 144 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) 131 ELSE ! standard or triad iso-neutral operator 132 DO jk = 2, jpkm1 133 DO jj = 2, jpjm1 134 DO ji = fs_2, fs_jpim1 ! vector opt. 135 zwt(ji,jj,jk) = zwt(ji,jj,jk) + ah_wslp2(ji,jj,jk) 136 END DO 145 137 END DO 146 138 END DO 147 END DO139 ENDIF 148 140 ENDIF 149 #endif 141 ! 150 142 ! Diagonal, lower (i), upper (s) (including the bottom boundary condition since avt is masked) 151 143 DO jk = 1, jpkm1 … … 202 194 ze3tb = ( 1. - r_vvl ) + r_vvl * fse3t_b(ji,jj,1) 203 195 ze3tn = ( 1. - r_vvl ) + r_vvl * fse3t(ji,jj,1) 204 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) & 205 & + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 196 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 206 197 END DO 207 198 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r5120 r5758 93 93 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 94 94 ! 95 INTEGER :: ji, jj, jn ! Dummy loop indices96 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points97 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporaryscalars98 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos99 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj !95 INTEGER :: ji, jj, jn ! Dummy loop indices 96 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 97 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! local scalars 98 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj, zhi, zhj ! NB: 3rd dim=1 to use eos 99 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! 100 100 !!---------------------------------------------------------------------- 101 101 ! 102 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 103 ! 104 pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 105 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ; 106 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ; 102 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde') 103 ! 104 pgtu(:,:,:)=0._wp ; zti (:,:,:)=0._wp ; zhi (:,: )=0._wp 105 pgtv(:,:,:)=0._wp ; ztj (:,:,:)=0._wp ; zhj (:,: )=0._wp 107 106 ! 108 107 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! … … 149 148 ! 150 149 END DO 151 152 ! horizontal derivative of density anomalies (rd)153 IF( PRESENT( prd ) ) THEN ! depth of the partial step level154 pgr u(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ;150 ! 151 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 152 pgru(:,:) = 0._wp 153 pgrv(:,:) = 0._wp ! depth of the partial step level 155 154 DO jj = 1, jpjm1 156 155 DO ji = 1, jpim1 … … 167 166 END DO 168 167 END DO 169 170 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 171 ! step and store it in zri, zrj for each case 172 CALL eos( zti, zhi, zri ) 173 CALL eos( ztj, zhj, zrj ) 174 175 ! Gradient of density at the last level 176 DO jj = 1, jpjm1 168 ! 169 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 170 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 171 ! 172 DO jj = 1, jpjm1 ! Gradient of density at the last level 177 173 DO ji = 1, jpim1 178 174 iku = mbku(ji,jj) … … 192 188 END IF 193 189 ! 194 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde')190 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde') 195 191 ! 196 192 END SUBROUTINE zps_hde 197 ! 198 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu, pgtv, & 199 & prd, pgru, pgrv, pmru, pmrv, pgzu, pgzv, pge3ru, pge3rv, & 200 & pgtui, pgtvi, pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 193 194 195 SUBROUTINE zps_hde_isf( kt, kjpt, pta, pgtu , pgtv , pgtui, pgtvi, & 196 & prd, pgru , pgrv , pmru , pmrv , pgzu , pgzv , pge3ru , pge3rv , & 197 & pgrui, pgrvi, pmrui, pmrvi, pgzui, pgzvi, pge3rui, pge3rvi ) 201 198 !!---------------------------------------------------------------------- 202 199 !! *** ROUTINE zps_hde *** … … 245 242 !! - pge3ru, pge3rv, pge3rui, pge3rvi: horizontal gradient of rho weighted by local e3w at u- & v-points 246 243 !!---------------------------------------------------------------------- 247 INTEGER , INTENT(in ) :: kt ! ocean time-step index 248 INTEGER , INTENT(in ) :: kjpt ! number of tracers 249 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 250 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! hor. grad. of ptra at u- & v-pts 251 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui, pgtvi ! hor. grad. of stra at u- & v-pts (ISF) 252 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 253 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! hor. grad of prd at u- & v-pts (bottom) 254 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmru, pmrv ! hor. sum of prd at u- & v-pts (bottom) 255 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu, pgzv ! hor. grad of z at u- & v-pts (bottom) 256 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru, pge3rv ! hor. grad of prd weighted by local e3w at u- & v-pts (bottom) 257 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui, pgrvi ! hor. grad of prd at u- & v-pts (top) 258 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmrui, pmrvi ! hor. sum of prd at u- & v-pts (top) 259 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzui, pgzvi ! hor. grad of z at u- & v-pts (top) 260 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3rui, pge3rvi ! hor. grad of prd weighted by local e3w at u- & v-pts (top) 244 INTEGER , INTENT(in ) :: kt ! ocean time-step index 245 INTEGER , INTENT(in ) :: kjpt ! number of tracers 246 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pta ! 4D tracers fields 247 ! !! u-point ! v-point ! 248 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu , pgtv ! bottom GRADh( ptra ) 249 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtui , pgtvi ! top GRADh( ptra ) 250 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ), OPTIONAL :: prd ! 3D density anomaly fields 251 ! !! u-point ! v-point ! 252 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru , pgrv ! bottom GRADh( prd ) 253 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmru , pmrv ! bottom SUM ( prd ) 254 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzu , pgzv ! bottom GRADh( z ) 255 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3ru , pge3rv ! bottom GRADh( prd ) weighted by e3w 256 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgrui , pgrvi ! top GRADh( prd ) 257 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pmrui , pmrvi ! top SUM ( prd ) 258 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgzui , pgzvi ! top GRADh( z ) 259 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pge3rui , pge3rvi ! top GRADh( prd ) weighted by e3w 261 260 ! 262 261 INTEGER :: ji, jj, jn ! Dummy loop indices … … 269 268 IF( nn_timing == 1 ) CALL timing_start( 'zps_hde_isf') 270 269 ! 271 pgtu (:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;272 pgtui(:,:,:) =0.0_wp ; pgtvi(:,:,:)=0.0_wp ;273 zti (:,:,:)=0.0_wp ; ztj (:,:,:)=0.0_wp ;274 zhi (:,: )=0.0_wp ; zhj (:,: )=0.0_wp ;270 pgtu (:,:,:) = 0._wp ; pgtv (:,:,:) =0._wp 271 pgtui(:,:,:) = 0._wp ; pgtvi(:,:,:) =0._wp 272 zti (:,:,:) = 0._wp ; ztj (:,:,:) =0._wp 273 zhi (:,: ) = 0._wp ; zhj (:,: ) =0._wp 275 274 ! 276 275 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! … … 322 321 END DO 323 322 324 ! horizontal derivative of density anomalies (rd) 325 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 326 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; 327 pgzu(:,:)=0.0_wp ; pgzv(:,:)=0.0_wp ; 328 pmru(:,:)=0.0_wp ; pmru(:,:)=0.0_wp ; 329 pge3ru(:,:)=0.0_wp ; pge3rv(:,:)=0.0_wp ; 330 DO jj = 1, jpjm1 323 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 324 ! 325 pgru (:,:)=0._wp ; pgrv (:,:) = 0._wp 326 pgzu (:,:)=0._wp ; pgzv (:,:) = 0._wp 327 pmru (:,:)=0._wp ; pmru (:,:) = 0._wp 328 pge3ru(:,:)=0._wp ; pge3rv(:,:) = 0._wp 329 ! 330 DO jj = 1, jpjm1 ! depth of the partial step level 331 331 DO ji = 1, jpim1 332 332 iku = mbku(ji,jj) … … 334 334 ze3wu = (gdept_0(ji+1,jj,iku) - gdepw_0(ji+1,jj,iku)) - (gdept_0(ji,jj,iku) - gdepw_0(ji,jj,iku)) 335 335 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 336 336 ! 337 337 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) - ze3wu ! i-direction: case 1 338 338 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) + ze3wu ! - - case 2 … … 343 343 END DO 344 344 END DO 345 346 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 347 ! step and store it in zri, zrj for each case 348 CALL eos( zti, zhi, zri ) 349 CALL eos( ztj, zhj, zrj ) 350 351 ! Gradient of density at the last level 352 DO jj = 1, jpjm1 345 ! 346 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 347 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 348 349 DO jj = 1, jpjm1 ! Gradient of density at the last level 353 350 DO ji = 1, jpim1 354 351 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points … … 394 391 ! 395 392 END IF 396 ! (ISH) compute grui and gruvi 393 ! 394 ! !== (ISH) compute grui and gruvi ==! 395 ! 397 396 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! ! 398 397 DO jj = 1, jpjm1 … … 442 441 END DO 443 442 444 ! horizontal derivative of density anomalies (rd)445 IF( PRESENT( prd ) ) THEN ! depth of the partial step level443 IF( PRESENT( prd ) ) THEN !== horizontal derivative of density anomalies (rd) ==! (optional part) 444 ! 446 445 pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ; 447 446 pgzui(:,:) =0.0_wp ; pgzvi(:,:) =0.0_wp ; 448 447 pmrui(:,:) =0.0_wp ; pmrui(:,:) =0.0_wp ; 449 448 pge3rui(:,:)=0.0_wp ; pge3rvi(:,:)=0.0_wp ; 450 451 DO jj = 1, jpjm1 449 ! 450 DO jj = 1, jpjm1 ! depth of the partial step level 452 451 DO ji = 1, jpim1 453 452 iku = miku(ji,jj) … … 455 454 ze3wu = (gdepw_0(ji+1,jj,iku+1) - gdept_0(ji+1,jj,iku)) - (gdepw_0(ji,jj,iku+1) - gdept_0(ji,jj,iku)) 456 455 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 457 456 ! 458 457 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji+1,jj,iku) + ze3wu ! i-direction: case 1 459 458 ELSE ; zhi(ji,jj) = fsdept(ji ,jj,iku) - ze3wu ! - - case 2 … … 464 463 END DO 465 464 END DO 466 467 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 468 ! step and store it in zri, zrj for each case 469 CALL eos( zti, zhi, zri ) 470 CALL eos( ztj, zhj, zrj ) 471 472 ! Gradient of density at the last level 473 DO jj = 1, jpjm1 465 ! 466 CALL eos( zti, zhi, zri ) ! interpolated density from zti, ztj 467 CALL eos( ztj, zhj, zrj ) ! at the partial step depth output in zri, zrj 468 ! 469 DO jj = 1, jpjm1 ! Gradient of density at the last level 474 470 DO ji = 1, jpim1 475 471 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 … … 482 478 pmrui (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 483 479 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 484 485 480 & * ( (fse3w(ji+1,jj,iku+1) - ze3wu) * (zri(ji,jj ) + prd(ji+1,jj,iku+1) + 2._wp) & 481 & - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 486 482 ELSE 487 483 pgzui (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) … … 489 485 pmrui (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 490 486 pge3rui(ji,jj) = umask(ji,jj,iku+1) & 491 492 487 & * ( fse3w(ji+1,jj,iku+1) * (prd(ji+1,jj,iku) + prd(ji+1,jj,iku+1) + 2._wp) & 488 & -(fse3w(ji ,jj,iku+1) + ze3wu) * (zri(ji,jj ) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 2 493 489 ENDIF 494 490 IF( ze3wv >= 0._wp ) THEN … … 497 493 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 498 494 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 499 * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) &500 - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1495 & * ( (fse3w(ji,jj+1,ikv+1) - ze3wv) * ( zrj(ji,jj ) + prd(ji,jj+1,ikv+1) + 2._wp) & 496 & - fse3w(ji,jj ,ikv+1) * ( prd(ji,jj,ikv) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 1 501 497 ! + 2 due to the formulation in density and not in anomalie in hpg sco 502 498 ELSE … … 505 501 pmrvi (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 506 502 pge3rvi(ji,jj) = vmask(ji,jj,ikv+1) & 507 508 503 & * ( fse3w(ji,jj+1,ikv+1) * ( prd(ji,jj+1,ikv) + prd(ji,jj+1,ikv+1) + 2._wp) & 504 & -(fse3w(ji,jj ,ikv+1) + ze3wv) * ( zrj(ji,jj ) + prd(ji,jj ,ikv+1) + 2._wp) ) ! j: 2 509 505 ENDIF 510 506 END DO … … 517 513 END IF 518 514 ! 519 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde_isf')515 IF( nn_timing == 1 ) CALL timing_stop( 'zps_hde_isf') 520 516 ! 521 517 END SUBROUTINE zps_hde_isf -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdglo.F90
r5215 r5758 19 19 USE trd_oce ! trends: ocean variables 20 20 USE phycst ! physical constants 21 USE ldftra _oce! ocean active tracers: lateral physics21 USE ldftra ! ocean active tracers: lateral physics 22 22 USE ldfdyn_oce ! ocean dynamics: lateral physics 23 23 USE zdf_oce ! ocean vertical physics -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5737 r5758 17 17 !!gm USE dynhpg ! hydrostatic pressure gradient 18 18 USE zdfbfr ! bottom friction 19 USE ldftra _oce! ocean active tracers lateral physics19 USE ldftra ! ocean active tracers lateral physics 20 20 USE sbc_oce ! surface boundary condition: ocean 21 21 USE phycst ! physical constants -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl.F90
r5656 r5758 22 22 USE trd_oce ! trends: ocean variables 23 23 USE trdmxl_oce ! ocean variables trends 24 USE ldftra _oce ! ocean active tracers lateral physics24 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 25 25 USE zdf_oce ! ocean vertical physics 26 26 USE in_out_manager ! I/O manager … … 73 73 !! * Substitutions 74 74 # include "domzgr_substitute.h90" 75 # include "ldftra_substitute.h90"76 75 # include "zdfddm_substitute.h90" 77 76 !!---------------------------------------------------------------------- -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdpen.F90
r5656 r5758 17 17 USE trd_oce ! trends: ocean variables 18 18 USE eosbn2 ! equation of state and related derivatives 19 USE ldftra _oce! ocean active tracers lateral physics19 USE ldftra ! ocean active tracers lateral physics 20 20 USE zdfddm ! vertical physics: double diffusion 21 21 USE phycst ! physical constants -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r4990 r5758 23 23 USE trdpen ! trends: Potential ENergy 24 24 USE trdmxl ! ocean active mixed layer tracers trends 25 USE ldftra_oce ! ocean active tracers lateral physics 25 USE ldftra ! ocean active tracers lateral physics 26 USE ldfslp 26 27 USE zdfddm ! vertical physics: double diffusion 27 28 USE phycst ! physical constants 29 ! 28 30 USE in_out_manager ! I/O manager 29 31 USE iom ! I/O manager library -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfevd.F90
r4990 r5758 7 7 !! History : OPA ! 1997-06 (G. Madec, A. Lazar) Original code 8 8 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 9 !! - ! 2005-06 (C. Ethe) KPP parameterization10 9 !! 3.2 ! 2009-03 (M. Leclair, G. Madec, R. Benshila) test on both before & after 11 10 !!---------------------------------------------------------------------- … … 18 17 USE dom_oce ! ocean space and time domain variables 19 18 USE zdf_oce ! ocean vertical physics variables 20 USE zdfkpp ! KPP vertical mixing21 19 USE in_out_manager ! I/O manager 22 20 USE iom ! for iom_put … … 80 78 DO jj = 2, jpj ! no vector opt. 81 79 DO ji = 2, jpi 82 #if defined key_zdfkpp83 ! no evd mixing in the boundary layer with KPP84 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 .AND. fsdepw(ji,jj,jk) > hkpp(ji,jj) ) THEN85 #else86 80 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 87 #endif88 81 avt (ji ,jj ,jk) = rn_avevd * tmask(ji ,jj ,jk) 89 82 avm (ji ,jj ,jk) = rn_avevd * tmask(ji ,jj ,jk) … … 107 100 DO jj = 1, jpj ! loop over the whole domain (no lbc_lnk call) 108 101 DO ji = 1, jpi 109 #if defined key_zdfkpp110 ! no evd mixing in the boundary layer with KPP111 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 .AND. fsdepw(ji,jj,jk) > hkpp(ji,jj) ) &112 #else113 102 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 114 #endif115 103 avt(ji,jj,jk) = rn_avevd * tmask(ji,jj,jk) 116 104 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r5386 r5758 6 6 !! History : 8.0 ! 1997-06 (G. Madec) Original code from inimix 7 7 !! 1.0 ! 2002-08 (G. Madec) F90 : free form 8 !! - ! 2005-06 (C. Ethe) KPP parameterization9 8 !! - ! 2009-07 (G. Madec) add avmb, avtb in restart for cen2 advection 10 9 !!---------------------------------------------------------------------- … … 14 13 !!---------------------------------------------------------------------- 15 14 USE par_oce ! mesh and scale factors 16 USE ldftra_oce! ocean active tracers: lateral physics17 USE ldfdyn_oce ! ocean dynamics lateral physics15 !!gm USE ldftra ! ocean active tracers: lateral physics 16 !!gm USE ldfdyn_oce ! ocean dynamics lateral physics 18 17 USE zdf_oce ! TKE vertical mixing 19 18 USE lib_mpp ! distribued memory computing 20 19 USE zdftke ! TKE vertical mixing 21 20 USE zdfgls ! GLS vertical mixing 22 USE zdfkpp ! KPP vertical mixing23 21 USE zdfddm ! double diffusion mixing 24 22 USE zdfevd ! enhanced vertical diffusion … … 111 109 ioptio = ioptio+1 112 110 ENDIF 113 IF( lk_zdfkpp ) THEN114 IF(lwp) WRITE(numout,*) ' KPP dependent eddy coefficients'115 ioptio = ioptio+1116 ENDIF117 111 IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) & 118 112 & CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 119 IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp) .AND. ln_isfcav ) &113 IF( ( lk_zdfric .OR. lk_zdfgls ) .AND. ln_isfcav ) & 120 114 & CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' ) 121 115 ! … … 143 137 IF(lwp) WRITE(numout,*) ' use the GLS closure scheme' 144 138 ENDIF 145 IF( lk_zdfkpp ) THEN146 IF(lwp) WRITE(numout,*) ' use the KPP closure scheme'147 IF(lk_mpp) THEN148 IF(lwp) WRITE(numout,cform_err)149 IF(lwp) WRITE(numout,*) 'The KPP scheme is not ready to run in MPI'150 ENDIF151 ENDIF152 139 IF ( ioptio > 1 .AND. .NOT. lk_esopa ) CALL ctl_stop( ' chose between ln_zdfnpc and ln_zdfevd' ) 153 IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp) ) &154 CALL ctl_stop( ' except for TKE , GLS or KPPphysics, a convection scheme is', &140 IF( ioptio == 0 .AND. .NOT.( lk_zdftke .OR. lk_zdfgls ) ) & 141 CALL ctl_stop( ' except for TKE or GLS physics, a convection scheme is', & 155 142 & ' required: ln_zdfevd or ln_zdfnpc logicals' ) 156 143 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r5656 r5758 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 31 !! ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 34 !! 3.7 ! 2014-12 (G. Madec) suppression of cross land advection option 35 !! - ! 2014-12 (G. Madec) remove KPP scheme 32 36 !!---------------------------------------------------------------------- 33 37 … … 81 85 USE sbctide, ONLY: lk_tide 82 86 USE crsini ! initialise grid coarsening utility 83 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop! Setup of north fold exchanges87 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 84 88 USE sbc_oce, ONLY: lk_oasis 85 89 USE stopar … … 96 100 97 101 !!---------------------------------------------------------------------- 98 !! NEMO/OPA 4.0 , NEMO Consortium (2011)102 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 99 103 !! $Id$ 100 104 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 363 367 WRITE(numout,*) ' NEMO team' 364 368 WRITE(numout,*) ' Ocean General Circulation Model' 365 WRITE(numout,*) ' version 3. 6(2015) '369 WRITE(numout,*) ' version 3.7 (2015) ' 366 370 WRITE(numout,*) 367 371 WRITE(numout,*) … … 396 400 CALL dom_cfg ! Domain configuration 397 401 CALL dom_init ! Domain 398 399 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 400 402 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 403 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) 401 404 IF( ln_ctl ) CALL prt_ctl_init ! Print control 402 403 405 CALL istate_init ! ocean initial state (Dynamics and tracers) 404 406 405 IF( lk_tide ) CALL tide_init( nit000 ) ! Initialisation of the tidal harmonics 406 407 CALL sbc_init ! Forcings : surface module (clem: moved here for bdy purpose) 408 407 ! ! external forcing 408 !!gm to be added : creation and call of sbc_apr_init 409 IF( lk_tide ) CALL tide_init( nit000 ) ! tidal harmonics 410 CALL sbc_init ! surface boundary conditions (including sea-ice) 411 !!gm ==>> bdy_init should call bdy_dta_init and bdytide_init NOT nemogcm !!! 409 412 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 410 413 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays 411 414 IF( lk_bdy .AND. lk_tide ) & 412 415 & CALL bdytide_init ! Open boundaries initialisation of tidal harmonic forcing 413 414 CALL dyn_nept_init ! simplified form of Neptune effect 415 ! 416 IF( ln_crs ) CALL crs_init ! Domain initialization of coarsened grid 417 ! 418 ! Ocean physics 416 417 ! ! Ocean physics 419 418 ! ! Vertical physics 420 419 CALL zdf_init ! namelist read … … 423 422 IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme 424 423 IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme 425 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme426 424 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 427 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) &428 & CALL zdf_ddm_init ! double diffusive mixing425 IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing 426 429 427 ! ! Lateral physics 430 428 CALL ldf_tra_init ! Lateral ocean tracer physics 429 CALL ldf_eiv_init ! eddy induced velocity param. 431 430 CALL ldf_dyn_init ! Lateral ocean momentum physics 432 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 433 434 ! ! Active tracers 435 CALL tra_qsr_init ! penetrative solar radiation qsr 436 CALL tra_bbc_init ! bottom heat flux 437 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 438 CALL tra_dmp_init ! internal damping trends- tracers 439 CALL tra_adv_init ! horizontal & vertical advection 440 CALL tra_ldf_init ! lateral mixing 441 CALL tra_zdf_init ! vertical mixing and after tracer fields 442 443 ! ! Dynamics 444 IF( lk_c1d ) CALL dyn_dmp_init ! internal damping trends- momentum 445 CALL dyn_adv_init ! advection (vector or flux form) 446 CALL dyn_vor_init ! vorticity term including Coriolis 447 CALL dyn_ldf_init ! lateral mixing 448 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 449 CALL dyn_zdf_init ! vertical diffusion 450 CALL dyn_spg_init ! surface pressure gradient 451 452 ! ! Misc. options 431 432 ! ! Active tracers 433 CALL tra_qsr_init ! penetrative solar radiation qsr 434 CALL tra_bbc_init ! bottom heat flux 435 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 436 CALL tra_dmp_init ! internal tracer damping 437 CALL tra_adv_init ! horizontal & vertical advection 438 CALL tra_ldf_init ! lateral mixing 439 CALL tra_zdf_init ! vertical mixing and after tracer fields 440 441 ! ! Dynamics 442 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 443 CALL dyn_adv_init ! advection (vector or flux form) 444 CALL dyn_vor_init ! vorticity term including Coriolis 445 CALL dyn_ldf_init ! lateral mixing 446 CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure 447 CALL dyn_zdf_init ! vertical diffusion 448 CALL dyn_spg_init ! surface pressure gradient 449 450 #if defined key_top 451 ! ! Passive tracers 452 CALL trc_init 453 #endif 454 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 455 456 ! ! Icebergs 457 CALL icb_init( rdt, nit000) ! initialise icebergs instance 458 459 ! ! Misc. options 453 460 IF( nn_cla == 1 .AND. cp_cfg == 'orca' .AND. jp_cfg == 2 ) CALL cla_init ! Cross Land Advection 454 CALL icb_init( rdt, nit000) ! initialise icebergs instance455 461 CALL sto_par_init ! Stochastic parametrization 456 462 IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations 457 463 458 #if defined key_top 459 ! ! Passive tracers 460 CALL trc_init 461 #endif 462 ! ! Diagnostics 464 ! ! Diagnostics 463 465 IF( lk_floats ) CALL flo_init ! drifting Floats 464 466 IF( lk_diaar5 ) CALL dia_ar5_init ! ar5 diag … … 471 473 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 472 474 ENDIF 473 474 ! ! Assimilation increments 475 ! ! Assimilation increments 475 476 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 476 477 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 610 611 IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports 611 612 IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports 612 613 613 ! 614 614 numout = 6 ! redefine numout in case it is used after this point... … … 628 628 USE dom_oce , ONLY: dom_oce_alloc 629 629 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc 630 USE ldftra_oce, ONLY: ldftra_oce_alloc631 630 USE trc_oce , ONLY: trc_oce_alloc 632 631 #if defined key_diadct … … 644 643 ierr = ierr + dom_oce_alloc () ! ocean domain 645 644 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics 646 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers647 645 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 648 646 ! … … 726 724 INTEGER, DIMENSION(ntest) :: ilfax 727 725 !!---------------------------------------------------------------------- 726 ! 728 727 ! lfax contains the set of allowed factors. 729 728 ilfax(:) = (/(2**jl,jl=ntest,1,-1)/) 730 729 ! 731 730 ! Clear the error flag and initialise output vars 732 kerr = 0733 kfax = 1731 kerr = 0 732 kfax = 1 734 733 knfax = 0 735 734 ! 736 735 ! Find the factors of n. 737 736 IF( kn == 1 ) GOTO 20 … … 741 740 ! l points to the allowed factor list. 742 741 ! ifac holds the current factor. 743 742 ! 744 743 inu = kn 745 744 knfax = 0 746 745 ! 747 746 DO jl = ntest, 1, -1 748 747 ! … … 768 767 ! 769 768 END DO 770 769 ! 771 770 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 772 771 ! … … 776 775 777 776 SUBROUTINE nemo_northcomms 778 !! ======================================================================777 !!---------------------------------------------------------------------- 779 778 !! *** ROUTINE nemo_northcomms *** 780 !! nemo_northcomms : Setup for north fold exchanges with explicit 781 !! point-to-point messaging 782 !!===================================================================== 783 !!---------------------------------------------------------------------- 784 !! 785 !! ** Purpose : Initialization of the northern neighbours lists. 779 !! ** Purpose : Setup for north fold exchanges with explicit 780 !! point-to-point messaging 781 !! 782 !! ** Method : Initialization of the northern neighbours lists. 786 783 !!---------------------------------------------------------------------- 787 784 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 788 785 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 789 786 !!---------------------------------------------------------------------- 790 791 787 INTEGER :: sxM, dxM, sxT, dxT, jn 792 788 INTEGER :: njmppmax 789 !!---------------------------------------------------------------------- 793 790 794 791 njmppmax = MAXVAL( njmppt ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/oce.F90
r4990 r5758 16 16 PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 17 17 18 LOGICAL, PUBLIC :: l_traldf_rot = .FALSE. !: rotated laplacian operator for lateral diffusion19 18 20 19 !! dynamics and tracer fields ! before ! now ! after ! the after trends becomes the fields -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step.F90
r5656 r5758 24 24 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 25 25 !! 3.4 ! 2011-04 (G. Madec, C. Ethe) Merge of dtatem and dtasal 26 !! ! 2012-07 (J. Simeon, G. Madec, C. Ethe) Online coarsening of outputs 27 !! 3.7 ! 2014-04 (F. Roquet, G. Madec) New equations of state 26 !! 3.6 ! 2012-07 (J. Simeon, G. Madec. C. Ethe) Online coarsening of outputs 27 !! 3.6 ! 2014-04 (F. Roquet, G. Madec) New equations of state 28 !! 3.7 ! 2014-10 (G. Madec) LDF simplication 29 !! - ! 2014-12 (G. Madec) remove KPP scheme 28 30 !!---------------------------------------------------------------------- 29 31 … … 37 39 PRIVATE 38 40 39 PUBLIC stp ! called by opa.F9041 PUBLIC stp ! called by nemogcm.F90 40 42 41 43 !! * Substitutions … … 43 45 !!gm # include "zdfddm_substitute.h90" 44 46 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3.7 , NEMO Consortium (201 4)47 !! NEMO/OPA 3.7 , NEMO Consortium (2015) 46 48 !! $Id$ 47 49 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 76 78 INTEGER :: kcall ! optional integer argument (dom_vvl_sf_nxt) 77 79 !! --------------------------------------------------------------------- 78 79 80 #if defined key_agrif 80 81 kstp = nit000 + Agrif_Nb_Step() 81 IF ( lk_agrif_debug ) THEN 82 IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 83 IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp, 'int tstep',Agrif_NbStepint() 84 ENDIF 85 86 IF ( kstp == (nit000 + 1) ) lk_agrif_fstep = .FALSE. 87 82 IF( lk_agrif_debug ) THEN 83 IF( Agrif_Root() .and. lwp) WRITE(*,*) '---' 84 IF(lwp) WRITE(*,*) 'Grid Number', Agrif_Fixed(),' time step ', kstp, 'int tstep', Agrif_NbStepint() 85 ENDIF 86 IF( kstp == nit000 + 1 ) lk_agrif_fstep = .FALSE. 88 87 # if defined key_iomput 89 88 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 90 89 # endif 91 90 #endif 92 indic = 0 ! reset to no error condition 93 IF( kstp == nit000 ) THEN 94 ! must be done after nemo_init for AGRIF+XIOS+OASIS 95 CALL iom_init( cxios_context ) ! iom_put initialization 96 IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! initialize context for coarse grid 97 ENDIF 98 91 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 92 ! update I/O and calendar 93 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 94 indic = 0 ! reset to no error condition 95 96 IF( kstp == nit000 ) THEN ! initialize IOM context (must be done after nemo_init for AGRIF+XIOS+OASIS) 97 CALL iom_init( cxios_context ) ! for model grid (including passible AGRIF zoom) 98 IF( ln_crs ) CALL iom_init( TRIM(cxios_context)//"_crs" ) ! for coarse grid 99 ENDIF 99 100 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 100 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 101 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp 102 103 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 104 ! Update data, open boundaries, surface boundary condition (including sea-ice) 105 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 106 IF( lk_tide ) CALL sbc_tide( kstp ) 107 IF( lk_bdy ) THEN 108 IF( ln_apr_dyn) CALL sbc_apr( kstp ) ! bdy_dta needs ssh_ib 109 CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 110 ENDIF 111 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 112 ! clem: moved here for bdy ice purpose 101 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell IOM we are at time step kstp 102 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell IOM we are at time step kstp 103 104 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 105 ! Update external forcing (tides, open boundaries, and surface boundary condition (including sea-ice) 106 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 107 IF( lk_tide ) CALL sbc_tide( kstp ) ! update tide potential 108 IF( ln_apr_dyn ) CALL sbc_apr ( kstp ) ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 109 IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 110 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 111 CALL FLUSH ( numout ) 113 112 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 114 113 ! Update stochastic parameters and random T/S fluctuations 115 114 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 116 CALL sto_par( kstp ) ! Stochastic parameters 115 CALL sto_par( kstp ) ! Stochastic parameters 116 CALL FLUSH ( numout ) 117 117 118 118 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 124 124 CALL bn2 ( tsb, rab_b, rn2b ) ! before Brunt-Vaisala frequency 125 125 CALL bn2 ( tsn, rab_n, rn2 ) ! now Brunt-Vaisala frequency 126 CALL FLUSH ( numout ) 126 127 ! 127 128 ! VERTICAL PHYSICS … … 131 132 IF( lk_zdftke ) CALL zdf_tke( kstp ) ! TKE closure scheme for Kz 132 133 IF( lk_zdfgls ) CALL zdf_gls( kstp ) ! GLS closure scheme for Kz 133 IF( lk_zdfkpp ) CALL zdf_kpp( kstp ) ! KPP closure scheme for Kz134 134 IF( lk_zdfcst ) THEN ! Constant Kz (reset avt, avm[uv] to the background value) 135 135 avt (:,:,:) = rn_avt0 * wmask (:,:,:) … … 137 137 avmv(:,:,:) = rn_avm0 * wvmask(:,:,:) 138 138 ENDIF 139 CALL FLUSH ( numout ) 139 140 IF( ln_rnf_mouth ) THEN ! increase diffusivity at rivers mouths 140 DO jk = 2, nkrnf ; avt(:,:,jk) = avt(:,:,jk) + 2. e0* rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk) ; END DO141 DO jk = 2, nkrnf ; avt(:,:,jk) = avt(:,:,jk) + 2._wp * rn_avt_rnf * rnfmsk(:,:) * tmask(:,:,jk) ; END DO 141 142 ENDIF 142 143 IF( ln_zdfevd ) CALL zdf_evd( kstp ) ! enhanced vertical eddy diffusivity … … 144 145 IF( lk_zdftmx ) CALL zdf_tmx( kstp ) ! tidal vertical mixing 145 146 146 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 147 & CALL zdf_ddm( kstp ) ! double diffusive mixing 147 IF( lk_zdfddm ) CALL zdf_ddm( kstp ) ! double diffusive mixing 148 148 149 149 CALL zdf_mxl( kstp ) ! mixed layer depth … … 152 152 IF( lrst_oce .AND. lk_zdftke ) CALL tke_rst( kstp, 'WRITE' ) 153 153 IF( lrst_oce .AND. lk_zdfgls ) CALL gls_rst( kstp, 'WRITE' ) 154 CALL FLUSH ( numout ) 154 155 ! 155 156 ! LATERAL PHYSICS 156 157 ! 157 IF( lk_ldfslp ) THEN ! slope of lateral mixing 158 IF( l_ldfslp ) THEN ! slope of lateral mixing 159 !!gm : why this here ???? 158 160 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 161 !!gm 159 162 CALL eos( tsb, rhd, gdept_0(:,:,:) ) ! before in situ density 163 160 164 IF( ln_zps .AND. .NOT. ln_isfcav) & 161 165 & CALL zps_hde ( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 162 166 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 167 163 168 IF( ln_zps .AND. ln_isfcav) & 164 & CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps for top cell (ISF)169 & CALL zps_hde_isf( kstp, jpts, tsb, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top cell (ISF) 165 170 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 166 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 167 IF( ln_traldf_grif ) THEN ! before slope for Griffies operator 168 CALL ldf_slp_grif( kstp ) 169 ELSE 170 CALL ldf_slp( kstp, rhd, rn2b ) ! before slope for Madec operator 171 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level 172 173 IF( ln_traldf_triad ) THEN 174 CALL ldf_slp_triad( kstp ) ! before slope for triad operator 175 ELSE 176 CALL ldf_slp ( kstp, rhd, rn2b ) ! before slope for standard operator 171 177 ENDIF 172 178 ENDIF 173 #if defined key_traldf_c2d 174 IF( lk_traldf_eiv ) CALL ldf_eiv( kstp ) ! eddy induced velocity coefficient 175 #endif 176 #if defined key_traldf_c3d && defined key_traldf_smag 177 CALL ldf_tra_smag( kstp ) ! eddy induced velocity coefficient 178 # endif 179 #if defined key_dynldf_c3d && defined key_dynldf_smag 180 CALL ldf_dyn_smag( kstp ) ! eddy induced velocity coefficient 181 # endif 179 ! ! eddy diffusivity coeff. and/or eiv coeff. 180 IF( l_ldftra_time .OR. l_ldfeiv_time ) CALL ldf_tra( kstp ) 181 write(*,*) 'after ldf_slp' 182 CALL FLUSH ( numout ) 182 183 183 184 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 187 188 IF( lk_vvl ) CALL dom_vvl_sf_nxt( kstp ) ! after vertical scale factors 188 189 CALL wzv ( kstp ) ! now cross-level velocity 190 write(*,*) 'after wzv' 191 CALL FLUSH ( numout ) 189 192 190 193 IF( lk_dynspg_ts ) THEN … … 192 195 ! Note that the computation of vertical velocity above, hence "after" sea level 193 196 ! is necessary to compute momentum advection for the rhs of barotropic loop: 197 !!gm : why also here ???? 194 198 IF(ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 199 !!gm 195 200 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 196 IF( ln_zps .AND. .NOT. ln_isfcav) & 197 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: before horizontal gradient 198 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 199 IF( ln_zps .AND. ln_isfcav) & 200 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps for top cell (ISF) 201 202 IF( ln_zps .AND. .NOT. ln_isfcav) & ! Partial steps: bottom before horizontal gradient 203 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! of t, s, rd at the last ocean level 204 & rhd, gru , grv ) 205 IF( ln_zps .AND. ln_isfcav) & ! Partial steps: top & bottom before horizontal gradient 206 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & 201 207 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 202 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level203 204 ua(:,:,:) = 0. e0! set dynamics trends to zero205 va(:,:,:) = 0. e0208 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 209 210 ua(:,:,:) = 0._wp ! set dynamics trends to zero 211 va(:,:,:) = 0._wp 206 212 IF( lk_asminc .AND. ln_asmiau .AND. & 207 213 & ln_dyninc ) CALL dyn_asm_inc ( kstp ) ! apply dynamics assimilation increment … … 225 231 CALL wzv ( kstp ) ! now cross-level velocity 226 232 ENDIF 233 write(*,*) 'after wzv 2' 234 CALL FLUSH ( numout ) 227 235 228 236 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 229 237 ! diagnostics and outputs (ua, va, tsa used as workspace) 230 238 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 231 IF( lk_floats ) 232 IF( lk_diahth ) 233 IF( .NOT. ln_cpl )CALL dia_fwb( kstp ) ! Fresh water budget diagnostics234 IF( lk_diadct ) 235 IF( lk_diaar5 ) 236 IF( lk_diaharm ) 237 238 ! 239 IF( ln_crs ) 239 IF( lk_floats ) CALL flo_stp( kstp ) ! drifting Floats 240 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20 degres isotherm depth) 241 IF(.NOT.ln_cpl ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 242 IF( lk_diadct ) CALL dia_dct( kstp ) ! Transports 243 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 244 IF( lk_diaharm ) CALL dia_harm( kstp ) ! Tidal harmonic analysis 245 CALL dia_wri( kstp ) ! ocean model: outputs 246 ! 247 IF( ln_crs ) CALL crs_fld( kstp ) ! ocean model: online field coarsening & output 240 248 241 249 #if defined key_top … … 245 253 CALL trc_stp( kstp ) ! time-stepping 246 254 #endif 247 255 write(*,*) 'end dyn ' 256 CALL FLUSH ( numout ) 248 257 249 258 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 250 259 ! Active tracers (ua, va used as workspace) 251 260 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 252 tsa(:,:,:,:) = 0. e0! set tracer trends to zero261 tsa(:,:,:,:) = 0._wp ! set tracer trends to zero 253 262 254 263 IF( lk_asminc .AND. ln_asmiau .AND. & … … 261 270 IF( lk_bdy ) CALL bdy_tra_dmp( kstp ) ! bdy damping trends 262 271 CALL tra_adv ( kstp ) ! horizontal & vertical advection 263 IF( lk_zdfkpp ) CALL tra_kpp ( kstp ) ! KPP non-local tracer fluxes 272 write(*,*) 'before tra_ldf' 273 CALL FLUSH ( numout ) 264 274 CALL tra_ldf ( kstp ) ! lateral mixing 265 275 write(*,*) 'after tra_ldf' 276 CALL FLUSH ( numout ) 277 278 !!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 266 279 IF( ln_diaptr ) CALL dia_ptr ! Poleward adv/ldf TRansports diagnostics 280 !!gm 267 281 268 282 #if defined key_agrif … … 274 288 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 275 289 CALL tra_nxt( kstp ) ! tracer fields at next time step 290 !!gm : why again a call to sto_pts ??? 276 291 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 292 !!gm 277 293 CALL eos ( tsa, rhd, rhop, fsdept_n(:,:,:) ) ! Time-filtered in situ density for hpg computation 278 294 IF( ln_zps .AND. .NOT. ln_isfcav) & … … 280 296 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 281 297 IF( ln_zps .AND. ln_isfcav) & 282 & CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps for top cell (ISF)298 & CALL zps_hde_isf( kstp, jpts, tsa, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top/bottom cells 283 299 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 284 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level300 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) 285 301 ELSE ! centered hpg (eos then time stepping) 286 302 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case 303 !!gm : why again a call to sto_pts ??? 287 304 IF( ln_sto_eos ) CALL sto_pts( tsn ) ! Random T/S fluctuations 305 !!gm 288 306 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) ! now in situ density for hpg computation 289 307 IF( ln_zps .AND. .NOT. ln_isfcav) & 290 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: b efore horizontal gradient291 & rhd, gru , grv ) ! of t, s, rd at the last ocean level308 & CALL zps_hde ( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: bottom before horizontal gradient 309 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 292 310 IF( ln_zps .AND. ln_isfcav) & 293 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps for top cell (ISF)311 & CALL zps_hde_isf( kstp, jpts, tsn, gtsu, gtsv, gtui, gtvi, & ! Partial steps for top/bottom cells 294 312 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 295 & g tui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level313 & grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 296 314 ENDIF 297 315 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 298 316 CALL tra_nxt( kstp ) ! tracer fields at next time step 299 317 ENDIF 318 write(*,*) 'after tra_nxt' 319 CALL FLUSH ( numout ) 300 320 301 321 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 315 335 CALL dyn_zdf( kstp ) ! vertical diffusion 316 336 ELSE 317 ua(:,:,:) = 0. e0! set dynamics trends to zero318 va(:,:,:) = 0. e0337 ua(:,:,:) = 0._wp ! set dynamics trends to zero 338 va(:,:,:) = 0._wp 319 339 320 340 IF( lk_asminc .AND. ln_asmiau .AND. & … … 340 360 IF( lk_vvl ) CALL dom_vvl_sf_swp( kstp ) ! swap of vertical scale factors 341 361 ! 362 write(*,*) 'after dom_vvl' 363 CALL FLUSH ( numout ) 364 365 366 !!gm : This does not only concern the dynamics ==>>> add a new title 367 !!gm2: why ouput restart before AGRIF update? 342 368 IF( lrst_oce ) CALL rst_write( kstp ) ! write output ocean restart file 343 369 … … 367 393 CALL iom_close( numror ) ! close input ocean restart file 368 394 IF(lwm) CALL FLUSH ( numond ) ! flush output namelist oce 369 IF( lwm.AND.numoni /= -1 ) CALL FLUSH ( numoni ) ! flush output namelist ice 395 IF(lwm.AND.numoni /= -1 ) & 396 & CALL FLUSH ( numoni ) ! flush output namelist ice (if exist) 370 397 ENDIF 371 398 … … 373 400 ! Coupled mode 374 401 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 402 !!gm why lk_oasis and not lk_cpl ???? 375 403 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 376 404 ! … … 383 411 ! 384 412 IF( nn_timing == 1 .AND. kstp == nit000 ) CALL timing_reset 385 !386 413 ! 387 414 END SUBROUTINE stp -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r5656 r5758 9 9 USE dom_oce ! ocean space and time domain variables 10 10 USE zdf_oce ! ocean vertical physics variables 11 USE ldftra _oce! ocean tracer - trends11 USE ldftra ! ocean tracer - trends 12 12 USE ldfdyn_oce ! ocean dynamics - trends 13 13 USE divcur ! hor. divergence and curl (div & cur routines) … … 22 22 USE daymod ! calendar (day routine) 23 23 24 USE sbcmod ! surface boundary condition (sbc routine)25 USE sbcrnf ! surface boundary condition: runoff variables26 USE sbccpl ! surface boundary condition: coupled formulation (call send at end of step)27 24 USE sbc_oce ! surface boundary condition: ocean 28 USE sbctide ! Tide initialisation 29 USE sbcapr ! surface boundary condition: ssh_ib required by bdydta 25 USE sbcrnf ! - - - : runoff variables 26 USE sbcmod ! - - - (sbc routine) 27 USE sbcapr ! - - - (sbc_apr routine) 28 USE sbctide ! - - - (sbc_tide routine) 29 USE sbccpl ! - - - : coupled formulation (call send at end of step) 30 30 31 31 USE traqsr ! solar radiation penetration (tra_qsr routine) … … 36 36 USE traadv ! advection scheme control (tra_adv_ctl routine) 37 37 USE traldf ! lateral mixing (tra_ldf routine) 38 ! zdfkpp ! KPP non-local tracer fluxes (tra_kpp routine)39 38 USE trazdf ! vertical mixing (tra_zdf routine) 40 39 USE tranxt ! time-stepping (tra_nxt routine) … … 71 70 72 71 USE ldfslp ! iso-neutral slopes (ldf_slp routine) 73 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)74 USE ldftra_smag ! Smagirinsky diffusion (ldftra_smag routine)75 USE ldfdyn_smag ! Smagorinsky viscosity (ldfdyn_smag routine)76 72 77 73 USE zdftmx ! tide-induced vertical mixing (zdf_tmx routine) … … 79 75 USE zdftke ! TKE vertical mixing (zdf_tke routine) 80 76 USE zdfgls ! GLS vertical mixing (zdf_gls routine) 81 USE zdfkpp ! KPP vertical mixing (zdf_kpp routine)82 77 USE zdfddm ! double diffusion mixing (zdf_ddm routine) 83 78 USE zdfevd ! enhanced vertical diffusion (zdf_evd routine) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r5385 r5758 25 25 USE traadv_eiv ! eddy induced velocity (tra_adv_eiv routine) 26 26 USE traadv_mle ! ML eddy induced velocity (tra_adv_mle routine) 27 USE ldftra _oce! lateral diffusion coefficient on tracers27 USE ldftra ! lateral diffusion coefficient on tracers 28 28 USE prtctl_trc ! Print control 29 29 … … 68 68 !! ** Method : - Update the tracer with the advection term following nadv 69 69 !!---------------------------------------------------------------------- 70 !!71 70 INTEGER, INTENT(in) :: kt ! ocean time-step index 72 71 ! … … 76 75 !!---------------------------------------------------------------------- 77 76 ! 78 IF( nn_timing == 1 ) CALL timing_start('trc_adv')77 IF( nn_timing == 1 ) CALL timing_start('trc_adv') 79 78 ! 80 CALL wrk_alloc( jpi, jpj, jpk,zun, zvn, zwn )79 CALL wrk_alloc( jpi,jpj,jpk, zun, zvn, zwn ) 81 80 ! 82 81 … … 88 87 r2dt(:) = 2. * rdttrc(:) ! = 2 rdttrc (leapfrog) 89 88 ENDIF 90 ! ! effective transport 89 ! !== effective transport ==! 90 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 91 zvn(:,:,jpk) = 0._wp 92 zwn(:,:,jpk) = 0._wp 91 93 DO jk = 1, jpkm1 92 ! ! eulerian transport only 93 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) 94 zun(:,:,jk) = e2u (:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport 94 95 zvn(:,:,jk) = e1v (:,:) * fse3v(:,:,jk) * vn(:,:,jk) 95 96 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 96 !97 97 END DO 98 98 ! 99 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 99 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 100 100 zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 101 101 zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 102 102 ENDIF 103 103 ! 104 zun(:,:,jpk) = 0._wp ! no transport trough the bottom 105 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 106 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 107 108 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) 109 & CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 104 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 105 & CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the eiv transport 110 106 ! 111 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport (if necessary) 107 IF( ln_mle ) CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' ) ! add the mle transport 108 ! 112 109 ! 113 110 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 111 ! 114 112 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 115 113 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD … … 119 117 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 120 118 ! 121 CASE (-1 ) !== esopa: test all possibility with control print ==!122 CALL tra_adv_cen2 ( kt, nittrc000, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )123 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout)124 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')125 CALL tra_adv_tvd ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )126 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout)127 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')128 CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra, ln_trcadv_msc_ups )129 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout)130 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')131 CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )132 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout)133 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')134 CALL tra_adv_ubs ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )135 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout)136 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')137 CALL tra_adv_qck ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )138 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout)139 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd')140 !141 119 END SELECT 142 143 ! ! print mean trends (used for debugging) 144 IF( ln_ctl ) THEN 120 ! 121 IF( ln_ctl ) THEN !== print mean trends (used for debugging) 145 122 WRITE(charout, FMT="('adv ')") ; CALL prt_ctl_trc_info(charout) 146 123 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 147 124 END IF 148 125 ! 149 CALL wrk_dealloc( jpi, jpj, jpk,zun, zvn, zwn )126 CALL wrk_dealloc( jpi,jpj,jpk, zun, zvn, zwn ) 150 127 ! 151 128 IF( nn_timing == 1 ) CALL timing_stop('trc_adv') … … 163 140 INTEGER :: ioptio 164 141 !!---------------------------------------------------------------------- 165 142 ! 166 143 ioptio = 0 ! Parameter control 167 144 IF( ln_trcadv_cen2 ) ioptio = ioptio + 1 … … 171 148 IF( ln_trcadv_ubs ) ioptio = ioptio + 1 172 149 IF( ln_trcadv_qck ) ioptio = ioptio + 1 173 IF( lk_esopa ) ioptio = 1 174 150 ! 175 151 IF( ioptio /= 1 ) CALL ctl_stop( 'Choose ONE advection scheme in namelist namtrc_adv' ) 176 152 ! 177 153 ! ! Set nadv 178 154 IF( ln_trcadv_cen2 ) nadv = 1 … … 182 158 IF( ln_trcadv_ubs ) nadv = 5 183 159 IF( ln_trcadv_qck ) nadv = 6 184 IF( lk_esopa ) nadv = -1 185 160 ! 186 161 IF(lwp) THEN ! Print the choice 187 162 WRITE(numout,*) … … 192 167 IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used' 193 168 IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used' 194 IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme'195 169 ENDIF 196 170 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r5385 r5758 4 4 !! Ocean Passive tracers : lateral diffusive trends 5 5 !!===================================================================== 6 !! History : 9.0 ! 2005-11 (G. Madec) Original code 7 !! NEMO 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 6 !! History : 1.0 ! 2005-11 (G. Madec) Original code 7 !! 3.0 ! 2008-01 (C. Ethe, G. Madec) merge TRC-TRA 8 !! 3.7 ! 2014-03 (G. Madec) LDF simplification 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_top … … 11 12 !! 'key_top' TOP models 12 13 !!---------------------------------------------------------------------- 13 !!---------------------------------------------------------------------- 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! ldf_ctl : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE oce_trc ! ocean dynamics and active tracers 18 USE trc ! ocean passive tracers variables 19 USE trcnam_trp ! passive tracers transport namelist variables 20 USE ldftra_oce ! lateral diffusion coefficient on tracers 21 USE ldfslp ! ??? 22 USE traldf_bilapg ! lateral mixing (tra_ldf_bilapg routine) 23 USE traldf_bilap ! lateral mixing (tra_ldf_bilap routine) 24 USE traldf_iso ! lateral mixing (tra_ldf_iso routine) 25 USE traldf_iso_grif ! lateral mixing (tra_ldf_iso_grif routine) 26 USE traldf_lap ! lateral mixing (tra_ldf_lap routine) 27 USE trd_oce 28 USE trdtra 14 !! trc_ldf : update the tracer trend with the lateral diffusion 15 !! ldf_ctl : initialization, namelist read, and parameters control 16 !!---------------------------------------------------------------------- 17 USE trc ! ocean passive tracers variables 18 USE oce_trc ! ocean dynamics and active tracers 19 USE trcnam_trp ! passive tracers transport namelist variables 20 USE ldfslp ! lateral diffusion: iso-neutral slope 21 USE traldf_lap ! lateral diffusion: laplacian iso-level operator (tra_ldf_lap routine) 22 USE traldf_iso ! lateral diffusion: laplacian iso-neutral standard operator (tra_ldf_iso routine) 23 USE traldf_triad ! lateral diffusion: laplacian iso-neutral triad operator (tra_ldf_triad routine) 24 USE traldf_blp ! lateral diffusion (iso-level lap/blp) (tra_ldf_lap routine) 25 USE trd_oce ! trends: ocean variables 26 USE trdtra ! trends manager: tracers 27 ! 29 28 USE prtctl_trc ! Print control 30 29 … … 32 31 PRIVATE 33 32 34 PUBLIC trc_ldf ! called by step.F9033 PUBLIC trc_ldf ! called by trctrp.F90 35 34 ! !!: ** lateral mixing namelist (nam_trcldf) ** 36 35 REAL(wp) :: rldf_rat ! ratio between active and passive tracers diffusive coefficient 37 36 INTEGER :: nldf = 0 ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 37 38 38 !! * Substitutions 39 39 # include "domzgr_substitute.h90" 40 40 # include "vectopt_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)42 !! NEMO/TOP 3.7 , NEMO Consortium (2014) 43 43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 45 45 !!---------------------------------------------------------------------- 46 47 46 CONTAINS 48 47 … … 58 57 INTEGER :: jn 59 58 CHARACTER (len=22) :: charout 59 REAL(wp), POINTER, DIMENSION(:,:,:) :: zahu, zahv 60 60 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrtrd 61 61 !!---------------------------------------------------------------------- … … 63 63 IF( nn_timing == 1 ) CALL timing_start('trc_ldf') 64 64 ! 65 66 !!gm this call should be put in trcini ! 65 67 IF( kt == nittrc000 ) CALL ldf_ctl ! initialisation & control of options 66 67 rldf = rldf_rat 68 !!gm end 68 69 69 70 IF( l_trdtrc ) THEN 70 CALL wrk_alloc( jpi, jpj, jpk, jptra,ztrtrd )71 CALL wrk_alloc( jpi,jpj,jpk,jptra, ztrtrd ) 71 72 ztrtrd(:,:,:,:) = tra(:,:,:,:) 72 73 ENDIF 73 74 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian 76 CASE ( 1 ) ! rotated laplacian 77 IF( ln_traldf_grif ) THEN 78 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 ELSE 80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian 83 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 84 ! 85 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 87 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 88 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 89 IF( ln_traldf_grif ) THEN 90 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 91 ELSE 92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 93 ENDIF 94 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 97 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 99 CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) 100 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 101 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 75 ! ! set the lateral diffusivity coef. for passive tracer 76 CALL wrk_alloc( jpi,jpj,jpk, zahu, zahv ) 77 zahu(:,:,:) = rldf_rat * ahtu(:,:,:) 78 zahv(:,:,:) = rldf_rat * ahtv(:,:,:) 79 80 SELECT CASE ( nldf ) !* compute lateral mixing trend and add it to the general trend 81 ! 82 CASE ( n_lap ) ! iso-level laplacian 83 CALL tra_ldf_lap ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, 1 ) 84 ! 85 CASE ( n_lap_i ) ! laplacian : standard iso-neutral operator (Madec) 86 CALL tra_ldf_iso ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 87 ! 88 CASE ( n_lap_it ) ! laplacian : triad iso-neutral operator (griffies) 89 CALL tra_ldf_triad( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb, trb, tra, jptra, 1 ) 90 ! 91 CASE ( n_blp , n_blp_i , n_blp_it ) ! bilaplacian: all operator (iso-level, -neutral) 92 CALL tra_ldf_blp ( kt, nittrc000,'TRC', zahu, zahv, gtru, gtrv, gtrui, gtrvi, trb , tra, jptra, nldf ) 93 ! 102 94 END SELECT 103 95 ! 104 IF( l_trdtrc ) THEN 96 IF( l_trdtrc ) THEN ! save the horizontal diffusive trends for further diagnostics 105 97 DO jn = 1, jptra 106 98 ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) … … 109 101 CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 110 102 ENDIF 111 ! ! print mean trends (used for debugging) 112 IF( ln_ctl ) THEN 113 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 114 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 115 ENDIF 103 ! ! print mean trends (used for debugging) 104 IF( ln_ctl ) THEN 105 WRITE(charout, FMT="('ldf ')") ; CALL prt_ctl_trc_info(charout) 106 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 107 ENDIF 108 ! 109 CALL wrk_dealloc( jpi,jpj,jpk, zahu, zahv ) 116 110 ! 117 111 IF( nn_timing == 1 ) CALL timing_stop('trc_ldf') … … 119 113 END SUBROUTINE trc_ldf 120 114 115 !!gm ldf_ctl should be called in trcini so that l_ldfslp=T cause the slope init and calculation 121 116 122 117 SUBROUTINE ldf_ctl … … 124 119 !! *** ROUTINE ldf_ctl *** 125 120 !! 126 !! ** Purpose : Choice of the operator for the lateral tracerdiffusion121 !! ** Purpose : Define the operator for the lateral diffusion 127 122 !! 128 123 !! ** Method : set nldf from the namtra_ldf logicals 129 124 !! nldf == -2 No lateral diffusion 130 !! nldf == -1 ESOPA test: ALL operators are used131 125 !! nldf == 0 laplacian operator 132 126 !! nldf == 1 Rotated laplacian operator … … 136 130 INTEGER :: ioptio, ierr ! temporary integers 137 131 !!---------------------------------------------------------------------- 138 139 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 140 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 141 rldf_rat = 1.0_wp 142 ELSE 143 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 144 END IF 145 ELSE 146 rldf_rat = rn_ahtrc_0 / rn_aht_0 147 END IF 148 ! Define the lateral mixing oparator for tracers 149 ! =============================================== 150 151 ! ! control the input 132 ! 133 ! ! control the namelist parameters 152 134 ioptio = 0 153 IF( ln_trcldf_lap ) ioptio = ioptio + 1 154 IF( ln_trcldf_bilap ) ioptio = ioptio + 1 155 IF( ioptio > 1 ) CALL ctl_stop( ' use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 156 IF( ioptio == 0 ) nldf = -2 ! No lateral diffusion 135 IF( ln_trcldf_lap ) ioptio = ioptio + 1 136 IF( ln_trcldf_blp ) ioptio = ioptio + 1 137 IF( ioptio > 1 ) CALL ctl_stop( 'trc_ldf_ctl: use ONE or NONE of the 2 lap/bilap operator type on tracer' ) 138 IF( ioptio == 0 ) nldf = n_no_ldf ! No lateral diffusion 139 140 IF( ln_trcldf_lap .AND. ln_trcldf_blp ) CALL ctl_stop( 'trc_ldf_ctl: bilaplacian should be used on both TRC and TRA' ) 141 IF( ln_trcldf_blp .AND. ln_trcldf_lap ) CALL ctl_stop( 'trc_ldf_ctl: laplacian should be used on both TRC and TRA' ) 142 157 143 ioptio = 0 158 IF( ln_trcldf_lev el) ioptio = ioptio + 1159 IF( ln_trcldf_hor 160 IF( ln_trcldf_iso 161 IF( ioptio /= 1 ) CALL ctl_stop( 'use only ONE direction (level/hor/iso)' )144 IF( ln_trcldf_lev ) ioptio = ioptio + 1 145 IF( ln_trcldf_hor ) ioptio = ioptio + 1 146 IF( ln_trcldf_iso ) ioptio = ioptio + 1 147 IF( ioptio /= 1 ) CALL ctl_stop( 'trc_ldf_ctl: use only ONE direction (level/hor/iso)' ) 162 148 163 149 ! defined the type of lateral diffusion from ln_trcldf_... logicals 164 150 ! CAUTION : nldf = 1 is used in trazdf_imp, change it carefully 165 151 ierr = 0 166 IF( ln_trcldf_lap ) THEN ! laplacian operator152 IF( ln_trcldf_lap ) THEN !== laplacian operator ==! 167 153 IF ( ln_zco ) THEN ! z-coordinate 168 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 169 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 170 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 171 ENDIF 172 IF ( ln_zps ) THEN ! z-coordinate 173 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 174 IF ( ln_trcldf_hor ) nldf = 0 ! horizontal (no rotation) 175 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 176 ENDIF 177 IF ( ln_sco ) THEN ! z-coordinate 178 IF ( ln_trcldf_level ) nldf = 0 ! iso-level (no rotation) 179 IF ( ln_trcldf_hor ) nldf = 1 ! horizontal ( rotation) 180 IF ( ln_trcldf_iso ) nldf = 1 ! isoneutral ( rotation) 181 ENDIF 182 ENDIF 183 184 IF( ln_trcldf_bilap ) THEN ! bilaplacian operator 154 IF ( ln_trcldf_lev ) nldf = n_lap ! iso-level = horizontal (no rotation) 155 IF ( ln_trcldf_hor ) nldf = n_lap ! iso-level = horizontal (no rotation) 156 IF ( ln_trcldf_iso ) nldf = n_lap_i ! iso-neutral: standard ( rotation) 157 IF ( ln_trcldf_triad ) nldf = n_lap_it ! iso-neutral: triad ( rotation) 158 ENDIF 159 IF ( ln_zps ) THEN ! z-coordinate with partial step 160 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 161 IF ( ln_trcldf_hor ) nldf = n_lap ! horizontal (no rotation) 162 IF ( ln_trcldf_iso ) nldf = n_lap_i ! iso-neutral: standard (rotation) 163 IF ( ln_trcldf_triad ) nldf = n_lap_it ! iso-neutral: triad (rotation) 164 ENDIF 165 IF ( ln_sco ) THEN ! s-coordinate 166 IF ( ln_trcldf_lev ) nldf = n_lap ! iso-level (no rotation) 167 IF ( ln_trcldf_hor ) nldf = n_lap_it ! horizontal ( rotation) !!gm a checker.... 168 IF ( ln_trcldf_iso ) nldf = n_lap_i ! iso-neutral: standard (rotation) 169 IF ( ln_trcldf_triad ) nldf = n_lap_it ! iso-neutral: triad (rotation) 170 ENDIF 171 ! ! diffusivity ratio: passive / active tracers 172 IF( ABS(rn_aht_0) < 2._wp*TINY(1.e0) ) THEN 173 IF( ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0) ) THEN 174 rldf_rat = 1.0_wp 175 ELSE 176 CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 177 ENDIF 178 ELSE 179 rldf_rat = rn_ahtrc_0 / rn_aht_0 180 ENDIF 181 ENDIF 182 183 IF( ln_trcldf_blp ) THEN !== bilaplacian operator ==! 185 184 IF ( ln_zco ) THEN ! z-coordinate 186 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 187 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 188 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 189 ENDIF 190 IF ( ln_zps ) THEN ! z-coordinate 191 IF ( ln_trcldf_level ) ierr = 1 ! iso-level not allowed 192 IF ( ln_trcldf_hor ) nldf = 2 ! horizontal (no rotation) 193 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 194 ENDIF 195 IF ( ln_sco ) THEN ! z-coordinate 196 IF ( ln_trcldf_level ) nldf = 2 ! iso-level (no rotation) 197 IF ( ln_trcldf_hor ) nldf = 3 ! horizontal ( rotation) 198 IF ( ln_trcldf_iso ) ierr = 2 ! isoneutral ( rotation) 185 IF ( ln_trcldf_lev ) nldf = n_blp ! iso-level = horizontal (no rotation) 186 IF ( ln_trcldf_hor ) nldf = n_blp ! iso-level = horizontal (no rotation) 187 IF ( ln_trcldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 188 IF ( ln_trcldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 189 ENDIF 190 IF ( ln_zps ) THEN ! z-coordinate with partial step 191 IF ( ln_trcldf_lev ) ierr = 1 ! iso-level not allowed 192 IF ( ln_trcldf_hor ) nldf = n_blp ! horizontal (no rotation) 193 IF ( ln_trcldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 194 IF ( ln_trcldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 195 ENDIF 196 IF ( ln_sco ) THEN ! s-coordinate 197 IF ( ln_trcldf_lev ) nldf = n_blp ! iso-level (no rotation) 198 IF ( ln_trcldf_hor ) nldf = n_blp_it ! horizontal ( rotation) !!gm a checker.... 199 IF ( ln_trcldf_iso ) nldf = n_blp_i ! iso-neutral: standard (rotation) 200 IF ( ln_trcldf_triad ) nldf = n_blp_it ! iso-neutral: triad (rotation) 201 ENDIF 202 ! ! diffusivity ratio: passive / active tracers 203 IF( ABS(rn_bht_0) < 2._wp*TINY(1.e0) ) THEN 204 IF( ABS(rn_bhtrc_0) < 2._wp*TINY(1.e0) ) THEN 205 rldf_rat = 1.0_wp 206 ELSE 207 CALL ctl_stop( 'STOP', 'trc_ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 208 ENDIF 209 ELSE 210 rldf_rat = SQRT( ABS( rn_bhtrc_0 / rn_bht_0 ) ) 199 211 ENDIF 200 212 ENDIF 201 213 202 214 IF( ierr == 1 ) CALL ctl_stop( ' iso-level in z-coordinate - partial step, not allowed' ) 203 IF( ierr == 2 ) CALL ctl_stop( ' isoneutral bilaplacian operator does not exist' ) 204 IF( lk_traldf_eiv .AND. .NOT.ln_trcldf_iso ) & 215 IF( ln_ldfeiv .AND. .NOT.ln_trcldf_iso ) & 205 216 CALL ctl_stop( ' eddy induced velocity on tracers', & 206 217 & ' the eddy induced velocity on tracers requires isopycnal laplacian diffusion' ) 207 218 IF( nldf == 1 .OR. nldf == 3 ) THEN ! rotation 208 IF( .NOT.lk_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require key_ldfslp' ) 209 #if defined key_offline 210 l_traldf_rot = .TRUE. ! needed for trazdf_imp 211 #endif 212 ENDIF 213 214 IF( lk_esopa ) THEN 215 IF(lwp) WRITE(numout,*) ' esopa control: use all lateral physics options' 216 nldf = -1 219 IF( .NOT.l_ldfslp ) CALL ctl_stop( ' the rotation of the diffusive tensor require l_ldfslp' ) 217 220 ENDIF 218 221 219 222 IF(lwp) THEN 220 223 WRITE(numout,*) 221 IF( nldf == -2 ) WRITE(numout,*) ' NO lateral diffusion' 222 IF( nldf == -1 ) WRITE(numout,*) ' ESOPA test All scheme used' 223 IF( nldf == 0 ) WRITE(numout,*) ' laplacian operator' 224 IF( nldf == 1 ) WRITE(numout,*) ' Rotated laplacian operator' 225 IF( nldf == 2 ) WRITE(numout,*) ' bilaplacian operator' 226 IF( nldf == 3 ) WRITE(numout,*) ' Rotated bilaplacian' 227 ENDIF 228 229 IF( ln_trcldf_bilap ) THEN 230 IF(lwp) WRITE(numout,*) ' biharmonic tracer diffusion' 231 IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa ) CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 232 ELSE 233 IF(lwp) WRITE(numout,*) ' harmonic tracer diffusion (default)' 234 IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa ) CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 235 ENDIF 236 237 ! ratio between active and passive tracers diffusive coef. 238 IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 239 IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 240 rldf_rat = 1.0_wp 241 ELSE 242 CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 243 END IF 244 ELSE 245 rldf_rat = rn_ahtrc_0 / rn_aht_0 246 END IF 247 IF( rldf_rat < 0 ) THEN 248 IF( .NOT.lk_offline ) THEN 249 CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 250 ELSE 251 CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 252 ENDIF 224 IF( nldf == n_no_ldf ) WRITE(numout,*) ' NO lateral diffusion' 225 IF( nldf == n_lap ) WRITE(numout,*) ' laplacian iso-level operator' 226 IF( nldf == n_lap_i ) WRITE(numout,*) ' Rotated laplacian operator (standard)' 227 IF( nldf == n_lap_it ) WRITE(numout,*) ' Rotated laplacian operator (triad)' 228 IF( nldf == n_blp ) WRITE(numout,*) ' bilaplacian iso-level operator' 229 IF( nldf == n_blp_i ) WRITE(numout,*) ' Rotated bilaplacian operator (standard)' 230 IF( nldf == n_blp_it ) WRITE(numout,*) ' Rotated bilaplacian operator (triad)' 253 231 ENDIF 254 232 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90
r5385 r5758 31 31 LOGICAL , PUBLIC :: ln_trcadv_msc_ups ! use upstream scheme within muscl 32 32 33 34 33 ! !!: ** lateral mixing namelist (nam_trcldf) ** 35 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 36 LOGICAL , PUBLIC :: ln_trcldf_bilap !: bilaplacian operator 37 LOGICAL , PUBLIC :: ln_trcldf_level !: iso-level direction 38 LOGICAL , PUBLIC :: ln_trcldf_hor !: horizontal (geopotential) direction 39 LOGICAL , PUBLIC :: ln_trcldf_iso !: iso-neutral direction 40 REAL(wp), PUBLIC :: rn_ahtrc_0 !: diffusivity coefficient for passive tracer (m2/s) 41 REAL(wp), PUBLIC :: rn_ahtrb_0 !: background diffusivity coefficient for passive tracer (m2/s) 34 LOGICAL , PUBLIC :: ln_trcldf_lap !: laplacian operator 35 LOGICAL , PUBLIC :: ln_trcldf_blp !: bilaplacian operator 36 LOGICAL , PUBLIC :: ln_trcldf_lev !: iso-level direction 37 LOGICAL , PUBLIC :: ln_trcldf_hor !: horizontal direction (rotation to geopotential) 38 LOGICAL , PUBLIC :: ln_trcldf_iso !: iso-neutral direction (standard) 39 LOGICAL , PUBLIC :: ln_trcldf_triad !: iso-neutral direction (triad) 40 REAL(wp), PUBLIC :: rn_ahtrc_0 !: laplacian diffusivity coefficient for passive tracer [m2/s] 41 REAL(wp), PUBLIC :: rn_bhtrc_0 !: bilaplacian - - - - - [m4/s] 42 42 43 43 ! !!: ** Treatment of Negative concentrations ( nam_trcrad ) … … 54 54 55 55 !!---------------------------------------------------------------------- 56 !! NEMO/TOP 3. 3 , NEMO Consortium (2010)56 !! NEMO/TOP 3.7 , NEMO Consortium (2015) 57 57 !! $Id$ 58 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 59 59 !!---------------------------------------------------------------------- 60 61 60 CONTAINS 62 61 … … 68 67 !!---------------------------------------------------------------------- 69 68 INTEGER :: ios ! Local integer output status for namelist read 69 !! 70 70 NAMELIST/namtrc_adv/ ln_trcadv_cen2 , ln_trcadv_tvd , & 71 71 & ln_trcadv_muscl, ln_trcadv_muscl2, & 72 72 & ln_trcadv_ubs , ln_trcadv_qck, ln_trcadv_msc_ups 73 74 NAMELIST/namtrc_ldf/ ln_trcldf_lap , & 75 & ln_trcldf_bilap, ln_trcldf_level, & 76 & ln_trcldf_hor , ln_trcldf_iso , rn_ahtrc_0, rn_ahtrb_0 73 NAMELIST/namtrc_ldf/ ln_trcldf_lap, ln_trcldf_blp, & 74 & ln_trcldf_lev, ln_trcldf_hor, ln_trcldf_iso, ln_trcldf_triad, & 75 & rn_ahtrc_0 , rn_bhtrc_0 77 76 NAMELIST/namtrc_zdf/ ln_trczdf_exp , nn_trczdf_exp 78 77 NAMELIST/namtrc_rad/ ln_trcrad … … 120 119 WRITE(numout,*) '~~~~~~~~~~~' 121 120 WRITE(numout,*) ' Namelist namtrc_ldf : set lateral mixing parameters (type, direction, coefficients)' 122 WRITE(numout,*) ' laplacian operator ln_trcldf_lap = ', ln_trcldf_lap 123 WRITE(numout,*) ' bilaplacian operator ln_trcldf_bilap = ', ln_trcldf_bilap 124 WRITE(numout,*) ' iso-level ln_trcldf_level = ', ln_trcldf_level 125 WRITE(numout,*) ' horizontal (geopotential) ln_trcldf_hor = ', ln_trcldf_hor 126 WRITE(numout,*) ' iso-neutral ln_trcldf_iso = ', ln_trcldf_iso 127 WRITE(numout,*) ' diffusivity coefficient rn_ahtrc_0 = ', rn_ahtrc_0 128 WRITE(numout,*) ' background hor. diffusivity rn_ahtrb_0 = ', rn_ahtrb_0 121 WRITE(numout,*) ' operator' 122 WRITE(numout,*) ' laplacian ln_trcldf_lap = ', ln_trcldf_lap 123 WRITE(numout,*) ' bilaplacian ln_trcldf_blp = ', ln_trcldf_blp 124 WRITE(numout,*) ' direction of action' 125 WRITE(numout,*) ' iso-level ln_trcldf_lev = ', ln_trcldf_lev 126 WRITE(numout,*) ' horizontal (geopotential) ln_trcldf_hor = ', ln_trcldf_hor 127 WRITE(numout,*) ' iso-neutral (standard) ln_trcldf_iso = ', ln_trcldf_iso 128 WRITE(numout,*) ' iso-neutral (triad) ln_trcldf_triad = ', ln_trcldf_triad 129 WRITE(numout,*) ' diffusivity coefficient' 130 WRITE(numout,*) ' laplacian rn_ahtrc_0 = ', rn_ahtrc_0 131 WRITE(numout,*) ' bilaplacian rn_bhtrc_0 = ', rn_bhtrc_0 129 132 ENDIF 130 133 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r5120 r5758 48 48 CONTAINS 49 49 50 SUBROUTINE trc_trp( k stp)50 SUBROUTINE trc_trp( kt ) 51 51 !!---------------------------------------------------------------------- 52 52 !! *** ROUTINE trc_trp *** … … 57 57 !! - Update the passive tracers 58 58 !!---------------------------------------------------------------------- 59 INTEGER, INTENT( in ) :: k stp! ocean time-step index59 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 60 !! --------------------------------------------------------------------- 61 61 ! … … 64 64 IF( .NOT. lk_c1d ) THEN 65 65 ! 66 CALL trc_sbc( kstp ) ! surface boundary condition 67 IF( lk_trabbl ) CALL trc_bbl( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 68 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 69 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kstp ) ! internal damping trends on closed seas only 70 CALL trc_adv( kstp ) ! horizontal & vertical advection 71 CALL trc_ldf( kstp ) ! lateral mixing 72 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 73 & CALL trc_kpp( kstp ) ! KPP non-local tracer fluxes 66 CALL trc_sbc ( kt ) ! surface boundary condition 67 IF( lk_trabbl ) CALL trc_bbl ( kt ) ! advective (and/or diffusive) bottom boundary layer scheme 68 IF( ln_trcdmp ) CALL trc_dmp ( kt ) ! internal damping trends 69 IF( ln_trcdmp_clo ) CALL trc_dmp_clo( kt ) ! internal damping trends on closed seas only 70 CALL trc_adv ( kt ) ! horizontal & vertical advection 71 CALL trc_ldf ( kt ) ! lateral mixing 74 72 #if defined key_agrif 75 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc 73 IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc ! tracers sponge 76 74 #endif 77 CALL trc_zdf ( kstp )! vertical mixing and after tracer fields78 CALL trc_nxt ( kstp )! tracer fields at next time step79 IF( ln_trcrad ) CALL trc_rad ( kstp )! Correct artificial negative concentrations75 CALL trc_zdf ( kt ) ! vertical mixing and after tracer fields 76 CALL trc_nxt ( kt ) ! tracer fields at next time step 77 IF( ln_trcrad ) CALL trc_rad ( kt ) ! Correct artificial negative concentrations 80 78 81 79 #if defined key_agrif 82 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp )! Update tracer at AGRIF zoom boundaries : children only80 IF( .NOT.Agrif_Root()) CALL Agrif_Update_Trc( kt ) ! Update tracer at AGRIF zoom boundaries : children only 83 81 #endif 84 82 85 IF( ln_zps .AND. .NOT. ln_isfcav) & 86 & CALL zps_hde ( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 87 IF( ln_zps .AND. ln_isfcav) & 88 & CALL zps_hde_isf( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive 89 ! tracers at the bottom ocean level 83 ! ! Partial top/bottom cell: GRADh( trn ) 84 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( kt, jptra, trn, gtru, gtrv, gtrui, gtrvi ) ! both top & bottom 85 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( kt, jptra, trn, gtru, gtrv ) ! only bottom 86 ENDIF 87 !!gm IF( ln_zps ) THEN 88 ! & CALL zps_hde ( kt, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 89 ! IF( ln_isfcav) & 90 ! & CALL zps_hde_isf( kt, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! Partial steps: now horizontal gradient of passive 91 !!gm ENDIF 90 92 ! 91 93 ELSE ! 1D vertical configuration 92 CALL trc_sbc( k stp) ! surface boundary condition94 CALL trc_sbc( kt ) ! surface boundary condition 93 95 IF( .NOT. lk_offline .AND. lk_zdfkpp ) & 94 & CALL trc_kpp( k stp) ! KPP non-local tracer fluxes95 CALL trc_zdf( k stp) ! vertical mixing and after tracer fields96 CALL trc_nxt( k stp) ! tracer fields at next time step97 IF( ln_trcrad ) CALL trc_rad( k stp) ! Correct artificial negative concentrations96 & CALL trc_kpp( kt ) ! KPP non-local tracer fluxes 97 CALL trc_zdf( kt ) ! vertical mixing and after tracer fields 98 CALL trc_nxt( kt ) ! tracer fields at next time step 99 IF( ln_trcrad ) CALL trc_rad( kt ) ! Correct artificial negative concentrations 98 100 ! 99 101 END IF … … 108 110 !!---------------------------------------------------------------------- 109 111 CONTAINS 110 SUBROUTINE trc_trp( k stp) ! Empty routine111 INTEGER, INTENT(in) :: k stp112 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', k stp112 SUBROUTINE trc_trp( kt ) ! Empty routine 113 INTEGER, INTENT(in) :: kt 114 WRITE(*,*) 'trc_trp: You should not have seen this print! error?', kt 113 115 END SUBROUTINE trc_trp 114 116 #endif -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90
r5385 r5758 11 11 !! 'key_top' TOP models 12 12 !!---------------------------------------------------------------------- 13 14 ! * Domain size *13 ! 14 ! !* Domain size * 15 15 USE par_oce , ONLY : jpi => jpi !: first dimension of grid --> i 16 16 USE par_oce , ONLY : jpj => jpj !: second dimension of grid --> j … … 24 24 USE par_oce , ONLY : jp_sal => jp_sal !: indice for salinity 25 25 26 !* IO manager * 27 USE in_out_manager 28 29 !* Memory Allocation * 30 USE wrk_nemo 31 32 !* Timing * 33 USE timing 34 35 !* MPP library 36 USE lib_mpp 37 38 !* Fortran utilities 39 USE lib_fortran 40 41 !* Lateral boundary conditions 42 USE lbclnk 43 44 !* physical constants * 45 USE phycst 46 47 !* 1D configuration 48 USE c1d 49 50 !* model domain * 51 USE dom_oce 26 USE in_out_manager !* IO manager * 27 USE wrk_nemo !* Memory Allocation * 28 USE timing !* Timing * 29 USE lib_mpp !* MPP library 30 USE lib_fortran !* Fortran utilities 31 USE lbclnk !* Lateral boundary conditions 32 USE phycst !* physical constants * 33 USE c1d !* 1D configuration 34 USE dom_oce !* model domain * 52 35 53 36 USE domvvl, ONLY : un_td, vn_td !: thickness diffusion transport … … 66 49 USE oce , ONLY : rhop => rhop !: potential volumic mass (kg m-3) 67 50 USE oce , ONLY : rhd => rhd !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 68 #if defined key_offline69 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points70 #endif71 51 USE oce , ONLY : hdivn => hdivn !: horizontal divergence (1/s) 72 52 USE oce , ONLY : rotn => rotn !: relative vorticity [s-1] … … 76 56 USE oce , ONLY : sshb => sshb !: sea surface height at t-point [m] 77 57 USE oce , ONLY : ssha => ssha !: sea surface height at t-point [m] 78 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 58 #if defined key_offline 59 USE oce , ONLY : rab_n => rab_n !: local thermal/haline expension ratio at T-points 60 #endif 79 61 80 62 !* surface fluxes * … … 102 84 USE trc_oce 103 85 86 !!gm : I don't understand this as ldftra (where everything is defined) is used by TRC in all cases (ON/OFF-line) 87 !!gm so the following lines should be removed.... logical should be the one of TRC namelist 88 !!gm In case off coarsening.... the ( ahtu, ahtv, aeiu, aeiv) arrays are needed that's all. 104 89 !* lateral diffusivity (tracers) * 105 USE ldftra_oce , ONLY : rldf => rldf !: multiplicative coef. for lateral diffusivity 106 USE ldftra_oce , ONLY : rn_aht_0 => rn_aht_0 !: horizontal eddy diffusivity for tracers (m2/s) 107 USE ldftra_oce , ONLY : aht0 => aht0 !: horizontal eddy diffusivity for tracers (m2/s) 108 USE ldftra_oce , ONLY : ahtb0 => ahtb0 !: background eddy diffusivity for isopycnal diff. (m2/s) 109 USE ldftra_oce , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 110 USE ldftra_oce , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 111 USE ldftra_oce , ONLY : ahtw => ahtw !: lateral diffusivity coef. at w-points 112 USE ldftra_oce , ONLY : ahtt => ahtt !: lateral diffusivity coef. at t-points 113 USE ldftra_oce , ONLY : aeiv0 => aeiv0 !: eddy induced velocity coefficient (m2/s) 114 USE ldftra_oce , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 115 USE ldftra_oce , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 116 USE ldftra_oce , ONLY : aeiw => aeiw !: eddy induced velocity coef. at w-points (m2/s) 117 USE ldftra_oce , ONLY : lk_traldf_eiv => lk_traldf_eiv !: eddy induced velocity flag 90 USE ldftra , ONLY : rn_aht_0 => rn_aht_0 !: laplacian lateral eddy diffusivity [m2/s] 91 USE ldftra , ONLY : rn_bht_0 => rn_bht_0 !: bilaplacian lateral eddy diffusivity [m4/s] 92 USE ldftra , ONLY : ahtu => ahtu !: lateral diffusivity coef. at u-points 93 USE ldftra , ONLY : ahtv => ahtv !: lateral diffusivity coef. at v-points 94 USE ldftra , ONLY : rn_aeiv_0 => rn_aeiv_0 !: eddy induced velocity coefficient (m2/s) 95 USE ldftra , ONLY : aeiu => aeiu !: eddy induced velocity coef. at u-points (m2/s) 96 USE ldftra , ONLY : aeiv => aeiv !: eddy induced velocity coef. at v-points (m2/s) 97 USE ldftra , ONLY : ln_ldfeiv => ln_ldfeiv !: eddy induced velocity flag 98 99 !!gm this should be : ln_trcldf_triad (TRC namelist) 100 USE ldfslp , ONLY : ln_traldf_triad => ln_traldf_triad !: triad scheme (Griffies et al.) 101 102 !* direction of lateral diffusion * 103 USE ldfslp , ONLY : l_ldfslp => l_ldfslp !: slopes flag 104 USE ldfslp , ONLY : uslp => uslp !: i-slope at u-point 105 USE ldfslp , ONLY : vslp => vslp !: j-slope at v-point 106 USE ldfslp , ONLY : wslpi => wslpi !: i-slope at w-point 107 USE ldfslp , ONLY : wslpj => wslpj !: j-slope at w-point 108 !!gm end 118 109 119 110 !* vertical diffusion * … … 128 119 USE zdfmxl , ONLY : hmlp => hmlp !: mixed layer depth (rho=rho0+zdcrit) (m) 129 120 USE zdfmxl , ONLY : hmlpt => hmlpt !: mixed layer depth at t-points (m) 130 131 !* direction of lateral diffusion *132 USE ldfslp , ONLY : lk_ldfslp => lk_ldfslp !: slopes flag133 # if defined key_ldfslp134 USE ldfslp , ONLY : uslp => uslp !: i-direction slope at u-, w-points135 USE ldfslp , ONLY : vslp => vslp !: j-direction slope at v-, w-points136 USE ldfslp , ONLY : wslpi => wslpi !: i-direction slope at u-, w-points137 USE ldfslp , ONLY : wslpj => wslpj !: j-direction slope at v-, w-points138 # endif139 121 140 122 USE diaar5 , ONLY : lk_diaar5 => lk_diaar5 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trc.F90
r5385 r5758 143 143 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_tm !: vertical double diffusivity coeff. at w-point [m/s] 144 144 # endif 145 #if defined key_ldfslp146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_tm !: i-direction slope at u-, w-points147 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpj_tm !: j-direction slope at u-, w-points148 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm !: j-direction slope at u-, w-points149 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslp_tm !: j-direction slope at u-, w-points150 #endif151 145 #if defined key_trabbl 152 146 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_tm !: u-, w-points … … 183 177 #endif 184 178 ! 185 #if defined key_ldfslp186 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpi_temp, wslpj_temp, uslp_temp, vslp_temp !: hold current values187 #endif188 !189 179 # if defined key_zdfddm 190 180 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avs_temp !: salinity vertical diffusivity coeff. at w-point [m/s] -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r5407 r5758 146 146 147 147 tra(:,:,:,:) = 0._wp 148 IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive 149 & CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient 150 IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) & 151 & CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level 152 148 149 !!gm case not.lk_c1d is useless since in 1D, 9 identical column all resulting arrays are zero 150 !! it is at the initialization so not a issue 151 ! IF(.NOT. lk_c1d ) THEN 152 !!gm 153 IF( ln_isfcav .AND. ln_zps ) THEN ; CALL zps_hde_isf( nit000, jptra, trn, gtru, gtrv, gtrui, gtrvi ) ! both top & bottom 154 ELSEIF( ln_zps ) THEN ; CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! only bottom 155 ENDIF 156 !!gm 157 ! ENDIF 158 !!gm 159 160 !!gm ===>>>>>> Anyyway, I don't understand why a call to zps_hde is needed here ! 153 161 154 162 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r5656 r5758 42 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- 44 45 44 CONTAINS 46 47 45 48 46 SUBROUTINE trc_nam … … 57 55 !!--------------------------------------------------------------------- 58 56 INTEGER :: jn ! dummy loop indice 59 ! ! Parameters of the run 60 IF( .NOT. lk_offline ) CALL trc_nam_run 61 62 ! ! passive tracer informations 63 CALL trc_nam_trc 64 65 ! ! Parameters of additional diagnostics 66 CALL trc_nam_dia 67 68 ! ! namelist of transport 69 CALL trc_nam_trp 70 71 72 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 73 ! 74 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 75 ! 76 IF( .NOT.ln_trcdta ) THEN 77 ln_trc_ini(:) = .FALSE. 78 ENDIF 79 80 IF(lwp) THEN ! control print 57 ! 58 IF( .NOT.lk_offline ) CALL trc_nam_run ! Parameters of the run 59 ! 60 CALL trc_nam_trc ! passive tracer informations 61 ! 62 CALL trc_nam_dia ! Parameters of additional diagnostics 63 ! 64 CALL trc_nam_trp ! namelist of transport 65 ! 66 ! 67 IF( ln_rsttr ) ln_trcdta = .FALSE. ! restart : no need of clim data 68 ! 69 IF( ln_trcdmp .OR. ln_trcdmp_clo ) ln_trcdta = .TRUE. ! damping : need to have clim data 70 ! 71 IF( .NOT.ln_trcdta ) ln_trc_ini(:) = .FALSE. 72 73 IF(lwp) THEN ! control print 81 74 WRITE(numout,*) 82 75 WRITE(numout,*) ' Namelist : namtrc' … … 149 142 ! Call the ice module for tracers 150 143 ! ------------------------------- 151 CALL trc_nam_ice144 CALL trc_nam_ice 152 145 153 146 ! namelist of SMS … … 171 164 END SUBROUTINE trc_nam 172 165 166 173 167 SUBROUTINE trc_nam_run 174 168 !!--------------------------------------------------------------------- … … 180 174 NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 181 175 & cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 182 183 176 ! 184 177 INTEGER :: ios ! Local integer output status for namelist read 185 186 !!--------------------------------------------------------------------- 187 188 178 !!--------------------------------------------------------------------- 179 ! 189 180 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 190 181 IF(lwp) WRITE(numout,*) '~~~~~~~' … … 220 211 END SUBROUTINE trc_nam_run 221 212 213 222 214 SUBROUTINE trc_nam_ice 223 215 !!--------------------------------------------------------------------- … … 229 221 !! 230 222 !!--------------------------------------------------------------------- 231 ! --- Variable declarations --- !232 223 INTEGER :: jn ! dummy loop indices 233 224 INTEGER :: ios ! Local integer output status for namelist read 234 235 ! --- Namelist declarations --- ! 225 ! 236 226 TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 227 !! 237 228 NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 238 229 !!--------------------------------------------------------------------- 230 ! 239 231 IF(lwp) THEN 240 232 WRITE(numout,*) … … 271 263 END SUBROUTINE trc_nam_ice 272 264 265 273 266 SUBROUTINE trc_nam_trc 274 267 !!--------------------------------------------------------------------- … … 278 271 !! 279 272 !!--------------------------------------------------------------------- 280 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput281 !!282 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo283 284 273 INTEGER :: ios ! Local integer output status for namelist read 285 274 INTEGER :: jn ! dummy loop indice 275 ! 276 TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer ! type of tracer for saving if not key_iomput 277 !! 278 NAMELIST/namtrc/ sn_tracer, ln_trcdta,ln_trcdmp, ln_trcdmp_clo 286 279 !!--------------------------------------------------------------------- 287 280 IF(lwp) WRITE(numout,*) 288 281 IF(lwp) WRITE(numout,*) 'trc_nam : read the passive tracer namelists' 289 282 IF(lwp) WRITE(numout,*) '~~~~~~~' 290 291 283 292 284 REWIND( numnat_ref ) ! Namelist namtrc in reference namelist : Passive tracer variables … … 306 298 ln_trc_wri(jn) = sn_tracer(jn)%llsave 307 299 END DO 308 309 300 ! 301 END SUBROUTINE trc_nam_trc 310 302 311 303 … … 320 312 !! ( (PISCES, CFC, MY_TRC ) 321 313 !!--------------------------------------------------------------------- 314 INTEGER :: ios ! Local integer output status for namelist read 322 315 INTEGER :: ierr 316 !! 323 317 #if defined key_trdmxl_trc || defined key_trdtrc 324 318 NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & … … 327 321 #endif 328 322 NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 329 330 INTEGER :: ios ! Local integer output status for namelist read331 323 !!--------------------------------------------------------------------- 332 324 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/TOP_SRC/trcsub.F90
r5215 r5758 44 44 REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1) 45 45 46 ! !* iso-neutral slopes (if l_ldfslp=T) 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_temp, vslp_temp, wslpi_temp, wslpj_temp !: hold current values 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslp_tm , vslp_tm , wslpi_tm , wslpj_tm !: time mean 49 46 50 !!* Substitution 47 51 # include "top_substitute.h90" … … 93 97 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:) 94 98 # endif 95 #if defined key_ldfslp 96 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)97 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)98 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)99 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp(:,:,:)100 #endif 99 IF( l_ldfslp ) THEN 100 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 101 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 102 wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 103 wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 104 ENDIF 101 105 # if defined key_trabbl 102 106 IF( nn_bbl_ldf == 1 ) THEN … … 131 135 avs_temp (:,:,:) = avs (:,:,:) 132 136 # endif 133 #if defined key_ldfslp 134 wslpi_temp (:,:,:) = wslpi (:,:,:) 135 wslpj_temp (:,:,:) = wslpj (:,:,:) 136 uslp_temp (:,:,:) = uslp (:,:,:) 137 vslp_temp (:,:,:) = vslp (:,:,:) 138 #endif 137 IF( l_ldfslp ) THEN 138 uslp_temp (:,:,:) = uslp (:,:,:) ; wslpi_temp (:,:,:) = wslpi (:,:,:) 139 vslp_temp (:,:,:) = vslp (:,:,:) ; wslpj_temp (:,:,:) = wslpj (:,:,:) 140 ENDIF 139 141 # if defined key_trabbl 140 142 IF( nn_bbl_ldf == 1 ) THEN … … 175 177 avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:) 176 178 # endif 177 #if defined key_ldfslp 178 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)179 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)180 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp(:,:,:)181 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)182 #endif 179 IF( l_ldfslp ) THEN 180 uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:) 181 vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:) 182 wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:) 183 wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:) 184 ENDIF 183 185 # if defined key_trabbl 184 186 IF( nn_bbl_ldf == 1 ) THEN … … 255 257 tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t 256 258 rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t 259 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 257 260 avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w 258 261 # if defined key_zdfddm 259 262 avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w 260 263 # endif 261 #if defined key_ldfslp 262 wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk)263 wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk)264 uslp (ji,jj,jk) = uslp_tm (ji,jj,jk)265 vslp (ji,jj,jk) = vslp_tm (ji,jj,jk)266 #endif 267 ENDDO268 ENDDO269 END DO264 END DO 265 END DO 266 END DO 267 IF( l_ldfslp ) THEN 268 wslpi(:,:,:) = wslpi_tm(:,:,:) 269 wslpj(:,:,:) = wslpj_tm(:,:,:) 270 uslp (:,:,:) = uslp_tm (:,:,:) 271 vslp (:,:,:) = vslp_tm (:,:,:) 272 ENDIF 270 273 ! 271 274 CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity … … 276 279 ! 277 280 END SUBROUTINE trc_sub_stp 281 278 282 279 283 SUBROUTINE trc_sub_ini … … 304 308 tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:) 305 309 rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:) 310 !!gm : BUG? ==>> for avt & avs I don't understand the division by e3w 306 311 avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:) 307 312 # if defined key_zdfddm 308 313 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 309 314 # endif 310 #if defined key_ldfslp 311 wslpi_tm(:,:,:)= wslpi(:,:,:)312 wslpj_tm(:,:,:)= wslpj(:,:,:)313 uslp_tm (:,:,:)= uslp (:,:,:)314 vslp_tm (:,:,:)= vslp (:,:,:)315 #endif 315 IF( l_ldfslp ) THEN 316 wslpi_tm(:,:,:) = wslpi(:,:,:) 317 wslpj_tm(:,:,:) = wslpj(:,:,:) 318 uslp_tm (:,:,:) = uslp (:,:,:) 319 vslp_tm (:,:,:) = vslp (:,:,:) 320 ENDIF 316 321 sshn_tm (:,:) = sshn (:,:) 317 322 rnf_tm (:,:) = rnf (:,:) … … 365 370 avs (:,:,:) = avs_temp (:,:,:) 366 371 # endif 367 #if defined key_ldfslp 368 wslpi (:,:,:)= wslpi_temp (:,:,:)369 wslpj (:,:,:)= wslpj_temp (:,:,:)370 uslp (:,:,:)= uslp_temp (:,:,:)371 vslp (:,:,:)= vslp_temp (:,:,:)372 #endif 372 IF( l_ldfslp ) THEN 373 wslpi (:,:,:)= wslpi_temp (:,:,:) 374 wslpj (:,:,:)= wslpj_temp (:,:,:) 375 uslp (:,:,:)= uslp_temp (:,:,:) 376 vslp (:,:,:)= vslp_temp (:,:,:) 377 ENDIF 373 378 sshn (:,:) = sshn_temp (:,:) 374 379 sshb (:,:) = sshb_temp (:,:) … … 411 416 avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:) 412 417 # endif 413 #if defined key_ldfslp 418 IF( l_ldfslp ) THEN 419 uslp_tm (:,:,:) = uslp (:,:,:) 420 vslp_tm (:,:,:) = vslp (:,:,:) 414 421 wslpi_tm(:,:,:) = wslpi(:,:,:) 415 422 wslpj_tm(:,:,:) = wslpj(:,:,:) 416 uslp_tm (:,:,:) = uslp (:,:,:) 417 vslp_tm (:,:,:) = vslp (:,:,:) 418 #endif 423 ENDIF 419 424 ! 420 425 sshb_hold (:,:) = sshn (:,:) … … 551 556 & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , & 552 557 & ssha_temp(jpi,jpj) , & 553 #if defined key_ldfslp554 & wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &555 & uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &556 #endif557 558 #if defined key_trabbl 558 559 & ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), & … … 577 578 & emp_b_hold(jpi,jpj) , & 578 579 & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , & 579 #if defined key_ldfslp580 & wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &581 & uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &582 #endif583 580 #if defined key_trabbl 584 581 & ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), & 585 582 & utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), & 586 583 #endif 587 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &588 & STAT=trc_sub_alloc )584 & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , STAT=trc_sub_alloc ) 585 ! 589 586 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays') 590 587 ! 588 IF( l_ldfslp ) THEN 589 ALLOCATE( uslp_temp(jpi,jpj,jpk) , wslpi_temp(jpi,jpj,jpk), & 590 & vslp_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), & 591 & uslp_tm (jpi,jpj,jpk) , wslpi_tm (jpi,jpj,jpk), & 592 & vslp_tm (jpi,jpj,jpk) , wslpj_tm (jpi,jpj,jpk), STAT=trc_sub_alloc ) 593 ENDIF 594 ! 595 IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate ldf_slp arrays') 591 596 ! 592 597 END FUNCTION trc_sub_alloc
Note: See TracChangeset
for help on using the changeset viewer.