Changeset 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA
- Timestamp:
- 2016-11-30T17:56:53+01:00 (8 years ago)
- Location:
- branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA
- Files:
-
- 9 edited
-
traadv.F90 (modified) (8 diffs)
-
traadv_cen.F90 (modified) (4 diffs)
-
traadv_fct.F90 (modified) (10 diffs)
-
traadv_mus.F90 (modified) (5 diffs)
-
traadv_qck.F90 (modified) (4 diffs)
-
traadv_ubs.F90 (modified) (4 diffs)
-
traldf_iso.F90 (modified) (5 diffs)
-
traldf_lap_blp.F90 (modified) (5 diffs)
-
traldf_triad.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r6140 r7403 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 113 zun(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * & 114 & ( un(:,:,jk) + usd3d(:,:,jk) ) ! eulerian transport + Stokes Drift 115 zvn(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * & 116 & ( vn(:,:,jk) + vsd3d(:,:,jk) ) 117 zwn(:,:,jk) = e1e2t(:,:) * & 118 & ( wn(:,:,jk) + wsd3d(:,:,jk) ) 119 END DO 120 ELSE 121 DO jk = 1, jpkm1 122 zun(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only 123 zvn(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 124 zwn(:,:,jk) = e1e2t(:,:) * wn(:,:,jk) 125 END DO 126 ENDIF 107 127 ! 108 128 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections … … 127 147 IF( ln_diaptr ) CALL dia_ptr( zvn ) ! diagnose the effective MSF 128 148 !!gm ??? 149 ! 150 IF( l_trdtra ) THEN !* Save ta and sa trends 151 CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 152 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 153 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 154 ENDIF 129 155 ! 130 156 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! … … 145 171 END SELECT 146 172 ! 147 ! ! print mean trends (used for debugging) 173 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 174 DO jk = 1, jpkm1 175 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 176 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 177 END DO 178 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 179 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 180 CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 181 ENDIF 182 ! ! print mean trends (used for debugging) 148 183 IF(ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, & 149 184 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90
r6140 r7403 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 … … 32 33 33 34 REAL(wp) :: r1_6 = 1._wp / 6._wp ! =1/6 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 34 39 35 40 !! * Substitutions … … 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 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_fct.F90
r6771 r7403 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 39 44 … … 80 85 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 81 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 82 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 87 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz, zptry 88 REAL(wp), POINTER, DIMENSION(:,:) :: z2d 83 89 !!---------------------------------------------------------------------- 84 90 ! … … 94 100 ! 95 101 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 102 l_hst = .FALSE. 103 l_ptr = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 106 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 107 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 108 ! 109 IF( l_trd .OR. l_hst ) THEN 99 110 CALL wrk_alloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 100 111 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 101 112 ENDIF 102 113 ! 114 IF( l_ptr ) THEN 115 CALL wrk_alloc( jpi, jpj, jpk, zptry ) 116 zptry(:,:,:) = 0._wp 117 ENDIF 103 118 ! ! surface & bottom value : flux set to zero one for all 104 119 zwz(:,:, 1 ) = 0._wp … … 161 176 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 162 177 ! 163 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)178 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 164 179 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 165 180 END IF 166 181 ! ! "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 182 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 171 183 ! 172 184 ! !== anti-diffusive flux : high order minus low order ==! … … 292 304 END DO 293 305 ! 294 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)306 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 295 307 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 296 308 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 297 309 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 298 ! 310 ENDIF 311 ! 312 IF( l_trd ) THEN 299 313 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 300 314 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 301 315 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 302 316 ! 303 CALL wrk_dealloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz )304 317 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(:,:,:) ) 318 ! ! heat/salt transport 319 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 320 321 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 322 IF( l_ptr ) THEN 323 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 324 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 309 325 ENDIF 310 326 ! 311 327 END DO ! end of tracer loop 312 328 ! 313 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 329 CALL wrk_dealloc( jpi,jpj,jpk, zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw ) 330 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 331 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 314 332 ! 315 333 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct') … … 357 375 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwi, zwx, zwy, zwz, zhdiv, zwzts, zwz_sav 358 376 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdx, ztrdy, ztrdz 377 REAL(wp), POINTER, DIMENSION(:,:,:) :: zptry 359 378 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrs 360 379 !!---------------------------------------------------------------------- … … 373 392 ! 374 393 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 394 l_hst = .FALSE. 395 l_ptr = .FALSE. 396 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 397 IF( cdtype == 'TRA' .AND. ln_diaptr ) l_ptr = .TRUE. 398 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 399 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 400 ! 401 IF( l_trd .OR. l_hst ) THEN 378 402 CALL wrk_alloc( jpi,jpj,jpk, ztrdx, ztrdy, ztrdz ) 379 403 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 380 404 ENDIF 381 405 ! 406 IF( l_ptr ) THEN 407 CALL wrk_alloc( jpi, jpj,jpk, zptry ) 408 zptry(:,:,:) = 0._wp 409 ENDIF 382 410 zwi(:,:,:) = 0._wp 383 411 z_rzts = 1._wp / REAL( kn_fct_zts, wp ) … … 445 473 CALL lbc_lnk( zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign) 446 474 ! 447 IF( l_trd ) THEN ! trend diagnostics (contribution of upstream fluxes)475 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 448 476 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 449 477 END IF 450 478 ! ! "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 479 IF( l_ptr ) zptry(:,:,:) = zwy(:,:,:) 455 480 456 481 ! 3. anti-diffusive flux : high order minus low order … … 568 593 END DO 569 594 570 ! ! trend diagnostics (contribution of upstream fluxes)571 IF( l_trd ) THEN595 ! 596 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 572 597 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< Add to previously computed 573 598 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 574 599 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 ) 600 ENDIF 601 ! 602 IF( l_trd ) THEN 603 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 604 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 605 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 606 ! 581 607 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(:) 608 ! ! heat/salt transport 609 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(:,:,:), ztrdy(:,:,:) ) 610 611 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 612 IF( l_ptr ) THEN 613 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< Add to previously computed 614 CALL dia_ptr_hst( jn, 'adv', zptry(:,:,:) ) 586 615 ENDIF 587 616 ! 588 617 END DO 589 618 ! 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 ) 619 CALL wrk_alloc( jpi,jpj, zwx_sav, zwy_sav ) 620 CALL wrk_alloc( jpi,jpj, jpk, zwx, zwy, zwz, zwi, zhdiv, zwzts, zwz_sav ) 621 CALL wrk_alloc( jpi,jpj,jpk,kjpt+1, ztrs ) 622 IF( l_trd .OR. l_hst ) CALL wrk_dealloc( jpi, jpj, jpk, ztrdx, ztrdy, ztrdz ) 623 IF( l_ptr ) CALL wrk_dealloc( jpi, jpj, jpk, zptry ) 593 624 ! 594 625 IF( nn_timing == 1 ) CALL timing_stop('tra_adv_fct_zts') -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mus.F90
r6140 r7403 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 … … 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 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r6140 r7403 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 -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r6140 r7403 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 ==! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r6140 r7403 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 ==! -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_blp.F90
r6140 r7403 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 ! ! ================== -
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r6140 r7403 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 ==!
Note: See TracChangeset
for help on using the changeset viewer.
