Changeset 2082 for branches/DEV_r2006_merge_TRA_TRC
- Timestamp:
- 2010-09-10T12:32:58+02:00 (14 years ago)
- Location:
- branches/DEV_r2006_merge_TRA_TRC/NEMO
- Files:
-
- 58 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/NST_SRC/agrif_user.F90
r1970 r2082 307 307 #if defined key_top 308 308 ! Check passive tracer cell 309 IF( n dttrc .ne. 1 ) THEN310 WRITE(*,*) 'n dttrc should be equal to 1'309 IF( nn_dttrc .ne. 1 ) THEN 310 WRITE(*,*) 'nn_dttrc should be equal to 1' 311 311 ENDIF 312 312 #endif … … 444 444 ENDIF 445 445 ! Check passive tracer cell 446 IF( n dttrc .ne. 1 ) THEN447 WRITE(*,*) 'n dttrc should be equal to 1'446 IF( nn_dttrc .ne. 1 ) THEN 447 WRITE(*,*) 'nn_dttrc should be equal to 1' 448 448 ENDIF 449 449 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/dtadyn.F90
r2053 r2082 184 184 185 185 IF( lk_ldfslp ) THEN 186 ! Computes slopes 187 ! Caution : here tn, sn and avt are used as workspace 188 tn (:,:,:) = tdta (:,:,:,2) 189 sn (:,:,:) = sdta (:,:,:,2) 190 avt(:,:,:) = avtdta(:,:,:,2) 191 192 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 193 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 186 ! Computes slopes. Caution : here tsn and avt are used as workspace 187 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 188 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) 189 avt(:,:,:) = avtdta(:,:,:,2) 190 191 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density 192 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency 194 193 IF( ln_zps ) & 195 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 196 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 197 & gtv, gsv, grv ) 194 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 195 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 198 196 CALL zdf_mxl( kt ) ! mixed layer depth 199 197 CALL ldf_slp( kt, rhd, rn2 ) … … 213 211 214 212 IF( lk_ldfslp ) THEN 215 ! Computes slopes 216 ! Caution : here tn, sn and avt are used as workspace 217 tn (:,:,:) = tdta (:,:,:,2) 218 sn (:,:,:) = sdta (:,:,:,2) 219 avt(:,:,:) = avtdta(:,:,:,2) 220 221 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 222 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 213 ! Computes slopes. Caution : here tsn and avt are used as workspace 214 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 215 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) 216 avt(:,:,:) = avtdta(:,:,:,2) 217 218 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density 219 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency 223 220 IF( ln_zps ) & 224 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 225 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 226 & gtv, gsv, grv ) 221 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 222 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 227 223 CALL zdf_mxl( kt ) ! mixed layer depth 228 224 CALL ldf_slp( kt, rhd, rn2 ) … … 261 257 262 258 IF( lk_ldfslp ) THEN 263 ! Computes slopes 264 ! Caution : here tn, sn and avt are used as workspace 265 tn (:,:,:) = tdta (:,:,:,2) 266 sn (:,:,:) = sdta (:,:,:,2) 267 avt(:,:,:) = avtdta(:,:,:,2) 268 269 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 270 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 259 ! Computes slopes. Caution : here tsn and avt are used as workspace 260 tsn (:,:,:,jp_tem) = tdta (:,:,:,2) 261 tsn (:,:,:,jp_sal) = sdta (:,:,:,2) 262 avt(:,:,:) = avtdta(:,:,:,2) 263 264 CALL eos( tsn, rhd, rhop ) ! Time-filtered in situ density 265 CALL bn2( tsn, rn2 ) ! before Brunt-Vaisala frequency 271 266 IF( ln_zps ) & 272 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 273 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 274 & gtv, gsv, grv ) 267 & CALL zps_hde( kt, jpts, tsn, gtsu, gtsv, & ! Partial steps: before Horizontal DErivative 268 & rhd, gru , grv ) ! of t, s, rd at the bottom ocean level 275 269 CALL zdf_mxl( kt ) ! mixed layer depth 276 270 CALL ldf_slp( kt, rhd, rn2 ) … … 311 305 312 306 ! In any case, we need rhop 313 CALL eos( t n,sn, rhd, rhop )307 CALL eos( tsn, rhd, rhop ) 314 308 315 309 #if ! defined key_degrad && defined key_traldf_c2d … … 320 314 ! Compute bbl coefficients if needed 321 315 IF( lk_trabbl ) THEN 322 tb(:,:,:) = tn(:,:,:) 323 sb(:,:,:) = sn(:,:,:) 316 tsb(:,:,:,:) = tsn(:,:,:,:) 324 317 CALL bbl( kt, 'TRC') 325 318 END IF … … 735 728 !!---------------------------------------------------------------------- 736 729 737 t n (:,:,:) = tdta (:,:,:,2)738 sn (:,:,:) = sdta (:,:,:,2)739 avt(:,:,:) = avtdta(:,:,:,2)730 tsn(:,:,:,jp_tem) = tdta (:,:,:,2) 731 tsn(:,:,:,jp_sal) = sdta (:,:,:,2) 732 avt(:,:,:) = avtdta(:,:,:,2) 740 733 741 734 un (:,:,:) = udta (:,:,:,2) … … 796 789 zweighm1 = 1. - pweigh 797 790 798 t n (:,:,:) = zweighm1 * tdta (:,:,:,1) + pweigh * tdta (:,:,:,2)799 sn (:,:,:) = zweighm1 * sdta (:,:,:,1) + pweigh * sdta (:,:,:,2)800 avt(:,:,:) = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2)791 tsn(:,:,:,jp_tem) = zweighm1 * tdta (:,:,:,1) + pweigh * tdta (:,:,:,2) 792 tsn(:,:,:,jp_sal) = zweighm1 * sdta (:,:,:,1) + pweigh * sdta (:,:,:,2) 793 avt(:,:,:) = zweighm1 * avtdta(:,:,:,1) + pweigh * avtdta(:,:,:,2) 801 794 802 795 un (:,:,:) = zweighm1 * udta (:,:,:,1) + pweigh * udta (:,:,:,2) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/istate.F90
r1715 r2082 59 59 ; hdivn(:,:,:) = 0.e0 ; 60 60 61 ; tn (:,:,:) = 0.e0 ; ta (:,:,:) = 0.e0 62 ; sn (:,:,:) = 0.e0 ; sa (:,:,:) = 0.e0 61 ; tsn (:,:,:,:) = 0.e0 63 62 64 63 rhd (:,:,:) = 0.e0 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/opa.F90
r2053 r2082 223 223 224 224 225 ! ! General initialization 225 226 CALL phy_cst ! Physical constants 226 227 CALL eos_init ! Equation of state … … 234 235 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 235 236 & CALL zdf_ddm_init ! double diffusive mixing 236 ! ! Lateral physics237 237 #if ! defined key_degrad 238 238 CALL ldf_tra_init ! Lateral ocean tracer physics 239 239 #endif 240 240 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 241 241 242 ! ! Active tracers 242 243 CALL tra_qsr_init ! penetrative solar radiation qsr 243 244 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 244 245 245 CALL trc_ini ! Passive tracers 246 ! ! Passive tracers 247 CALL trc_init ! Passive tracers initialization 248 ! ! Dynamics 246 249 CALL dta_dyn_init ! Initialization for the dynamics 247 250 CALL iom_init ! iom_put initialization -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/DIA/diaar5.F90
r2027 r2082 67 67 REAL(wp), DIMENSION(jpi,jpj ) :: zarea_ssh, zbotpres 68 68 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrhd, zrhop 69 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: ztsn 69 70 !!-------------------------------------------------------------------- 70 71 … … 82 83 83 84 ! ! thermosteric ssh 84 CALL eos( tn, sn0, zrhd ) ! now in situ density using initial salinity 85 ztsn(:,:,:,jp_tem) = tn (:,:,:) 86 ztsn(:,:,:,jp_sal) = sn0(:,:,:) 87 CALL eos( ztsn, zrhd ) ! now in situ density using initial salinity 85 88 ! 86 89 zbotpres(:,:) = 0.e0 ! no atmospheric surface pressure, levitating sea-ice … … 96 99 97 100 ! ! steric sea surface height 98 CALL eos( t n,sn, zrhd, zrhop ) ! now in situ and potential density101 CALL eos( tsn, zrhd, zrhop ) ! now in situ and potential density 99 102 zrhop(:,:,jpk) = 0.e0 100 103 CALL iom_put( 'rhop', zrhop ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/IOM/restart.F90
r1613 r2082 26 26 USE zdfmxl ! mixed layer depth 27 27 USE trdmld_oce ! ocean active mixed layer tracers trends variables 28 28 #if defined key_zdfkpp 29 USE traswap 30 #endif 29 31 IMPLICIT NONE 30 32 PRIVATE … … 205 207 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly 206 208 ELSE 207 CALL eos( tn, sn, rhd ) ! compute rhd 209 CALL tra_swap 210 CALL eos( tsn, rhd ) ! compute rhd 208 211 ENDIF 209 212 #endif -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/eosbn2.F90
r1613 r2082 68 68 CONTAINS 69 69 70 SUBROUTINE eos_insitu( pt em, psal, prd )70 SUBROUTINE eos_insitu( pts, prd ) 71 71 !!---------------------------------------------------------------------- 72 72 !! *** ROUTINE eos_insitu *** … … 98 98 !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 99 99 !! Note that no boundary condition problem occurs in this routine 100 !! as (ptem,psal)are defined over the whole domain.100 !! as pts are defined over the whole domain. 101 101 !! 102 102 !! ** Action : compute prd , the in situ density (no units) … … 104 104 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 105 105 !!---------------------------------------------------------------------- 106 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: ptem !potential temperature [Celcius]107 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal !salinity [psu]108 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: prd! in situ density106 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 107 ! ! 2 : salinity [psu] 108 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: prd ! in situ density 109 109 !! 110 110 INTEGER :: ji, jj, jk ! dummy loop indices … … 123 123 zrau0r = 1.e0 / rau0 124 124 !CDIR NOVERRCHK 125 zws(:,:,:) = SQRT( ABS( p sal(:,:,:) ) )125 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 126 126 ! 127 127 DO jk = 1, jpkm1 128 128 DO jj = 1, jpj 129 129 DO ji = 1, jpi 130 zt = pt em (ji,jj,jk)131 zs = p sal (ji,jj,jk)130 zt = pts (ji,jj,jk,jp_tem) 131 zs = pts (ji,jj,jk,jp_sal) 132 132 zh = fsdept(ji,jj,jk) ! depth 133 133 zsr= zws (ji,jj,jk) ! square root salinity … … 169 169 CASE( 1 ) !== Linear formulation function of temperature only ==! 170 170 DO jk = 1, jpkm1 171 prd(:,:,jk) = ( 0.0285 - rn_alpha * pt em(:,:,jk) ) * tmask(:,:,jk)171 prd(:,:,jk) = ( 0.0285 - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 172 172 END DO 173 173 ! 174 174 CASE( 2 ) !== Linear formulation function of temperature and salinity ==! 175 175 DO jk = 1, jpkm1 176 prd(:,:,jk) = ( rn_beta * p sal(:,:,jk) - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk)176 prd(:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 177 177 END DO 178 178 ! … … 184 184 185 185 186 SUBROUTINE eos_insitu_pot( pt em, psal, prd, prhop )186 SUBROUTINE eos_insitu_pot( pts, prd, prhop ) 187 187 !!---------------------------------------------------------------------- 188 188 !! *** ROUTINE eos_insitu_pot *** … … 230 230 !! Brown and Campana, Mon. Weather Rev., 1978 231 231 !!---------------------------------------------------------------------- 232 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: ptem !potential temperature [Celcius]233 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal !salinity [psu]234 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density235 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced)232 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 233 ! ! 2 : salinity [psu] 234 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prd ! in situ density 235 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( out) :: prhop ! potential density (surface referenced) 236 236 237 237 INTEGER :: ji, jj, jk ! dummy loop indices … … 246 246 zrau0r = 1.e0 / rau0 247 247 !CDIR NOVERRCHK 248 zws(:,:,:) = SQRT( ABS( p sal(:,:,:) ) )248 zws(:,:,:) = SQRT( ABS( pts(:,:,:,jp_sal) ) ) 249 249 ! 250 250 DO jk = 1, jpkm1 251 251 DO jj = 1, jpj 252 252 DO ji = 1, jpi 253 zt = pt em (ji,jj,jk)254 zs = p sal (ji,jj,jk)253 zt = pts (ji,jj,jk,jp_tem) 254 zs = pts (ji,jj,jk,jp_sal) 255 255 zh = fsdept(ji,jj,jk) ! depth 256 256 zsr= zws (ji,jj,jk) ! square root salinity … … 295 295 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 296 296 DO jk = 1, jpkm1 297 prd (:,:,jk) = ( 0.0285 - rn_alpha * pt em(:,:,jk) ) * tmask(:,:,jk)298 prhop(:,:,jk) = ( 1.e0 + prd (:,:,jk)) * rau0 * tmask(:,:,jk)297 prd (:,:,jk) = ( 0.0285 - rn_alpha * pts(:,:,jk,jp_sal) ) * tmask(:,:,jk) 298 prhop(:,:,jk) = ( 1.e0 + prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 299 299 END DO 300 300 ! 301 301 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 302 302 DO jk = 1, jpkm1 303 prd (:,:,jk) = ( rn_beta * p sal(:,:,jk) - rn_alpha * ptem(:,:,jk) ) * tmask(:,:,jk)304 prhop(:,:,jk) = ( 1.e0 + prd (:,:,jk) )* rau0 * tmask(:,:,jk)303 prd (:,:,jk) = ( rn_beta * pts(:,:,jk,jp_sal) - rn_alpha * pts(:,:,jk,jp_tem) ) * tmask(:,:,jk) 304 prhop(:,:,jk) = ( 1.e0 + prd (:,:,jk) ) * rau0 * tmask(:,:,jk) 305 305 END DO 306 306 ! … … 312 312 313 313 314 SUBROUTINE eos_insitu_2d( pt em, psal, pdep, prd )314 SUBROUTINE eos_insitu_2d( pts, pdep, prd ) 315 315 !!---------------------------------------------------------------------- 316 316 !! *** ROUTINE eos_insitu_2d *** … … 342 342 !! prd(t,s) = rn_beta * s - rn_alpha * tn - 1. 343 343 !! Note that no boundary condition problem occurs in this routine 344 !! as (ptem,psal)are defined over the whole domain.344 !! as pts are defined over the whole domain. 345 345 !! 346 346 !! ** Action : - prd , the in situ density (no units) … … 348 348 !! References : Jackett and McDougall, J. Atmos. Ocean. Tech., 1994 349 349 !!---------------------------------------------------------------------- 350 REAL(wp), DIMENSION(jpi,jpj ), INTENT(in ) :: ptem !potential temperature [Celcius]351 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal !salinity [psu]352 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep! depth [m]353 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd! in situ density350 REAL(wp), DIMENSION(jpi,jpj,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 351 ! ! 2 : salinity [psu] 352 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in ) :: pdep ! depth [m] 353 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out) :: prd ! in situ density 354 354 !! 355 355 INTEGER :: ji, jj ! dummy loop indices … … 369 369 !CDIR NOVERRCHK 370 370 DO ji = 1, fs_jpim1 ! vector opt. 371 zws(ji,jj) = SQRT( ABS( p sal(ji,jj) ) )371 zws(ji,jj) = SQRT( ABS( pts(ji,jj,jp_sal) ) ) 372 372 END DO 373 373 END DO … … 375 375 DO ji = 1, fs_jpim1 ! vector opt. 376 376 zmask = tmask(ji,jj,1) ! land/sea bottom mask = surf. mask 377 zt = pt em (ji,jj) ! interpolated T378 zs = p sal (ji,jj) ! interpolated S377 zt = pts (ji,jj,jp_tem) ! interpolated T 378 zs = pts (ji,jj,jp_sal) ! interpolated S 379 379 zsr = zws (ji,jj) ! square root of interpolated S 380 380 zh = pdep (ji,jj) ! depth at the partial step level … … 416 416 DO jj = 1, jpjm1 417 417 DO ji = 1, fs_jpim1 ! vector opt. 418 prd(ji,jj) = ( 0.0285 - rn_alpha * pt em(ji,jj) ) * tmask(ji,jj,1)418 prd(ji,jj) = ( 0.0285 - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 419 419 END DO 420 420 END DO … … 423 423 DO jj = 1, jpjm1 424 424 DO ji = 1, fs_jpim1 ! vector opt. 425 prd(ji,jj) = ( rn_beta * p sal(ji,jj) - rn_alpha * ptem(ji,jj) ) * tmask(ji,jj,1)425 prd(ji,jj) = ( rn_beta * pts(ji,jj,jp_sal) - rn_alpha * pts(ji,jj,jp_tem) ) * tmask(ji,jj,1) 426 426 END DO 427 427 END DO … … 434 434 435 435 436 SUBROUTINE eos_bn2( pt em, psal, pn2 )436 SUBROUTINE eos_bn2( pts, pn2 ) 437 437 !!---------------------------------------------------------------------- 438 438 !! *** ROUTINE eos_bn2 *** … … 464 464 !! References : McDougall, J. Phys. Oceanogr., 17, 1950-1964, 1987. 465 465 !!---------------------------------------------------------------------- 466 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: ptem ! potential temperature[Celcius]467 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: psal ! salinity[psu]468 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1]466 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 467 ! ! 2 : salinity [psu] 468 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT( out) :: pn2 ! Brunt-Vaisala frequency [s-1] 469 469 !! 470 470 INTEGER :: ji, jj, jk ! dummy loop indices … … 485 485 DO ji = 1, jpi 486 486 zgde3w = grav / fse3w(ji,jj,jk) 487 zt = 0.5 * ( pt em(ji,jj,jk) + ptem(ji,jj,jk-1) ) ! potential temperature at w-point488 zs = 0.5 * ( p sal(ji,jj,jk) + psal(ji,jj,jk-1) ) - 35.0 ! salinity anomaly (s-35) at w-point487 zt = 0.5 * ( pts(ji,jj,jk,jp_tem) + pts(ji,jj,jk-1,jp_tem) ) ! potential temperature at w-point 488 zs = 0.5 * ( pts(ji,jj,jk,jp_sal) + pts(ji,jj,jk-1,jp_sal) ) - 35.0 ! salinity anomaly (s-35) at w-point 489 489 zh = fsdepw(ji,jj,jk) ! depth in meters at w-point 490 490 ! … … 515 515 ! 516 516 pn2(ji,jj,jk) = zgde3w * zbeta * tmask(ji,jj,jk) & ! N^2 517 & * ( zalbet * ( pt em(ji,jj,jk-1) - ptem(ji,jj,jk) ) &518 & - ( p sal(ji,jj,jk-1) - psal(ji,jj,jk) ) )517 & * ( zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) & 518 & - ( pts(ji,jj,jk-1njp_sal) - pts(ji,jj,jk,jp_sal) ) ) 519 519 #if defined key_zdfddm 520 520 ! !!bug **** caution a traiter zds=dk[S]= 0 !!!! 521 zds = ( p sal(ji,jj,jk-1) - psal(ji,jj,jk) ) ! Rrau = (alpha / beta) (dk[t] / dk[s])521 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) ! Rrau = (alpha / beta) (dk[t] / dk[s]) 522 522 IF ( ABS( zds) <= 1.e-20 ) zds = 1.e-20 523 rrau(ji,jj,jk) = zalbet * ( pt em(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds523 rrau(ji,jj,jk) = zalbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 524 524 #endif 525 525 END DO … … 529 529 CASE( 1 ) !== Linear formulation = F( temperature ) ==! 530 530 DO jk = 2, jpkm1 531 pn2(:,:,jk) = grav * rn_alpha * ( pt em(:,:,jk-1) - ptem(:,:,jk) ) / fse3w(:,:,jk) * tmask(:,:,jk)531 pn2(:,:,jk) = grav * rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) / fse3w(:,:,jk) * tmask(:,:,jk) 532 532 END DO 533 533 ! 534 534 CASE( 2 ) !== Linear formulation = F( temperature , salinity ) ==! 535 535 DO jk = 2, jpkm1 536 pn2(:,:,jk) = grav * ( rn_alpha * ( pt em(:,:,jk-1) - ptem(:,:,jk) ) &537 & - rn_beta * ( p sal(:,:,jk-1) - psal(:,:,jk) ) ) &536 pn2(:,:,jk) = grav * ( rn_alpha * ( pts(:,:,jk-1,jp_tem) - pts(:,:,jk,jp_tem) ) & 537 & - rn_beta * ( pts(:,:,jk-1,jp_sal) - pts(:,:,jk,jp_sal) ) ) & 538 538 & / fse3w(:,:,jk) * tmask(:,:,jk) 539 539 END DO … … 542 542 DO jj = 1, jpj 543 543 DO ji = 1, jpi 544 zds = ( p sal(ji,jj,jk-1) - psal(ji,jj,jk) )544 zds = ( pts(ji,jj,jk-1,jp_sal) - pts(ji,jj,jk,jp_sal) ) 545 545 IF ( ABS( zds ) <= 1.e-20 ) zds = 1.e-20 546 rrau(ji,jj,jk) = ralpbet * ( pt em(ji,jj,jk-1) - ptem(ji,jj,jk) ) / zds546 rrau(ji,jj,jk) = ralpbet * ( pts(ji,jj,jk-1,jp_tem) - pts(ji,jj,jk,jp_tem) ) / zds 547 547 END DO 548 548 END DO -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv.F90
r2034 r2082 42 42 INTEGER :: nadv ! choice of the type of advection scheme 43 43 44 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 45 ! ! except at nit000 (=rdttra) if neuler=0 46 44 47 !! * Substitutions 45 48 # include "domzgr_substitute.h90" … … 66 69 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zun, zvn, zwn ! effective transport 67 70 !!---------------------------------------------------------------------- 71 ! ! set time step 72 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 73 r2dt(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 74 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 75 r2dt(:) = 2. * rdttra(:) ! = 2 rdttra (leapfrog) 76 ENDIF 68 77 ! !== effective transport ==! 69 78 DO jk = 1, jpkm1 … … 82 91 83 92 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 centered85 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD86 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL87 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL288 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS89 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST93 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 94 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 95 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 96 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 97 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 98 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 90 99 ! 91 100 CASE (-1 ) !== esopa: test all possibility with control print ==! 92 CALL tra_adv_cen2 ( kt , 'TRA',zun, zvn, zwn, tsb, tsn, tsa, jpts )101 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 93 102 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 94 103 & 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 )104 CALL tra_adv_tvd ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 96 105 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 97 106 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 98 CALL tra_adv_muscl ( kt, 'TRA', zun, zvn, zwn, tsb, tsa, jpts )107 CALL tra_adv_muscl ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsa, jpts ) 99 108 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 100 109 & 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 )110 CALL tra_adv_muscl2( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 102 111 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 103 112 & 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 )113 CALL tra_adv_ubs ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 105 114 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 106 115 & 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 )116 CALL tra_adv_qck ( kt, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 108 117 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 109 118 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 179 188 IF( nadv == 5 ) WRITE(numout,*) ' UBS scheme is used' 180 189 IF( nadv == 6 ) WRITE(numout,*) ' QUICKEST scheme is used' 181 IF( nadv == 7 ) WRITE(numout,*) ' SMOLAR scheme is used'182 190 IF( nadv == -1 ) WRITE(numout,*) ' esopa test: use all advection scheme' 183 191 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r2052 r2082 20 20 !! area (set for orca 2 and 4 only) 21 21 !!---------------------------------------------------------------------- 22 USE oce, ONLY: t n,sn ! now ocean temperature and salinity22 USE oce, ONLY: tsn ! now ocean temperature and salinity 23 23 USE dom_oce ! ocean space and time domain 24 24 USE eosbn2 ! equation of state … … 32 32 USE zdf_oce ! ocean vertical physics 33 33 USE restart ! ocean restart 34 USE trc_oce ! share passive tracers/Ocean variables 34 35 35 36 IMPLICIT NONE … … 134 135 !!---------------------------------------------------------------------- 135 136 136 IF( kt == nit000 ) THEN 137 138 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 137 139 IF(lwp) WRITE(numout,*) 138 IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme '140 IF(lwp) WRITE(numout,*) 'tra_adv_cen2 : 2nd order centered advection scheme on ', cdtype 139 141 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ Vector optimization case' 140 142 IF(lwp) WRITE(numout,*) … … 159 161 !!gm not strickly exact : the freezing point should be computed at each ocean levels... 160 162 !!gm not a big deal since cen2 is no more used in global ice-ocean simulations 161 ztfreez(:,:) = tfreez( sn(:,:,1) )163 ztfreez(:,:) = tfreez( tsn(:,:,1,jp_sal) ) 162 164 DO jk = 1, jpk 163 165 DO jj = 1, jpj 164 166 DO ji = 1, jpi 165 167 ! ! below ice covered area (if tn < "freezing"+0.1 ) 166 IF( t n(ji,jj,jk) <= ztfreez(ji,jj) + 0.1 ) THEN ; zice = 1.e0167 ELSE ; zice = 0.e0168 IF( tsn(ji,jj,jk,jp_tem) <= ztfreez(ji,jj) + 0.1 ) THEN ; zice = 1.e0 169 ELSE ; zice = 0.e0 168 170 ENDIF 169 171 zind(ji,jj,jk) = MAX ( & -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r2024 r2082 22 22 USE in_out_manager ! I/O manager 23 23 USE iom 24 USE trc_oce ! share passive tracers/Ocean variables 24 25 # if defined key_diaeiv 25 26 USE phycst ! physical constants … … 80 81 !!---------------------------------------------------------------------- 81 82 82 IF( kt == nit000 )THEN83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 83 84 IF(lwp) WRITE(numout,*) 84 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection :'85 IF(lwp) WRITE(numout,*) 'tra_adv_eiv : eddy induced advection on ', cdtype,' :' 85 86 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ add to velocity fields the eiv component' 86 87 # if defined key_diaeiv -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r2034 r2082 24 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 25 25 USE diaptr ! poleward transport diagnostics 26 USE trc_oce ! share passive tracers/Ocean variables 26 27 27 28 … … 44 45 CONTAINS 45 46 46 SUBROUTINE tra_adv_muscl( kt, cdtype, p un, pvn, pwn, &47 & ptb, pta, kjpt )47 SUBROUTINE tra_adv_muscl( kt, cdtype, p2dt, pun, pvn, pwn, & 48 & ptb, pta, kjpt ) 48 49 !!---------------------------------------------------------------------- 49 50 !! *** ROUTINE tra_adv_muscl *** … … 67 68 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 68 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 69 71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 70 72 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb ! before and now tracer fields … … 75 77 REAL(wp) :: zv, z0v, zzwy 76 78 REAL(wp) :: zw, z0w 77 REAL(wp) :: ztra, zbtr, z 2, zdt, zalpha79 REAL(wp) :: ztra, zbtr, zdt, zalpha 78 80 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy ! 3D workspace 79 81 !!---------------------------------------------------------------------- 80 82 81 IF( kt == nit000 .AND. lwp )THEN83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 82 84 WRITE(numout,*) 83 WRITE(numout,*) 'tra_adv : MUSCL advection scheme '85 WRITE(numout,*) 'tra_adv : MUSCL advection scheme on ', cdtype 84 86 WRITE(numout,*) '~~~~~~~' 85 87 ! … … 88 90 ENDIF 89 91 90 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2 = 1.91 ELSE ; z2 = 2.92 ENDIF93 !94 92 ! ! =========== 95 93 DO jn = 1, kjpt ! tracer loop … … 139 137 ! !-- MUSCL horizontal advective fluxes 140 138 DO jk = 1, jpkm1 ! interior values 141 zdt = z2 * rdttra(jk)139 zdt = p2dt(jk) 142 140 DO jj = 2, jpjm1 143 141 DO ji = fs_2, fs_jpim1 ! vector opt. … … 230 228 ! 231 229 DO jk = 1, jpkm1 ! interior values 232 zdt = z2 * rdttra(jk)230 zdt = p2dt(jk) 233 231 DO jj = 2, jpjm1 234 232 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2034 r2082 22 22 USE lbclnk ! ocean lateral boundary condition (or mpp link) 23 23 USE diaptr ! poleward transport diagnostics 24 USE trc_oce ! share passive tracers/Ocean variables 24 25 25 26 … … 43 44 CONTAINS 44 45 45 SUBROUTINE tra_adv_muscl2( kt, cdtype, p un, pvn, pwn, &46 & ptb, ptn, pta, kjpt )46 SUBROUTINE tra_adv_muscl2( kt, cdtype, p2dt, pun, pvn, pwn, & 47 & ptb, ptn, pta, kjpt ) 47 48 !!---------------------------------------------------------------------- 48 49 !! *** ROUTINE tra_adv_muscl2 *** … … 67 68 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 68 69 INTEGER , INTENT(in ) :: kjpt ! number of tracers 70 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 69 71 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 70 72 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields … … 75 77 REAL(wp) :: zv, z0v, zzwy 76 78 REAL(wp) :: zw, z0w 77 REAL(wp) :: ztra, zbtr, z 2, zdt, zalpha79 REAL(wp) :: ztra, zbtr, zdt, zalpha 78 80 REAL(wp), DIMENSION (jpi,jpj,jpk) :: zslpx, zslpy ! 3D workspace 79 81 !!---------------------------------------------------------------------- 80 82 81 IF( kt == nit000 .AND. lwp )THEN83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 82 84 WRITE(numout,*) 83 WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme '85 WRITE(numout,*) 'tra_adv_muscl2 : MUSCL2 advection scheme on ', cdtype 84 86 WRITE(numout,*) '~~~~~~~~~~~~~~~' 85 87 ! … … 88 90 ENDIF 89 91 90 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2 = 1.91 ELSE ; z2 = 2.92 ENDIF93 !94 92 ! 95 93 DO jn = 1, kjpt ! tracer loop … … 139 137 ! !-- MUSCL horizontal advective fluxes 140 138 DO jk = 1, jpkm1 ! interior values 141 zdt = z2 * rdttra(jk)139 zdt = p2dt(jk) 142 140 DO jj = 2, jpjm1 143 141 DO ji = fs_2, fs_jpim1 ! vector opt. … … 255 253 ! 256 254 DO jk = 1, jpkm1 ! interior values 257 zdt = z2 * rdttra(jk)255 zdt = p2dt(jk) 258 256 DO jj = 2, jpjm1 259 257 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_qck.F90
r2034 r2082 25 25 USE in_out_manager ! I/O manager 26 26 USE diaptr ! poleward transport diagnostics 27 USE trc_oce ! share passive tracers/Ocean variables 27 28 28 29 IMPLICIT NONE … … 45 46 CONTAINS 46 47 47 SUBROUTINE tra_adv_qck ( kt, cdtype, p un, pvn, pwn, &48 & ptb, ptn, pta, kjpt )48 SUBROUTINE tra_adv_qck ( kt, cdtype, p2dt, pun, pvn, pwn, & 49 & ptb, ptn, pta, kjpt ) 49 50 !!---------------------------------------------------------------------- 50 51 !! *** ROUTINE tra_adv_qck *** … … 85 86 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 86 87 INTEGER , INTENT(in ) :: kjpt ! number of tracers 88 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 87 89 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 88 90 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 89 91 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 90 !! 91 REAL(wp) :: z2 ! temporary scalar 92 !!---------------------------------------------------------------------- 93 94 IF( kt == nit000 ) THEN 92 !!---------------------------------------------------------------------- 93 94 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 95 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme '96 IF(lwp) WRITE(numout,*) 'tra_adv_qck : 3rd order quickest advection scheme on ', cdtype 97 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 98 98 IF(lwp) WRITE(numout,*) … … 102 102 ENDIF 103 103 104 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2 = 1.105 ELSE ; z2 = 2.106 ENDIF107 108 104 ! I. The horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 109 105 !--------------------------------------------------------------------------- 110 106 111 CALL tra_adv_qck_i( kt, cdtype, p un, z2, ptb, ptn, pta, kjpt )112 CALL tra_adv_qck_j( kt, cdtype, p vn, z2, ptb, ptn, pta, kjpt )107 CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt ) 108 CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt ) 113 109 114 110 ! II. The vertical fluxes are computed with the 2nd order centered scheme … … 119 115 END SUBROUTINE tra_adv_qck 120 116 121 SUBROUTINE tra_adv_qck_i( kt, cdtype, p un, pz2,&122 & ptb, ptn, pta, kjpt )117 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, & 118 & ptb, ptn, pta, kjpt ) 123 119 !!---------------------------------------------------------------------- 124 120 !! … … 129 125 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 130 126 INTEGER , INTENT(in ) :: kjpt ! number of tracers 127 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 131 128 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun ! zonal velocity component 132 129 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before tracer fields 133 130 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 134 REAL(wp) , INTENT(in ) :: pz2135 131 !! 136 132 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 176 172 ! 177 173 DO jk = 1, jpkm1 178 zdt = p z2 * rdttra(jk)174 zdt = p2dt(jk) 179 175 DO jj = 2, jpjm1 180 176 DO ji = fs_2, fs_jpim1 ! vector opt. … … 239 235 END SUBROUTINE tra_adv_qck_i 240 236 241 SUBROUTINE tra_adv_qck_j( kt, cdtype, p vn, pz2, &242 & ptb, ptn, pta, kjpt )237 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 238 & ptb, ptn, pta, kjpt ) 243 239 !!---------------------------------------------------------------------- 244 240 !! … … 250 246 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 251 247 INTEGER , INTENT(in ) :: kjpt ! number of tracers 248 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 252 249 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pvn ! meridional velocity component 253 250 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before tracer fields 254 251 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend 255 REAL(wp) , INTENT(in ) :: pz2256 252 !! 257 253 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 296 292 ! 297 293 DO jk = 1, jpkm1 298 zdt = p z2 * rdttra(jk)294 zdt = p2dt(jk) 299 295 DO jj = 2, jpjm1 300 296 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r2034 r2082 32 32 USE lbclnk ! ocean lateral boundary condition (or mpp link) 33 33 USE diaptr ! poleward transport diagnostics 34 USE trc_oce ! share passive tracers/Ocean variables 34 35 35 36 … … 52 53 CONTAINS 53 54 54 SUBROUTINE tra_adv_tvd ( kt, cdtype, p un, pvn, pwn, &55 & ptb, ptn, pta, kjpt )55 SUBROUTINE tra_adv_tvd ( kt, cdtype, p2dt, pun, pvn, pwn, & 56 & ptb, ptn, pta, kjpt ) 56 57 !!---------------------------------------------------------------------- 57 58 !! *** ROUTINE tra_adv_tvd *** … … 73 74 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 74 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 75 77 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 76 78 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields … … 79 81 INTEGER :: ji, jj, jk, jn ! dummy loop indices 80 82 REAL(wp) :: & 81 z2 , z2dtt, zbtr, ztra,& ! temporary scalar83 z2dtt, zbtr, ztra, & ! temporary scalar 82 84 zfp_ui, zfp_vj, zfp_wk, & ! " " 83 85 zfm_ui, zfm_vj, zfm_wk ! " " … … 86 88 !!---------------------------------------------------------------------- 87 89 88 zwi(:,:,:) = 0.e0 89 90 IF( kt == nit000 .AND. lwp ) THEN 90 91 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 91 92 WRITE(numout,*) 92 WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme '93 WRITE(numout,*) 'tra_adv_tvd : TVD advection scheme on ', cdtype 93 94 WRITE(numout,*) '~~~~~~~~~~~' 94 95 ! … … 103 104 END IF 104 105 ! 105 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2 = 1. 106 ELSE ; z2 = 2. 107 ENDIF 106 zwi(:,:,:) = 0.e0 108 107 ! 109 108 ! ! =========== … … 150 149 ! total advective trend 151 150 DO jk = 1, jpkm1 152 z2dtt = z2 * rdttra(jk)151 z2dtt = p2dt(jk) 153 152 DO jj = 2, jpjm1 154 153 DO ji = fs_2, fs_jpim1 ! vector opt. … … 209 208 ! 4. monotonicity algorithm 210 209 ! ------------------------- 211 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, z2)210 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 212 211 213 212 … … 253 252 254 253 255 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p rdt )254 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 256 255 !!--------------------------------------------------------------------- 257 256 !! *** ROUTINE nonosc *** … … 266 265 !! in-space based differencing for fluid 267 266 !!---------------------------------------------------------------------- 268 REAL(wp), INTENT( in ) :: prdt ! ??? 267 REAL(wp), DIMENSION(jpk) , INTENT( in ) :: & 268 p2dt ! vertical profile of tracer time-step 269 269 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT( in ) :: & 270 270 pbef, & ! before field … … 299 299 DO jk = 1, jpkm1 300 300 ikm1 = MAX(jk-1,1) 301 z2dtt = p rdt * rdttra(jk)301 z2dtt = p2dt(jk) 302 302 DO jj = 2, jpjm1 303 303 DO ji = fs_2, fs_jpim1 ! vector opt. -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r2034 r2082 21 21 USE diaptr ! poleward transport diagnostics 22 22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 USE trc_oce ! share passive tracers/Ocean variables 23 24 24 25 IMPLICIT NONE … … 40 41 CONTAINS 41 42 42 SUBROUTINE tra_adv_ubs ( kt, cdtype, p un, pvn, pwn, &43 & ptb, ptn, pta, kjpt )43 SUBROUTINE tra_adv_ubs ( kt, cdtype, p2dt, pun, pvn, pwn, & 44 & ptb, ptn, pta, kjpt ) 44 45 !!---------------------------------------------------------------------- 45 46 !! *** ROUTINE tra_adv_ubs *** … … 81 82 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk) :: pun, pvn, pwn ! 3 ocean velocity components 82 83 INTEGER , INTENT(in ) :: kjpt ! number of tracers 84 REAL(wp) , INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 83 85 REAL(wp) , INTENT(in ), DIMENSION(jpi,jpj,jpk,kjpt) :: ptb, ptn ! before and now tracer fields 84 86 REAL(wp) , INTENT(inout), DIMENSION(jpi,jpj,jpk,kjpt) :: pta ! tracer trend … … 88 90 REAL(wp) :: zfp_ui, zfm_ui, zcenut ! " " 89 91 REAL(wp) :: zfp_vj, zfm_vj, zcenvt ! " " ! " " 90 REAL(wp) :: z2dtt , z292 REAL(wp) :: z2dtt 91 93 REAL(wp) :: ztak, zfp_wk, zfm_wk ! " " 92 94 REAL(wp) :: zeeu, zeev, z_hdivn … … 96 98 97 99 98 IF( kt == nit000 )THEN100 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 99 101 IF(lwp) WRITE(numout,*) 100 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme '102 IF(lwp) WRITE(numout,*) 'tra_adv_ubs : horizontal UBS advection scheme on ', cdtype 101 103 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 102 104 ! 103 105 l_trd = .FALSE. 104 106 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 ENDIF106 !107 IF( neuler == 0 .AND. kt == nit000 ) THEN ; z2 = 1.108 ELSE ; z2 = 2.109 107 ENDIF 110 108 ! … … 232 230 ! update and guess with monotonic sheme 233 231 DO jk = 1, jpkm1 234 z2dtt = z2 * rdttra(jk)232 z2dtt = p2dt(jk) 235 233 DO jj = 2, jpjm1 236 234 DO ji = fs_2, fs_jpim1 ! vector opt. … … 255 253 END DO 256 254 ! 257 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, z2) ! monotonicity algorithm255 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt ) ! monotonicity algorithm 258 256 259 257 ! final trend with corrected fluxes … … 288 286 END SUBROUTINE tra_adv_ubs 289 287 290 SUBROUTINE nonosc_z( pbef, pcc, paft, p rdt )288 SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt ) 291 289 !!--------------------------------------------------------------------- 292 290 !! *** ROUTINE nonosc_z *** … … 301 299 !! in-space based differencing for fluid 302 300 !!---------------------------------------------------------------------- 303 REAL(wp), INTENT(in ) :: prdt ! ???301 REAL(wp), INTENT(in ), DIMENSION(jpk) :: p2dt ! vertical profile of tracer time-step 304 302 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field 305 303 REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) :: paft ! after field … … 356 354 357 355 DO jk = 1, jpkm1 358 z2dtt = p rdt * rdttra(jk)356 z2dtt = p2dt(jk) 359 357 DO jj = 2, jpjm1 360 358 DO ji = fs_2, fs_jpim1 ! vector opt. … … 374 372 DO jj = 2, jpjm1 375 373 DO ji = fs_2, fs_jpim1 ! vector opt. 376 377 374 za = MIN( 1., zbetdo(ji,jj,jk), zbetup(ji,jj,jk-1) ) 378 375 zb = MIN( 1., zbetup(ji,jj,jk), zbetdo(ji,jj,jk-1) ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trabbl.F90
r2034 r2082 32 32 USE lbclnk ! ocean lateral boundary conditions 33 33 USE prtctl ! Print control 34 USE trc_oce ! share passive tracers/Ocean variables 34 35 35 36 IMPLICIT NONE … … 377 378 378 379 ! !* bottom temperature, salinity, velocity and depth 379 IF( kt == nit000 )THEN380 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 380 381 IF(lwp) WRITE(numout,*) ' ' 381 IF(lwp) WRITE(numout,*) ' trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype , ' at time step ', kt382 IF(lwp) WRITE(numout,*) ' trabbl:bbl : Compute bbl velocities and diffusive coefficients in ', cdtype 382 383 IF(lwp) WRITE(numout,*) ' ' 383 384 ENDIF … … 391 392 #endif 392 393 ik = mbkt(ji,jj) ! bottom T-level index 393 ztb (ji,jj) = t b(ji,jj,ik) ! bottom before T and S394 zsb (ji,jj) = sb(ji,jj,ik)394 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) ! bottom before T and S 395 zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) 395 396 zdep(ji,jj) = fsdept_0(ji,jj,ik) ! bottom T-level reference depth 396 397 ! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf.F90
r2034 r2082 62 62 !! 63 63 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds 64 REAL(wp), DIMENSION(jpi,jpj,jpts) :: zgtsu, zgtsv65 64 !!---------------------------------------------------------------------- 66 65 … … 70 69 ENDIF 71 70 72 zgtsu(:,:,jp_tem) = gtu(:,:) ; zgtsu(:,:,jp_sal) = gsu(:,:)73 zgtsv(:,:,jp_tem) = gtv(:,:) ; zgtsv(:,:,jp_sal) = gsv(:,:)74 75 71 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, tsb, tsa, jpts ) ! iso-level laplacian77 CASE ( 1 ) ; CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian78 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts ) ! iso-level bilaplacian79 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt , 'TRA',tsb, tsa, jpts ) ! s-coord. horizontal bilaplacian72 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level laplacian 73 CASE ( 1 ) ; CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) ! rotated laplacian 74 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) ! iso-level bilaplacian 75 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) ! s-coord. horizontal bilaplacian 80 76 ! 81 77 CASE ( -1 ) ! esopa: test all possibility with control print 82 CALL tra_ldf_lap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts )78 CALL tra_ldf_lap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 83 79 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf0 - Ta: ', mask1=tmask, & 84 80 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 85 CALL tra_ldf_iso ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts, ahtb0 )81 CALL tra_ldf_iso ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts, ahtb0 ) 86 82 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf1 - Ta: ', mask1=tmask, & 87 83 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 88 CALL tra_ldf_bilap ( kt , 'TRA', zgtsu, zgtsv, tsb, tsa, jpts )84 CALL tra_ldf_bilap ( kt, 'TRA', gtsu, gtsv, tsb, tsa, jpts ) 89 85 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf2 - Ta: ', mask1=tmask, & 90 86 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 91 CALL tra_ldf_bilapg( kt , 'TRA',tsb, tsa, jpts )87 CALL tra_ldf_bilapg( kt, 'TRA', tsb, tsa, jpts ) 92 88 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' ldf3 - Ta: ', mask1=tmask, & 93 89 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r2034 r2082 28 28 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 29 USE diaptr ! poleward transport diagnostics 30 USE trc_oce ! share passive tracers/Ocean variables 30 31 31 32 IMPLICIT NONE … … 93 94 !!---------------------------------------------------------------------- 94 95 95 IF( kt == nit000 )THEN96 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 96 97 IF(lwp) WRITE(numout,*) 97 IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator '98 IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype 98 99 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~' 99 100 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r2034 r2082 24 24 USE lbclnk ! ocean lateral boundary condition (or mpp link) 25 25 USE diaptr ! poleward transport diagnostics 26 USE trc_oce ! share passive tracers/Ocean variables 26 27 27 28 IMPLICIT NONE … … 80 81 !!---------------------------------------------------------------------- 81 82 82 IF( kt == nit000 )THEN83 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 83 84 IF(lwp) WRITE(numout,*) 84 IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate '85 IF(lwp) WRITE(numout,*) 'tra_ldf_bilapg : horizontal biharmonic operator in s-coordinate on ', cdtype 85 86 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~' 86 87 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_iso.F90
r2034 r2082 28 28 USE ldfslp ! iso-neutral slopes 29 29 USE diaptr ! poleward transport diagnostics 30 USE trc_oce ! share passive tracers/Ocean variables 30 31 #if defined key_diaar5 31 32 USE phycst ! physical constants … … 116 117 !!---------------------------------------------------------------------- 117 118 118 IF( kt == nit000 )THEN119 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 119 120 IF(lwp) WRITE(numout,*) 120 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator '121 IF(lwp) WRITE(numout,*) 'tra_ldf_iso : rotated laplacian diffusion operator on ', cdtype 121 122 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 122 123 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/traldf_lap.F90
r2034 r2082 23 23 USE in_out_manager ! I/O manager 24 24 USE diaptr ! poleward transport diagnostics 25 USE trc_oce ! share passive tracers/Ocean variables 25 26 26 27 … … 84 85 !!---------------------------------------------------------------------- 85 86 86 IF( kt == nit000 )THEN87 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 87 88 IF(lwp) WRITE(numout,*) 88 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion '89 IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype 89 90 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ ' 90 91 e1ur(:,:) = e2u(:,:) / e1u(:,:) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranpc.F90
r2024 r2082 74 74 inpci = 0 75 75 76 CALL eos( tsa (:,:,:,jp_tem), tsa(:,:,:,jp_sal), rhd, zrhop ) ! Potential density76 CALL eos( tsa, rhd, zrhop ) ! Potential density 77 77 78 78 IF( l_trdtra ) THEN !* Save ta and sa trends -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/tranxt.F90
r2034 r2082 48 48 PUBLIC tra_nxt_vvl ! to be used in trcnxt 49 49 50 REAL(wp), DIMENSION(jpk) :: r2dt _t! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler)50 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 51 51 52 52 !! * Substitutions … … 120 120 121 121 ! set time step size (Euler/Leapfrog) 122 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt _t(:) = rdttra(:) ! at nit000 (Euler)123 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt _t(:) = 2.* rdttra(:) ! at nit000 or nit000+1 (Leapfrog)122 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt(:) = rdttra(:) ! at nit000 (Euler) 123 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt(:) = 2.* rdttra(:) ! at nit000 or nit000+1 (Leapfrog) 124 124 ENDIF 125 125 … … 145 145 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 146 146 DO jk = 1, jpkm1 147 zfact = 1.e0 / r2dt _t(jk)147 zfact = 1.e0 / r2dt(jk) 148 148 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 149 149 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact … … 194 194 !!---------------------------------------------------------------------- 195 195 196 IF( kt == kit000 ) THEN196 IF( kt == kit000 ) THEN 197 197 IF(lwp) WRITE(numout,*) 198 198 IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf.F90
r2034 r2082 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 82 CASE ( 1 ) ; CALL tra_zdf_imp( kt 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 83 83 CASE ( -1 ) ! esopa: test all possibility with control print 84 CALL tra_zdf_exp( kt 84 CALL tra_zdf_exp( kt, 'TRA', r2dt, nn_zdfexp, tsb, tsa, jpts ) 85 85 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf0 - Ta: ', mask1=tmask, & 86 86 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 87 CALL tra_zdf_imp( kt 87 CALL tra_zdf_imp( kt, 'TRA', r2dt, tsb, tsa, jpts ) 88 88 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' zdf1 - Ta: ', mask1=tmask, & 89 89 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_exp.F90
r2034 r2082 29 29 USE zdfddm ! ocean vertical physics: double diffusion 30 30 USE in_out_manager ! I/O manager 31 USE trc_oce ! share passive tracers/Ocean variables 31 32 32 33 IMPLICIT NONE … … 87 88 !!--------------------------------------------------------------------- 88 89 89 IF( kt == nit000 )THEN90 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 90 91 IF(lwp) WRITE(numout,*) 91 IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing '92 IF(lwp) WRITE(numout,*) 'tra_zdf_exp : explicit vertical mixing on ', cdtype 92 93 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 93 94 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r2052 r2082 31 31 USE domvvl ! variable volume 32 32 USE ldftra ! lateral mixing type 33 USE trc_oce ! share passive tracers/Ocean variables 33 34 34 35 IMPLICIT NONE … … 105 106 !!--------------------------------------------------------------------- 106 107 107 IF( kt == nit000 )THEN108 IF( ( cdtype == 'TRA' .AND. kt == nit000 ) .OR. ( cdtype == 'TRC' .AND. kt == nittrc000 ) ) THEN 108 109 IF(lwp)WRITE(numout,*) 109 IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing '110 IF(lwp)WRITE(numout,*) 'tra_zdf_imp : implicit vertical mixing on ', cdtype 110 111 IF(lwp)WRITE(numout,*) '~~~~~~~~~~~ ' 111 112 zavi = 0.e0 ! avoid warning at compilation phase when lk_ldfslp=F -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRA/zpshde.F90
r2024 r2082 14 14 !! zps_hde : Horizontal DErivative of T, S and rd at the last 15 15 !! ocean level (Z-coord. with Partial Steps) 16 !! zps_hde_trc : Horizontal DErivative of passive tracers at the last17 !! ocean level (Z-coord. with Partial Steps)18 16 !!---------------------------------------------------------------------- 19 17 !! * Modules used … … 31 29 PUBLIC zps_hde ! routine called by step.F90 32 30 PUBLIC zps_hde_init ! routine called by opa.F90 33 #if defined key_top34 PUBLIC zps_hde_trc35 #endif36 31 37 32 !! * module variables … … 49 44 !!---------------------------------------------------------------------- 50 45 CONTAINS 51 SUBROUTINE zps_hde ( kt, ptem, psal, prd , & 52 pgtu, pgsu, pgru, &53 pgtv, pgsv, pgrv)46 47 SUBROUTINE zps_hde( kt, kjpt, pta, pgtu, pgtv, & 48 prd, pgru, pgrv ) 54 49 !!---------------------------------------------------------------------- 55 50 !! *** ROUTINE zps_hde *** … … 91 86 !! di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~ 92 87 !! 93 !! ** Action : - pgtu, pgsu, pgru: horizontal gradient of T, S 94 !! and rd at U-points 95 !! - pgtv, pgsv, pgrv: horizontal gradient of T, S 88 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at U/V-points 89 !! - pgru, pgrv: horizontal gradient of rd if present at U/V-points 96 90 !! and rd at V-points 97 91 !!---------------------------------------------------------------------- 98 92 !! * Arguments 99 INTEGER, INTENT( in ) :: kt ! ocean time-step index 100 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: ptem, psal, prd ! 3D T, S and rd fields 101 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out ) :: pgtu, pgsu, pgru ! horizontal grad. of T, S and rd at u-point 102 REAL(wp), DIMENSION(jpi,jpj) , INTENT( out ) :: pgtv, pgsv, pgrv ! horizontal grad. of T, S and rd at v-point 103 !! * Local declarations 104 INTEGER :: ji , jj ! Dummy loop indices 105 INTEGER :: iku, ikv ! partial step level at u- and v-points 106 REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj, zsi, zsj ! interpolated value of T, S 107 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd 108 REAL(wp), DIMENSION(jpi,jpj) :: zhgi, zhgj ! depth of interpolation for eos2d 109 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 110 111 112 ! Interpolation of T and S at the last ocean level 113 # if defined key_vectopt_loop 114 jj = 1 115 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 116 # else 117 DO jj = 1, jpjm1 118 DO ji = 1, jpim1 119 # endif 120 ! last level 121 iku = mbatu(ji,jj) 122 ikv = mbatv(ji,jj) 123 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 124 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 125 126 ! i- direction 127 IF( ze3wu >= 0. ) THEN ! case 1 128 ! interpolated values of T and S 129 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 130 zti(ji,jj) = ptem(ji+1,jj,iku) + zmaxu * ( ptem(ji+1,jj,iku-1) - ptem(ji+1,jj,iku) ) 131 zsi(ji,jj) = psal(ji+1,jj,iku) + zmaxu * ( psal(ji+1,jj,iku-1) - psal(ji+1,jj,iku) ) 132 ! depth of the partial step level 133 zhgi(ji,jj) = fsdept(ji,jj,iku) 134 ! gradient of T and S 135 pgtu(ji,jj) = umask(ji,jj,1) * ( zti(ji,jj) - ptem(ji,jj,iku) ) 136 pgsu(ji,jj) = umask(ji,jj,1) * ( zsi(ji,jj) - psal(ji,jj,iku) ) 137 138 ELSE ! case 2 139 ! interpolated values of T and S 140 zmaxu = -ze3wu / fse3w(ji,jj,iku) 141 zti(ji,jj) = ptem(ji,jj,iku) + zmaxu * ( ptem(ji,jj,iku-1) - ptem(ji,jj,iku) ) 142 zsi(ji,jj) = psal(ji,jj,iku) + zmaxu * ( psal(ji,jj,iku-1) - psal(ji,jj,iku) ) 143 ! depth of the partial step level 144 zhgi(ji,jj) = fsdept(ji+1,jj,iku) 145 ! gradient of T and S 146 pgtu(ji,jj) = umask(ji,jj,1) * ( ptem(ji+1,jj,iku) - zti (ji,jj) ) 147 pgsu(ji,jj) = umask(ji,jj,1) * ( psal(ji+1,jj,iku) - zsi (ji,jj) ) 148 ENDIF 149 150 ! j- direction 151 IF( ze3wv >= 0. ) THEN ! case 1 152 ! interpolated values of T and S 153 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 154 ztj(ji,jj) = ptem(ji,jj+1,ikv) + zmaxv * ( ptem(ji,jj+1,ikv-1) - ptem(ji,jj+1,ikv) ) 155 zsj(ji,jj) = psal(ji,jj+1,ikv) + zmaxv * ( psal(ji,jj+1,ikv-1) - psal(ji,jj+1,ikv) ) 156 ! depth of the partial step level 157 zhgj(ji,jj) = fsdept(ji,jj,ikv) 158 ! gradient of T and S 159 pgtv(ji,jj) = vmask(ji,jj,1) * ( ztj(ji,jj) - ptem(ji,jj,ikv) ) 160 pgsv(ji,jj) = vmask(ji,jj,1) * ( zsj(ji,jj) - psal(ji,jj,ikv) ) 161 162 ELSE ! case 2 163 ! interpolated values of T and S 164 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 165 ztj(ji,jj) = ptem(ji,jj,ikv) + zmaxv * ( ptem(ji,jj,ikv-1) - ptem(ji,jj,ikv) ) 166 zsj(ji,jj) = psal(ji,jj,ikv) + zmaxv * ( psal(ji,jj,ikv-1) - psal(ji,jj,ikv) ) 167 ! depth of the partial step level 168 zhgj(ji,jj) = fsdept(ji,jj+1,ikv) 169 ! gradient of T and S 170 pgtv(ji,jj) = vmask(ji,jj,1) * ( ptem(ji,jj+1,ikv) - ztj(ji,jj) ) 171 pgsv(ji,jj) = vmask(ji,jj,1) * ( psal(ji,jj+1,ikv) - zsj(ji,jj) ) 172 ENDIF 173 # if ! defined key_vectopt_loop 174 END DO 175 # endif 176 END DO 177 178 ! Compute interpolated rd from zti, zsi, ztj, zsj for the 2 cases at the depth of the partial 179 ! step and store it in zri, zrj for each case 180 CALL eos( zti, zsi, zhgi, zri ) 181 CALL eos( ztj, zsj, zhgj, zrj ) 182 183 184 ! Gradient of density at the last level 185 # if defined key_vectopt_loop 186 jj = 1 187 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 188 # else 189 DO jj = 1, jpjm1 190 DO ji = 1, jpim1 191 # endif 192 iku = mbatu(ji,jj) 193 ikv = mbatv(ji,jj) 194 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 195 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 196 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 197 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 198 ELSE ! i-direction: case 2 199 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 200 ENDIF 201 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 202 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 203 ELSE ! j-direction: case 2 204 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 205 ENDIF 206 # if ! defined key_vectopt_loop 207 END DO 208 # endif 209 END DO 210 211 ! Lateral boundary conditions on each gradient 212 CALL lbc_lnk( pgtu , 'U', -1. ) ; CALL lbc_lnk( pgtv , 'V', -1. ) 213 CALL lbc_lnk( pgsu , 'U', -1. ) ; CALL lbc_lnk( pgsv , 'V', -1. ) 214 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 215 216 END SUBROUTINE zps_hde 217 218 #if defined key_top 219 !!---------------------------------------------------------------------- 220 !! 'key_top' TOP models 221 !!---------------------------------------------------------------------- 222 SUBROUTINE zps_hde_trc ( kt, kjpt, ptra, pgtru, pgtrv ) 223 !!---------------------------------------------------------------------- 224 !! *** ROUTINE zps_hde_trc *** 225 !! 226 !! ** Purpose : Compute the horizontal derivative of passive tracers 227 !! TRA at u- and v-points with a linear interpolation for z-coordinate 228 !! with partial steps. 229 !! 230 !! ** Method : the same for T & S 231 !! 232 !! ** Action : - pgtru : horizontal gradient of TRA at U-points 233 !! - pgtrv : horizontal gradient of TRA at V-points 234 !!---------------------------------------------------------------------- 235 !! * Arguments 236 INTEGER , INTENT( in ) :: kt ! ocean time-step index 237 INTEGER , INTENT( in ) :: kjpt ! number of tracers 238 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) :: ptra ! 4D tracers fields 239 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out ) :: pgtru, pgtrv ! horizontal grad. of TRA u- and v-points 93 INTEGER , INTENT( in ) :: kt ! ocean time-step index 94 INTEGER , INTENT( in ) :: kjpt ! number of tracers 95 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT( in ) :: pta ! 4D active or passive tracers fields 96 REAL(wp), DIMENSION(jpi,jpj, kjpt), INTENT( out) :: pgtu, pgtv ! horizontal grad. of ptra u- and v-points 97 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( in ), OPTIONAL :: prd ! 3D rd fields 98 REAL(wp), DIMENSION(jpi,jpj ), INTENT( out), OPTIONAL :: pgru, pgrv ! horizontal grad. of prd u- and v-points 240 99 !! * Local declarations 241 100 INTEGER :: ji, jj, jn ! Dummy loop indices 242 101 INTEGER :: iku, ikv ! partial step level at u- and v-points 243 REAL(wp) :: ztrai, ztraj, ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 244 !!---------------------------------------------------------------------- 245 102 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! interpolated value of tracer 103 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd 104 REAL(wp), DIMENSION(jpi,jpj) :: zhi, zhj ! depth of interpolation for eos2d 105 REAL(wp) :: ze3wu, ze3wv, zmaxu, zmaxv ! temporary scalars 106 !!---------------------------------------------------------------------- 107 108 109 ! Interpolation of tracers at the last ocean level 246 110 DO jn = 1, kjpt 247 ! Interpolation of passive tracers at the last ocean level248 111 # if defined key_vectopt_loop 249 112 jj = 1 … … 262 125 IF( ze3wu >= 0. ) THEN ! case 1 263 126 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 264 ! interpolated values of passivetracers265 zt rai = ptra(ji+1,jj,iku,jn) + zmaxu * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) )266 ! gradient of passivetracers267 pgt ru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai - ptra(ji,jj,iku,jn) )127 ! interpolated values of tracers 128 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku-1,jn) - pta(ji+1,jj,iku,jn) ) 129 ! gradient of tracers 130 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 268 131 ELSE ! case 2 269 132 zmaxu = -ze3wu / fse3w(ji,jj,iku) 270 ! interpolated values of passivetracers271 zt rai = ptra(ji,jj,iku,jn) + zmaxu * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) )272 ! gradient of passivetracers273 pgt ru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai)133 ! interpolated values of tracers 134 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku-1,jn) - pta(ji,jj,iku,jn) ) 135 ! gradient of tracers 136 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 274 137 ENDIF 275 138 … … 277 140 IF( ze3wv >= 0. ) THEN ! case 1 278 141 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 279 ! interpolated values of passivetracers280 zt raj = ptra(ji,jj+1,ikv,jn) + zmaxv * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) )281 ! gradient of passivetracers282 pgt rv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj - ptra(ji,jj,ikv,jn) )142 ! interpolated values of tracers 143 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv-1,jn) - pta(ji,jj+1,ikv,jn) ) 144 ! gradient of tracers 145 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 283 146 ELSE ! case 2 284 147 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 285 ! interpolated values of passivetracers286 zt raj = ptra(ji,jj,ikv,jn) + zmaxv * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) )287 ! gradient of passivetracers288 pgt rv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj)148 ! interpolated values of tracers 149 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv-1,jn) - pta(ji,jj,ikv,jn) ) 150 ! gradient of tracers 151 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 289 152 ENDIF 290 153 # if ! defined key_vectopt_loop … … 294 157 295 158 ! Lateral boundary conditions on each gradient 296 CALL lbc_lnk( pgt ru(:,:,jn) , 'U', -1. )297 CALL lbc_lnk( pgt rv(:,:,jn) , 'V', -1. )159 CALL lbc_lnk( pgtu(:,:,jn) , 'U', -1. ) 160 CALL lbc_lnk( pgtv(:,:,jn) , 'V', -1. ) 298 161 299 162 END DO 300 163 301 END SUBROUTINE zps_hde_trc 302 #endif 164 ! horizontal derivative of rd 165 IF( PRESENT( prd ) ) THEN 166 ! depth of the partial step level 167 # if defined key_vectopt_loop 168 jj = 1 169 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 170 # else 171 DO jj = 1, jpjm1 172 DO ji = 1, jpim1 173 # endif 174 iku = mbatu(ji,jj) 175 ikv = mbatv(ji,jj) 176 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 177 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 178 IF( ze3wu >= 0. ) THEN 179 zhi(ji,jj) = fsdept(ji ,jj,iku) 180 ELSE 181 zhi(ji,jj) = fsdept(ji+1,jj,iku) 182 ENDIF 183 IF( ze3wv >= 0. ) THEN 184 zhj(ji,jj) = fsdept(ji,jj ,ikv) 185 ELSE 186 zhj(ji,jj) = fsdept(ji,jj+1,ikv) 187 ENDIF 188 # if ! defined key_vectopt_loop 189 END DO 190 # endif 191 END DO 192 193 ! Compute interpolated rd from zti, ztj for the 2 cases at the depth of the partial 194 ! step and store it in zri, zrj for each case 195 CALL eos( zti, zhi, zri ) 196 CALL eos( ztj, zhj, zrj ) 197 198 ! Gradient of density at the last level 199 # if defined key_vectopt_loop 200 jj = 1 201 DO ji = 1, jpij-jpi ! vector opt. (forced unrolled) 202 # else 203 DO jj = 1, jpjm1 204 DO ji = 1, jpim1 205 # endif 206 iku = mbatu(ji,jj) 207 ikv = mbatv(ji,jj) 208 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 209 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 210 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 211 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 212 ELSE ! i-direction: case 2 213 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 214 ENDIF 215 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 216 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 217 ELSE ! j-direction: case 2 218 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 219 ENDIF 220 # if ! defined key_vectopt_loop 221 END DO 222 # endif 223 END DO 224 225 ! Lateral boundary conditions on each gradient 226 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) 227 ! 228 END IF 229 ! 230 END SUBROUTINE zps_hde 303 231 304 232 SUBROUTINE zps_hde_init -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/TRD/trdicp.F90
r2026 r2082 370 370 zkepe(:,:,:) = 0.e0 371 371 372 CALL eos( t n,sn, rhd, rhop ) ! now potential and in situ densities372 CALL eos( tsn, rhd, rhop ) ! now potential and in situ densities 373 373 374 374 ! Density flux at w-point -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/istate.F90
r1566 r2082 42 42 USE dynspg_exp ! pressure gradient schemes 43 43 USE dynspg_ts ! pressure gradient schemes 44 USE traswp ! Swap arrays (tra_swp routine) 44 45 45 46 IMPLICIT NONE … … 122 123 ENDIF 123 124 124 CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities 125 ta(:,:,:) = 0. ; sa(:,:,:) = 0. 126 CALL tra_swap 127 CALL eos( tsb, rhd, rhop ) ! before potential and in situ densities 125 128 126 129 IF( ln_zps .AND. .NOT. lk_c1d ) & 127 & CALL zps_hde( nit000, tb, sb, rhd, & ! Partial steps: before Horizontal DErivative 128 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 129 & gtv, gsv, grv ) 130 CALL zps_hde( nit000, 'TRA', tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 131 & rhd, gru , grv , jpts ) ! of t, s, rd at the last ocean level 130 132 131 133 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/oce.F90
r2025 r2082 39 39 !! interpolated gradient (only used in zps case) 40 40 !! --------------------- 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj ) :: gtu, gsu, gru !: horizontal gradient of T, S and rd atbottom u-point42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gtv, gsv, grv !: horizontal gradient of T, S and rd at bottom v-point41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpts) :: gtsu, gtsv !: horizontal gradient of T, S bottom u-point 42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: gru , grv !: horizontal gradient of rd at bottom u-point 43 43 44 44 !! free surface ! before ! now ! after ! -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/opa.F90
r2052 r2082 37 37 USE step_oce ! Time stepping module definition 38 38 USE sbc_oce ! surface boundary condition: ocean 39 USE trdmod_oce ! ocean variables trends40 39 USE domcfg ! domain configuration (dom_cfg routine) 41 40 USE mppini ! shared/distributed memory setting (mpp_init routine) … … 48 47 USE zdfini 49 48 USE phycst ! physical constant (par_cst routine) 50 USE trdmod ! momentum/tracers trends (trd_mod_init routine)51 49 USE step ! OPA time-stepping (stp routine) 52 50 #if defined key_oasis3 … … 160 158 !! 161 159 !!---------------------------------------------------------------------- 162 #if defined key_oasis3 || defined key_oasis4 || defined key_iomput163 160 INTEGER :: ilocal_comm 164 #endif165 161 CHARACTER(len=80),dimension(10) :: cltxt = '' 166 162 INTEGER :: ji ! local loop indices … … 192 188 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 193 189 # else 190 ilocal_comm = 0 194 191 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) 195 192 # endif … … 220 217 ! !--------------------------------! 221 218 222 CALL opa_flg ! Control prints & Benchmark223 224 ! Domain decomposition219 CALL opa_flg ! Control prints & Benchmark 220 221 ! ! Domain decomposition 225 222 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 226 223 ELSE ; CALL mpp_init2 ! eliminate land processors … … 231 228 232 229 230 ! ! General initialization 233 231 CALL phy_cst ! Physical constants 234 232 CALL eos_init ! Equation of state … … 245 243 246 244 ! ! Ocean physics 247 CALL sbc_init ! Read namsbc namelist : surface module (needed for iom_init)248 249 ! ! Vertical physics250 CALL zdf_init ! namelist read251 CALL zdf_bfr_init ! bottom friction252 IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz253 IF( lk_zdftke_old ) CALL zdf_tke_init ! TKE closure scheme for Kz (old scheme)254 IF( lk_zdftke ) CALL tke_init ! TKE closure scheme for Kz255 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme for Kz256 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing245 CALL sbc_init ! Forcings : surface module 246 247 ! ! Vertical physics 248 CALL zdf_init ! namelist read 249 CALL zdf_bfr_init ! bottom friction 250 IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz 251 IF( lk_zdftke_old ) CALL zdf_tke_init ! TKE closure scheme for Kz (old scheme) 252 IF( lk_zdftke ) CALL tke_init ! TKE closure scheme for Kz 253 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme for Kz 254 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 257 255 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 258 & CALL zdf_ddm_init ! double diffusive mixing 259 ! ! Lateral physics 260 CALL ldf_tra_init ! Lateral ocean tracer physics 261 CALL ldf_dyn_init ! Lateral ocean momentum physics 262 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 256 & CALL zdf_ddm_init ! double diffusive mixing 257 ! ! Lateral physics 258 CALL ldf_tra_init ! Lateral ocean tracer physics 259 CALL ldf_dyn_init ! Lateral ocean momentum physics 260 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 261 263 262 ! ! Active tracers 264 263 CALL tra_qsr_init ! penetrative solar radiation qsr … … 280 279 #if defined key_top 281 280 ! ! Passive tracers 282 CALL trc_ini 283 #endif 284 281 CALL trc_init 282 #endif 285 283 ! ! diagnostics 286 284 CALL iom_init ! iom_put initialization -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step.F90
r2027 r2082 105 105 ! Ocean physics update (ua, va, ta, sa used as workspace) 106 106 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 107 CALL bn2( t b, sb, rn2b )! before Brunt-Vaisala frequency108 CALL bn2( t n, sn, rn2 )! now Brunt-Vaisala frequency107 CALL bn2( tsb, rn2b ) ! before Brunt-Vaisala frequency 108 CALL bn2( tsn, rn2 ) ! now Brunt-Vaisala frequency 109 109 ! 110 110 ! VERTICAL PHYSICS … … 137 137 ! 138 138 IF( lk_ldfslp ) THEN ! slope of lateral mixing 139 CALL eos( tb, sb, rhd ) ! before in situ density 140 IF( ln_zps ) CALL zps_hde( kstp, tb, sb, rhd, & ! Partial steps: before horizontal gradient 141 & gtu, gsu, gru, & ! of t, s, rd at the last ocean level 142 & gtv, gsv, grv ) 139 CALL eos( tsb, rhd ) ! before in situ density 140 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsb, gtsu, gtsv, & ! Partial steps: before horizontal gradient 141 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 143 142 CALL ldf_slp( kstp, rhd, rn2b ) ! before slope of the lateral mixing 144 143 ENDIF … … 169 168 ! Active tracers (ua, va used as workspace) 170 169 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 171 ta(:,:,:) = 0.e0 ! set tracer trends to zero 172 sa(:,:,:) = 0.e0 173 174 CALL tra_swap 170 tsa(:,:,:,:) = 0.e0 ! set tracer trends to zero 171 175 172 CALL tra_sbc ( kstp ) ! surface boundary condition 176 173 IF( ln_traqsr ) CALL tra_qsr ( kstp ) ! penetrative solar radiation qsr … … 192 189 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection 193 190 CALL tra_nxt ( kstp ) ! tracer fields at next time step 194 CALL tra_unswap 195 CALL eos( ta, sa, rhd, rhop ) ! Time-filtered in situ density for hpg computation 196 IF( ln_zps ) CALL zps_hde( kstp, ta, sa, rhd, & ! Partial steps: time filtered hor. derivative 197 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 198 & gtv, gsv, grv ) 191 CALL eos( tsa, rhd, rhop ) ! Time-filtered in situ density for hpg computation 192 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsa, gtsu, gtsv, & ! Partial steps: time filtered hor. derivative 193 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 199 194 200 195 ELSE ! centered hpg (eos then time stepping) 201 CALL tra_unswap 202 CALL eos( tn, sn, rhd, rhop ) ! now in situ density for hpg computation 203 IF( ln_zps ) CALL zps_hde( kstp, tn, sn, rhd, & ! Partial steps: now horizontal derivative 204 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 205 & gtv, gsv, grv ) 206 CALL tra_swap 196 CALL eos( tsn, rhd, rhop ) ! now in situ density for hpg computation 197 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! Partial steps: now hor. derivative 198 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 207 199 IF( ln_zdfnpc ) CALL tra_npc ( kstp ) ! update after fields by non-penetrative convection 208 200 CALL tra_nxt ( kstp ) ! tracer fields at next time step 201 ENDIF 209 202 CALL tra_unswap 210 ENDIF211 203 212 204 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/step_oce.F90
r2027 r2082 81 81 USE trdmld_rst ! restart for mixed-layer trends 82 82 USE trdmod_oce ! ocean momentum/tracers trends 83 USE trdmod ! momentum/tracers trends 83 84 USE trdvor ! vorticity budget (trd_vor routine) 84 85 USE diagap ! hor. mean model-data gap (dia_gap routine) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OPA_SRC/trc_oce.F90
r1970 r2082 20 20 PUBLIC trc_oce_rgb_read ! routine called by traqsr.F90 21 21 PUBLIC trc_oce_ext_lev ! function called by traqsr.F90 at least 22 22 23 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers 24 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model 25 23 26 REAL(wp), PUBLIC , DIMENSION(jpi,jpj,jpk) :: etot3 !: light absortion coefficient 24 27 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/C14b/trcsms_c14b.F90
r2038 r2082 234 234 ! Computation of solubility 235 235 IF (tmask(ji,jj,1) > 0.) THEN 236 ztp = ( t n(ji,jj,1) + 273.16 ) * 0.01236 ztp = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 237 237 zsk = 0.023517 + ztp * ( -0.023656 + 0.0047036 * ztp ) 238 zsol = EXP( -60.2409 + 93.4517 / ztp + 23.3585 * LOG( ztp ) + zsk * sn(ji,jj,1) )238 zsol = EXP( -60.2409 + 93.4517 / ztp + 23.3585 * LOG( ztp ) + zsk * tsn(ji,jj,1,jp_sal) ) 239 239 ! convert solubilities [mol/(l * atm)] -> [mol/(m^3 * ppm)] 240 240 zsol = zsol * 1.0e-03 … … 247 247 248 248 ! Computes the Schmidt number of CO2 in seawater 249 zt = t n(ji,jj,1)249 zt = tsn(ji,jj,1,jp_tem) 250 250 zsch = 2073.1 + zt * ( -125.62 + zt * (3.6276 - 0.043219 * zt ) ) 251 251 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r2052 r2082 129 129 ! coefficient for solubility for CFC-11/12 in mol/l/atm 130 130 IF( tmask(ji,jj,1) .GE. 0.5 ) THEN 131 ztap = ( t n(ji,jj,1) + 273.16 ) * 0.01131 ztap = ( tsn(ji,jj,1,jp_tem) + 273.16 ) * 0.01 132 132 zdtap = sob(1,jl) + ztap * ( sob(2,jl) + ztap * sob(3,jl) ) 133 133 zsol = EXP( soa(1,jl) + soa(2,jl) / ztap + soa(3,jl) * LOG( ztap ) & 134 & + soa(4,jl) * ztap * ztap + sn(ji,jj,1) * zdtap )134 & + soa(4,jl) * ztap * ztap + tsn(ji,jj,1,jp_sal) * zdtap ) 135 135 ELSE 136 136 zsol = 0.e0 … … 143 143 ! Computation of speed transfert 144 144 ! Schmidt number 145 zt1 = t n(ji,jj,1)145 zt1 = tsn(ji,jj,1,jp_tem) 146 146 zt2 = zt1 * zt1 147 147 zt3 = zt1 * zt2 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcbio.F90
r2038 r2082 81 81 !!--------------------------------------------------------------------- 82 82 83 IF( kt == nit 000 ) THEN83 IF( kt == nittrc000 ) THEN 84 84 IF(lwp) WRITE(numout,*) 85 85 IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcexp.F90
r2038 r2082 60 60 !!--------------------------------------------------------------------- 61 61 62 IF( kt == nit 000 ) THEN62 IF( kt == nittrc000 ) THEN 63 63 IF(lwp) WRITE(numout,*) 64 64 IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcopt.F90
r2038 r2082 65 65 !!--------------------------------------------------------------------- 66 66 67 IF( kt == nit 000 ) THEN67 IF( kt == nittrc000 ) THEN 68 68 IF(lwp) WRITE(numout,*) 69 69 IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/LOBSTER/trcsed.F90
r2038 r2082 67 67 !!--------------------------------------------------------------------- 68 68 69 IF( kt == nit 000 ) THEN69 IF( kt == nittrc000 ) THEN 70 70 IF(lwp) WRITE(numout,*) 71 71 IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zche.F90
r1953 r2082 181 181 182 182 ! ! SET ABSOLUTE TEMPERATURE 183 ztkel = t n(ji,jj,1) + 273.16183 ztkel = tsn(ji,jj,1,jp_tem) + 273.16 184 184 zqtt = ztkel * 0.01 185 185 zqtt2 = zqtt * zqtt 186 zsal = sn(ji,jj,1) + (1.- tmask(ji,jj,1) ) * 35.186 zsal = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35. 187 187 zlqtt = LOG( zqtt ) 188 188 … … 214 214 215 215 ! SET ABSOLUTE TEMPERATURE 216 ztkel = t n(ji,jj,jk) + 273.16216 ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 217 217 zqtt = ztkel * 0.01 218 zsal = sn(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35.218 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 219 219 zsqrt = SQRT( zsal ) 220 220 zsal15 = zsqrt * zsal … … 224 224 zis2 = zis * zis 225 225 zisqrt = SQRT( zis ) 226 ztc = t n(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20.226 ztc = tsn(ji,jj,jk,jp_tem) + ( 1.- tmask(ji,jj,jk) ) * 20. 227 227 228 228 ! CHLORINITY (WOOSTER ET AL., 1969) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zflx.F90
r2038 r2082 128 128 !CDIR NOVERRCHK 129 129 DO ji = 1, jpi 130 ztc = MIN( 35., t n(ji,jj,1) )130 ztc = MIN( 35., tsn(ji,jj,1,jp_tem) ) 131 131 ztc2 = ztc * ztc 132 132 ztc3 = ztc * ztc2 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zint.F90
r1753 r2082 55 55 ! ------------------------------------------- 56 56 57 tgfunc (:,:,:) = EXP( 0.063913 * t n(:,:,:) )58 tgfunc2(:,:,:) = EXP( 0.07608 * t n(:,:,:) )57 tgfunc (:,:,:) = EXP( 0.063913 * tsn(:,:,:,jp_tem) ) 58 tgfunc2(:,:,:) = EXP( 0.07608 * tsn(:,:,:,jp_tem) ) 59 59 60 60 ! Computation of the silicon dependant half saturation -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zlim.F90
r1953 r2082 161 161 DO jj = 1, jpj 162 162 DO ji = 1, jpi 163 ztemp = MAX( 0., t n(ji,jj,jk) )163 ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 164 164 xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk) & 165 165 & * MAX( 0.0001, ztemp / ( 2.+ ztemp ) ) & -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2038 r2082 147 147 ! Computation of the P-I slope for nanos and diatoms 148 148 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 149 ztn = MAX( 0., t n(ji,jj,jk) - 15. )149 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 150 150 zadap = 0.+ 1.* ztn / ( 2.+ ztn ) 151 151 zadap2 = 0.e0 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zrem.F90
r2038 r2082 287 287 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 288 288 zsatur = MAX( rtrn, zsatur ) 289 zsatur2 = zsatur * ( 1. + t n(ji,jj,jk) / 400.)**4290 znusil = 0.225 * ( 1. + t n(ji,jj,jk) / 15.) * zsatur + 0.775 * zsatur2**9289 zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 290 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 291 291 # if defined key_degrad 292 292 zsiremin = xsirem * xstep * znusil * facvol(ji,jj,jk) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2038 r2082 383 383 imois2 = nmonth 384 384 385 ! 1. first call kt=nit 000385 ! 1. first call kt=nittrc000 386 386 ! ----------------------- 387 387 388 IF( kt == nit 000 ) THEN388 IF( kt == nittrc000 ) THEN 389 389 ! initializations 390 390 nflx1 = 0 … … 402 402 ! ---------------- 403 403 404 IF( kt == nit 000 .OR. imois /= nflx1 ) THEN404 IF( kt == nittrc000 .OR. imois /= nflx1 ) THEN 405 405 406 406 ! Calendar computation … … 423 423 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 424 424 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 425 426 IF(lwp .AND. nitend-nit000 <= 100 ) THEN427 WRITE(numout,*)428 WRITE(numout,*) ' read clio flx ok'429 WRITE(numout,*)430 WRITE(numout,*)431 WRITE(numout,*) 'Clio month: ',nflx1,' field: dust'432 CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout )433 ENDIF434 425 435 426 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/par_sed.F90
r1250 r2082 16 16 jpjm1 => jpjm1 , & !: jpj - 1 17 17 jpij => jpij !: jpi x jpj 18 jp_tem => jp_tem !: indice of temperature 19 jp_sal => jp_sal !: indice of salintity 18 20 19 21 #if ! defined key_sed_off -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/sed.F90
r1715 r2082 34 34 35 35 USE oce , ONLY : & 36 tn => tn , & !: pot. temperature (celsius) 37 sn => sn !: salinity (psu) 36 tsn => tsn & !: pot. temperature (celsius) and salinity (psu) 38 37 39 38 USE trc, ONLY : & … … 215 214 INTEGER, PUBLIC :: & 216 215 numsed = 27 217 218 216 #else 219 217 !!====================================================================== -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/SED/seddta.F90
r1264 r2082 131 131 trc_data(ji,jj,9 ) = sinking2(ji,jj,ikt) 132 132 trc_data(ji,jj,10) = sinkcal (ji,jj,ikt) 133 trc_data(ji,jj,11) = t n (ji,jj,ikt)134 trc_data(ji,jj,12) = sn (ji,jj,ikt)133 trc_data(ji,jj,11) = tsn (ji,jj,ikt,jp_tem) 134 trc_data(ji,jj,12) = tsn (ji,jj,ikt,jp_sal) 135 135 # else 136 136 trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 137 137 trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 138 138 trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt) 139 trc_data(ji,jj,10) = t n (ji,jj,ikt)140 trc_data(ji,jj,11) = sn (ji,jj,ikt)139 trc_data(ji,jj,10) = tsn (ji,jj,ikt,jp_tem) 140 trc_data(ji,jj,11) = tsn (ji,jj,ikt,jp_sal) 141 141 # endif 142 142 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcadv.F90
r2034 r2082 33 33 34 34 PUBLIC trc_adv ! routine called by step module 35 35 36 INTEGER :: nadv ! choice of the type of advection scheme 37 REAL(wp), DIMENSION(jpk) :: r2dt ! vertical profile time-step, = 2 rdttra 38 ! ! except at nit000 (=rdttra) if neuler=0 36 39 37 40 !! * Substitutions … … 64 67 IF( kt == nittrc000 ) CALL trc_adv_ctl ! initialisation & control of options 65 68 69 IF( neuler == 0 .AND. kt == nittrc000 ) THEN ! at nit000 70 r2dt(:) = rdttra(:) * FLOAT(nn_dttrc) ! = rdtra (restarting with Euler time stepping) 71 ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ! at nit000 or nit000+1 72 r2dt(:) = 2. * rdttra(:) * FLOAT(nn_dttrc) ! = 2 rdttra (leapfrog) 73 ENDIF 74 66 75 ! ! effective transport 67 76 DO jk = 1, jpkm1 … … 78 87 ! 79 88 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 centered81 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD82 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', zun, zvn, zwn, trb, tra, jptra ) ! MUSCL83 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL284 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS85 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST89 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) ! 2nd order centered 90 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! TVD 91 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) ! MUSCL 92 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! MUSCL2 93 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! UBS 94 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) ! QUICKEST 86 95 ! 87 96 CASE (-1 ) !== esopa: test all possibility with control print ==! 88 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra )97 CALL tra_adv_cen2 ( kt, 'TRC', zun, zvn, zwn, trb, trn, tra, jptra ) 89 98 WRITE(charout, FMT="('adv1')") ; CALL prt_ctl_trc_info(charout) 90 99 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 )100 CALL tra_adv_tvd ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 92 101 WRITE(charout, FMT="('adv2')") ; CALL prt_ctl_trc_info(charout) 93 102 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 )103 CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, tra, jptra ) 95 104 WRITE(charout, FMT="('adv3')") ; CALL prt_ctl_trc_info(charout) 96 105 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 )106 CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 98 107 WRITE(charout, FMT="('adv4')") ; CALL prt_ctl_trc_info(charout) 99 108 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 )109 CALL tra_adv_ubs ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 101 110 WRITE(charout, FMT="('adv5')") ; CALL prt_ctl_trc_info(charout) 102 111 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 )112 CALL tra_adv_qck ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra ) 104 113 WRITE(charout, FMT="('adv6')") ; CALL prt_ctl_trc_info(charout) 105 114 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcldf.F90
r2034 r2082 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 73 CASE ( 1 ) ; CALL tra_ldf_iso ( kt 74 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt 75 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt 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 76 76 ! 77 77 CASE ( -1 ) ! esopa: test all possibility with control print 78 CALL tra_ldf_lap ( kt 78 CALL tra_ldf_lap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) 79 79 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 80 80 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 81 CALL tra_ldf_iso ( kt 81 CALL tra_ldf_iso ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 82 82 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 83 83 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 84 CALL tra_ldf_bilap ( kt 84 CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra ) 85 85 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 86 86 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 87 CALL tra_ldf_bilapg( kt 87 CALL tra_ldf_bilapg( kt, 'TRC', trb, tra, jptra ) 88 88 WRITE(charout, FMT="('ldf3 ')") ; CALL prt_ctl_trc_info(charout) 89 89 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trcnxt.F90
r2034 r2082 44 44 PUBLIC trc_nxt ! routine called by step.F90 45 45 46 REAL(wp), DIMENSION(jpk) :: r2dt _t46 REAL(wp), DIMENSION(jpk) :: r2dt 47 47 !!---------------------------------------------------------------------- 48 48 !! TOP 1.0 , LOCEAN-IPSL (2005) … … 109 109 110 110 ! set time step size (Euler/Leapfrog) 111 IF( neuler == 0 .AND. kt == nittrc000) THEN ; r2dt _t(:) = rdttra(:) * FLOAT( nn_dttrc ) ! at nit000 (Euler)112 ELSEIF( kt <= nittrc000 + 1 ) THEN ; r2dt _t(:) = 2.* rdttra(:) * FLOAT( nn_dttrc ) ! at nit000 or nit000+1 (Leapfrog)111 IF( neuler == 0 .AND. kt == nittrc000) THEN ; r2dt(:) = rdttra(:) * FLOAT( nn_dttrc ) ! at nit000 (Euler) 112 ELSEIF( kt <= nittrc000 + 1 ) THEN ; r2dt(:) = 2.* rdttra(:) * FLOAT( nn_dttrc ) ! at nit000 or nit000+1 (Leapfrog) 113 113 ENDIF 114 114 … … 133 133 DO jn = 1, jptra 134 134 DO jk = 1, jpkm1 135 zfact = 1.e0 / r2dt _t(jk)135 zfact = 1.e0 / r2dt(jk) 136 136 ztrdt(:,:,jk,jn) = ( trb(:,:,jk,jn) - ztrdt(:,:,jk,jn) ) * zfact 137 137 CALL trd_tra( kt, 'TRC', jn, jptra_trd_atf, ztrdt ) -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trctrp.F90
r2052 r2082 28 28 USE trcrad ! positivity (trc_rad routine) 29 29 USE trcsbc ! surface boundary condition (trc_sbc routine) 30 USE zpshde ! partial step: hor. derivative (zps_hde_trcroutine)30 USE zpshde ! partial step: hor. derivative (zps_hde routine) 31 31 32 32 #if defined key_agrif … … 74 74 #endif 75 75 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 76 IF( ln_zps ) CALL zps_hde _trc( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive76 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv ) ! Partial steps: now horizontal gradient of passive 77 77 ! tracers at the bottom ocean level 78 78 CALL trc_nxt( kstp ) ! tracer fields at next time step -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/TRP/trczdf.F90
r2052 r2082 80 80 SELECT CASE ( nzdf ) ! compute lateral mixing trend and add it to the general trend 81 81 CASE ( -1 ) ! esopa: test all possibility with control print 82 CALL tra_zdf_exp( kt 82 CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) 83 83 WRITE(charout, FMT="('zdf1 ')") ; CALL prt_ctl_trc_info(charout) 84 84 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 85 CALL tra_zdf_imp( kt 85 CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra ) 86 86 WRITE(charout, FMT="('zdf2 ')") ; CALL prt_ctl_trc_info(charout) 87 87 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 88 CASE ( 0 ) ; CALL tra_zdf_exp( kt 89 CASE ( 1 ) ; CALL tra_zdf_imp( kt 88 CASE ( 0 ) ; CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra ) ! explicit scheme 89 CASE ( 1 ) ; CALL tra_zdf_imp( kt, 'TRC', r2dt, trb, tra, jptra ) ! implicit scheme 90 90 91 91 END SELECT -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/oce_trc.F90
r2052 r2082 173 173 USE oce , ONLY : l_traldf_rot => l_traldf_rot !: rotated laplacian operator for lateral diffusion 174 174 #if defined key_offline 175 USE oce , ONLY : gt u => gtu!: t-, s- and rd horizontal gradient at u- and176 USE oce , ONLY : g su => gsu !: v-points at bottom ocean level175 USE oce , ONLY : gtsu => gtsu !: t-, s- and rd horizontal gradient at u- and 176 USE oce , ONLY : gtsv => gtsv !: 177 177 USE oce , ONLY : gru => gru !: 178 USE oce , ONLY : gtv => gtv !:179 USE oce , ONLY : gsv => gsv !:180 178 USE oce , ONLY : grv => grv !: 181 179 # if defined key_degrad -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trc.F90
r2052 r2082 55 55 !! passive tracers restart (input and output) 56 56 !! ------------------------------------------ 57 INTEGER , PUBLIC :: nn_dttrc !: frequency of step on passive tracers58 INTEGER , PUBLIC :: nittrc000 !: first time step of passive tracers model59 57 LOGICAL , PUBLIC :: ln_rsttr !: boolean term for restart i/o for passive tracers (namelist) 60 58 LOGICAL , PUBLIC :: lrst_trc !: logical to control the trc restart write -
branches/DEV_r2006_merge_TRA_TRC/NEMO/TOP_SRC/trcini.F90
r2038 r2082 29 29 USE daymod 30 30 #endif 31 USE zpshde ! partial step: hor. derivative (zps_hde _trcroutine)31 USE zpshde ! partial step: hor. derivative (zps_hde routine) 32 32 USE in_out_manager ! I/O manager 33 33 USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine) … … 49 49 CONTAINS 50 50 51 SUBROUTINE trc_ini 51 SUBROUTINE trc_init 52 52 !!--------------------------------------------------------------------- 53 !! *** ROUTINE trc_ini ***53 !! *** ROUTINE trc_init *** 54 54 !! 55 55 !! ** Purpose : Initialization of the passive tracer fields … … 67 67 68 68 IF(lwp) WRITE(numout,*) 69 IF(lwp) WRITE(numout,*) 'trc_ini : initial set up of the passive tracers'69 IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 70 70 IF(lwp) WRITE(numout,*) '~~~~~~~' 71 71 … … 138 138 139 139 IF( ln_zps .AND. .NOT. lk_trc_c1d ) & ! Partial steps: before horizontal gradient of passive 140 & CALL zps_hde _trc( nittrc000, jptra, trb, gtru, gtrv ) ! tracers at the bottom ocean level140 & CALL zps_hde( nittrc000, jptra, trb, gtru, gtrv ) ! tracers at the bottom ocean level 141 141 142 142 … … 170 170 ENDIF 171 171 172 END SUBROUTINE trc_ini 172 END SUBROUTINE trc_init 173 173 174 174 #else … … 177 177 !!---------------------------------------------------------------------- 178 178 CONTAINS 179 SUBROUTINE trc_ini ! Dummy routine180 END SUBROUTINE trc_ini 179 SUBROUTINE trc_init ! Dummy routine 180 END SUBROUTINE trc_init 181 181 #endif 182 182
Note: See TracChangeset
for help on using the changeset viewer.