Changeset 2034
- Timestamp:
- 2010-07-29T17:05:35+02:00 (14 years ago)
- Location:
- branches/DEV_r2006_merge_TRA_TRC/NEMO
- Files:
-
- 23 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90
r2024 r2034 46 46 # include "vectopt_loop_substitute.h90" 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)48 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 49 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 66 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective transport 67 67 !!---------------------------------------------------------------------- 68 69 ! ! effective transport 68 ! !== effective transport ==! 70 69 DO jk = 1, jpkm1 71 ! ! eulerian transport only 72 zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 70 zun(:,:,jk) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) ! eulerian transport only 73 71 zvn(:,:,jk) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 74 72 zwn(:,:,jk) = e1t(:,:) * e2t(:,:) * wn(:,:,jk) 75 !76 73 END DO 77 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 78 79 ! ! add the eiv transport (if necessary) 80 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) 74 zwn(:,:,jpk) = 0.e0 ! no transport trough the bottom 75 ! 76 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 77 ! 78 CALL iom_put( "uoce_eff", zun ) ! output effective transport 79 CALL iom_put( "voce_eff", zvn ) 80 CALL iom_put( "woce_eff", zwn ) 81 81 82 82 83 SELECT CASE ( nadv ) ! compute advection trend and add it to general trend 84 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt , 'TRA', zun, zvn, zwn, & 85 & tsb, tsn , tsa, jpts ) ! 2nd order centered scheme 86 CASE ( 2 ) ; CALL tra_adv_tvd ( kt , 'TRA', zun, zvn, zwn, & 87 & tsb, tsn , tsa, jpts ) ! TVD scheme 88 CASE ( 3 ) ; CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, & 89 & tsb, tsa , jpts ) ! MUSCL scheme 90 CASE ( 4 ) ; CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, & 91 & tsb, tsn , tsa, jpts ) ! MUSCL2 scheme 92 CASE ( 5 ) ; CALL tra_adv_ubs ( kt , 'TRA', zun, zvn, zwn, & 93 & tsb, tsn , tsa, jpts ) ! UBS scheme 94 CASE ( 6 ) ; CALL tra_adv_qck ( kt , 'TRA', zun, zvn, zwn, & 95 & tsb, tsn , tsa, jpts ) ! QUICKEST scheme 83 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 84 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 85 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 86 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 87 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 88 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 89 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 96 90 ! 97 CASE (-1 ) ! esopa: test all possibility with control pr 98 CALL tra_adv_cen2 ( kt , 'TRA', zun, zvn, zwn, & 99 & tsb, tsn , tsa, jpts ) 100 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 101 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 102 CALL tra_adv_tvd ( kt , 'TRA', zun, zvn, zwn, & 103 & tsb, tsn , tsa, jpts ) 104 CALL tra_adv_tvd ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 105 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 106 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 107 CALL tra_adv_muscl ( kt , 'TRA', zun, zvn, zwn, & 108 & tsb, tsa , jpts ) 109 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 110 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 111 CALL tra_adv_muscl2( kt , 'TRA', zun, zvn, zwn, & 112 & tsb, tsn , tsa, jpts ) 113 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 114 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 115 CALL tra_adv_ubs ( kt , 'TRA', zun, zvn, zwn, & 116 & tsb, tsn , tsa, jpts ) 117 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 118 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 119 CALL tra_adv_qck ( kt , 'TRA', zun, zvn, zwn, & 120 & tsb, tsn , tsa, jpts ) 121 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 122 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 91 CASE (-1 ) !== esopa: test all possibility with control print ==! 92 CALL tra_adv_cen2 ( kt , 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 93 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 94 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 95 CALL tra_adv_tvd ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 96 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 97 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 98 CALL tra_adv_muscl ( kt, 'TRA', zun, zvn, zwn, tsb, tsa, jpts ) 99 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 100 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 101 CALL tra_adv_muscl2( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 102 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 103 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 104 CALL tra_adv_ubs ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 105 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 106 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 107 CALL tra_adv_qck ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 108 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 109 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 123 110 ! 124 111 END SELECT 125 126 CALL iom_put( "uoce_eff", zun ) ! effective i-current127 CALL iom_put( "voce_eff", zvn ) ! effective j-current128 CALL iom_put( "woce_eff", zwn ) ! effective vert. current129 112 130 113 ! ! print mean trends (used for debugging) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2024 r2034 47 47 # include "vectopt_loop_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 50 50 !! $Id$ 51 51 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 54 54 CONTAINS 55 55 56 SUBROUTINE tra_adv_cen2( kt , cdtype, pun, pvn, pwn, &57 & ptrab, ptran , ptraa, kjpt )56 SUBROUTINE tra_adv_cen2( kt, cdtype, pun, pvn, pwn, & 57 & ptb, ptn, pta, kjpt ) 58 58 !!---------------------------------------------------------------------- 59 59 !! *** ROUTINE tra_adv_cen2 *** … … 71 71 !! Part I : horizontal advection 72 72 !! * centered flux: 73 !! zcenu = e2u*e3u un mi(pt ran)74 !! zcenv = e1v*e3v vn mj(pt ran)73 !! zcenu = e2u*e3u un mi(ptn) 74 !! zcenv = e1v*e3v vn mj(ptn) 75 75 !! * upstream flux: 76 !! zupsu = e2u*e3u un (pt rab(i) or ptrab(i-1) ) [un>0 or <0]77 !! zupsv = e1v*e3v vn (pt rab(j) or ptrab(j-1) ) [vn>0 or <0]76 !! zupsu = e2u*e3u un (ptb(i) or ptb(i-1) ) [un>0 or <0] 77 !! zupsv = e1v*e3v vn (ptb(j) or ptb(j-1) ) [vn>0 or <0] 78 78 !! * mixed upstream / centered horizontal advection scheme 79 79 !! zcofi = max(zind(i+1), zind(i)) … … 84 84 !! ztra = 1/(e1t*e2t*e3t) { di-1[zwx] + dj-1[zwy] } 85 85 !! * Add this trend now to the general trend of tracer (ta,sa): 86 !! pt raa = ptraa + ztra86 !! pta = pta + ztra 87 87 !! * trend diagnostic ('key_trdtra' defined): the trend is 88 88 !! saved for diagnostics. The trends saved is expressed as 89 89 !! Uh.gradh(T), i.e. 90 !! save trend = ztra + pt ran divn90 !! save trend = ztra + ptn divn 91 91 !! 92 92 !! Part II : vertical advection … … 97 97 !! zwz = zcofk * zupst + (1-zcofk) * zcent 98 98 !! with 99 !! zupsv = upstream flux = wn * (pt rab(k) or ptrab(k-1) ) [wn>0 or <0]99 !! zupsv = upstream flux = wn * (ptb(k) or ptb(k-1) ) [wn>0 or <0] 100 100 !! zcenu = centered flux = wn * mk(tn) 101 101 !! The surface boundary condition is : 102 102 !! variable volume (lk_vvl = T) : zero advective flux 103 !! lin. free-surf (lk_vvl = F) : wn(:,:,1) * pt ran(:,:,1)103 !! lin. free-surf (lk_vvl = F) : wn(:,:,1) * ptn(:,:,1) 104 104 !! Add this trend now to the general trend of tracer (ta,sa): 105 !! pt raa = ptraa + ztra105 !! pta = pta + ztra 106 106 !! Trend diagnostic ('key_trdtra' defined): the trend is 107 107 !! saved for diagnostics. The trends saved is expressed as : 108 !! save trend = w.gradz(T) = ztra - pt ran divn.109 !! 110 !! ** Action : - update pt raa with the now advective tracer trends108 !! save trend = w.gradz(T) = ztra - ptn divn. 109 !! 110 !! ** Action : - update pta with the now advective tracer trends 111 111 !! - save trends if needed 112 112 !!---------------------------------------------------------------------- 113 !!* Module used114 113 USE oce , zwx => ua ! use ua as workspace 115 114 USE oce , zwy => va ! use va as workspace 116 !! * Arguments115 !! 117 116 INTEGER , INTENT(in ) :: kt ! ocean time-step index 118 117 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 119 118 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 120 119 INTEGER , INTENT(in ) :: kjpt ! number of tracers 121 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before and now tracer fields122 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend123 !! * Local declarations120 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 121 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 122 !! 124 123 INTEGER :: ji, jj, jk, jn ! dummy loop indices 125 124 REAL(wp) :: zbtr, ztra ! temporary scalars … … 196 195 zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 197 196 zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 198 zupsut = zfp_ui * pt rab(ji,jj,jk,jn) + zfm_ui * ptrab(ji+1,jj ,jk,jn)199 zupsvt = zfp_vj * pt rab(ji,jj,jk,jn) + zfm_vj * ptrab(ji ,jj+1,jk,jn)197 zupsut = zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) 198 zupsvt = zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) 200 199 ! centered scheme 201 zcenut = pun(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji+1,jj ,jk,jn) )202 zcenvt = pvn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji ,jj+1,jk,jn) )200 zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ) 201 zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) ) 203 202 ! mixed centered / upstream scheme 204 203 zwx(ji,jj,jk) = 0.5 * ( zcofi * zupsut + (1.-zcofi) * zcenut ) … … 215 214 ! ! Surface value : 216 215 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! volume variable 217 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * pt ran(:,:,1,jn) ! linear free surface216 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn) ! linear free surface 218 217 ENDIF 219 218 ! … … 226 225 zfp_w = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 227 226 zfm_w = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 228 zupst = zfp_w * pt rab(ji,jj,jk,jn) + zfm_w * ptrab(ji,jj,jk-1,jn)227 zupst = zfp_w * ptb(ji,jj,jk,jn) + zfm_w * ptb(ji,jj,jk-1,jn) 229 228 ! centered scheme 230 zcent = pwn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) )229 zcent = pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) 231 230 ! mixed centered / upstream scheme 232 231 zwz(ji,jj,jk) = 0.5 * ( zcofk * zupst + (1.-zcofk) * zcent ) … … 246 245 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) 247 246 ! advective trends added to the general tracer trends 248 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra247 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 249 248 END DO 250 249 END DO … … 253 252 ! ! trend diagnostics (contribution of upstream fluxes) 254 253 IF( l_trd ) THEN 255 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, pt ran(:,:,:,jn) )256 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, pt ran(:,:,:,jn) )257 CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, pt ran(:,:,:,jn) )254 CALL trd_tra( kt, cdtype, jn, jptra_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 255 CALL trd_tra( kt, cdtype, jn, jptra_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 256 CALL trd_tra( kt, cdtype, jn, jptra_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 258 257 END IF 259 258 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2024 r2034 37 37 # include "vectopt_loop_substitute.h90" 38 38 !!---------------------------------------------------------------------- 39 !! OPA 9.0 , LOCEAN-IPSL (2006)39 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 40 40 !! $Id$ 41 41 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 44 44 CONTAINS 45 45 46 SUBROUTINE tra_adv_muscl( kt 47 & ptrab, ptraa, kjpt )46 SUBROUTINE tra_adv_muscl( kt, cdtype, pun, pvn, pwn, & 47 & ptb, pta, kjpt ) 48 48 !!---------------------------------------------------------------------- 49 49 !! *** ROUTINE tra_adv_muscl *** … … 61 61 !! IPSL, Sept. 2000 (http://www.lodyc.jussieu.fr/opa) 62 62 !!---------------------------------------------------------------------- 63 !!* Module used64 63 USE oce , zwx => ua ! use ua as workspace 65 64 USE oce , zwy => va ! use va as workspace 66 !! * Arguments65 !! 67 66 INTEGER , INTENT(in ) :: kt ! ocean time-step index 68 67 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 69 68 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 69 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields72 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend73 !! * Local declarations70 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 71 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 72 !! 74 73 INTEGER :: ji, jj, jk, jn ! dummy loop indices 75 74 REAL(wp) :: zu, z0u, zzwx … … 104 103 DO jj = 1, jpjm1 105 104 DO ji = 1, fs_jpim1 ! vector opt. 106 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt rab(ji+1,jj,jk,jn) - ptrab(ji,jj,jk,jn) )107 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt rab(ji,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )105 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) ) 106 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 108 107 END DO 109 108 END DO … … 147 146 zalpha = 0.5 - z0u 148 147 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 149 zzwx = pt rab(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)150 zzwy = pt rab(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk)148 zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 149 zzwy = ptb(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk) 151 150 zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 152 151 ! … … 154 153 zalpha = 0.5 - z0v 155 154 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 156 zzwx = pt rab(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)157 zzwy = pt rab(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk)155 zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 156 zzwy = ptb(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk) 158 157 zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 159 158 END DO … … 172 171 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) 173 172 ! add it to the general tracer trends 174 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra173 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 175 174 END DO 176 175 END DO … … 178 177 ! ! trend diagnostics (contribution of upstream fluxes) 179 178 IF( l_trd ) THEN 180 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_xad, zwx, pun, ptrab(:,:,:,jn) )181 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_yad, zwy, pvn, ptrab(:,:,:,jn) )179 CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 180 CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 182 181 END IF 183 182 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 201 200 zwx (:,:, 1 ) = 0.e0 ; zwx (:,:,jpk) = 0.e0 ! surface & bottom boundary conditions 202 201 DO jk = 2, jpkm1 ! interior values 203 zwx(:,:,jk) = tmask(:,:,jk) * ( pt rab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) )202 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 204 203 END DO 205 204 … … 227 226 ! ! surface values (bottom already set to zero) 228 227 IF( lk_vvl ) THEN ; zwx(:,:, 1 ) = 0.e0 ! variable volume 229 ELSE ; zwx(:,:, 1 ) = pwn(:,:,1) * pt rab(:,:,1,jn) ! linear free surface228 ELSE ; zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface 230 229 ENDIF 231 230 ! … … 238 237 zalpha = 0.5 + z0w 239 238 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 240 zzwx = pt rab(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)241 zzwy = pt rab(ji,jj,jk ,jn) + zw * zslpx(ji,jj,jk )239 zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1) 240 zzwy = ptb(ji,jj,jk ,jn) + zw * zslpx(ji,jj,jk ) 242 241 zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 243 242 END DO … … 253 252 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 254 253 ! add it to the general tracer trends 255 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra254 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 256 255 END DO 257 256 END DO 258 257 END DO 259 258 ! ! Save the vertical advective trends for diagnostic 260 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt ra_trd_zad, zwx, pwn, ptrab(:,:,:,jn) )259 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 261 260 ! 262 261 ENDDO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2024 r2034 36 36 # include "vectopt_loop_substitute.h90" 37 37 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2006)38 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 39 39 !! $Id$ 40 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 43 43 CONTAINS 44 44 45 SUBROUTINE tra_adv_muscl2( kt , cdtype, pun, pvn, pwn, &46 & ptrab, ptran , ptraa, kjpt )45 SUBROUTINE tra_adv_muscl2( kt, cdtype, pun, pvn, pwn, & 46 & ptb, ptn, pta, kjpt ) 47 47 !!---------------------------------------------------------------------- 48 48 !! *** ROUTINE tra_adv_muscl2 *** … … 54 54 !! ** Method : MUSCL scheme plus centered scheme at ocean boundaries 55 55 !! 56 !! ** Action : - update (pt raa) with the now advective tracer trends56 !! ** Action : - update (pta) with the now advective tracer trends 57 57 !! - save trends 58 58 !! … … 68 68 INTEGER , INTENT(in ) :: kjpt ! number of tracers 69 69 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 70 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before and now tracer fields71 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend70 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 71 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 72 72 !!* Local declarations 73 73 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 103 103 DO jj = 1, jpjm1 104 104 DO ji = 1, fs_jpim1 ! vector opt. 105 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt rab(ji+1,jj,jk,jn) - ptrab(ji,jj,jk,jn) )106 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt rab(ji,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )105 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) ) 106 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 107 107 END DO 108 108 END DO … … 146 146 zalpha = 0.5 - z0u 147 147 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1u(ji,jj) * e2u(ji,jj) * fse3u(ji,jj,jk) ) 148 zzwx = pt rab(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk)149 zzwy = pt rab(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk)148 zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 149 zzwy = ptb(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk) 150 150 zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 151 151 ! … … 153 153 zalpha = 0.5 - z0v 154 154 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1v(ji,jj) * e2v(ji,jj) * fse3v(ji,jj,jk) ) 155 zzwx = pt rab(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk)156 zzwy = pt rab(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk)155 zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 156 zzwy = ptb(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk) 157 157 zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 158 158 END DO … … 166 166 IF( umask(ji,jj,jk) == 0. ) THEN 167 167 IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN 168 zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( pt ran(ji+1,jj,jk,jn) + ptran(ji+2,jj,jk,jn) )168 zwx(ji+1,jj,jk) = 0.5 * pun(ji+1,jj,jk) * ( ptn(ji+1,jj,jk,jn) + ptn(ji+2,jj,jk,jn) ) 169 169 ENDIF 170 170 IF( pun(ji-1,jj,jk) < 0. ) THEN 171 zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( pt ran(ji-1,jj,jk,jn) + ptran(ji,jj,jk,jn) )171 zwx(ji-1,jj,jk) = 0.5 * pun(ji-1,jj,jk) * ( ptn(ji-1,jj,jk,jn) + ptn(ji,jj,jk,jn) ) 172 172 ENDIF 173 173 ENDIF 174 174 IF( vmask(ji,jj,jk) == 0. ) THEN 175 175 IF( pvn(ji,jj+1,jk) > 0. .AND. jj /= jpj ) THEN 176 zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( pt ran(ji,jj+1,jk,jn) + ptran(ji,jj+2,jk,jn) )176 zwy(ji,jj+1,jk) = 0.5 * pvn(ji,jj+1,jk) * ( ptn(ji,jj+1,jk,jn) + ptn(ji,jj+2,jk,jn) ) 177 177 ENDIF 178 178 IF( pvn(ji,jj-1,jk) < 0. ) THEN 179 zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( pt ran(ji,jj-1,jk,jn) + ptran(ji,jj,jk,jn) )179 zwy(ji,jj-1,jk) = 0.5 * pvn(ji,jj-1,jk) * ( ptn(ji,jj-1,jk,jn) + ptn(ji,jj,jk,jn) ) 180 180 ENDIF 181 181 ENDIF … … 195 195 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) 196 196 ! added to the general tracer trends 197 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra197 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 198 198 END DO 199 199 END DO … … 201 201 ! ! trend diagnostics (contribution of upstream fluxes) 202 202 IF( l_trd ) THEN 203 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_xad, zwx, pun, ptrab(:,:,:,jn) )204 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_yad, zwy, pvn, ptrab(:,:,:,jn) )203 CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, zwx, pun, ptb(:,:,:,jn) ) 204 CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, zwy, pvn, ptb(:,:,:,jn) ) 205 205 END IF 206 206 … … 225 225 zwx (:,:, 1 ) = 0.e0 ; zwx (:,:,jpk) = 0.e0 ! surface & bottom boundary conditions 226 226 DO jk = 2, jpkm1 ! interior values 227 zwx(:,:,jk) = tmask(:,:,jk) * ( pt rab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) )227 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 228 228 END DO 229 229 … … 251 251 ! ! surface values (bottom already set to zero) 252 252 IF( lk_vvl ) THEN ; zwx(:,:, 1 ) = 0.e0 ! variable volume 253 ELSE ; zwx(:,:, 1 ) = pwn(:,:,1) * pt rab(:,:,1,jn) ! linear free surface253 ELSE ; zwx(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface 254 254 ENDIF 255 255 ! … … 262 262 zalpha = 0.5 + z0w 263 263 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * zdt * zbtr 264 zzwx = pt rab(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1)265 zzwy = pt rab(ji,jj,jk ,jn) + zw * zslpx(ji,jj,jk )264 zzwx = ptb(ji,jj,jk+1,jn) + zw * zslpx(ji,jj,jk+1) 265 zzwy = ptb(ji,jj,jk ,jn) + zw * zslpx(ji,jj,jk ) 266 266 zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 267 267 END DO … … 274 274 IF( tmask(ji,jj,jk+1) == 0. ) THEN 275 275 IF( pwn(ji,jj,jk) > 0. ) THEN 276 zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt ran(ji,jj,jk-1,jn) + ptran(ji,jj,jk,jn) )276 zwx(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 277 277 ENDIF 278 278 ENDIF … … 289 289 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) 290 290 ! added to the general tracer trends 291 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra291 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 292 292 END DO 293 293 END DO … … 297 297 ! ------------------------------------------------- 298 298 ! ! trend diagnostics (contribution of upstream fluxes) 299 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt ra_trd_zad, zwx, pwn, ptrab(:,:,:,jn) )299 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, zwx, pwn, ptb(:,:,:,jn) ) 300 300 ! 301 301 ENDDO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2024 r2034 31 31 PUBLIC tra_adv_qck ! routine called by step.F90 32 32 33 REAL(wp) :: 33 REAL(wp) :: r1_6 = 1./ 6. 34 34 LOGICAL :: l_trd ! flag to compute trends 35 35 … … 38 38 # include "vectopt_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)41 !! $Id $40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 41 !! $Id: traadv_qck.F90 2024 2010-07-29 10:57:35Z cetlod $ 42 42 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 43 43 !!---------------------------------------------------------------------- … … 45 45 CONTAINS 46 46 47 SUBROUTINE tra_adv_qck ( kt , cdtype, pun, pvn, pwn, &48 & ptrab, ptran , ptraa, kjpt )47 SUBROUTINE tra_adv_qck ( kt, cdtype, pun, pvn, pwn, & 48 & ptb, ptn, pta, kjpt ) 49 49 !!---------------------------------------------------------------------- 50 50 !! *** ROUTINE tra_adv_qck *** … … 70 70 !! dt = 2*rdtra and the scalar values are tb and sb 71 71 !! 72 !! On the vertical, the simple centered scheme used pt ran72 !! On the vertical, the simple centered scheme used ptn 73 73 !! 74 74 !! The fluxes are bounded by the ULTIMATE limiter to … … 76 76 !! prevent the appearance of spurious numerical oscillations 77 77 !! 78 !! ** Action : - update (pt raa) with the now advective tracer trends78 !! ** Action : - update (pta) with the now advective tracer trends 79 79 !! - save the trends 80 80 !! 81 81 !! ** Reference : Leonard (1979, 1991) 82 82 !!---------------------------------------------------------------------- 83 !! * Arguments83 !! 84 84 INTEGER , INTENT(in ) :: kt ! ocean time-step index 85 85 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 86 86 INTEGER , INTENT(in ) :: kjpt ! number of tracers 87 87 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 88 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before and now tracer fields89 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend90 !! * Local declarations88 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 89 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 90 !! 91 91 REAL(wp) :: z2 ! temporary scalar 92 92 !!---------------------------------------------------------------------- … … 109 109 !--------------------------------------------------------------------------- 110 110 111 CALL tra_adv_qck_i( kt , cdtype, pun , z2, & 112 & ptrab, ptran , ptraa, kjpt ) 113 CALL tra_adv_qck_j( kt , cdtype, pvn , z2, & 114 & ptrab, ptran , ptraa, kjpt ) 111 CALL tra_adv_qck_i( kt, cdtype, pun, z2, ptb, ptn, pta, kjpt ) 112 CALL tra_adv_qck_j( kt, cdtype, pvn, z2, ptb, ptn, pta, kjpt ) 115 113 116 114 ! II. The vertical fluxes are computed with the 2nd order centered scheme 117 115 !------------------------------------------------------------------------- 118 116 ! 119 CALL tra_adv_cen2_k( kt , cdtype, pwn, & 120 & ptran, ptraa , kjpt ) 117 CALL tra_adv_cen2_k( kt, cdtype, pwn, ptn, pta, kjpt ) 121 118 ! 122 119 END SUBROUTINE tra_adv_qck 123 120 124 SUBROUTINE tra_adv_qck_i( kt , cdtype, pun , pz2, & 125 & ptrab, ptran , ptraa, kjpt ) 126 !!---------------------------------------------------------------------- 127 !! 128 !!---------------------------------------------------------------------- 129 !!* Module used 121 SUBROUTINE tra_adv_qck_i( kt, cdtype, pun, pz2, & 122 & ptb, ptn, pta, kjpt ) 123 !!---------------------------------------------------------------------- 124 !! 125 !!---------------------------------------------------------------------- 130 126 USE oce , zwx => ua ! use ua as workspace 131 !! * Arguments127 !! 132 128 INTEGER , INTENT(in ) :: kt ! ocean time-step index 133 129 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 134 130 INTEGER , INTENT(in ) :: kjpt ! number of tracers 135 131 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! zonal velocity component 136 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before tracer fields137 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend132 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before tracer fields 133 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 138 134 REAL(wp) , INTENT(in ) :: pz2 139 !! * Local declarations135 !! 140 136 INTEGER :: ji, jj, jk, jn ! dummy loop indices 141 137 REAL(wp) :: ztra, zbtr ! temporary scalars … … 156 152 DO ji = fs_2, fs_jpim1 ! vector opt. 157 153 ! Upstream in the x-direction for the tracer 158 zfc(ji,jj,jk) = pt rab(ji-1,jj,jk,jn)154 zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn) 159 155 ! Downstream in the x-direction for the tracer 160 zfd(ji,jj,jk) = pt rab(ji+1,jj,jk,jn)156 zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn) 161 157 END DO 162 158 END DO … … 186 182 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * fse3u(ji,jj,jk) 187 183 zwx(ji,jj,jk) = ABS( pun(ji,jj,jk) ) * zdt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 188 zfc(ji,jj,jk) = zdir * pt rab(ji ,jj,jk,jn) + ( 1. - zdir ) * ptrab(ji+1,jj,jk,jn) ! FC in the x-direction for T189 zfd(ji,jj,jk) = zdir * pt rab(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptrab(ji ,jj,jk,jn) ! FD in the x-direction for T184 zfc(ji,jj,jk) = zdir * ptb(ji ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn) ! FC in the x-direction for T 185 zfd(ji,jj,jk) = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji ,jj,jk,jn) ! FD in the x-direction for T 190 186 END DO 191 187 END DO … … 231 227 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 232 228 !--- add it to the general tracer trends 233 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 234 230 END DO 235 231 END DO … … 237 233 END DO 238 234 ! ! trend diagnostics (contribution of upstream fluxes) 239 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt ra_trd_xad, zwx, pun, ptran(:,:,:,jn) )235 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 240 236 ! 241 237 END DO … … 243 239 END SUBROUTINE tra_adv_qck_i 244 240 245 SUBROUTINE tra_adv_qck_j( kt , cdtype, pvn, pz2, &246 & ptrab, ptran , ptraa, kjpt )247 !!---------------------------------------------------------------------- 248 !! 249 !!---------------------------------------------------------------------- 250 !! * Module used241 SUBROUTINE tra_adv_qck_j( kt, cdtype, pvn, pz2, & 242 & ptb, ptn, pta, kjpt ) 243 !!---------------------------------------------------------------------- 244 !! 245 !!---------------------------------------------------------------------- 246 !! 251 247 USE oce , zwy => ua ! use ua as workspace 252 !! * Arguments248 !! 253 249 INTEGER , INTENT(in ) :: kt ! ocean time-step index 254 250 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 255 251 INTEGER , INTENT(in ) :: kjpt ! number of tracers 256 252 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pvn ! meridional velocity component 257 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before tracer fields258 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend253 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before tracer fields 254 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 259 255 REAL(wp) , INTENT(in ) :: pz2 260 !! * Local declarations256 !! 261 257 INTEGER :: ji, jj, jk, jn ! dummy loop indices 262 258 REAL(wp) :: ztra, zbtr ! temporary scalars … … 276 272 DO ji = fs_2, fs_jpim1 ! vector opt. 277 273 ! Upstream in the x-direction for the tracer 278 zfc(ji,jj,jk) = pt rab(ji,jj-1,jk,jn)274 zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn) 279 275 ! Downstream in the x-direction for the tracer 280 zfd(ji,jj,jk) = pt rab(ji,jj+1,jk,jn)276 zfd(ji,jj,jk) = ptb(ji,jj+1,jk,jn) 281 277 END DO 282 278 END DO … … 306 302 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * fse3v(ji,jj,jk) 307 303 zwy(ji,jj,jk) = ABS( pvn(ji,jj,jk) ) * zdt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 308 zfc(ji,jj,jk) = zdir * pt rab(ji,jj ,jk,jn) + ( 1. - zdir ) * ptrab(ji,jj+1,jk,jn) ! FC in the x-direction for T309 zfd(ji,jj,jk) = zdir * pt rab(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptrab(ji,jj ,jk,jn) ! FD in the x-direction for T304 zfc(ji,jj,jk) = zdir * ptb(ji,jj ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn) ! FC in the x-direction for T 305 zfd(ji,jj,jk) = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj ,jk,jn) ! FD in the x-direction for T 310 306 END DO 311 307 END DO … … 351 347 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 352 348 !--- add it to the general tracer trends 353 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra349 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 354 350 END DO 355 351 END DO … … 357 353 END DO 358 354 ! ! trend diagnostics (contribution of upstream fluxes) 359 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt ra_trd_yad, zwy, pvn, ptran(:,:,:,jn) )355 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 360 356 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 361 357 IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN … … 368 364 END SUBROUTINE tra_adv_qck_j 369 365 370 SUBROUTINE tra_adv_cen2_k( kt 371 & ptran, ptraa , kjpt)372 !!---------------------------------------------------------------------- 373 !! 374 !!---------------------------------------------------------------------- 375 !! * Module used366 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, & 367 & ptn, pta, kjpt ) 368 !!---------------------------------------------------------------------- 369 !! 370 !!---------------------------------------------------------------------- 371 !! 376 372 USE oce , zwz => ua ! use ua as workspace 377 !! * Arguments373 !! 378 374 INTEGER , INTENT(in ) :: kt ! ocean time-step index 379 375 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 380 376 INTEGER , INTENT(in ) :: kjpt ! number of tracers 381 377 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pwn ! vertical velocity component 382 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt ran ! now tracer field383 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend384 !! * Local declarations378 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer field 379 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 380 !! 385 381 INTEGER :: ji, jj, jk, jn ! dummy loop indices 386 382 REAL(wp) :: zbtr , ztra ! temporary scalars … … 395 391 ! ! Surface value 396 392 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! Variable volume : flux set to zero 397 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * pt ran(:,:,1,jn) ! Constant volume : advective flux through the surface393 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn) ! Constant volume : advective flux through the surface 398 394 ENDIF 399 395 ! … … 401 397 DO jj = 2, jpjm1 402 398 DO ji = fs_2, fs_jpim1 ! vector opt. 403 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt ran(ji,jj,jk-1,jn) + ptran(ji,jj,jk,jn) )399 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) 404 400 END DO 405 401 END DO … … 413 409 ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) 414 410 ! added to the general tracer trends 415 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra411 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 416 412 END DO 417 413 END DO 418 414 END DO 419 415 ! ! Save the vertical advective trends for diagnostic 420 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt ra_trd_zad, zwz, pwn, ptran(:,:,:,jn) )416 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, zwz, pwn, ptn(:,:,:,jn) ) 421 417 ! 422 418 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2024 r2034 8 8 !! ! 00-10 (MA Foujols E.Kestenare) include file not routine 9 9 !! ! 00-12 (E. Kestenare M. Levy) fix bug in trtrd indexes 10 !! ! 01-07 (E. Durand G. Madec) adapt raation to ORCA config10 !! ! 01-07 (E. Durand G. Madec) adaptation to ORCA config 11 11 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 12 12 !! 9.0 ! 04-01 (A. de Miranda, G. Madec, J.M. Molines ): advective bbl 13 13 !! 9.0 ! 08-04 (S. Cravatte) add the i-, j- & k- trends computation 14 14 !! " " ! 09-11 (V. Garnier) Surface pressure gradient organization 15 !! 3.3 ! 10-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport15 !! 3.3 ! 10-05 (C. Ethe, G. Madec) merge TRC-TRA + switch from velocity to transport 16 16 !!---------------------------------------------------------------------- 17 17 … … 45 45 # include "vectopt_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 !! OPA 9.0 , LOCEAN-IPSL (2006)47 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 48 48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 52 52 CONTAINS 53 53 54 SUBROUTINE tra_adv_tvd ( kt , cdtype, pun, pvn, pwn, &55 & ptrab, ptran , ptraa, kjpt )54 SUBROUTINE tra_adv_tvd ( kt, cdtype, pun, pvn, pwn, & 55 & ptb, ptn, pta, kjpt ) 56 56 !!---------------------------------------------------------------------- 57 57 !! *** ROUTINE tra_adv_tvd *** … … 64 64 !! note: - this advection scheme needs a leap-frog time scheme 65 65 !! 66 !! ** Action : - update (pt raa) with the now advective tracer trends66 !! ** Action : - update (pta) with the now advective tracer trends 67 67 !! - save the trends 68 68 !!---------------------------------------------------------------------- 69 !!* Module used70 69 USE oce , zwx => ua ! use ua as workspace 71 70 USE oce , zwy => va ! use va as workspace 72 !! * Arguments71 !! 73 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index 74 73 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 74 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 75 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before and now tracer fields78 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend79 !! * Local declarations76 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 77 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 78 !! 80 79 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 80 REAL(wp) :: & … … 127 126 zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 128 127 zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 129 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt rab(ji,jj,jk,jn) + zfm_ui * ptrab(ji+1,jj ,jk,jn) )130 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt rab(ji,jj,jk,jn) + zfm_vj * ptrab(ji ,jj+1,jk,jn) )128 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) ) 129 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) ) 131 130 END DO 132 131 END DO … … 136 135 ! Surface value 137 136 IF( lk_vvl ) THEN ; zwz(:,:, 1 ) = 0.e0 ! volume variable 138 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * pt rab(:,:,1,jn) ! linear free surface137 ELSE ; zwz(:,:, 1 ) = pwn(:,:,1) * ptb(:,:,1,jn) ! linear free surface 139 138 ENDIF 140 139 ! Interior value … … 144 143 zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 145 144 zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 146 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt rab(ji,jj,jk,jn) + zfm_wk * ptrab(ji,jj,jk-1,jn) )145 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) 147 146 END DO 148 147 END DO … … 160 159 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) 161 160 ! update and guess with monotonic sheme 162 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra163 zwi(ji,jj,jk) = ( pt rab(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk)161 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 162 zwi(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ztra ) * tmask(ji,jj,jk) 164 163 END DO 165 164 END DO … … 185 184 DO jj = 1, jpjm1 186 185 DO ji = 1, fs_jpim1 ! vector opt. 187 zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)188 zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)186 zwx(ji,jj,jk) = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 187 zwy(ji,jj,jk) = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 189 188 END DO 190 189 END DO … … 198 197 DO jj = 1, jpj 199 198 DO ji = 1, jpi 200 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk)199 zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - zwz(ji,jj,jk) 201 200 END DO 202 201 END DO … … 210 209 ! 4. monotonicity algorithm 211 210 ! ------------------------- 212 CALL nonosc( pt rab(:,:,:,jn), zwx, zwy, zwz, zwi, z2 )211 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, z2 ) 213 212 214 213 … … 224 223 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) 225 224 ! add them to the general tracer trends 226 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra225 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 227 226 END DO 228 227 END DO … … 235 234 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! <<< Add to previously computed 236 235 237 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_xad, ztrdx, pun, ptran(:,:,:,jn) )238 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_yad, ztrdy, pvn, ptran(:,:,:,jn) )239 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_zad, ztrdz, pwn, ptran(:,:,:,jn) )236 CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, ztrdx, pun, ptn(:,:,:,jn) ) 237 CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 238 CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 240 239 END IF 241 240 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2024 r2034 33 33 # include "vectopt_loop_substitute.h90" 34 34 !!---------------------------------------------------------------------- 35 !! OPA 9.0 , LOCEAN-IPSL (2006)35 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 36 36 !! $Id$ 37 37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 40 40 CONTAINS 41 41 42 SUBROUTINE tra_adv_ubs ( kt , cdtype, pun, pvn, pwn, &43 & ptrab, ptran , ptraa, kjpt )42 SUBROUTINE tra_adv_ubs ( kt, cdtype, pun, pvn, pwn, & 43 & ptb, ptn, pta, kjpt ) 44 44 !!---------------------------------------------------------------------- 45 45 !! *** ROUTINE tra_adv_ubs *** … … 68 68 !! the UBS have been found to be too diffusive. 69 69 !! 70 !! ** Action : - update (pt raa) with the now advective tracer trends70 !! ** Action : - update (pta) with the now advective tracer trends 71 71 !! 72 72 !! Reference : Shchepetkin, A. F., J. C. McWilliams, 2005, Ocean Modelling, 9, 347-404. … … 81 81 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 82 82 INTEGER , INTENT(in ) :: kjpt ! number of tracers 83 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab, ptran ! before and now tracer fields84 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend83 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 84 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 85 85 !!* Local declarations 86 86 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 124 124 zeeu = e2u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk) 125 125 zeev = e1v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk) 126 ztu(ji,jj,jk) = zeeu * ( pt rab(ji+1,jj ,jk,jn) - ptrab(ji,jj,jk,jn) )127 ztv(ji,jj,jk) = zeev * ( pt rab(ji ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )126 ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 127 ztv(ji,jj,jk) = zeev * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 128 128 END DO 129 129 END DO … … 154 154 zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 155 155 ! centered scheme 156 zcenut = 0.5 * pun(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji+1,jj ,jk,jn) )157 zcenvt = 0.5 * pvn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji ,jj+1,jk,jn) )156 zcenut = 0.5 * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ) 157 zcenvt = 0.5 * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) ) 158 158 ! UBS scheme 159 159 zwx(ji,jj,jk) = zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) … … 163 163 ENDDO 164 164 165 zltu(:,:,:) = pt raa(:,:,:,jn) ! store ptraa trends165 zltu(:,:,:) = pta(:,:,:,jn) ! store pta trends 166 166 167 167 ! Horizontal advective trends … … 175 175 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk) ) 176 176 ! add it to the general tracer trends 177 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra177 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 178 178 END DO 179 179 END DO … … 183 183 184 184 ! Horizontal trend used in tra_adv_ztvd subroutine 185 zltu(:,:,:) = pt raa(:,:,:,jn) - zltu(:,:,:)185 zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:) 186 186 187 187 ! 3. Save the horizontal advective trends for diagnostic … … 189 189 ! ! trend diagnostics (contribution of upstream fluxes) 190 190 IF( l_trd ) THEN 191 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_xad, zwx, pun, ptran(:,:,:,jn) )192 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_yad, zwy, pvn, ptran(:,:,:,jn) )191 CALL trd_tra( kt, cdtype, jn, jpt_trd_xad, zwx, pun, ptn(:,:,:,jn) ) 192 CALL trd_tra( kt, cdtype, jn, jpt_trd_yad, zwy, pvn, ptn(:,:,:,jn) ) 193 193 END IF 194 194 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 209 209 ! TVD scheme for the vertical direction 210 210 ! ---------------------- 211 IF( l_trd ) zltv(:,:,:) = pt raa(:,:,:,jn) ! store pta if trend diag.211 IF( l_trd ) zltv(:,:,:) = pta(:,:,:,jn) ! store pta if trend diag. 212 212 213 213 ! Bottom value : flux set to zero … … 216 216 ! Surface value 217 217 IF( lk_vvl ) THEN ; ztw(:,:,1) = 0.e0 ! variable volume : flux set to zero 218 ELSE ; ztw(:,:,1) = pwn(:,:,1) * pt rab(:,:,1,jn) ! free constant surface218 ELSE ; ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) ! free constant surface 219 219 ENDIF 220 220 ! upstream advection with initial mass fluxes & intermediate update … … 226 226 zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 227 227 zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 228 ztw(ji,jj,jk) = 0.5 * ( zfp_wk * pt rab(ji,jj,jk,jn) + zfm_wk * ptrab(ji,jj,jk-1,jn) )228 ztw(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) 229 229 END DO 230 230 END DO … … 237 237 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 238 238 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * zbtr 239 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztak240 zti(ji,jj,jk) = ( pt rab(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)239 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak 240 zti(ji,jj,jk) = ( ptb(ji,jj,jk,jn) + z2dtt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 241 241 END DO 242 242 END DO … … 250 250 DO jj = 1, jpj 251 251 DO ji = 1, jpi 252 ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( pt ran(ji,jj,jk,jn) + ptran(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk)252 ztw(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) - ztw(ji,jj,jk) 253 253 END DO 254 254 END DO 255 255 END DO 256 256 ! 257 CALL nonosc_z( pt rab(:,:,:,jn), ztw, zti, z2 ) ! monotonicity algorithm257 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, z2 ) ! monotonicity algorithm 258 258 259 259 ! final trend with corrected fluxes … … 265 265 ztra = - zbtr * ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) 266 266 ! added to the general tracer trends 267 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra267 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 268 268 END DO 269 269 END DO … … 277 277 zbtr = 1.e0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 278 278 z_hdivn = ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) * zbtr 279 zltv(ji,jj,jk) = pt raa(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptran(ji,jj,jk,jn) * z_hdivn279 zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn 280 280 END DO 281 281 END DO 282 282 END DO 283 CALL trd_tra( kt, cdtype, jn, jpt ra_trd_zad, zltv )283 CALL trd_tra( kt, cdtype, jn, jpt_trd_zad, zltv ) 284 284 ENDIF 285 285 ! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90
r2024 r2034 71 71 # include "vectopt_loop_substitute.h90" 72 72 !!---------------------------------------------------------------------- 73 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)73 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 74 74 !! $Id$ 75 75 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90
r2024 r2034 45 45 # include "vectopt_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 !! OPA 9.0 , LOCEAN-IPSL (2006)47 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 48 48 !! $Id$ 49 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 74 74 75 75 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 76 CASE ( 0 ) ; CALL tra_ldf_lap ( kt , 'TRA', zgtsu, zgtsv, & 77 & tsb, tsa , jpts ) ! iso-level laplacian 78 CASE ( 1 ) ; CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, & 79 & tsb, tsa , jpts , ahtb0 ) ! rotated laplacian 80 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, & 81 & tsb, tsa , jpts ) ! iso-level bilaplacian 82 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilaplacian 76 CASE ( 0 ) ; CALL tra_ldf_lap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts ) ! iso-level laplacian 77 CASE ( 1 ) ; CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 78 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 79 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilaplacian 83 80 ! 84 81 CASE ( -1 ) ! esopa: test all possibility with control print 85 CALL tra_ldf_lap ( kt , 'TRA', zgtsu, zgtsv, & 86 & tsb, tsa , jpts ) 87 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 88 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 89 CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, & 90 & tsb, tsa , jpts , ahtb0 ) 91 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 92 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 93 CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, & 94 & tsb, tsa , jpts ) 95 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 96 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 97 CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts ) 98 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 99 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 82 CALL tra_ldf_lap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts ) 83 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 84 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 85 CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts, ahtb0 ) 86 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 87 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 88 CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts ) 89 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 90 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 91 CALL tra_ldf_bilapg( kt , 'TRA', tsb, tsa, jpts ) 92 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 93 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 100 94 END SELECT 101 95 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2024 r2034 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! OPA 9.0 , LOCEAN-IPSL (2005)43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 44 !! $Id$ 45 45 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt … … 48 48 CONTAINS 49 49 50 SUBROUTINE tra_ldf_bilap( kt , cdtype, pgtu, pgtv, &51 & ptrab, ptraa , kjpt)50 SUBROUTINE tra_ldf_bilap( kt, cdtype, pgu, pgv, & 51 & ptb, pta, kjpt ) 52 52 !!---------------------------------------------------------------------- 53 53 !! *** ROUTINE tra_ldf_bilap *** … … 70 70 !! 71 71 !! Add this trend to the general trend 72 !! (pt raa) = (ptraa) + ( difft )72 !! (pta) = (pta) + ( difft ) 73 73 !! 74 !! ** Action : - Update pt raa arrays with the before iso-level74 !! ** Action : - Update pta arrays with the before iso-level 75 75 !! biharmonic mixing trend. 76 76 !!---------------------------------------------------------------------- 77 !! * Module used77 !! 78 78 USE oce , ztu => ua ! use ua as workspace 79 79 USE oce , ztv => va ! use va as workspace 80 !! * Arguments80 !! 81 81 INTEGER , INTENT(in ) :: kt ! ocean time-step index 82 82 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 83 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers 84 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pg tu, pgtv ! tracer gradient at pstep levels85 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields86 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend87 !! * Local declarations84 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv ! tracer gradient at pstep levels 85 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 86 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 87 !! 88 88 INTEGER :: ji, jj, jk, jn ! dummy loop indices 89 89 INTEGER :: iku, ikv ! temporary integers … … 121 121 DO jj = 1, jpjm1 122 122 DO ji = 1, fs_jpim1 ! vector opt. 123 ztu(ji,jj,jk) = zeeu(ji,jj) * ( pt rab(ji+1,jj ,jk,jn) - ptrab(ji,jj,jk,jn) )124 ztv(ji,jj,jk) = zeev(ji,jj) * ( pt rab(ji ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )123 ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 124 ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 125 125 END DO 126 126 END DO … … 131 131 iku = MIN ( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1 132 132 ikv = MIN ( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 133 IF( iku == jk ) ztu(ji,jj,jk) = zeeu(ji,jj) * pg tu(ji,jj,jn)134 IF( ikv == jk ) ztv(ji,jj,jk) = zeev(ji,jj) * pg tv(ji,jj,jn)133 IF( iku == jk ) ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn) 134 IF( ikv == jk ) ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn) 135 135 END DO 136 136 END DO … … 167 167 ztra = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 168 168 ! add it to the general tracer trends 169 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra169 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 170 170 END DO 171 171 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2024 r2034 36 36 # include "ldfeiv_substitute.h90" 37 37 !!---------------------------------------------------------------------- 38 !! OPA 9.0 , LOCEAN-IPSL (2005)38 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 39 39 !! $Id$ 40 40 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt … … 43 43 CONTAINS 44 44 45 SUBROUTINE tra_ldf_bilapg( kt, cdtype, pt rab, ptraa, kjpt )45 SUBROUTINE tra_ldf_bilapg( kt, cdtype, ptb, pta, kjpt ) 46 46 !!---------------------------------------------------------------------- 47 47 !! *** ROUTINE tra_ldf_bilapg *** … … 55 55 !! computed in routine inildf. 56 56 !! -1- compute the geopotential harmonic operator applied to 57 !! pt rab and multiply it by the eddy diffusivity coefficient57 !! ptb and multiply it by the eddy diffusivity coefficient 58 58 !! (done by a call to ldfght routine, result in wk1 arrays). 59 59 !! Applied the domain lateral boundary conditions by call to lbc_lnk … … 62 62 !! arrays). 63 63 !! -3- Add this trend to the general trend 64 !! pt raa = ptraa + wk265 !! 66 !! ** Action : - Update pt raa arrays with the before geopotential64 !! pta = pta + wk2 65 !! 66 !! ** Action : - Update pta arrays with the before geopotential 67 67 !! biharmonic mixing trend. 68 68 !!---------------------------------------------------------------------- … … 71 71 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 72 72 INTEGER , INTENT(in ) :: kjpt ! number of tracers 73 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields74 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend73 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 74 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 75 75 !! * Local declarations 76 76 INTEGER :: ji, jj, jk, jn ! dummy loop indices 77 REAL(wp), DIMENSION(jpi,jpj,jpk,SIZE(pt rab,4)) :: &77 REAL(wp), DIMENSION(jpi,jpj,jpk,SIZE(ptb,4)) :: & 78 78 wk1, wk2 ! work array used for rotated biharmonic 79 79 ! ! operator on tracers and/or momentum … … 88 88 ! 89 89 90 ! 1. Laplacian of pt rab * aht90 ! 1. Laplacian of ptb * aht 91 91 ! ----------------------------- 92 ! rotated harmonic operator applied to pt rab and multiply by aht ; output in wk193 94 CALL ldfght( kt, cdtype, pt rab, wk1, kjpt, 1 )92 ! rotated harmonic operator applied to ptb and multiply by aht ; output in wk1 93 94 CALL ldfght( kt, cdtype, ptb, wk1, kjpt, 1 ) 95 95 96 96 ! … … 100 100 END DO 101 101 102 ! 2. Bilaplacian of pt rab102 ! 2. Bilaplacian of ptb 103 103 ! ------------------------- 104 104 ! rotated harmonic operator applied to wk1 ; output in wk2 … … 117 117 DO ji = 2, jpim1 118 118 ! add it to the general tracer trends 119 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + wk2(ji,jj,jk,jn)119 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + wk2(ji,jj,jk,jn) 120 120 END DO 121 121 END DO … … 166 166 !! 167 167 !!---------------------------------------------------------------------- 168 !! * Modules used168 !! 169 169 USE oce , zftv => ua ! use ua as workspace 170 !! * Arguments170 !! 171 171 INTEGER , INTENT(in ) :: kt ! ocean time-step index 172 172 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 178 178 INTEGER , INTENT(in ) :: kaht !: =1 multiply the laplacian by the eddy diffusivity coeff. 179 179 ! !: =2 no multiplication 180 !! * Local declarations180 !! 181 181 INTEGER :: ji, jj, jk,jn ! dummy loop indices 182 182 ! ! temporary scalars -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2024 r2034 43 43 # include "vectopt_loop_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 !! OPA 9.0 , LOCEAN-IPSL (2005)45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 46 46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 50 50 CONTAINS 51 51 52 SUBROUTINE tra_ldf_iso( kt , cdtype, pgtu, pgtv, &53 & ptrab, ptraa, kjpt, pahtb0 )52 SUBROUTINE tra_ldf_iso( kt, cdtype, pgu, pgv, & 53 & ptb, pta, kjpt, pahtb0 ) 54 54 !!---------------------------------------------------------------------- 55 55 !! *** ROUTINE tra_ldf_iso *** … … 98 98 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 99 99 INTEGER , INTENT(in ) :: kjpt ! number of tracers 100 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pg tu, pgtv ! tracer gradient at pstep levels101 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields102 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend100 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv ! tracer gradient at pstep levels 101 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 102 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 103 103 REAL(wp) , INTENT(in ) :: pahtb0 ! background diffusion coef 104 104 !!* Local declarations … … 138 138 DO jj = 1, jpjm1 139 139 DO ji = 1, fs_jpim1 ! vector opt. 140 zdit(ji,jj,jk) = ( pt rab(ji+1,jj ,jk,jn) - ptrab(ji,jj,jk,jn) ) * umask(ji,jj,jk)141 zdjt(ji,jj,jk) = ( pt rab(ji ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) ) * vmask(ji,jj,jk)140 zdit(ji,jj,jk) = ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 141 zdjt(ji,jj,jk) = ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 142 142 END DO 143 143 END DO … … 149 149 iku = MIN( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1 150 150 ikv = MIN( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1 151 zdit(ji,jj,iku) = pg tu(ji,jj,jn)152 zdjt(ji,jj,ikv) = pg tv(ji,jj,jn)151 zdit(ji,jj,iku) = pgu(ji,jj,jn) 152 zdjt(ji,jj,ikv) = pgv(ji,jj,jn) 153 153 END DO 154 154 END DO … … 167 167 ! surface boundary condition: zdkt(jk=1)=zdkt(jk=2) 168 168 169 zdk1t(:,:) = ( pt rab(:,:,jk,jn) - ptrab(:,:,jk+1,jn) ) * tmask(:,:,jk+1)169 zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 170 170 171 171 IF( jk == 1 ) THEN 172 172 zdkt(:,:) = zdk1t(:,:) 173 173 ELSE 174 zdkt(:,:) = ( pt rab(:,:,jk-1,jn) - ptrab(:,:,jk,jn) ) * tmask(:,:,jk)174 zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 175 175 ENDIF 176 176 … … 209 209 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 210 210 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 211 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra211 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 212 212 END DO 213 213 END DO … … 229 229 DO ji = fs_2, fs_jpim1 ! vector opt. 230 230 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) & 231 & * ( pt ran(ji,jj,jk,jn) + ptran(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk)231 & * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 232 232 END DO 233 233 END DO … … 240 240 DO ji = fs_2, fs_jpim1 ! vector opt. 241 241 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) & 242 & * ( pt ran(ji,jj,jk,jn) + ptran(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk)242 & * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 243 243 END DO 244 244 END DO … … 295 295 zbtr = 1.0 / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 296 296 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 297 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra297 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 298 298 END DO 299 299 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2024 r2034 38 38 # include "vectopt_loop_substitute.h90" 39 39 !!---------------------------------------------------------------------- 40 !! OPA 9.0 , LOCEAN-IPSL (2005)40 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 41 41 !! $Id$ 42 42 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt … … 45 45 CONTAINS 46 46 47 SUBROUTINE tra_ldf_lap( kt , cdtype, pgtu, pgtv, &48 & ptrab, ptraa , kjpt)47 SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv, & 48 & ptb, pta, kjpt ) 49 49 !!---------------------------------------------------------------------- 50 50 !! *** ROUTINE tra_ldf_lap *** … … 67 67 !! harmonic mixing trend. 68 68 !!---------------------------------------------------------------------- 69 !! * Module used69 !! 70 70 USE oce , ztu => ua ! use ua as workspace 71 71 USE oce , ztv => va ! use va as workspace 72 !! * Arguments72 !! 73 73 INTEGER , INTENT(in ) :: kt ! ocean time-step index 74 74 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pg tu, pgtv ! tracer gradient at pstep levels77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields78 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend79 !! * Local declarations76 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,kjpt ) :: pgu, pgv ! tracer gradient at pstep levels 77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 78 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 79 !! 80 80 INTEGER :: ji, jj, jk, jn ! dummy loop indices 81 81 INTEGER :: iku, ikv ! temporary integers … … 104 104 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk) 105 105 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk) 106 ztu(ji,jj,jk) = zabe1 * ( pt rab(ji+1,jj ,jk,jn) - ptrab(ji,jj,jk,jn) )107 ztv(ji,jj,jk) = zabe2 * ( pt rab(ji ,jj+1,jk,jn) - ptrab(ji,jj,jk,jn) )106 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 107 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 108 108 END DO 109 109 END DO … … 116 116 IF( iku == jk ) THEN 117 117 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku) 118 ztu(ji,jj,jk) = zabe1 * pg tu(ji,jj,jn)118 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 119 119 ENDIF 120 120 IF( ikv == jk ) THEN 121 121 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv) 122 ztv(ji,jj,jk) = zabe2 * pg tv(ji,jj,jn)122 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 123 123 ENDIF 124 124 END DO … … 136 136 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 137 137 ! add it to the general tracer trends 138 pt raa(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) + ztra138 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 139 139 END DO 140 140 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90
r2024 r2034 53 53 # include "domzgr_substitute.h90" 54 54 !!---------------------------------------------------------------------- 55 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)55 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 56 56 !! $Id$ 57 57 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 131 131 132 132 ! Leap-Frog + Asselin filter time stepping 133 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt , nit000, & 134 & tsb, tsn , tsa, jpts ) ! variable volume level (vvl) 135 ELSE ; CALL tra_nxt_fix( kt , nit000, & 136 & tsb, tsn , tsa, jpts ) ! fixed volume level 133 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nit000, tsb, tsn, tsa, jpts ) ! variable volume level (vvl) 134 ELSE ; CALL tra_nxt_fix( kt, nit000, tsb, tsn, tsa, jpts ) ! fixed volume level 137 135 ENDIF 138 136 … … 151 149 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact 152 150 END DO 153 CALL trd_tra( kt, 'TRA', jp_tem, jpt ra_trd_atf, ztrdt )154 CALL trd_tra( kt, 'TRA', jp_sal, jpt ra_trd_atf, ztrds )151 CALL trd_tra( kt, 'TRA', jp_tem, jpt_trd_atf, ztrdt ) 152 CALL trd_tra( kt, 'TRA', jp_sal, jpt_trd_atf, ztrds ) 155 153 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 156 154 END IF … … 162 160 END SUBROUTINE tra_nxt 163 161 164 SUBROUTINE tra_nxt_fix( kt , kit000,&165 & ptrab, ptran , ptraa, kjpt )162 SUBROUTINE tra_nxt_fix( kt, kit000, & 163 & ptb, ptn, pta, kjpt ) 166 164 !!---------------------------------------------------------------------- 167 165 !! *** ROUTINE tra_nxt_fix *** … … 188 186 INTEGER , INTENT(in ) :: kit000 ! first time-step index 189 187 INTEGER , INTENT(in ) :: kjpt ! number of tracers 190 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before tracer fields191 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt ran ! now tracer fields192 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend188 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 189 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 190 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 193 191 !! 194 192 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 212 210 DO jj = 1, jpj 213 211 DO ji = 1, jpi 214 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! ptrab <-- ptran212 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptb <-- ptn 215 213 END DO 216 214 END DO … … 222 220 DO jj = 1, jpj 223 221 DO ji = 1, jpi 224 ztm = 0.25 * ( pt raa(ji,jj,jk,jn) + 2.* ptran(ji,jj,jk,jn) + ptrab(ji,jj,jk,jn) ) ! mean ptra225 ztf = atfp * ( pt raa(ji,jj,jk,jn) - 2.* ptran(ji,jj,jk,jn) + ptran(ji,jj,jk,jn) ) ! Asselin filter on ptra226 pt rab(ji,jj,jk,jn) = ptran(ji,jj,jk,jn) + ztf ! ptrab <-- filtered ptran227 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! ptran <-- ptraa228 pt raa(ji,jj,jk,jn) = ztm ! ptraa <-- mean ptra222 ztm = 0.25 * ( pta(ji,jj,jk,jn) + 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn) ) ! mean pt 223 ztf = atfp * ( pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptn(ji,jj,jk,jn) ) ! Asselin filter on pt 224 ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + ztf ! ptb <-- filtered ptn 225 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 226 pta(ji,jj,jk,jn) = ztm ! pta <-- mean pt 229 227 END DO 230 228 END DO … … 241 239 DO jj = 1, jpj 242 240 DO ji = 1, jpi 243 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! ptran <-- ptraa241 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 244 242 END DO 245 243 END DO … … 251 249 DO jj = 1, jpj 252 250 DO ji = 1, jpi 253 ztf = atfp * ( pt raa(ji,jj,jk,jn) - 2.* ptran(ji,jj,jk,jn) + ptrab(ji,jj,jk,jn) ) ! Asselin filter on t254 pt rab(ji,jj,jk,jn) = ptran(ji,jj,jk,jn) + ztf ! ptrab <-- filtered ptran255 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! ptran <-- ptraa251 ztf = atfp * ( pta(ji,jj,jk,jn) - 2.* ptn(ji,jj,jk,jn) + ptb(ji,jj,jk,jn) ) ! Asselin filter on t 252 ptb(ji,jj,jk,jn) = ptn(ji,jj,jk,jn) + ztf ! ptb <-- filtered ptn 253 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 256 254 END DO 257 255 END DO … … 264 262 END SUBROUTINE tra_nxt_fix 265 263 266 267 SUBROUTINE tra_nxt_vvl( kt , kit000, & 268 & ptrab, ptran , ptraa, kjpt ) 264 SUBROUTINE tra_nxt_vvl( kt, kit000, & 265 & ptb, ptn, pta, kjpt ) 269 266 !!---------------------------------------------------------------------- 270 267 !! *** ROUTINE tra_nxt_vvl *** … … 293 290 INTEGER , INTENT(in ) :: kit000 ! first time-step index 294 291 INTEGER , INTENT(in ) :: kjpt ! number of tracers 295 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before tracer fields296 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt ran ! now tracer fields297 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend292 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before tracer fields 293 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: ptn ! now tracer fields 294 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 298 295 !! 299 296 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 318 315 DO jj = 1, jpj 319 316 DO ji = 1, jpi 320 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! tn <-- ta317 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! tn <-- ta 321 318 END DO 322 319 END DO … … 332 329 ze3t_a = fse3t_a(ji,jj,jk) 333 330 ! ! tracer content at Before, now and after 334 ztcb = pt rab(ji,jj,jk,jn) * ze3t_b335 ztcn = pt ran(ji,jj,jk,jn) * ze3t_n336 ztca = pt raa(ji,jj,jk,jn) * ze3t_a331 ztcb = ptb(ji,jj,jk,jn) * ze3t_b 332 ztcn = ptn(ji,jj,jk,jn) * ze3t_n 333 ztca = pta(ji,jj,jk,jn) * ze3t_a 337 334 ! 338 335 ! ! Asselin filter on thickness and tracer content … … 349 346 !!gm e3t_m(ji,jj,jk) = 0.25 / ze3mr 350 347 ! ! swap of arrays 351 pt rab(ji,jj,jk,jn) = ztf ! ptrab <-- ptran + filter352 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! ptran <-- ptraa353 pt raa(ji,jj,jk,jn) = ztm ! ptraa <-- mean t348 ptb(ji,jj,jk,jn) = ztf ! ptb <-- ptn + filter 349 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 350 pta(ji,jj,jk,jn) = ztm ! pta <-- mean t 354 351 END DO 355 352 END DO … … 366 363 DO jj = 1, jpj 367 364 DO ji = 1, jpi 368 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! tn <-- ta365 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! tn <-- ta 369 366 END DO 370 367 END DO … … 381 378 ze3t_a = fse3t_a(ji,jj,jk) 382 379 ! ! tracer content at Before, now and after 383 ztcb = pt rab(ji,jj,jk,jn) * ze3t_b384 ztcn = pt ran(ji,jj,jk,jn) * ze3t_n385 ztca = pt raa(ji,jj,jk,jn) * ze3t_a380 ztcb = ptb(ji,jj,jk,jn) * ze3t_b 381 ztcn = ptn(ji,jj,jk,jn) * ze3t_n 382 ztca = pta(ji,jj,jk,jn) * ze3t_a 386 383 ! 387 384 ! ! Asselin filter on thickness and tracer content … … 393 390 ztf = ( ztcn + ztc_f ) * ze3fr 394 391 ! ! swap of arrays 395 pt rab(ji,jj,jk,jn) = ztf ! tb <-- tn filtered396 pt ran(ji,jj,jk,jn) = ptraa(ji,jj,jk,jn) ! tn <-- ta392 ptb(ji,jj,jk,jn) = ztf ! tb <-- tn filtered 393 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! tn <-- ta 397 394 END DO 398 395 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traswp.F90
r2024 r2034 10 10 PRIVATE 11 11 12 PUBLIC tra_swap ! routine called by step.F9013 PUBLIC tra_unswap 12 PUBLIC tra_swap ! routine called by step.F90 13 PUBLIC tra_unswap ! routine called by step.F90 14 14 15 15 !!---------------------------------------------------------------------- 16 !! OPA 9.0 , LOCEAN-IPSL (2005)17 !! $Id: tras bc.F90 1739 2009-11-19 13:24:00Z rblod $16 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 17 !! $Id: traswap.F90 2024 2010-07-29 10:57:35Z cetlod $ 18 18 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 19 19 !!---------------------------------------------------------------------- -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90
r2024 r2034 47 47 # include "vectopt_loop_substitute.h90" 48 48 !!---------------------------------------------------------------------- 49 !! OPA 9.0 , LOCEAN-IPSL (2005)49 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 50 50 !! $Id$ 51 51 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 79 79 80 80 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 81 CASE ( 0 ) ; CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp, & 82 & tsb, tsa , jpts ) ! explicit scheme 83 CASE ( 1 ) ; CALL tra_zdf_imp( kt , 'TRA', r2dt, & 84 & tsb, tsa , jpts ) ! implicit scheme 81 CASE ( 0 ) ; CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) ! explicit scheme 82 CASE ( 1 ) ; CALL tra_zdf_imp( kt , 'TRA', r2dt, tsb, tsa, jpts ) ! implicit scheme 85 83 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp, & 87 & tsb, tsa , jpts ) 88 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 89 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 90 CALL tra_zdf_imp( kt , 'TRA', r2dt, & 91 & tsb, tsa , jpts ) 92 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 93 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 84 CALL tra_zdf_exp( kt , 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) 85 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 86 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 87 CALL tra_zdf_imp( kt , 'TRA', r2dt, tsb, tsa, jpts ) 88 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 89 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 94 90 END SELECT 95 91 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2024 r2034 40 40 # include "vectopt_loop_substitute.h90" 41 41 !!---------------------------------------------------------------------- 42 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)42 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 43 43 !! $Id$ 44 44 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 47 47 CONTAINS 48 48 49 SUBROUTINE tra_zdf_exp( kt 50 & ptrab , ptraa , kjpt)49 SUBROUTINE tra_zdf_exp( kt, cdtype, p2dt, kn_zdfexp, & 50 & ptb , pta , kjpt ) 51 51 !!---------------------------------------------------------------------- 52 52 !! *** ROUTINE tra_zdf_exp *** … … 57 57 !! ** Method : - The after tracer fields due to the vertical diffusion 58 58 !! of tracers alone is given by: 59 !! zwx = pt rab + p2dt difft60 !! where difft = dz( avt dz(pt rab) ) = 1/e3t dk+1( avt/e3w dk(ptrab) )59 !! zwx = ptb + p2dt difft 60 !! where difft = dz( avt dz(ptb) ) = 1/e3t dk+1( avt/e3w dk(ptb) ) 61 61 !! (if lk_zdfddm=T use avs on salinity and passive tracers instead of avt) 62 62 !! difft is evaluated with an Euler split-explit scheme using a … … 65 65 !! - the after tracer fields due to the whole trend is 66 66 !! obtained in leap-frog environment by : 67 !! pt raa = zwx + p2dt ptraa67 !! pta = zwx + p2dt pta 68 68 !! - in case of variable level thickness (lk_vvl=T) the 69 69 !! the leap-frog is applied on thickness weighted tracer. That is: 70 !! pt raa = [ ptrab*e3tb + e3tn*( zwx - ptrab + p2dt ptraa ) ] / e3tn70 !! pta = [ ptb*e3tb + e3tn*( zwx - ptb + p2dt pta ) ] / e3tn 71 71 !! 72 72 !! ** Action : - after tracer fields pta 73 73 !!--------------------------------------------------------------------- 74 !! * Arguments74 !! 75 75 INTEGER , INTENT(in ) :: kt ! ocean time-step index 76 76 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 78 78 INTEGER , INTENT(in ) :: kn_zdfexp ! number of sub-time step 79 79 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 80 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields81 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend82 !! * Local declarations80 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 81 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 82 !! 83 83 INTEGER :: ji, jj, jk, jn, jl ! dummy loop indices 84 84 REAL(wp) :: zlavmr, zave3r, ze3tr ! temporary scalars … … 103 103 zwy(:,:,jpk) = 0.e0 ! bottom boundary conditions: no flux 104 104 ! 105 zwx(:,:,:) = pt rab(:,:,:,jn) ! zwx array set to before tracer values105 zwx(:,:,:) = ptb(:,:,:,jn) ! zwx array set to before tracer values 106 106 107 107 ! Split-explicit loop (after tracer due to the vertical diffusion alone) … … 141 141 DO ji = fs_2, fs_jpim1 ! vector opt. 142 142 ze3tb = fse3t_b(ji,jj,jk) / fse3t(ji,jj,jk) ! before e3t 143 ztra = zwx(ji,jj,jk) - pt rab(ji,jj,jk,jn) + p2dt(jk) * ptraa(ji,jj,jk,jn) ! total trends * 2*rdt144 pt raa(ji,jj,jk,jn) = ( ze3tb * ptrab(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk)143 ztra = zwx(ji,jj,jk) - ptb(ji,jj,jk,jn) + p2dt(jk) * pta(ji,jj,jk,jn) ! total trends * 2*rdt 144 pta(ji,jj,jk,jn) = ( ze3tb * ptb(ji,jj,jk,jn) + ztra ) * tmask(ji,jj,jk) 145 145 END DO 146 146 END DO … … 150 150 DO jj = 2, jpjm1 151 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 pt raa(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * ptraa(ji,jj,jk,jn) ) * tmask(ji,jj,jk)152 pta(ji,jj,jk,jn) = ( zwx(ji,jj,jk) + p2dt(jk) * pta(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 153 153 END DO 154 154 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2024 r2034 43 43 # include "vectopt_loop_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)45 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 46 46 !! $Id$ 47 47 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 49 49 CONTAINS 50 50 51 SUBROUTINE tra_zdf_imp( kt , cdtype, p2dt, & 52 & ptrab , ptraa , kjpt ) 51 SUBROUTINE tra_zdf_imp( kt, cdtype, p2dt, ptb, pta, kjpt ) 53 52 !!---------------------------------------------------------------------- 54 53 !! *** ROUTINE tra_zdf_imp *** … … 89 88 !! 90 89 !!--------------------------------------------------------------------- 91 !! * Modules used90 !! 92 91 USE oce , ONLY : zwd => ua ! ua used as workspace 93 92 USE oce , ONLY : zws => va ! va - - 94 !! * Arguments93 !! 95 94 INTEGER , INTENT(in ) :: kt ! ocean time-step index 96 95 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 97 96 INTEGER , INTENT(in ) :: kjpt ! number of tracers 98 97 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 99 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: pt rab ! before and now tracer fields100 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pt raa ! tracer trend98 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields 99 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 101 100 !! 102 101 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 265 264 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1) 266 265 ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1) 267 pt raa(ji,jj,1,jn) = ze3tb * ptrab(ji,jj,1,jn) + p2dt(1) * ze3tn * ptraa(ji,jj,1,jn)266 pta(ji,jj,1,jn) = ze3tb * ptb(ji,jj,1,jn) + p2dt(1) * ze3tn * pta(ji,jj,1,jn) 268 267 END DO 269 268 END DO … … 273 272 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk) 274 273 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,jk) 275 zrhs = ze3tb * pt rab(ji,jj,jk,jn) + p2dt(jk) * ze3tn * ptraa(ji,jj,jk,jn) ! zrhs=right hand side276 pt raa(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ptraa(ji,jj,jk-1,jn)274 zrhs = ze3tb * ptb(ji,jj,jk,jn) + p2dt(jk) * ze3tn * pta(ji,jj,jk,jn) ! zrhs=right hand side 275 pta(ji,jj,jk,jn) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * pta(ji,jj,jk-1,jn) 277 276 END DO 278 277 END DO … … 284 283 DO jj = 2, jpjm1 285 284 DO ji = fs_2, fs_jpim1 286 pt raa(ji,jj,jpkm1,jn) = ptraa(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1)285 pta(ji,jj,jpkm1,jn) = pta(ji,jj,jpkm1,jn) / zwt(ji,jj,jpkm1) * tmask(ji,jj,jpkm1) 287 286 END DO 288 287 END DO … … 290 289 DO jj = 2, jpjm1 291 290 DO ji = fs_2, fs_jpim1 292 pt raa(ji,jj,jk,jn) = ( ptraa(ji,jj,jk,jn) - zws(ji,jj,jk) * ptraa(ji,jj,jk+1,jn) ) &291 pta(ji,jj,jk,jn) = ( pta(ji,jj,jk,jn) - zws(ji,jj,jk) * pta(ji,jj,jk+1,jn) ) & 293 292 & / zwt(ji,jj,jk) * tmask(ji,jj,jk) 294 293 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcadv.F90
r2030 r2034 39 39 # include "vectopt_loop_substitute.h90" 40 40 !!---------------------------------------------------------------------- 41 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)42 !! $Id: trcadv.F90 1601 2009-08-11 10:09:19Z ctlod $41 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 42 !! $Id: trcadv.F90 2024 2010-07-29 10:57:35Z cetlod $ 43 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 44 !!---------------------------------------------------------------------- … … 76 76 ! ! add the eiv transport (if necessary) 77 77 IF( lk_traldf_eiv ) CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' ) 78 79 SELECT CASE ( nadv ) ! compute advection trend and add it to general trend80 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt , 'TRC', zun, zvn, zwn, &81 & trb, trn , tra, jptra ) ! 2nd order centered scheme82 CASE ( 2 ) ; CALL tra_adv_tvd ( kt , 'TRC', zun, zvn, zwn, &83 & trb, trn , tra, jptra ) ! TVD scheme84 CASE ( 3 ) ; CALL tra_adv_muscl ( kt , 'TRC', zun, zvn, zwn, &85 & trb, tra , jptra ) ! MUSCL scheme86 CASE ( 4 ) ; CALL tra_adv_muscl2( kt , 'TRC', zun, zvn, zwn, &87 & trb, trn , tra, jptra ) ! MUSCL2 scheme88 CASE ( 5 ) ; CALL tra_adv_ubs ( kt , 'TRC', zun, zvn, zwn, &89 & trb, trn , tra, jptra ) ! UBS scheme90 CASE ( 6 ) ; CALL tra_adv_qck ( kt , 'TRC', zun, zvn, zwn, &91 & trb, trn , tra, jptra ) ! QUICKEST scheme92 78 ! 93 CASE (-1 ) ! esopa: test all possibility with control print 94 CALL tra_adv_cen2 ( kt , 'TRC', zun, zvn, zwn, & 95 & trb, trn , tra, jptra ) 96 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 97 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 98 ! 99 CALL tra_adv_tvd ( kt , 'TRC', zun, zvn, zwn, & 100 & trb, trn , tra, jptra ) 101 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 102 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 103 ! 104 CALL tra_adv_muscl ( kt , 'TRC', zun, zvn, zwn, & 105 & trb, tra, jptra ) 106 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 107 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 108 ! 109 CALL tra_adv_muscl2( kt , 'TRC', zun, zvn, zwn, & 110 & trb, trn , tra, jptra ) 111 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 112 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 113 ! 114 CALL tra_adv_ubs ( kt , 'TRC', zun, zvn, zwn, & 115 & trb, trn , tra, jptra ) 116 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 117 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 118 ! 119 CALL tra_adv_qck ( kt , 'TRC', zun, zvn, zwn, & 120 & trb, trn , tra, jptra ) 121 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 122 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 123 ! 79 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 80 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 81 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 82 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', zun, zvn, zwn, trb, tra, jptra ) ! MUSCL 83 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 84 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 85 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 86 ! 87 CASE (-1 ) !== esopa: test all possibility with control print ==! 88 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 89 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 90 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 91 CALL tra_adv_tvd ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 92 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 93 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 94 CALL tra_adv_muscl ( kt, 'TRC', zun, zvn, zwn, trb, tra, jptra ) 95 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 96 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 97 CALL tra_adv_muscl2( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 98 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 99 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 100 CALL tra_adv_ubs ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 101 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 102 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 103 CALL tra_adv_qck ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 104 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 105 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 106 ! 124 107 END SELECT 125 108 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcbbl.F90
r2030 r2034 34 34 # include "top_substitute.h90" 35 35 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)36 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 37 37 !! $Id$ 38 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcldf.F90
r2030 r2034 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! OPA 9.0 , LOCEAN-IPSL (2006)44 !! $Id: tr aldf.F90 1601 2009-08-11 10:09:19Z ctlod $43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 !! $Id: trcldf.F90 2024 2010-07-29 10:57:35Z cetlod $ 45 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- … … 70 70 71 71 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt , 'TRC', gtru , gtrv, & 73 & trb, tra , jptra ) ! iso-level laplacian 74 CASE ( 1 ) ; CALL tra_ldf_iso ( kt , 'TRC', gtru , gtrv, & 75 & trb, tra , jptra, rn_ahtrb_0 ) ! rotated laplacian 76 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt , 'TRC', gtru , gtrv, & 77 & trb, tra , jptra ) ! iso-level bilaplacian 78 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt , 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt , 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level laplacian 73 CASE ( 1 ) ; CALL tra_ldf_iso ( kt , 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) ! rotated laplacian 74 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt , 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian 75 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt , 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 79 76 ! 80 77 CASE ( -1 ) ! esopa: test all possibility with control print 81 CALL tra_ldf_lap ( kt , 'TRC', gtru, gtrv, & 82 & trb, tra , jptra ) 83 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 84 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 85 ! 86 CALL tra_ldf_iso ( kt , 'TRC', gtru , gtrv, & 87 & trb, tra , jptra, rn_ahtrb_0 ) 88 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 89 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 90 ! 91 CALL tra_ldf_bilap ( kt , 'TRC', gtru , gtrv, & 92 & trb, tra , jptra ) 93 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 94 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 95 ! 96 CALL tra_ldf_bilapg( kt, 'TRC', trb, tra , jptra ) 97 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 78 CALL tra_ldf_lap ( kt , 'TRC', gtru, gtrv, trb, tra, jptra ) 79 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 80 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 81 CALL tra_ldf_iso ( kt , 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 82 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 83 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 84 CALL tra_ldf_bilap ( kt , 'TRC', gtru, gtrv, trb, tra, jptra ) 85 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 86 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 87 CALL tra_ldf_bilapg( kt , 'TRC', trb, tra, jptra ) 88 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 89 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 99 90 END SELECT 100 91 ! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcnxt.F90
r2030 r2034 120 120 121 121 ! Leap-Frog + Asselin filter time stepping 122 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt , nittrc000, & 123 & trb, trn, tra, jptra ) ! variable volume level (vvl) 124 ELSE ; CALL tra_nxt_fix( kt , nittrc000, & 125 & trb, trn, tra, jptra ) ! fixed volume level 122 IF( lk_vvl ) THEN ; CALL tra_nxt_vvl( kt, nittrc000, trb, trn, tra, jptra ) ! variable volume level (vvl) 123 ELSE ; CALL tra_nxt_fix( kt, nittrc000, trb, trn, tra, jptra ) ! fixed volume level 126 124 ENDIF 127 125 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trczdf.F90
r2030 r2034 41 41 # include "vectopt_loop_substitute.h90" 42 42 !!---------------------------------------------------------------------- 43 !! OPA 9.0 , LOCEAN-IPSL (2005)44 !! $Id: tr azdf.F90 1533 2009-07-24 09:54:48Z ctlod $43 !! NEMO/OPA 3.3 , LOCEAN-IPSL (2010) 44 !! $Id: trcldf.F90 2024 2010-07-29 10:57:35Z cetlod $ 45 45 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 46 46 !!---------------------------------------------------------------------- … … 76 76 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 77 77 CASE ( -1 ) ! esopa: test all possibility with control print 78 CALL tra_zdf_exp( kt , 'TRC', r2dt, nn_trczdf_exp, & 79 & trb, tra, jptra ) 80 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 81 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 82 ! 83 CALL tra_zdf_imp( kt , 'TRC', r2dt, & 84 & trb, tra, jptra ) 85 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 86 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 87 CASE ( 0 ) ; CALL tra_zdf_exp( kt , 'TRC', r2dt, nn_trczdf_exp, & 88 & trb, tra , jptra ) ! explicit scheme 89 CASE ( 1 ) ; CALL tra_zdf_imp( kt , 'TRC', r2dt, & 90 & trb, tra , jptra ) ! implicit scheme 78 CALL tra_zdf_exp( kt , 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 79 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 80 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 81 CALL tra_zdf_imp( kt , 'TRC', r2dt, trb, tra, jptra ) 82 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 83 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 84 CASE ( 0 ) ; CALL tra_zdf_exp( kt , 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 85 CASE ( 1 ) ; CALL tra_zdf_imp( kt , 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 91 86 92 87 END SELECT
Note: See TracChangeset
for help on using the changeset viewer.