Changeset 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA
- Timestamp:
- 2017-02-06T10:25:03+01:00 (7 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 18 edited
-
eosbn2.F90 (modified) (11 diffs)
-
traadv.F90 (modified) (9 diffs)
-
traadv_cen.F90 (modified) (4 diffs)
-
traadv_fct.F90 (modified) (13 diffs)
-
traadv_mle.F90 (modified) (3 diffs)
-
traadv_mus.F90 (modified) (5 diffs)
-
traadv_qck.F90 (modified) (4 diffs)
-
traadv_ubs.F90 (modified) (4 diffs)
-
trabbc.F90 (modified) (1 diff)
-
trabbl.F90 (modified) (4 diffs)
-
tradmp.F90 (modified) (1 diff)
-
traldf.F90 (modified) (2 diffs)
-
traldf_iso.F90 (modified) (5 diffs)
-
traldf_lap_blp.F90 (modified) (5 diffs)
-
traldf_triad.F90 (modified) (5 diffs)
-
tranxt.F90 (modified) (4 diffs)
-
traqsr.F90 (modified) (2 diffs)
-
trazdf.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r6505 r7646 204 204 !! 205 205 !! ln_teos10 : polynomial TEOS-10 equation of state is used for rho(t,s,z). 206 !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Cel cius, sa=35.5 g/kg206 !! Check value: rho = 1028.21993233072 kg/m^3 for z=3000 dbar, ct=3 Celsius, sa=35.5 g/kg 207 207 !! 208 208 !! ln_eos80 : polynomial EOS-80 equation of state is used for rho(t,s,z). 209 !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Cel cius, sp=35.5 psu209 !! Check value: rho = 1028.35011066567 kg/m^3 for z=3000 dbar, pt=3 Celsius, sp=35.5 psu 210 210 !! 211 211 !! ln_seos : simplified equation of state … … 221 221 !! TEOS-10 Manual, 2010 222 222 !!---------------------------------------------------------------------- 223 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Cel cius]223 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 224 224 ! ! 2 : salinity [psu] 225 225 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] … … 316 316 !! 317 317 !!---------------------------------------------------------------------- 318 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Cel cius]318 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 319 319 ! ! 2 : salinity [psu] 320 320 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density [-] … … 481 481 !! 482 482 !!---------------------------------------------------------------------- 483 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Cel cius]483 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celsius] 484 484 ! ! 2 : salinity [psu] 485 485 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] … … 907 907 !! 908 908 !!---------------------------------------------------------------------- 909 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Cel cius,psu]910 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Cel cius-1,psu-1]909 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celsius,psu] 910 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celsius-1,psu-1] 911 911 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 912 912 ! … … 944 944 !! *** ROUTINE eos_pt_from_ct *** 945 945 !! 946 !! ** Purpose : Compute pot.temp. from cons. temp. [Cel cius]946 !! ** Purpose : Compute pot.temp. from cons. temp. [Celsius] 947 947 !! 948 948 !! ** Method : rational approximation (5/3th order) of TEOS-10 algorithm … … 952 952 !! Rational approximation to TEOS10 algorithm (rms error on WOA13 values: 4.0e-5 degC) 953 953 !!---------------------------------------------------------------------- 954 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celcius]955 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu]954 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ctmp ! Cons. Temp [Celsius] 955 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 956 956 ! Leave result array automatic rather than making explicitly allocated 957 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Cel cius]957 REAL(wp), DIMENSION(jpi,jpj) :: ptmp ! potential temperature [Celsius] 958 958 ! 959 959 INTEGER :: ji, jj ! dummy loop indices … … 1003 1003 !! *** ROUTINE eos_fzp *** 1004 1004 !! 1005 !! ** Purpose : Compute the freezing point temperature [Cel cius]1006 !! 1007 !! ** Method : UNESCO freezing point (ptf) in Cel cius is given by1005 !! ** Purpose : Compute the freezing point temperature [Celsius] 1006 !! 1007 !! ** Method : UNESCO freezing point (ptf) in Celsius is given by 1008 1008 !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 1009 1009 !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m … … 1013 1013 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 1014 1014 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1015 REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Cel cius]1015 REAL(wp), DIMENSION(jpi,jpj), INTENT(out ) :: ptf ! freezing temperature [Celsius] 1016 1016 ! 1017 1017 INTEGER :: ji, jj ! dummy loop indices … … 1056 1056 !! *** ROUTINE eos_fzp *** 1057 1057 !! 1058 !! ** Purpose : Compute the freezing point temperature [Cel cius]1059 !! 1060 !! ** Method : UNESCO freezing point (ptf) in Cel cius is given by1058 !! ** Purpose : Compute the freezing point temperature [Celsius] 1059 !! 1060 !! ** Method : UNESCO freezing point (ptf) in Celsius is given by 1061 1061 !! ptf(t,z) = (-.0575+1.710523e-3*sqrt(abs(s))-2.154996e-4*s)*s - 7.53e-4*z 1062 1062 !! checkvalue: tf=-2.588567 Celsius for s=40psu, z=500m … … 1066 1066 REAL(wp), INTENT(in ) :: psal ! salinity [psu] 1067 1067 REAL(wp), INTENT(in ), OPTIONAL :: pdep ! depth [m] 1068 REAL(wp), INTENT(out) :: ptf ! freezing temperature [Cel cius]1068 REAL(wp), INTENT(out) :: ptf ! freezing temperature [Celsius] 1069 1069 ! 1070 1070 REAL(wp) :: zs ! local scalars -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r6140 r7646 9 9 !! 3.7 ! 2014-05 (G. Madec) Add 2nd/4th order cases for CEN and FCT schemes 10 10 !! - ! 2014-12 (G. Madec) suppression of cross land advection option 11 !! 3.6 ! 2015-06 (E. Clementi) Addition of Stokes drift in case of wave coupling 11 12 !!---------------------------------------------------------------------- 12 13 … … 26 27 USE ldftra ! lateral diffusion: eddy diffusivity & EIV coeff. 27 28 USE ldfslp ! Lateral diffusion: slopes of neutral surfaces 29 USE trd_oce ! trends: ocean variables 30 USE trdtra ! trends manager: tracers 28 31 ! 29 32 USE in_out_manager ! I/O manager … … 33 36 USE wrk_nemo ! Memory Allocation 34 37 USE timing ! Timing 35 36 USE diaptr ! Poleward heat transport 38 USE sbcwave ! wave module 39 USE sbc_oce ! surface boundary condition: ocean 40 USE diaptr ! Poleward heat transport 37 41 38 42 IMPLICIT NONE … … 86 90 INTEGER :: jk ! dummy loop index 87 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 92 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds ! 3D workspace 88 93 !!---------------------------------------------------------------------- 89 94 ! … … 93 98 ! 94 99 ! ! set time step 100 zun(:,:,:) = 0.0 101 zvn(:,:,:) = 0.0 102 zwn(:,:,:) = 0.0 103 ! 95 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 96 105 r2dt = rdt ! = rdt (restarting with Euler time stepping) … … 100 109 ! 101 110 ! !== effective transport ==! 102 DO jk = 1, jpkm1 103 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 104 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 105 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 106 END DO 111 IF( ln_wave .AND. ln_sdw ) THEN 112 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 113 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 114 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 115 zwn(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) ) 116 END DO 117 ELSE 118 DO jk = 1, jpkm1 119 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 120 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 121 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 122 END DO 123 ENDIF 107 124 ! 108 125 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections … … 127 144 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 128 145 !!gm ??? 146 ! 147 IF( l_trdtra ) THEN !* Save ta and sa trends 148 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 149 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 150 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 151 ENDIF 129 152 ! 130 153 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! … … 145 168 END SELECT 146 169 ! 147 ! ! print mean trends (used for debugging) 170 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 171 DO jk = 1, jpkm1 172 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 173 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 174 END DO 175 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 176 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 177 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 178 ENDIF 179 ! ! print mean trends (used for debugging) 148 180 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & 149 181 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 255 287 WRITE(numout,*) 256 288 SELECT CASE ( nadv ) 257 CASE( np_NO_adv ) ; WRITE(numout,*) ' NO T-S advection'258 CASE( np_CEN ) ; WRITE(numout,*) ' CEN scheme is used. Horizontal order: ', nn_cen_h, &289 CASE( np_NO_adv ) ; WRITE(numout,*) ' ===>> NO T-S advection' 290 CASE( np_CEN ) ; WRITE(numout,*) ' ===>> CEN scheme is used. Horizontal order: ', nn_cen_h, & 259 291 & ' Vertical order: ', nn_cen_v 260 CASE( np_FCT ) ; WRITE(numout,*) ' FCT scheme is used. Horizontal order: ', nn_fct_h, &292 CASE( np_FCT ) ; WRITE(numout,*) ' ===>> FCT scheme is used. Horizontal order: ', nn_fct_h, & 261 293 & ' Vertical order: ', nn_fct_v 262 CASE( np_FCT_zts ) ; WRITE(numout,*) ' use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping'263 CASE( np_MUS ) ; WRITE(numout,*) ' MUSCL scheme is used'264 CASE( np_UBS ) ; WRITE(numout,*) ' UBS scheme is used'265 CASE( np_QCK ) ; WRITE(numout,*) ' QUICKEST scheme is used'294 CASE( np_FCT_zts ) ; WRITE(numout,*) ' ===>> use 2nd order FCT with ', nn_fct_zts,'vertical sub-timestepping' 295 CASE( np_MUS ) ; WRITE(numout,*) ' ===>> MUSCL scheme is used' 296 CASE( np_UBS ) ; WRITE(numout,*) ' ===>> UBS scheme is used' 297 CASE( np_QCK ) ; WRITE(numout,*) ' ===>> QUICKEST scheme is used' 266 298 END SELECT 267 299 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r6140 r7646 18 18 USE trdtra ! trends manager: tracers 19 19 USE diaptr ! poleward transport diagnostics 20 USE diaar5 ! AR5 diagnostics 20 21 ! 21 22 USE in_out_manager ! I/O manager … … 33 34 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 34 35 36 LOGICAL :: l_trd ! flag to compute trends 37 LOGICAL :: l_ptr ! flag to compute poleward transport 38 LOGICAL :: l_hst ! flag to compute heat/salt transport 39 35 40 !! * Substitutions 36 41 # include "vectopt_loop_substitute.h90" 37 42 !!---------------------------------------------------------------------- 38 43 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 39 !! $Id : traadv_cen2.F90 5737 2015-09-13 07:42:41Z gm$44 !! $Id$ 40 45 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 41 46 !!---------------------------------------------------------------------- … … 88 93 ENDIF 89 94 ! 95 l_trd = .FALSE. 96 l_hst = .FALSE. 97 l_ptr = .FALSE. 98 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 99 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 100 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 101 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 102 ! 90 103 ! 91 104 zwz(:,:, 1 ) = 0._wp ! surface & bottom vertical flux set to zero for all tracers … … 184 197 END DO 185 198 ! ! trend diagnostics 186 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc )) THEN199 IF( l_trd ) THEN 187 200 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 188 201 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 189 202 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 190 203 END IF 191 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 192 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 193 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 194 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 195 ENDIF 204 ! ! "Poleward" heat and salt transports 205 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 206 ! ! heat and salt transport 207 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 196 208 ! 197 209 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r6771 r7646 20 20 USE trdtra ! tracers trends 21 21 USE diaptr ! poleward transport diagnostics 22 USE diaar5 ! AR5 diagnostics 23 USE phycst, ONLY: rau0_rcp 22 24 ! 23 25 USE in_out_manager ! I/O manager 26 USE iom 24 27 USE lib_mpp ! MPP library 25 28 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 36 39 37 40 LOGICAL :: l_trd ! flag to compute trends 41 LOGICAL :: l_ptr ! flag to compute poleward transport 42 LOGICAL :: l_hst ! flag to compute heat/salt transport 38 43 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 44 45 ! ! tridiag solver associated indices: 46 INTEGER, PARAMETER :: np_NH = 0 ! Neumann homogeneous boundary condition 47 INTEGER, PARAMETER :: np_CEN2 = 1 ! 2nd order centered boundary condition 39 48 40 49 !! * Substitutions … … 80 89 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 81 90 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 91 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 92 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 83 93 !!---------------------------------------------------------------------- 84 94 ! … … 94 104 ! 95 105 l_trd = .FALSE. 96 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 97 ! 98 IF( l_trd ) THEN 106 l_hst = .FALSE. 107 l_ptr = .FALSE. 108 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 109 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 110 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 111 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 112 ! 113 IF( l_trd .OR. l_hst ) THEN 99 114 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 100 115 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 101 116 ENDIF 102 117 ! 118 IF( l_ptr ) THEN 119 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 120 zptry(:,:,:) = 0._wp 121 ENDIF 103 122 ! ! surface & bottom value : flux set to zero one for all 104 123 zwz(:,:, 1 ) = 0._wp … … 161 180 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 162 181 ! 163 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)182 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 164 183 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 165 184 END IF 166 185 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 167 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 168 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 169 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 170 ENDIF 186 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 171 187 ! 172 188 ! !== anti-diffusive flux : high order minus low order ==! … … 292 308 END DO 293 309 ! 294 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)310 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 295 311 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 296 312 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 297 313 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 298 ! 314 ENDIF 315 ! 316 IF( l_trd ) THEN 299 317 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 300 318 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 301 319 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 302 320 ! 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz )304 321 END IF 305 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 306 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 307 IF( jn == jp_tem ) htr_adv(:) = htr_adv(:) + ptr_sj( zwy(:,:,:) ) 308 IF( jn == jp_sal ) str_adv(:) = str_adv(:) + ptr_sj( zwy(:,:,:) ) 322 ! ! heat/salt transport 323 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 324 325 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 326 IF( l_ptr ) THEN 327 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 328 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 309 329 ENDIF 310 330 ! 311 331 END DO ! end of tracer loop 312 332 ! 313 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 333 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 334 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 335 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 314 336 ! 315 337 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct') … … 357 379 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 358 380 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 381 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 359 382 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 360 383 !!---------------------------------------------------------------------- … … 373 396 ! 374 397 l_trd = .FALSE. 375 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 376 ! 377 IF( l_trd ) THEN 398 l_hst = .FALSE. 399 l_ptr = .FALSE. 400 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 401 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 402 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 403 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 404 ! 405 IF( l_trd .OR. l_hst ) THEN 378 406 CALL wrk_alloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 379 407 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 408 ENDIF 381 409 ! 410 IF( l_ptr ) THEN 411 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 412 zptry(:,:,:) = 0._wp 413 ENDIF 382 414 zwi(:,:,:) = 0._wp 383 415 z_rzts = 1._wp / REAL( kn_fct_zts, wp ) … … 445 477 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 446 478 ! 447 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)479 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 448 480 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 449 481 END IF 450 482 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 451 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 452 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 453 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 454 ENDIF 483 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 455 484 456 485 ! 3. anti-diffusive flux : high order minus low order … … 568 597 END DO 569 598 570 ! ! trend diagnostics (contribution of upstream fluxes)571 IF( l_trd ) THEN599 ! 600 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 572 601 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 573 602 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 574 603 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 575 ! 576 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 577 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 578 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 579 ! 580 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 604 ENDIF 605 ! 606 IF( l_trd ) THEN 607 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 608 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 609 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 610 ! 581 611 END IF 582 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 583 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 584 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) + htr_adv(:) 585 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) + str_adv(:) 612 ! ! heat/salt transport 613 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 614 615 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 616 IF( l_ptr ) THEN 617 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 618 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 586 619 ENDIF 587 620 ! 588 621 END DO 589 622 ! 590 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 591 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 592 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 623 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 624 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 625 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 626 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 627 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 593 628 ! 594 629 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct_zts') … … 706 741 707 742 708 SUBROUTINE interp_4th_cpt ( pt_in, pt_out )709 !!---------------------------------------------------------------------- 710 !! *** ROUTINE interp_4th_cpt ***743 SUBROUTINE interp_4th_cpt_org( pt_in, pt_out ) 744 !!---------------------------------------------------------------------- 745 !! *** ROUTINE interp_4th_cpt_org *** 711 746 !! 712 747 !! ** Purpose : Compute the interpolation of tracer at w-point … … 739 774 END DO 740 775 ! 741 jk =2! Switch to second order centered at top742 DO jj =1,jpj743 DO ji =1,jpi776 jk = 2 ! Switch to second order centered at top 777 DO jj = 1, jpj 778 DO ji = 1, jpi 744 779 zwd (ji,jj,jk) = 1._wp 745 780 zwi (ji,jj,jk) = 0._wp … … 789 824 END DO 790 825 ! 826 END SUBROUTINE interp_4th_cpt_org 827 828 829 SUBROUTINE interp_4th_cpt( pt_in, pt_out ) 830 !!---------------------------------------------------------------------- 831 !! *** ROUTINE interp_4th_cpt *** 832 !! 833 !! ** Purpose : Compute the interpolation of tracer at w-point 834 !! 835 !! ** Method : 4th order compact interpolation 836 !!---------------------------------------------------------------------- 837 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point 838 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT( out) :: pt_out ! field interpolated at w-point 839 ! 840 INTEGER :: ji, jj, jk ! dummy loop integers 841 INTEGER :: ikt, ikb ! local integers 842 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt 843 !!---------------------------------------------------------------------- 844 ! 845 ! !== build the three diagonal matrix & the RHS ==! 846 ! 847 DO jk = 3, jpkm1 ! interior (from jk=3 to jpk-1) 848 DO jj = 2, jpjm1 849 DO ji = fs_2, fs_jpim1 850 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 851 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal 852 zws (ji,jj,jk) = wmask(ji,jj,jk) ! upper diagonal 853 zwrm(ji,jj,jk) = 3._wp * wmask(ji,jj,jk) & ! RHS 854 & * ( pt_in(ji,jj,jk) + pt_in(ji,jj,jk-1) ) 855 END DO 856 END DO 857 END DO 858 ! 859 !!gm 860 ! SELECT CASE( kbc ) !* boundary condition 861 ! CASE( np_NH ) ! Neumann homogeneous at top & bottom 862 ! CASE( np_CEN2 ) ! 2nd order centered at top & bottom 863 ! END SELECT 864 !!gm 865 ! 866 DO jj = 2, jpjm1 ! 2nd order centered at top & bottom 867 DO ji = fs_2, fs_jpim1 868 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 869 ikb = mbkt(ji,jj) ! - above the last wet point 870 ! 871 zwd (ji,jj,ikt) = 1._wp ! top 872 zwi (ji,jj,ikt) = 0._wp 873 zws (ji,jj,ikt) = 0._wp 874 zwrm(ji,jj,ikt) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 875 ! 876 zwd (ji,jj,ikb) = 1._wp ! bottom 877 zwi (ji,jj,ikb) = 0._wp 878 zws (ji,jj,ikb) = 0._wp 879 zwrm(ji,jj,ikb) = 0.5_wp * ( pt_in(ji,jj,jk-1) + pt_in(ji,jj,jk) ) 880 END DO 881 END DO 882 ! 883 ! !== tridiagonal solver ==! 884 ! 885 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 886 DO ji = fs_2, fs_jpim1 887 zwt(ji,jj,2) = zwd(ji,jj,2) 888 END DO 889 END DO 890 DO jk = 3, jpkm1 891 DO jj = 2, jpjm1 892 DO ji = fs_2, fs_jpim1 893 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 894 END DO 895 END DO 896 END DO 897 ! 898 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 899 DO ji = fs_2, fs_jpim1 900 pt_out(ji,jj,2) = zwrm(ji,jj,2) 901 END DO 902 END DO 903 DO jk = 3, jpkm1 904 DO jj = 2, jpjm1 905 DO ji = fs_2, fs_jpim1 906 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 907 END DO 908 END DO 909 END DO 910 911 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 912 DO ji = fs_2, fs_jpim1 913 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 914 END DO 915 END DO 916 DO jk = jpk-2, 2, -1 917 DO jj = 2, jpjm1 918 DO ji = fs_2, fs_jpim1 919 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 920 END DO 921 END DO 922 END DO 923 ! 791 924 END SUBROUTINE interp_4th_cpt 792 925 926 927 SUBROUTINE tridia_solver( pD, pU, pL, pRHS, pt_out , klev ) 928 !!---------------------------------------------------------------------- 929 !! *** ROUTINE tridia_solver *** 930 !! 931 !! ** Purpose : solve a symmetric 3diagonal system 932 !! 933 !! ** Method : solve M.t_out = RHS(t) where M is a tri diagonal matrix ( jpk*jpk ) 934 !! 935 !! ( D_1 U_1 0 0 0 )( t_1 ) ( RHS_1 ) 936 !! ( L_2 D_2 U_2 0 0 )( t_2 ) ( RHS_2 ) 937 !! ( 0 L_3 D_3 U_3 0 )( t_3 ) = ( RHS_3 ) 938 !! ( ... )( ... ) ( ... ) 939 !! ( 0 0 0 L_k D_k )( t_k ) ( RHS_k ) 940 !! 941 !! M is decomposed in the product of an upper and lower triangular matrix. 942 !! The tri-diagonals matrix is given as input 3D arrays: pD, pU, pL 943 !! (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 944 !! The solution is pta. 945 !! The 3d array zwt is used as a work space array. 946 !!---------------------------------------------------------------------- 947 REAL(wp),DIMENSION(:,:,:), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix 948 REAL(wp),DIMENSION(:,:,:), INTENT(in ) :: pRHS ! Right-Hand-Side 949 REAL(wp),DIMENSION(:,:,:), INTENT( out) :: pt_out !!gm field at level=F(klev) 950 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level 951 ! ! =0 pt at t-level 952 INTEGER :: ji, jj, jk ! dummy loop integers 953 INTEGER :: kstart ! local indices 954 REAL(wp),DIMENSION(jpi,jpj,jpk) :: zwt ! 3D work array 955 !!---------------------------------------------------------------------- 956 ! 957 kstart = 1 + klev 958 ! 959 DO jj = 2, jpjm1 !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 960 DO ji = fs_2, fs_jpim1 961 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 962 END DO 963 END DO 964 DO jk = kstart+1, jpkm1 965 DO jj = 2, jpjm1 966 DO ji = fs_2, fs_jpim1 967 zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 968 END DO 969 END DO 970 END DO 971 ! 972 DO jj = 2, jpjm1 !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 973 DO ji = fs_2, fs_jpim1 974 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 975 END DO 976 END DO 977 DO jk = kstart+1, jpkm1 978 DO jj = 2, jpjm1 979 DO ji = fs_2, fs_jpim1 980 pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 981 END DO 982 END DO 983 END DO 984 985 DO jj = 2, jpjm1 !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 986 DO ji = fs_2, fs_jpim1 987 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 988 END DO 989 END DO 990 DO jk = jpk-2, kstart, -1 991 DO jj = 2, jpjm1 992 DO ji = fs_2, fs_jpim1 993 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 994 END DO 995 END DO 996 END DO 997 ! 998 END SUBROUTINE tridia_solver 999 793 1000 !!====================================================================== 794 1001 END MODULE traadv_fct -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r6140 r7646 308 308 WRITE(numout,*) 309 309 IF( ln_mle ) THEN 310 WRITE(numout,*) ' Mixed Layer Eddy induced transport added to tracer advection'311 IF( nn_mle == 0 ) WRITE(numout,*) ' Fox-Kemper et al 2010 formulation'312 IF( nn_mle == 1 ) WRITE(numout,*) ' New formulation'310 WRITE(numout,*) ' ===>> Mixed Layer Eddy induced transport added to tracer advection' 311 IF( nn_mle == 0 ) WRITE(numout,*) ' Fox-Kemper et al 2010 formulation' 312 IF( nn_mle == 1 ) WRITE(numout,*) ' New formulation' 313 313 ELSE 314 WRITE(numout,*) ' Mixed Layer Eddy parametrisation NOT used'314 WRITE(numout,*) ' ===>> Mixed Layer Eddy parametrisation NOT used' 315 315 ENDIF 316 316 ENDIF … … 329 329 DO jj = 2, jpj ! "coriolis+ time^-1" at u- & v-points 330 330 DO ji = fs_2, jpi ! vector opt. 331 zfu = ( ff (ji,jj) + ff(ji,jj-1) ) * 0.5_wp332 zfv = ( ff (ji,jj) + ff(ji-1,jj) ) * 0.5_wp331 zfu = ( ff_f(ji,jj) + ff_f(ji,jj-1) ) * 0.5_wp 332 zfv = ( ff_f(ji,jj) + ff_f(ji-1,jj) ) * 0.5_wp 333 333 rfu(ji,jj) = SQRT( zfu * zfu + z1_t2 ) 334 334 rfv(ji,jj) = SQRT( zfv * zfv + z1_t2 ) … … 347 347 ! 348 348 z1_t2 = 1._wp / ( rn_time * rn_time ) 349 r1_ft(:,:) = 2._wp * omega * SIN( rad * gphit(:,:) ) 350 r1_ft(:,:) = 1._wp / SQRT( r1_ft(:,:) * r1_ft(:,:) + z1_t2 ) 349 r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 351 350 ! 352 351 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r6140 r7646 23 23 USE sbcrnf ! river runoffs 24 24 USE diaptr ! poleward transport diagnostics 25 USE diaar5 ! AR5 diagnostics 26 25 27 ! 28 USE iom 26 29 USE wrk_nemo ! Memory Allocation 27 30 USE timing ! Timing … … 37 40 38 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: upsmsk !: mixed upstream/centered scheme near some straits 39 ! ! and in closed seas (orca 2 and 4configurations)42 ! ! and in closed seas (orca 2 and 1 configurations) 40 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xind !: mixed upstream/centered index 41 44 45 LOGICAL :: l_trd ! flag to compute trends 46 LOGICAL :: l_ptr ! flag to compute poleward transport 47 LOGICAL :: l_hst ! flag to compute heat/salt transport 48 42 49 !! * Substitutions 43 50 # include "vectopt_loop_substitute.h90" … … 116 123 ENDIF 117 124 ! 125 l_trd = .FALSE. 126 l_hst = .FALSE. 127 l_ptr = .FALSE. 128 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 129 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 130 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 131 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 132 ! 118 133 DO jn = 1, kjpt !== loop over the tracers ==! 119 134 ! … … 192 207 END DO 193 208 ! ! trend diagnostics 194 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 195 &( cdtype == 'TRC' .AND. l_trdtrc ) ) THEN 209 IF( l_trd ) THEN 196 210 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 197 211 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 198 212 END IF 199 ! ! "Poleward" heat and salt transports 200 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 201 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 202 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 203 ENDIF 213 ! ! "Poleward" heat and salt transports 214 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 215 ! ! heat transport 216 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) ) 204 217 ! 205 218 ! !* Vertical advective fluxes … … 262 275 END DO 263 276 ! ! send trends for diagnostic 264 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. & 265 &( cdtype == 'TRC' .AND. l_trdtrc ) ) & 266 CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 277 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 267 278 ! 268 279 END DO ! end of tracer loop -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6140 r7646 34 34 PUBLIC tra_adv_qck ! routine called by step.F90 35 35 36 LOGICAL :: l_trd ! flag to compute trends37 36 REAL(wp) :: r1_6 = 1./ 6. ! 1/6 ratio 37 38 LOGICAL :: l_trd ! flag to compute trends 39 LOGICAL :: l_ptr ! flag to compute poleward transport 40 38 41 39 42 !! * Substitutions … … 103 106 ! 104 107 l_trd = .FALSE. 105 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 108 l_ptr = .FALSE. 109 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 110 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 111 ! 106 112 ! 107 113 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme … … 224 230 END DO 225 231 ! ! trend diagnostics 226 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )232 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 227 233 ! 228 234 END DO … … 347 353 END DO 348 354 ! ! trend diagnostics 349 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 350 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 351 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 352 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( zwy(:,:,:) ) 353 IF( jn == jp_sal ) str_adv(:) = ptr_sj( zwy(:,:,:) ) 354 ENDIF 357 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 355 358 ! 356 359 END DO -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6140 r7646 19 19 USE trdtra ! trends manager: tracers 20 20 USE diaptr ! poleward transport diagnostics 21 USE diaar5 ! AR5 diagnostics 22 21 23 ! 24 USE iom 22 25 USE lib_mpp ! I/O library 23 26 USE lbclnk ! ocean lateral boundary condition (or mpp link) … … 32 35 PUBLIC tra_adv_ubs ! routine called by traadv module 33 36 34 LOGICAL :: l_trd ! flag to compute trends or not 37 LOGICAL :: l_trd ! flag to compute trends 38 LOGICAL :: l_ptr ! flag to compute poleward transport 39 LOGICAL :: l_hst ! flag to compute heat transport 40 35 41 36 42 !! * Substitutions … … 109 115 ! 110 116 l_trd = .FALSE. 111 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 117 l_hst = .FALSE. 118 l_ptr = .FALSE. 119 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 120 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 121 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 122 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 112 123 ! 113 124 ztw (:,:, 1 ) = 0._wp ! surface & bottom value : set to zero for all tracers … … 176 187 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 177 188 END IF 178 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 179 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 180 IF( jn == jp_tem ) htr_adv(:) = ptr_sj( ztv(:,:,:) ) 181 IF( jn == jp_sal ) str_adv(:) = ptr_sj( ztv(:,:,:) ) 182 ENDIF 189 ! 190 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 191 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', ztv(:,:,:) ) 192 ! ! heati/salt transport 193 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztu(:,:,:), ztv(:,:,:) ) 194 ! 183 195 ! 184 196 ! !== vertical advective trend ==! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90
r6140 r7646 176 176 ! fill sf_chl with sn_chl and control print 177 177 CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init', & 178 & 'bottom temperature boundary condition', 'nambbc' )178 & 'bottom temperature boundary condition', 'nambbc', no_print ) 179 179 180 180 CALL fld_read( nit000, 1, sf_qgh ) ! Read qgh data -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r6140 r7646 519 519 WRITE(numout,*) 'tra_bbl_init : bottom boundary layer initialisation' 520 520 WRITE(numout,*) '~~~~~~~~~~~~' 521 WRITE(numout,*) ' 522 WRITE(numout,*) ' 523 WRITE(numout,*) ' 524 WRITE(numout,*) ' 525 WRITE(numout,*) ' 521 WRITE(numout,*) ' Namelist nambbl : set bbl parameters' 522 WRITE(numout,*) ' diffusive bbl (=1) or not (=0) nn_bbl_ldf = ', nn_bbl_ldf 523 WRITE(numout,*) ' advective bbl (=1/2) or not (=0) nn_bbl_adv = ', nn_bbl_adv 524 WRITE(numout,*) ' diffusive bbl coefficient rn_ahtbbl = ', rn_ahtbbl, ' m2/s' 525 WRITE(numout,*) ' advective bbl coefficient rn_gambbl = ', rn_gambbl, ' s' 526 526 ENDIF 527 527 … … 545 545 CALL wrk_dealloc( jpi, jpj, zmbk ) 546 546 547 547 ! !* sign of grad(H) at u- and v-points 548 548 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 549 549 DO jj = 1, jpjm1 … … 553 553 END DO 554 554 END DO 555 555 ! 556 556 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 557 557 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) … … 561 561 END DO 562 562 CALL lbc_lnk( e3u_bbl_0, 'U', 1. ) ; CALL lbc_lnk( e3v_bbl_0, 'V', 1. ) ! lateral boundary conditions 563 563 ! 564 564 ! !* masked diffusive flux coefficients 565 565 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 566 566 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 567 567 568 569 IF( cp_cfg == "orca" ) THEN !* ORCA configuration : regional enhancement of ah_bbl570 !571 SELECT CASE ( jp_cfg )572 CASE ( 2 ) ! ORCA_R2573 ij0 = 102 ; ij1 = 102 ! Gibraltar enhancement of BBL574 ii0 = 139 ; ii1 = 140575 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))576 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))577 !578 ij0 = 88 ; ij1 = 88 ! Red Sea enhancement of BBL579 ii0 = 161 ; ii1 = 162580 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))581 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))582 !583 CASE ( 4 ) ! ORCA_R4584 ij0 = 52 ; ij1 = 52 ! Gibraltar enhancement of BBL585 ii0 = 70 ; ii1 = 71586 ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))587 ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1))588 END SELECT589 !590 ENDIF591 568 ! 592 569 IF( nn_timing == 1 ) CALL timing_stop( 'tra_bbl_init') -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90
r6140 r7646 192 192 WRITE(numout,*) 193 193 WRITE(numout,*) 'tra_dmp_init : T and S newtonian relaxation' 194 WRITE(numout,*) '~~~~~~~~~~~ '194 WRITE(numout,*) '~~~~~~~~~~~~' 195 195 WRITE(numout,*) ' Namelist namtra_dmp : set relaxation parameters' 196 196 WRITE(numout,*) ' Apply relaxation or not ln_tradmp = ', ln_tradmp -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf.F90
r6352 r7646 110 110 WRITE(numout,*) 111 111 WRITE(numout,*) 'tra_ldf_init : lateral tracer diffusive operator' 112 WRITE(numout,*) '~~~~~~~~~~~ '112 WRITE(numout,*) '~~~~~~~~~~~~' 113 113 WRITE(numout,*) ' Namelist namtra_ldf: already read in ldftra module' 114 114 WRITE(numout,*) ' see ldf_tra_init report for lateral mixing parameters' 115 WRITE(numout,*)116 115 ENDIF 117 116 ! ! use of lateral operator or not … … 187 186 WRITE(numout,*) 188 187 SELECT CASE( nldf ) 189 CASE( np_no_ldf ) ; WRITE(numout,*) ' NO lateral diffusion'190 CASE( np_lap ) ; WRITE(numout,*) ' laplacian iso-level operator'191 CASE( np_lap_i ) ; WRITE(numout,*) ' Rotated laplacian operator (standard)'192 CASE( np_lap_it ) ; WRITE(numout,*) ' Rotated laplacian operator (triad)'193 CASE( np_blp ) ; WRITE(numout,*) ' bilaplacian iso-level operator'194 CASE( np_blp_i ) ; WRITE(numout,*) ' Rotated bilaplacian operator (standard)'195 CASE( np_blp_it ) ; WRITE(numout,*) ' Rotated bilaplacian operator (triad)'188 CASE( np_no_ldf ) ; WRITE(numout,*) ' ===>> NO lateral diffusion' 189 CASE( np_lap ) ; WRITE(numout,*) ' ===>> laplacian iso-level operator' 190 CASE( np_lap_i ) ; WRITE(numout,*) ' ===>> Rotated laplacian operator (standard)' 191 CASE( np_lap_it ) ; WRITE(numout,*) ' ===>> Rotated laplacian operator (triad)' 192 CASE( np_blp ) ; WRITE(numout,*) ' ===>> bilaplacian iso-level operator' 193 CASE( np_blp_i ) ; WRITE(numout,*) ' ===>> Rotated bilaplacian operator (standard)' 194 CASE( np_blp_it ) ; WRITE(numout,*) ' ===>> Rotated bilaplacian operator (triad)' 196 195 END SELECT 197 196 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6140 r7646 24 24 USE ldfslp ! iso-neutral slopes 25 25 USE diaptr ! poleward transport diagnostics 26 USE diaar5 ! AR5 diagnostics 26 27 ! 27 28 USE in_out_manager ! I/O manager … … 36 37 37 38 PUBLIC tra_ldf_iso ! routine called by step.F90 39 40 LOGICAL :: l_ptr ! flag to compute poleward transport 41 LOGICAL :: l_hst ! flag to compute heat transport 38 42 39 43 !! * Substitutions … … 107 111 REAL(wp) :: zmskv, zahv_w, zabe2, zcof2, zcoef4 ! - - 108 112 REAL(wp) :: zcoef0, ze3w_2, zsign, z2dt, z1_2dt ! - - 109 #if defined key_diaar5110 REAL(wp) :: zztmp ! local scalar111 #endif112 113 REAL(wp), POINTER, DIMENSION(:,:) :: zdkt, zdk1t, z2d 113 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw … … 127 128 ah_wslp2(:,:,:) = 0._wp 128 129 ENDIF 129 ! ! set time step size (Euler/Leapfrog) 130 ! 131 l_hst = .FALSE. 132 l_ptr = .FALSE. 133 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 134 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 135 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 136 ! 137 ! ! set time step size (Euler/Leapfrog) 130 138 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2dt = rdt ! at nit000 (Euler) 131 139 ELSE ; z2dt = 2.* rdt ! (Leapfrog) … … 369 377 ! 370 378 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 371 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 372 ! note sign is reversed to give down-gradient diffusive transports (#1043) 373 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -zftv(:,:,:) ) 374 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -zftv(:,:,:) ) 375 ENDIF 376 ! 377 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 378 ! 379 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 380 z2d(:,:) = zftu(ji,jj,1) 381 DO jk = 2, jpkm1 382 DO jj = 2, jpjm1 383 DO ji = fs_2, fs_jpim1 ! vector opt. 384 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 385 END DO 386 END DO 387 END DO 388 !!gm CAUTION I think there is an error of sign when using BLP operator.... 389 !!gm a multiplication by zsign is required (to be checked twice !) 390 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 391 CALL lbc_lnk( z2d, 'U', -1. ) 392 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 393 ! 394 z2d(:,:) = zftv(ji,jj,1) 395 DO jk = 2, jpkm1 396 DO jj = 2, jpjm1 397 DO ji = fs_2, fs_jpim1 ! vector opt. 398 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 399 END DO 400 END DO 401 END DO 402 z2d(:,:) = - rau0_rcp * z2d(:,:) ! note sign is reversed to give down-gradient diffusive transports (#1043) 403 CALL lbc_lnk( z2d, 'V', -1. ) 404 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 405 END IF 406 ! 407 ENDIF 379 ! note sign is reversed to give down-gradient diffusive transports ) 380 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -zftv(:,:,:) ) 381 ! ! Diffusive heat transports 382 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -zftu(:,:,:), -zftv(:,:,:) ) 408 383 ! 409 384 ENDIF !== end pass selection ==! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
r6140 r7646 17 17 USE traldf_triad ! iso-neutral lateral diffusion (triad operator) (tra_ldf_triad routine) 18 18 USE diaptr ! poleward transport diagnostics 19 USE diaar5 ! AR5 diagnostics 19 20 USE trc_oce ! share passive tracers/Ocean variables 20 21 USE zpshde ! partial step: hor. derivative (zps_hde routine) … … 25 26 USE timing ! Timing 26 27 USE wrk_nemo ! Memory allocation 28 USE iom 27 29 28 30 IMPLICIT NONE … … 39 41 INTEGER, PARAMETER, PUBLIC :: np_lap_i = 11 , np_blp_i = 21 ! standard iso-neutral or geopotential operator 40 42 INTEGER, PARAMETER, PUBLIC :: np_lap_it = 12 , np_blp_it = 22 ! triad iso-neutral or geopotential operator 43 44 LOGICAL :: l_ptr ! flag to compute poleward transport 45 LOGICAL :: l_hst ! flag to compute heat transport 41 46 42 47 !! * Substitutions … … 95 100 CALL wrk_alloc( jpi,jpj,jpk, ztu, ztv, zaheeu, zaheev ) 96 101 ! 102 l_hst = .FALSE. 103 l_ptr = .FALSE. 104 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 105 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 106 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 107 ! 97 108 ! !== Initialization of metric arrays used for all tracers ==! 98 109 IF( kpass == 1 ) THEN ; zsign = 1._wp ! bilaplacian operator require a minus sign (eddy diffusivity >0) … … 150 161 IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR. & !== first pass only ( laplacian) ==! 151 162 ( kpass == 2 .AND. ln_traldf_blp ) ) THEN !== 2nd pass only (bilaplacian) ==! 152 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 153 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( -ztv(:,:,:) ) 154 IF( jn == jp_sal) str_ldf(:) = ptr_sj( -ztv(:,:,:) ) 155 ENDIF 163 164 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', -ztv(:,:,:) ) 165 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', -ztu(:,:,:), -ztv(:,:,:) ) 156 166 ENDIF 157 167 ! ! ================== -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r6140 r7646 20 20 USE traldf_iso ! lateral diffusion (Madec operator) (tra_ldf_iso routine) 21 21 USE diaptr ! poleward transport diagnostics 22 USE diaar5 ! AR5 diagnostics 22 23 USE zpshde ! partial step: hor. derivative (zps_hde routine) 23 24 ! … … 35 36 36 37 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: zdkt3d !: vertical tracer gradient at 2 levels 38 39 LOGICAL :: l_ptr ! flag to compute poleward transport 40 LOGICAL :: l_hst ! flag to compute heat transport 41 37 42 38 43 !! * Substitutions … … 89 94 REAL(wp) :: ze1ur, ze2vr, ze3wr, zdxt, zdyt, zdzt 90 95 REAL(wp) :: zah, zah_slp, zaei_slp 91 #if defined key_diaar592 REAL(wp) :: zztmp ! local scalar93 #endif94 96 REAL(wp), POINTER, DIMENSION(:,: ) :: z2d ! 2D workspace 95 97 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdit, zdjt, zftu, zftv, ztfw, zpsi_uw, zpsi_vw ! 3D - … … 112 114 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 113 115 ENDIF 114 ! ! set time step size (Euler/Leapfrog) 116 ! 117 l_hst = .FALSE. 118 l_ptr = .FALSE. 119 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 120 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 121 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 122 ! 123 ! ! set time step size (Euler/Leapfrog) 115 124 IF( neuler == 0 .AND. kt == kit000 ) THEN ; z2dt = rdt ! at nit000 (Euler) 116 125 ELSE ; z2dt = 2.* rdt ! (Leapfrog) … … 416 425 ! 417 426 ! ! "Poleward" diffusive heat or salt transports (T-S case only) 418 IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN 419 IF( jn == jp_tem) htr_ldf(:) = ptr_sj( zftv(:,:,:) ) ! 3.3 names 420 IF( jn == jp_sal) str_ldf(:) = ptr_sj( zftv(:,:,:) ) 421 ENDIF 422 ! 423 IF( iom_use("udiff_heattr") .OR. iom_use("vdiff_heattr") ) THEN 424 ! 425 IF( cdtype == 'TRA' .AND. jn == jp_tem ) THEN 426 z2d(:,:) = zftu(ji,jj,1) 427 DO jk = 2, jpkm1 428 DO jj = 2, jpjm1 429 DO ji = fs_2, fs_jpim1 ! vector opt. 430 z2d(ji,jj) = z2d(ji,jj) + zftu(ji,jj,jk) 431 END DO 432 END DO 433 END DO 434 z2d(:,:) = rau0_rcp * z2d(:,:) 435 CALL lbc_lnk( z2d, 'U', -1. ) 436 CALL iom_put( "udiff_heattr", z2d ) ! heat i-transport 437 ! 438 z2d(:,:) = zftv(ji,jj,1) 439 DO jk = 2, jpkm1 440 DO jj = 2, jpjm1 441 DO ji = fs_2, fs_jpim1 ! vector opt. 442 z2d(ji,jj) = z2d(ji,jj) + zftv(ji,jj,jk) 443 END DO 444 END DO 445 END DO 446 z2d(:,:) = rau0_rcp * z2d(:,:) 447 CALL lbc_lnk( z2d, 'V', -1. ) 448 CALL iom_put( "vdiff_heattr", z2d ) ! heat j-transport 449 ENDIF 450 ! 451 ENDIF 427 IF( l_ptr ) CALL dia_ptr_hst( jn, 'ldf', zftv(:,:,:) ) 428 ! ! Diffusive heat transports 429 IF( l_hst ) CALL dia_ar5_hst( jn, 'ldf', zftu(:,:,:), zftv(:,:,:) ) 452 430 ! 453 431 ENDIF !== end pass selection ==! -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r6140 r7646 37 37 USE ldftra ! lateral physics on tracers 38 38 USE ldfslp 39 USE bdy_oce ! BDY open boundary condition variables39 USE bdy_oce , ONLY: ln_bdy 40 40 USE bdytra ! open boundary condition (bdy_tra routine) 41 41 ! … … 79 79 !! - Apply lateral boundary conditions on (ta,sa) 80 80 !! at the local domain boundaries through lbc_lnk call, 81 !! at the one-way open boundaries (l k_bdy=T),81 !! at the one-way open boundaries (ln_bdy=T), 82 82 !! at the AGRIF zoom boundaries (lk_agrif=T) 83 83 !! … … 111 111 CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1._wp ) 112 112 ! 113 #if defined key_bdy 114 IF( lk_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 115 #endif 113 IF( ln_bdy ) CALL bdy_tra( kt ) ! BDY open boundaries 116 114 117 115 ! set time step size (Euler/Leapfrog) … … 121 119 122 120 ! trends computation initialisation 123 IF( l_trdtra ) THEN ! store now fields before applying the Asselin filter121 IF( l_trdtra ) THEN 124 122 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 125 ztrdt(:,:, :) = tsn(:,:,:,jp_tem)126 ztrds(:,:, :) = tsn(:,:,:,jp_sal)123 ztrdt(:,:,jk) = 0._wp 124 ztrds(:,:,jk) = 0._wp 127 125 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 128 126 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) 129 127 CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds ) 130 128 ENDIF 129 ! total trend for the non-time-filtered variables. 130 zfact = 1.0 / rdt 131 DO jk = 1, jpkm1 132 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact 133 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact 134 END DO 135 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 136 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 137 ! Store now fields before applying the Asselin filter 138 ! in order to calculate Asselin filter trend later. 139 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 140 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 131 141 ENDIF 132 142 -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r6403 r7646 406 406 ! ! fill sf_chl with sn_chl and control print 407 407 CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init', & 408 & 'Solar penetration function of read chlorophyll', 'namtra_qsr' )408 & 'Solar penetration function of read chlorophyll', 'namtra_qsr' , no_print ) 409 409 ENDIF 410 410 IF( nqsr == np_RGB ) THEN ! constant Chl … … 422 422 ! 423 423 IF(lwp) WRITE(numout,*) ' bio-model light penetration' 424 IF( .NOT.lk_ qsr_bio) CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' )424 IF( .NOT.lk_top ) CALL ctl_stop( 'No bio model : ln_qsr_bio = true impossible ' ) 425 425 ! 426 426 END SELECT -
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r6140 r7646 141 141 WRITE(numout,*) 'tra_zdf_init : vertical tracer physics scheme' 142 142 WRITE(numout,*) '~~~~~~~~~~~' 143 IF( nzdf == 0 ) WRITE(numout,*) ' 144 IF( nzdf == 1 ) WRITE(numout,*) ' 143 IF( nzdf == 0 ) WRITE(numout,*) ' ===>> Explicit time-splitting scheme' 144 IF( nzdf == 1 ) WRITE(numout,*) ' ===>> Implicit (euler backward) scheme' 145 145 ENDIF 146 146 !
Note: See TracChangeset
for help on using the changeset viewer.
