Changeset 12377 for NEMO/trunk/src/OCE/TRA/traadv.F90
- Timestamp:
- 2020-02-12T15:39:06+01:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRA/traadv.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEAD ext/AGRIF5 ^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL
-
- Property svn:externals
-
NEMO/trunk/src/OCE/TRA/traadv.F90
r11993 r12377 66 66 INTEGER, PARAMETER :: np_QCK = 5 ! QUICK scheme 67 67 68 !! * Substitutions69 # include "vectopt_loop_substitute.h90"70 68 !!---------------------------------------------------------------------- 71 69 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 73 CONTAINS 76 74 77 SUBROUTINE tra_adv( kt )75 SUBROUTINE tra_adv( kt, Kbb, Kmm, pts, Krhs ) 78 76 !!---------------------------------------------------------------------- 79 77 !! *** ROUTINE tra_adv *** … … 81 79 !! ** Purpose : compute the ocean tracer advection trend. 82 80 !! 83 !! ** Method : - Update (ua,va) with the advection term following nadv 84 !!---------------------------------------------------------------------- 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 81 !! ** Method : - Update (uu(:,:,:,Krhs),vv(:,:,:,Krhs)) with the advection term following nadv 82 !!---------------------------------------------------------------------- 83 INTEGER , INTENT(in) :: kt ! ocean time-step index 84 INTEGER , INTENT(in) :: Kbb, Kmm, Krhs ! time level indices 85 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 86 86 ! 87 87 INTEGER :: jk ! dummy loop index 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zu n, zvn, zwn! 3D workspace88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zuu, zvv, zww ! 3D workspace 89 89 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 90 90 !!---------------------------------------------------------------------- … … 98 98 ! 99 99 ! !== effective transport ==! 100 zu n(:,:,jpk) = 0._wp101 zv n(:,:,jpk) = 0._wp102 zw n(:,:,jpk) = 0._wp100 zuu(:,:,jpk) = 0._wp 101 zvv(:,:,jpk) = 0._wp 102 zww(:,:,jpk) = 0._wp 103 103 IF( ln_wave .AND. ln_sdw ) THEN 104 104 DO jk = 1, jpkm1 ! eulerian transport + Stokes Drift 105 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) )106 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) )107 zw n(:,:,jk) = e1e2t(:,:) * ( wn(:,:,jk) + wsd(:,:,jk) )105 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 106 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 107 zww(:,:,jk) = e1e2t(:,:) * ( ww(:,:,jk) + wsd(:,:,jk) ) 108 108 END DO 109 109 ELSE 110 110 DO jk = 1, jpkm1 111 zu n(:,:,jk) = e2u (:,:) * e3u_n(:,:,jk) * un(:,:,jk) ! eulerian transport only112 zv n(:,:,jk) = e1v (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)113 zw n(:,:,jk) = e1e2t(:,:) * wn(:,:,jk)111 zuu(:,:,jk) = e2u (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm) ! eulerian transport only 112 zvv(:,:,jk) = e1v (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 113 zww(:,:,jk) = e1e2t(:,:) * ww(:,:,jk) 114 114 END DO 115 115 ENDIF 116 116 ! 117 117 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! add z-tilde and/or vvl corrections 118 zu n(:,:,:) = zun(:,:,:) + un_td(:,:,:)119 zv n(:,:,:) = zvn(:,:,:) + vn_td(:,:,:)120 ENDIF 121 ! 122 zu n(:,:,jpk) = 0._wp ! no transport trough the bottom123 zv n(:,:,jpk) = 0._wp124 zw n(:,:,jpk) = 0._wp118 zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 119 zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 120 ENDIF 121 ! 122 zuu(:,:,jpk) = 0._wp ! no transport trough the bottom 123 zvv(:,:,jpk) = 0._wp 124 zww(:,:,jpk) = 0._wp 125 125 ! 126 126 IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad ) & 127 & CALL ldf_eiv_trp( kt, nit000, zu n, zvn, zwn, 'TRA') ! add the eiv transport (if necessary)128 ! 129 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zu n, zvn, zwn, 'TRA') ! add the mle transport (if necessary)130 ! 131 CALL iom_put( "uocetr_eff", zu n) ! output effective transport132 CALL iom_put( "vocetr_eff", zv n)133 CALL iom_put( "wocetr_eff", zw n)127 & CALL ldf_eiv_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm, Krhs ) ! add the eiv transport (if necessary) 128 ! 129 IF( ln_mle ) CALL tra_mle_trp( kt, nit000, zuu, zvv, zww, 'TRA', Kmm ) ! add the mle transport (if necessary) 130 ! 131 CALL iom_put( "uocetr_eff", zuu ) ! output effective transport 132 CALL iom_put( "vocetr_eff", zvv ) 133 CALL iom_put( "wocetr_eff", zww ) 134 134 ! 135 135 !!gm ??? 136 IF( ln_diaptr ) CALL dia_ptr( zvn) ! diagnose the effective MSF136 CALL dia_ptr( kt, Kmm, zvv ) ! diagnose the effective MSF 137 137 !!gm ??? 138 138 ! 139 139 140 IF( l_trdtra ) THEN !* Save ta and sa trends 140 141 ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 141 ztrdt(:,:,:) = tsa(:,:,:,jp_tem)142 ztrds(:,:,:) = tsa(:,:,:,jp_sal)142 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 143 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 143 144 ENDIF 144 145 ! … … 146 147 ! 147 148 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 CALL tra_adv_cen ( kt, nit000, 'TRA', zu n, zvn, zwn , tsn, tsa, jpts, nn_cen_h, nn_cen_v )149 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 149 150 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 150 CALL tra_adv_fct ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v )151 CALL tra_adv_fct ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 151 152 CASE ( np_MUS ) ! MUSCL 152 CALL tra_adv_mus ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsa, jpts, ln_mus_ups )153 CALL tra_adv_mus ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 153 154 CASE ( np_UBS ) ! UBS 154 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts, nn_ubs_v )155 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 155 156 CASE ( np_QCK ) ! QUICKEST 156 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zu n, zvn, zwn, tsb, tsn, tsa, jpts)157 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 157 158 ! 158 159 END SELECT … … 160 161 IF( l_trdtra ) THEN ! save the advective trends for further diagnostics 161 162 DO jk = 1, jpkm1 162 ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk)163 ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk)163 ztrdt(:,:,jk) = pts(:,:,jk,jp_tem,Krhs) - ztrdt(:,:,jk) 164 ztrds(:,:,jk) = pts(:,:,jk,jp_sal,Krhs) - ztrds(:,:,jk) 164 165 END DO 165 CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt )166 CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds )166 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_totad, ztrdt ) 167 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_totad, ztrds ) 167 168 DEALLOCATE( ztrdt, ztrds ) 168 169 ENDIF 169 170 ! ! print mean trends (used for debugging) 170 IF( ln_ctl) CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv - Ta: ', mask1=tmask, &171 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )171 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' adv - Ta: ', mask1=tmask, & 172 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 172 173 ! 173 174 IF( ln_timing ) CALL timing_stop( 'tra_adv' ) … … 194 195 ! 195 196 ! !== Namelist ==! 196 REWIND( numnam_ref ) ! Namelist namtra_adv in reference namelist : Tracer advection scheme197 197 READ ( numnam_ref, namtra_adv, IOSTAT = ios, ERR = 901) 198 198 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_adv in reference namelist' ) 199 199 ! 200 REWIND( numnam_cfg ) ! Namelist namtra_adv in configuration namelist : Tracer advection scheme201 200 READ ( numnam_cfg, namtra_adv, IOSTAT = ios, ERR = 902 ) 202 201 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtra_adv in configuration namelist' )
Note: See TracChangeset
for help on using the changeset viewer.
