Changeset 14143
- Timestamp:
- 2020-12-09T22:26:04+01:00 (3 years ago)
- Location:
- NEMO/trunk/src
- Files:
-
- 18 edited
-
ICE/iceistate.F90 (modified) (2 diffs)
-
NST/agrif_oce_update.F90 (modified) (4 diffs)
-
OCE/DIA/diawri.F90 (modified) (8 diffs)
-
OCE/DOM/dom_oce.F90 (modified) (8 diffs)
-
OCE/DOM/domzgr_substitute.h90 (modified) (1 diff)
-
OCE/DYN/dynatf.F90 (modified) (1 diff)
-
OCE/DYN/dynatf_qco.F90 (modified) (3 diffs)
-
OCE/DYN/dynhpg.F90 (modified) (1 diff)
-
OCE/DYN/dynvor.F90 (modified) (4 diffs)
-
OCE/ISF/isfcpl.F90 (modified) (4 diffs)
-
OCE/ISF/isfstp.F90 (modified) (2 diffs)
-
OCE/nemogcm.F90 (modified) (6 diffs)
-
OCE/step.F90 (modified) (1 diff)
-
OCE/step_oce.F90 (modified) (1 diff)
-
OCE/stpctl.F90 (modified) (3 diffs)
-
OCE/stpmlf.F90 (modified) (5 diffs)
-
SWE/stprk3.F90 (modified) (2 diffs)
-
TOP/TRP/trcatf.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/iceistate.F90
r14086 r14143 22 22 USE eosbn2 ! equation of state 23 23 # if defined key_qco 24 USE domqco ! Variable volume 24 USE domqco ! Quasi-Eulerian coord. 25 # elif defined key_linssh 26 ! ! Fix in time coord. 25 27 # else 26 28 USE domvvl ! Variable volume … … 424 426 ! 425 427 #if defined key_qco 426 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm ) ! interpolation scale factor, depth and water column 428 IF( .NOT.ln_linssh ) CALL dom_qco_zgr( Kbb, Kmm ) ! upadte of r3=ssh/h0 ratios 429 #elif defined key_linssh 430 ! ! fix in time coord. : no update of vertical coord. 427 431 #else 428 432 IF( .NOT.ln_linssh ) CALL dom_vvl_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column -
NEMO/trunk/src/NST/agrif_oce_update.F90
r14086 r14143 192 192 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 193 193 ! 194 #if ! defined key_qco 194 #if defined key_qco 195 CALL Agrif_ChildGrid_To_ParentGrid() 196 CALL Agrif_Update_qco 197 CALL Agrif_ParentGrid_To_ChildGrid() 198 #elif defined key_linssh 199 ! 200 #else 195 201 Agrif_UseSpecialValueInUpdate = .TRUE. 196 202 Agrif_SpecialValueFineGrid = 0. … … 204 210 CALL Agrif_ChildGrid_To_ParentGrid() 205 211 CALL dom_vvl_update_UVF 206 CALL Agrif_ParentGrid_To_ChildGrid()207 #else208 CALL Agrif_ChildGrid_To_ParentGrid()209 CALL Agrif_Update_qco210 212 CALL Agrif_ParentGrid_To_ChildGrid() 211 213 #endif … … 232 234 233 235 234 #if ! defined key_qco 236 #if ! defined key_qco && ! defined key_linssh 235 237 SUBROUTINE dom_vvl_update_UVF 236 238 !!--------------------------------------------- … … 1163 1165 END SUBROUTINE updateAVM 1164 1166 1165 #if ! defined key_qco 1167 #if ! defined key_qco && ! defined key_linssh 1166 1168 SUBROUTINE updatee3t(ptab_dum, i1, i2, j1, j2, k1, k2, before ) 1167 1169 !!--------------------------------------------- -
NEMO/trunk/src/OCE/DIA/diawri.F90
r14086 r14143 215 215 ENDIF 216 216 217 #if ! defined key_qco218 217 CALL iom_put( "rhop", rhop(:,:,:) ) ! 3D potential density (sigma0) 219 #endif220 218 221 219 IF ( iom_use("taubot") ) THEN ! bottom stress … … 360 358 ENDIF 361 359 ! 362 IF ( iom_use("s KEf") ) THEN ! surface kinetic energy at F point360 IF ( iom_use("ssKEf") ) THEN ! surface kinetic energy at F point 363 361 z2d(:,:) = 0._wp ! CAUTION : only valid in SWE, not with bathymetry 364 362 DO_2D( 0, 0, 0, 0 ) … … 370 368 END_2D 371 369 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 372 CALL iom_put( "s KEf", z2d )370 CALL iom_put( "ssKEf", z2d ) 373 371 ENDIF 374 372 ! … … 473 471 IF (ln_dia25h) CALL dia_25h( kt, Kmm ) ! 25h averaging 474 472 475 ! Output of vorticity terms476 IF ( iom_use(" relvor") .OR. iom_use("plavor") .OR. &477 & iom_use(" relpotvor") .OR. iom_use("abspotvor") .OR. &478 & iom_use(" Ens") ) THEN473 ! Output of surface vorticity terms 474 IF ( iom_use("ssrelvor") .OR. iom_use("ssplavor") .OR. & 475 & iom_use("ssrelpotvor") .OR. iom_use("ssabspotvor") .OR. & 476 & iom_use("ssEns") ) THEN 479 477 ! 480 478 z2d(:,:) = 0._wp … … 485 483 END_2D 486 484 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 487 CALL iom_put( " relvor", z2d ) ! relative vorticity ( zeta )488 ! 489 CALL iom_put( " plavor", ff_f ) ! planetary vorticity ( f )485 CALL iom_put( "ssrelvor", z2d ) ! relative vorticity ( zeta ) 486 ! 487 CALL iom_put( "ssplavor", ff_f ) ! planetary vorticity ( f ) 490 488 ! 491 489 DO_2D( 1, 0, 1, 0 ) … … 498 496 END_2D 499 497 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 500 CALL iom_put( " relpotvor", z2d ) ! relative potential vorticity (zeta/h)498 CALL iom_put( "ssrelpotvor", z2d ) ! relative potential vorticity (zeta/h) 501 499 ! 502 500 DO_2D( 1, 0, 1, 0 ) … … 509 507 END_2D 510 508 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 511 CALL iom_put( " abspotvor", z2d ) ! absolute potential vorticity ( q )509 CALL iom_put( "ssabspotvor", z2d ) ! absolute potential vorticity ( q ) 512 510 ! 513 511 DO_2D( 1, 0, 1, 0 ) … … 515 513 END_2D 516 514 CALL lbc_lnk( 'diawri', z2d, 'F', 1. ) 517 CALL iom_put( " Ens", z2d ) ! potential enstrophy ( 1/2*q2 )515 CALL iom_put( "ssEns", z2d ) ! potential enstrophy ( 1/2*q2 ) 518 516 ! 519 517 ENDIF -
NEMO/trunk/src/OCE/DOM/dom_oce.F90
r14072 r14143 136 136 ! 137 137 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff_f , ff_t !: Coriolis factor at f- & t-points [1/s] 138 138 139 !!---------------------------------------------------------------------- 139 140 !! vertical coordinate and scale factors 140 141 !! --------------------------------------------------------------------- 142 #if defined key_qco 143 LOGICAL, PUBLIC, PARAMETER :: lk_qco = .TRUE. !: qco key flag 144 #else 145 LOGICAL, PUBLIC, PARAMETER :: lk_qco = .FALSE. !: qco key flag 146 #endif 147 #if defined key_linssh 148 LOGICAL, PUBLIC, PARAMETER :: lk_linssh = .TRUE. !: linssh key flag 149 #else 150 LOGICAL, PUBLIC, PARAMETER :: lk_linssh = .FALSE. !: linssh key flag 151 #endif 141 152 LOGICAL, PUBLIC :: ln_zco !: z-coordinate - full step 142 153 LOGICAL, PUBLIC :: ln_zps !: z-coordinate - partial step … … 151 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3uw_0 !: uw-vert. scale factor [m] 152 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3vw_0 !: vw-vert. scale factor [m] 153 ! ! time-dependent scale factors 154 #if ! defined key_qco 164 165 ! ! time-dependent scale factors (domvvl) 155 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: e3t, e3u, e3v, e3w, e3uw, e3vw !: vert. scale factor [m] 156 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e3f !: F-point vert. scale factor [m] 157 #endif 158 ! ! time-dependent ratio ssh / h_0 168 169 ! ! time-dependent ratio ssh / h_0 (domqco) 159 170 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: r3t, r3u, r3v !: time-dependent ratio at t-, u- and v-point [-] 160 171 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: r3f !: mid-time-level ratio at f-point [-] … … 165 176 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gdepw_0 !: w- depth [m] 166 177 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w_0 !: w- depth (sum of e3w) [m] 167 ! ! time-dependent depths of cells 178 179 ! ! time-dependent depths of cells (domvvl) 168 180 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: gdept, gdepw 169 181 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gde3w … … 174 186 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hv_0, r1_hv_0 !: v-depth [m] and [1/m] 175 187 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hf_0, r1_hf_0 !: f-depth [m] and [1/m] 176 ! ! time-dependent heights of ocean water column177 #if ! defined key_qco 188 189 ! ! time-dependent heights of ocean water column (domvvl) 178 190 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht !: t-points [m] 179 #endif180 191 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hu, r1_hu !: u-depth [m] and [1/m] 181 192 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hv, r1_hv !: v-depth [m] and [1/m] … … 207 218 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask !: land/ocean mask at T-, U-, V-, W- and F-pts 208 219 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask !: land/ocean mask at WU- and WV-pts 209 #if defined key_qco 210 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts for qco 211 #endif 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fe3mask !: land/ocean mask at F-pts (qco only) 221 212 222 !!---------------------------------------------------------------------- 213 223 !! calendar variables … … 301 311 ! 302 312 ii = ii+1 303 ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & 304 & gdept (jpi,jpj,jpk,jpt) , gdepw (jpi,jpj,jpk,jpt) , gde3w (jpi,jpj,jpk) , STAT=ierr(ii) ) 305 ! 306 ii = ii+1 307 ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0 (jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , & 308 & e3w_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , STAT=ierr(ii) ) 313 ALLOCATE( gdept_0 (jpi,jpj,jpk) , gdepw_0 (jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) , & 314 & gdept_1d( jpk) , gdepw_1d( jpk) , STAT=ierr(ii) ) 315 ! 316 ii = ii+1 317 ALLOCATE( e3t_0 (jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , e3v_0 (jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , & 318 & e3w_0 (jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , & 319 & e3t_1d( jpk) , e3w_1d( jpk) , STAT=ierr(ii) ) 320 ! 321 ii = ii+1 322 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 323 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(ii) ) 309 324 ! 310 325 #if defined key_qco 311 ii = ii+1 312 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 313 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 326 ! qco : ssh to h ratio and specific fmask 327 ii = ii+1 328 ALLOCATE( r3t (jpi,jpj,jpt) , r3u (jpi,jpj,jpt) , r3v (jpi,jpj,jpt) , r3f (jpi,jpj) , & 329 & r3t_f(jpi,jpj) , r3u_f(jpi,jpj) , r3v_f(jpi,jpj) , STAT=ierr(ii) ) 330 ! 331 ii = ii+1 332 ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) ) 333 ! 334 #elif defined key_linssh 335 ! linear ssh no time varying coordinate arrays 314 336 #else 337 ! vvl : time varation for all vertical coordinate variables 338 ii = ii+1 339 ALLOCATE( gdept (jpi,jpj,jpk,jpt) , gdepw (jpi,jpj,jpk,jpt) , gde3w (jpi,jpj,jpk) , STAT=ierr(ii) ) 340 ! 315 341 ii = ii+1 316 342 ALLOCATE( e3t(jpi,jpj,jpk,jpt) , e3u (jpi,jpj,jpk,jpt) , e3v (jpi,jpj,jpk,jpt) , e3f(jpi,jpj,jpk) , & 317 343 & e3w(jpi,jpj,jpk,jpt) , e3uw(jpi,jpj,jpk,jpt) , e3vw(jpi,jpj,jpk,jpt) , STAT=ierr(ii) ) 318 #endif 319 ! 320 ii = ii+1 321 ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) , hf_0(jpi,jpj) , & 322 & r1_ht_0(jpi,jpj) , r1_hu_0(jpi,jpj) , r1_hv_0(jpi,jpj), r1_hf_0(jpi,jpj) , STAT=ierr(ii) ) 323 ! 324 #if ! defined key_qco 325 ii = ii+1 326 ALLOCATE( ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 327 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) ) 344 ! 345 ii = ii+1 346 ALLOCATE( ht (jpi,jpj) , hu (jpi,jpj,jpt), hv (jpi,jpj,jpt) , & 347 & r1_hu (jpi,jpj,jpt), r1_hv (jpi,jpj,jpt) , STAT=ierr(ii) ) 328 348 #endif 329 349 ! … … 332 352 ! 333 353 ii = ii+1 334 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , e3t_1d(jpk) , e3w_1d(jpk) , STAT=ierr(ii) ) 335 ! 336 ii = ii+1 337 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 354 ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) , & 338 355 & ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 339 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) ,STAT=ierr(ii) )356 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv (jpi,jpj) , STAT=ierr(ii) ) 340 357 ! 341 358 ii = ii+1 … … 348 365 ii = ii+1 349 366 ALLOCATE( wmask(jpi,jpj,jpk) , wumask(jpi,jpj,jpk), wvmask(jpi,jpj,jpk) , STAT=ierr(ii) ) 350 #if defined key_qco351 !352 ii = ii+1353 ALLOCATE( fe3mask(jpi,jpj,jpk) , STAT=ierr(ii) )354 #endif355 367 ! 356 368 dom_oce_alloc = MAXVAL(ierr) -
NEMO/trunk/src/OCE/DOM/domzgr_substitute.h90
r14053 r14143 28 28 # define gdepw(i,j,k,t) (gdepw_0(i,j,k)*(1._wp+r3t(i,j,t))) 29 29 # define gde3w(i,j,k) (gdept_0(i,j,k)*(1._wp+r3t(i,j,Kmm))-ssh(i,j,Kmm)) 30 #elif defined key_linssh 31 # define e3t(i,j,k,t) e3t_0(i,j,k) 32 # define e3u(i,j,k,t) e3u_0(i,j,k) 33 # define e3v(i,j,k,t) e3v_0(i,j,k) 34 # define e3f(i,j,k) e3f_0(i,j,k) 35 # define e3f_vor(i,j,k) e3f_0vor(i,j,k) 36 # define e3w(i,j,k,t) e3w_0(i,j,k) 37 # define e3uw(i,j,k,t) e3uw_0(i,j,k) 38 # define e3vw(i,j,k,t) e3vw_0(i,j,k) 39 # define ht(i,j) ht_0(i,j) 40 # define hu(i,j,t) hu_0(i,j) 41 # define hv(i,j,t) hv_0(i,j) 42 # define r1_hu(i,j,t) r1_hu_0(i,j) 43 # define r1_hv(i,j,t) r1_hv_0(i,j) 44 # define gdept(i,j,k,t) gdept_0(i,j,k) 45 # define gdepw(i,j,k,t) gdepw_0(i,j,k) 46 # define gde3w(i,j,k) (gdept_0(i,j,k)-ssh(i,j,Kmm)) 30 47 #endif 31 48 !!---------------------------------------------------------------------- 32 !!# define e3t_f(i,j,k) (e3t_0(i,j,k)*(1._wp+r3t_f(i,j)*tmask(i,j,k))) 33 !!# define e3u_f(i,j,k) (e3u_0(i,j,k)*(1._wp+r3u_f(i,j)*umask(i,j,k))) 34 !!# define e3v_f(i,j,k) (e3v_0(i,j,k)*(1._wp+r3v_f(i,j)*vmask(i,j,k))) 49 -
NEMO/trunk/src/OCE/DYN/dynatf.F90
r14072 r14143 60 60 PUBLIC dyn_atf ! routine called by step.F90 61 61 62 #if defined key_qco 62 #if defined key_qco || defined key_linssh 63 63 !!---------------------------------------------------------------------- 64 !! 'key_qco' EMPTY ROUTINE Quasi-Eulerian vertical coordonate 64 !! 'key_qco' Quasi-Eulerian vertical coordinate 65 !! OR EMPTY MODULE 66 !! 'key_linssh' Fix in time vertical coordinate 65 67 !!---------------------------------------------------------------------- 66 68 CONTAINS 67 69 68 SUBROUTINE dyn_atf 70 SUBROUTINE dyn_atf( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 69 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 70 72 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! before and after time level indices -
NEMO/trunk/src/OCE/DYN/dynatf_qco.F90
r14053 r14143 66 66 CONTAINS 67 67 68 SUBROUTINE dyn_atf_qco 68 SUBROUTINE dyn_atf_qco( kt, Kbb, Kmm, Kaa, puu, pvv ) 69 69 !!---------------------------------------------------------------------- 70 70 !! *** ROUTINE dyn_atf_qco *** … … 196 196 ! JC: Would be more clever to swap variables than to make a full vertical 197 197 ! integration 198 ! CAUTION : calculation need to be done in the same way than see GM 198 ! CAUTION : calculation need to be done in the same way than see GM 199 #if defined key_linssh 200 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 201 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) 202 vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 203 vv_b(:,:,Kmm) = e3v(:,:,1,Kmm) * pvv(:,:,1,Kmm) * vmask(:,:,1) 204 DO jk = 2, jpkm1 205 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 206 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 207 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 208 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 209 END DO 210 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 211 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa) 212 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 213 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 214 #else 199 215 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 200 216 uu_b(:,:,Kmm) = (e3u_0(:,:,1) * ( 1._wp + r3u_f(:,:) * umask(:,:,1) )) * puu(:,:,1,Kmm) * umask(:,:,1) … … 211 227 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * (r1_hu_0(:,:)/( 1._wp + r3u_f(:,:) )) 212 228 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * (r1_hv_0(:,:)/( 1._wp + r3v_f(:,:) )) 229 #endif 213 230 ! 214 231 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents -
NEMO/trunk/src/OCE/DYN/dynhpg.F90
r14141 r14143 186 186 & CALL ctl_stop( 'dyn_hpg_init : non-linear free surface incompatible with hpg_zco or hpg_zps' ) 187 187 ! 188 IF( .NOT. (ln_hpg_isf.AND.ln_isfcav) ) &188 IF( (.NOT.ln_hpg_isf .AND. ln_isfcav) .OR. (ln_hpg_isf .AND. .NOT.ln_isfcav) ) & 189 189 & CALL ctl_stop( 'dyn_hpg_init : ln_hpg_isf=T requires ln_isfcav=T and vice versa' ) 190 190 ! -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r14072 r14143 406 406 END SELECT 407 407 ! 408 #if defined key_qco 408 #if defined key_qco || defined key_linssh 409 409 DO_2D( 1, 0, 1, 0 ) !== potential vorticity ==! (key_qco) 410 410 zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) … … 533 533 ! 534 534 ! 535 #if defined key_qco 535 #if defined key_qco || defined key_linssh 536 536 DO_2D( 1, 0, 1, 0 ) !== potential vorticity ==! (key_qco) 537 537 zwz(ji,jj) = zwz(ji,jj) / e3f_vor(ji,jj,jk) … … 624 624 ! ! =============== 625 625 ! 626 #if defined key_qco 626 #if defined key_qco || defined key_linssh 627 627 DO_2D( 1, 0, 1, 0 ) ! == reciprocal of e3 at F-point (key_qco) 628 628 z1_e3f(ji,jj) = 1._wp / e3f_vor(ji,jj,jk) … … 952 952 ! 953 953 END SELECT 954 #if defined key_qco 955 SELECT CASE( nvor_scheme ) ! qco case: pre-computed a specific e3f_0 for some vorticity schemes954 #if defined key_qco || defined key_linssh 955 SELECT CASE( nvor_scheme ) ! qco or linssh cases : pre-computed a specific e3f_0 for some vorticity schemes 956 956 CASE( np_ENS , np_ENE , np_EEN , np_MIX ) 957 957 ! -
NEMO/trunk/src/OCE/ISF/isfcpl.F90
r14072 r14143 15 15 #if defined key_qco 16 16 USE domqco , ONLY : dom_qco_zgr ! vertical scale factor interpolation 17 #elif defined key_linssh 18 ! ! fix in time coordinate 17 19 #else 18 20 USE domvvl , ONLY : dom_vvl_zgr ! vertical scale factor interpolation … … 117 119 vv (:,:,:,Kbb) = vv (:,:,:,Kmm) 118 120 ssh (:,:,Kbb) = ssh (:,:,Kmm) 119 #if ! defined key_qco 121 #if ! defined key_qco && ! defined key_linssh 120 122 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 121 123 #endif … … 217 219 IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)' 218 220 IF(lwp) write(numout,*) '~~~~~~~~~~~' 219 #if ! defined key_qco 221 #if defined key_qco 222 CALL dom_qco_zgr(Kbb, Kmm) 223 #elif defined key_linssh 224 ! linear ssh : fix in time coord. 225 #else 220 226 DO jk = 1, jpk 221 227 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( 1._wp + (ht_0(:,:) + ssh(:,:,Kmm)) * r1_ht_0(:,:) ) … … 223 229 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 224 230 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 225 #else226 CALL dom_qco_zgr(Kbb, Kmm)227 231 #endif 228 232 ! -
NEMO/trunk/src/OCE/ISF/isfstp.F90
r14064 r14143 87 87 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 88 88 END DO 89 CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )89 CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 90 90 #else 91 CALL isf_tbl_lvl( ht(:,:), e3t , misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav )91 CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav ) 92 92 #endif 93 93 ! … … 116 116 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 117 117 END DO 118 CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )118 CALL isf_tbl_lvl( ht(:,:), ze3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 119 119 #else 120 CALL isf_tbl_lvl( ht(:,:), e3t , misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par )120 CALL isf_tbl_lvl( ht(:,:), e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par ) 121 121 #endif 122 122 ! -
NEMO/trunk/src/OCE/nemogcm.F90
r14118 r14143 51 51 USE istate ! initial state setting (istate_init routine) 52 52 USE trdini ! dyn/tra trends initialization (trd_init routine) 53 USE asminc ! assimilation increments54 USE asmbkg ! writing out state trajectory55 USE diadct ! sections transports (dia_dct_init routine)56 USE diaobs ! Observation diagnostics (dia_obs_init routine)57 USE diacfl ! CFL diagnostics (dia_cfl_init routine)58 USE diamlr ! IOM context management for multiple-linear-regression analysis59 USE isfstp ! ice shelf (isf_stp_init routine)60 53 USE icbini ! handle bergs, initialisation 61 54 USE icbstp , ONLY : icb_end ! handle bergs, close iceberg files … … 73 66 USE ice_domain_size, only: nx_global, ny_global 74 67 #endif 75 #if defined key_qco 68 #if defined key_qco || defined key_linssh 76 69 USE stpmlf ! NEMO time-stepping (stp_MLF routine) 77 70 #else … … 83 76 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 84 77 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 85 #if defined key_iomput 86 USE xios ! xIOserver 87 #endif 88 #if defined key_agrif 89 USE agrif_all_update ! Master Agrif update 90 USE agrif_oce_update 91 #endif 92 USE halo_mng 78 USE halo_mng ! halo manager 93 79 94 80 IMPLICIT NONE … … 175 161 ! 176 162 DO WHILE( istp <= nitend .AND. nstop == 0 ) 177 # if defined key_qco 163 ! 164 # if defined key_qco || defined key_linssh 178 165 CALL stp_MLF 179 166 # else … … 196 183 ENDIF 197 184 ! 198 # if defined key_qco 199 CALL stp_MLF 185 # if defined key_qco || defined key_linssh 186 CALL stp_MLF( istp ) 200 187 # else 201 CALL stp 188 CALL stp ( istp ) 202 189 # endif 203 190 istp = istp + 1 … … 343 330 IF(lwp) THEN ! open listing units 344 331 ! 345 IF( .NOT. lwm ) & ! alreay opened for narea == 1332 IF( .NOT. lwm ) & ! alreay opened for narea == 1 346 333 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 347 334 ! -
NEMO/trunk/src/OCE/step.F90
r14072 r14143 33 33 !! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme 34 34 !!---------------------------------------------------------------------- 35 #if defined key_qco 36 !!---------------------------------------------------------------------- 37 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordonate 35 #if defined key_qco || defined key_linssh 36 !!---------------------------------------------------------------------- 37 !! 'key_qco' EMPTY MODULE Quasi-Eulerian vertical coordinate 38 !! OR 39 !! 'key_linssh EMPTY MODULE Fixed in time vertical coordinate 38 40 !!---------------------------------------------------------------------- 39 41 #else -
NEMO/trunk/src/OCE/step_oce.F90
r14090 r14143 110 110 USE agrif_oce_sponge ! Momemtum and tracers sponges 111 111 USE agrif_all_update ! Main update driver 112 USE agrif_oce_update 112 113 #endif 113 114 #if defined key_top -
NEMO/trunk/src/OCE/stpctl.F90
r14131 r14143 15 15 !!---------------------------------------------------------------------- 16 16 !! stp_ctl : Control the run 17 !! stp_ctl_SWE : Control the run (SWE only) 17 18 !!---------------------------------------------------------------------- 18 19 USE oce ! ocean dynamics and tracers variables … … 33 34 34 35 PUBLIC stp_ctl ! routine called by step.F90 36 PUBLIC stp_ctl_SWE ! routine called by stpmlf.F90 35 37 36 38 INTEGER :: nrunid ! netcdf file id 37 39 INTEGER, DIMENSION(8) :: nvarid ! netcdf variable id 40 INTEGER, DIMENSION(2) :: nvarid_SWE ! netcdf variable id (SWE only) 38 41 !!---------------------------------------------------------------------- 39 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 270 273 271 274 275 SUBROUTINE stp_ctl_SWE( kt, Kmm ) 276 !!---------------------------------------------------------------------- 277 !! *** ROUTINE stp_ctl_SWE *** 278 !! 279 !! ** Purpose : Control the run 280 !! 281 !! ** Method : - Save the time step in numstp 282 !! - Print it each 50 time steps 283 !! - Stop the run IF problem encountered by setting nstop > 0 284 !! Problems checked: e3t0+ssh minimum smaller that 0 285 !! |U| maximum larger than 10 m/s 286 !! ( not for SWE : negative sea surface salinity ) 287 !! 288 !! ** Actions : "time.step" file = last ocean time-step 289 !! "run.stat" file = run statistics 290 !! nstop indicator sheared among all local domain 291 !!---------------------------------------------------------------------- 292 INTEGER, INTENT(in ) :: kt ! ocean time-step index 293 INTEGER, INTENT(in ) :: Kmm ! ocean time level index 294 !! 295 INTEGER :: ji ! dummy loop indices 296 INTEGER :: idtime, istatus 297 INTEGER , DIMENSION(3) :: iareasum, iareamin, iareamax 298 INTEGER , DIMENSION(3,4) :: iloc ! min/max loc indices 299 REAL(wp) :: zzz ! local real 300 REAL(wp), DIMENSION(3) :: zmax, zmaxlocal 301 LOGICAL :: ll_wrtstp, ll_colruns, ll_wrtruns, ll_0oce 302 LOGICAL, DIMENSION(jpi,jpj,jpk) :: llmsk 303 CHARACTER(len=20) :: clname 304 !!---------------------------------------------------------------------- 305 ! 306 IF( nstop > 0 .AND. ngrdstop > -1 ) RETURN ! stpctl was already called by a child grid 307 ! 308 ll_wrtstp = ( MOD( kt-nit000, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) 309 ll_colruns = ll_wrtstp .AND. sn_cfctl%l_runstat .AND. jpnij > 1 310 ll_wrtruns = ( ll_colruns .OR. jpnij == 1 ) .AND. lwm 311 ! 312 IF( kt == nit000 ) THEN 313 ! 314 IF( lwp ) THEN 315 WRITE(numout,*) 316 WRITE(numout,*) 'stp_ctl_SWE : time-stepping control' 317 WRITE(numout,*) '~~~~~~~~~~~' 318 ENDIF 319 ! ! open time.step ascii file, done only by 1st subdomain 320 IF( lwm ) CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 321 ! 322 IF( ll_wrtruns ) THEN 323 ! ! open run.stat ascii file, done only by 1st subdomain 324 CALL ctl_opn( numrun, 'run.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 325 ! ! open run.stat.nc netcdf file, done only by 1st subdomain 326 clname = 'run.stat.nc' 327 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 328 istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, nrunid ) 329 istatus = NF90_DEF_DIM( nrunid, 'time', NF90_UNLIMITED, idtime ) 330 istatus = NF90_DEF_VAR( nrunid, 'abs_ssh_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(1) ) 331 istatus = NF90_DEF_VAR( nrunid, 'abs_u_max', NF90_DOUBLE, (/ idtime /), nvarid_SWE(2) ) 332 istatus = NF90_ENDDEF(nrunid) 333 ENDIF 334 ! 335 ENDIF 336 ! 337 ! !== write current time step ==! 338 ! !== done only by 1st subdomain at writting timestep ==! 339 IF( lwm .AND. ll_wrtstp ) THEN 340 WRITE ( numstp, '(1x, i8)' ) kt 341 REWIND( numstp ) 342 ENDIF 343 ! !== test of local extrema ==! 344 ! !== done by all processes at every time step ==! 345 ! 346 llmsk( 1:Nis1,:,:) = .FALSE. ! exclude halos from the checked region 347 llmsk(Nie1: jpi,:,:) = .FALSE. 348 llmsk(:, 1:Njs1,:) = .FALSE. 349 llmsk(:,Nje1: jpj,:) = .FALSE. 350 ! 351 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0) == 1._wp ! define only the inner domain 352 ! 353 ll_0oce = .NOT. ANY( llmsk(:,:,1) ) ! no ocean point in the inner domain? 354 ! 355 zmax(1) = MINVAL( -e3t_0(:,:,1)-ssh(:,:,Kmm) , mask = llmsk(:,:,1) ) ! e3t_Kmm min 356 ! 357 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 358 zmax(2) = MAXVAL( ABS( uu(:,:,:,Kmm) ) , mask = llmsk(:,:,:) ) ! velocity max (zonal only) 359 zmax(3) = REAL( nstop , wp ) ! stop indicator 360 361 ! !== get global extrema ==! 362 ! !== done by all processes if writting run.stat ==! 363 IF( ll_colruns ) THEN 364 zmaxlocal(:) = zmax(:) 365 CALL mpp_max( "stpctl", zmax ) ! max over the global domain 366 nstop = NINT( zmax(3) ) ! update nstop indicator (now sheared among all local domains) 367 ELSE 368 ! if no ocean point: MAXVAL returns -HUGE => we must overwrite this value to avoid error handling bellow. 369 IF( ll_0oce ) zmax(1:4) = (/ 0._wp, 0._wp, -1._wp, 1._wp /) ! default "valid" values... 370 ENDIF 371 ! 372 zmax(1) = -zmax(1) ! move back from max(-zz) to min(zz) : easier to manage! 373 ! 374 ! !== write "run.stat" files ==! 375 ! !== done only by 1st subdomain at writting timestep ==! 376 IF( ll_wrtruns ) THEN 377 WRITE(numrun,9500) kt, zmax(1), zmax(2) 378 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(1), (/ zmax(1)/), (/kt/), (/1/) ) 379 istatus = NF90_PUT_VAR( nrunid, nvarid_SWE(2), (/ zmax(2)/), (/kt/), (/1/) ) 380 IF( kt == nitend ) istatus = NF90_CLOSE(nrunid) 381 ENDIF 382 ! !== error handling ==! 383 ! !== done by all processes at every time step ==! 384 ! 385 !!SWE specific : start 386 IF( zmax(1) <= 0._wp .OR. & ! negative e3t_Kmm 387 & zmax(2) > 10._wp .OR. & ! too large velocity ( > 10 m/s) 388 & ISNAN( zmax(1) + zmax(2) ) .OR. & ! NaN encounter in the tests 389 & ABS( zmax(1) + zmax(2) ) > HUGE(1._wp) ) THEN ! Infinity encounter in the tests 390 ! 391 iloc(:,:) = 0 392 IF( ll_colruns ) THEN ! zmax is global, so it is the same on all subdomains -> no dead lock with mpp_maxloc 393 ! first: close the netcdf file, so we can read it 394 IF( lwm .AND. kt /= nitend ) istatus = NF90_CLOSE(nrunid) 395 ! get global loc on the min/max 396 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 397 CALL mpp_minloc( 'stpctl', e3t_0(:,:,1) + ssh(:,:,Kmm), llmsk(:,:,1), zzz, iloc(1:2,1) ) ! mpp_maxloc ok if mask = F 398 llmsk(Nis0:Nie0,Njs0:Nje0,:) = tmask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 399 CALL mpp_maxloc( 'stpctl', ABS( uu(:,:,:,Kmm)) , llmsk(:,:,:), zzz, iloc(1:3,2) ) 400 ! find which subdomain has the max. 401 iareamin(:) = jpnij+1 ; iareamax(:) = 0 ; iareasum(:) = 0 402 DO ji = 1, 3 403 IF( zmaxlocal(ji) == zmax(ji) ) THEN 404 iareamin(ji) = narea ; iareamax(ji) = narea ; iareasum(ji) = 1 405 ENDIF 406 END DO 407 CALL mpp_min( "stpctl", iareamin ) ! min over the global domain 408 CALL mpp_max( "stpctl", iareamax ) ! max over the global domain 409 CALL mpp_sum( "stpctl", iareasum ) ! sum over the global domain 410 ELSE ! find local min and max locations: 411 ! if we are here, this means that the subdomain contains some oce points -> no need to test the mask used in maxloc 412 llmsk(Nis0:Nie0,Njs0:Nje0,1) = ssmask(Nis0:Nie0,Njs0:Nje0 ) == 1._wp ! define only the inner domain 413 iloc(1:2,1) = MINLOC( e3t_0(:,:,1) + ssh(:,:,Kmm), mask = llmsk(:,:,1) ) 414 ! 415 llmsk(Nis0:Nie0,Njs0:Nje0,:) = umask(Nis0:Nie0,Njs0:Nje0,:) == 1._wp ! define only the inner domain 416 iloc(1:3,2) = MAXLOC( ABS( uu(:,:,:, Kmm)), mask = llmsk(:,:,:) ) 417 iareamin(:) = narea ; iareamax(:) = narea ; iareasum(:) = 1 ! this is local information 418 ENDIF 419 ! 420 WRITE(ctmp1,*) ' stp_ctl_SWE: e3t0+ssh < 0 m or |U| > 10 m/s or NaN encounter in the tests' 421 CALL wrt_line( ctmp2, kt, 'e3t0+ssh min', zmax(1), iloc(:,1), iareasum(1), iareamin(1), iareamax(1) ) 422 CALL wrt_line( ctmp3, kt, '|U| max' , zmax(2), iloc(:,2), iareasum(2), iareamin(2), iareamax(2) ) 423 IF( Agrif_Root() ) THEN 424 WRITE(ctmp6,*) ' ===> output of last computed fields in output.abort* files' 425 ELSE 426 WRITE(ctmp6,*) ' ===> output of last computed fields in '//TRIM(Agrif_CFixed())//'_output.abort* files' 427 ENDIF 428 ! 429 CALL dia_wri_state( Kmm, 'output.abort' ) ! create an output.abort file 430 ! 431 IF( ll_colruns .or. jpnij == 1 ) THEN ! all processes synchronized -> use lwp to print in opened ocean.output files 432 IF(lwp) THEN ; CALL ctl_stop( ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 433 ELSE ; nstop = MAX(1, nstop) ! make sure nstop > 0 (automatically done when calling ctl_stop) 434 ENDIF 435 ELSE ! only mpi subdomains with errors are here -> STOP now 436 CALL ctl_stop( 'STOP', ctmp1, ' ', ctmp2, ctmp3, ' ', ctmp6 ) 437 ENDIF 438 ! 439 ENDIF 440 !!SWE specific : end 441 ! 442 IF( nstop > 0 ) THEN ! an error was detected and we did not abort yet... 443 ngrdstop = Agrif_Fixed() ! store which grid got this error 444 IF( .NOT. ll_colruns .AND. jpnij > 1 ) CALL ctl_stop( 'STOP' ) ! we must abort here to avoid MPI deadlock 445 ENDIF 446 ! 447 9500 FORMAT(' it :', i8, ' e3t_min: ', D23.16, ' |U|_max: ', D23.16) 448 ! 449 END SUBROUTINE stp_ctl_SWE 450 451 272 452 SUBROUTINE wrt_line( cdline, kt, cdprefix, pval, kloc, ksum, kmin, kmax ) 273 453 !!---------------------------------------------------------------------- -
NEMO/trunk/src/OCE/stpmlf.F90
r14118 r14143 36 36 !!---------------------------------------------------------------------- 37 37 38 #if defined key_qco 39 !!---------------------------------------------------------------------- 40 !! 'key_qco' Quasi-Eulerian vertical coordonate 41 !!---------------------------------------------------------------------- 42 43 !!---------------------------------------------------------------------- 44 !! stp_MLF : NEMO modified Leap Frog time-stepping with qco 38 #if defined key_qco || defined key_linssh 39 !!---------------------------------------------------------------------- 40 !! 'key_qco' Quasi-Eulerian vertical coordinate 41 !! OR 42 !! 'key_linssh Fixed in time vertical coordinate 43 !!---------------------------------------------------------------------- 44 45 !!---------------------------------------------------------------------- 46 !! stp_MLF : NEMO modified Leap Frog time-stepping with qco or linssh 45 47 !!---------------------------------------------------------------------- 46 48 USE step_oce ! time stepping definition modules … … 196 198 END DO 197 199 CALL ssh_nxt ( kstp, Nbb, Nnn, ssh, Naa ) ! after ssh (includes call to div_hor) 198 IF( .NOT.l n_linssh ) THEN200 IF( .NOT.lk_linssh ) THEN 199 201 CALL dom_qco_r3c( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa) ) ! "after" ssh/h_0 ratio at t,u,v pts 200 202 IF( ln_dynspg_exp ) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t(:,:,Nnn), r3u(:,:,Nnn), r3v(:,:,Nnn), r3f(:,:) ) ! spg_exp : needed only for "now" ssh/h_0 ratio at f point … … 225 227 IF( ln_dynspg_ts ) THEN ! vertical scale factors and vertical velocity need to be updated 226 228 CALL div_hor ( kstp, Nbb, Nnn ) ! Horizontal divergence (2nd call in time-split case) 227 IF(.NOT.l n_linssh) CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! update ssh/h_0 ratio at t,u,v,f pts229 IF(.NOT.lk_linssh) CALL dom_qco_r3c ( ssh(:,:,Naa), r3t(:,:,Naa), r3u(:,:,Naa), r3v(:,:,Naa), r3f(:,:) ) ! update ssh/h_0 ratio at t,u,v,f pts 228 230 ENDIF 229 231 CALL dyn_zdf ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa ) ! vertical diffusion … … 257 259 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 258 260 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 259 261 IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 260 262 #if defined key_top 261 263 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 311 313 CALL finalize_lbc ( kstp, Nbb , Naa, uu, vv, ts ) ! boundary conditions 312 314 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa , ts ) ! time filtering of "now" tracer arrays 313 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities 315 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities 316 IF(.NOT.lk_linssh) THEN 314 317 r3t(:,:,Nnn) = r3t_f(:,:) ! update now ssh/h_0 with time filtered values 315 318 r3u(:,:,Nnn) = r3u_f(:,:) 316 319 r3v(:,:,Nnn) = r3v_f(:,:) 320 ENDIF 317 321 318 322 ! -
NEMO/trunk/src/SWE/stprk3.F90
r14137 r14143 347 347 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 348 348 349 IF( ln_diacfl ) CALL dia_cfl ( kstp, Nnn ) ! Courant number diagnostics350 CALL dia_wri ( kstp, Nnn ) ! ocean model: outputs349 IF( ln_diacfl ) CALL dia_cfl ( kstp, Nnn ) ! Courant number diagnostics 350 CALL dia_wri ( kstp, Nnn ) ! ocean model: outputs 351 351 ! 352 352 IF( lrst_oce ) CALL rst_write ( kstp, Nbb, Nnn ) ! write output ocean restart file … … 355 355 ! Control 356 356 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 357 CALL stp_ctl_SWE ( kstp , Nnn )357 CALL stp_ctl_SWE ( kstp , Nnn ) 358 358 359 359 IF( kstp == nit000 ) THEN ! 1st time step only -
NEMO/trunk/src/TOP/TRP/trcatf.F90
r14086 r14143 25 25 !! 'key_top' TOP models 26 26 !!---------------------------------------------------------------------- 27 !! trc_atf : time stepping on passive tracers27 !! trc_atf : time stepping on passive tracers 28 28 !!---------------------------------------------------------------------- 29 29 USE par_trc ! need jptra, number of passive tracers 30 USE oce_trc 31 USE trc 30 USE oce_trc ! ocean dynamics and tracers variables 31 USE trc ! ocean passive tracers variables 32 32 USE trd_oce 33 33 USE trdtra 34 # if defined key_qco 35 USE traatf_qco 34 # if defined key_qco || defined key_linssh 35 USE traatf_qco ! tracer : Asselin filter (qco) 36 36 # else 37 USE traatf 37 USE traatf ! tracer : Asselin filter (vvl) 38 38 # endif 39 39 USE bdy_oce , ONLY: ln_bdy 40 USE trcbdy 40 USE trcbdy ! BDY open boundaries 41 41 # if defined key_agrif 42 42 USE agrif_top_interp 43 43 # endif 44 44 ! 45 USE lbclnk 46 USE prtctl 45 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 46 USE prtctl ! Print control for debbuging 47 47 48 48 IMPLICIT NONE … … 157 157 ELSE 158 158 IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 159 # if defined key_qco 159 # if defined key_qco || defined key_linssh 160 160 IF( ln_linssh ) THEN ; CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 161 161 ELSE ; CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 162 162 # else 163 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh164 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh163 IF( ln_linssh ) THEN ; CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000, 'TRC', ptr, jptra ) ! linear ssh 164 ELSE ; CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 165 165 # endif 166 166 ENDIF … … 193 193 END SUBROUTINE trc_atf 194 194 195 # if ! defined key_qco195 # if defined key_qco || defined key_linssh 196 196 SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 197 197 !!---------------------------------------------------------------------- … … 225 225 INTEGER :: ji, jj, jk, jn ! dummy loop indices 226 226 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 227 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f , ze3t_d! - -227 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f ! - - 228 228 !!---------------------------------------------------------------------- 229 229 ! … … 241 241 DO jn = 1, jptra 242 242 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 243 ze3t_b = e3t(ji,jj,jk,Kbb)244 ze3t_n = e3t(ji,jj,jk,Kmm)245 ze3t_a = e3t(ji,jj,jk,Kaa)243 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 244 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 245 ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk) 246 246 ! ! tracer content at Before, now and after 247 ztc_b = ptr(ji,jj,jk,jn,Kbb) 248 ztc_n = ptr(ji,jj,jk,jn,Kmm) 247 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 248 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 249 249 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 250 250 ! 251 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b252 251 ztc_d = ztc_a - 2. * ztc_n + ztc_b 253 252 ! 254 ze3t_f = ze3t_n + rn_atfp * ze3t_d253 ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk) 255 254 ztc_f = ztc_n + rn_atfp * ztc_d 256 255 ! 257 256 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 258 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) )259 257 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 260 258 ENDIF … … 300 298 INTEGER :: ji, jj, jk, jn ! dummy loop indices 301 299 REAL(wp) :: ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 302 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f 300 REAL(wp) :: ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 303 301 !!---------------------------------------------------------------------- 304 302 ! … … 316 314 DO jn = 1, jptra 317 315 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 318 ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk)319 ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk)320 ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk)316 ze3t_b = e3t(ji,jj,jk,Kbb) 317 ze3t_n = e3t(ji,jj,jk,Kmm) 318 ze3t_a = e3t(ji,jj,jk,Kaa) 321 319 ! ! tracer content at Before, now and after 322 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b323 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n320 ztc_b = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 321 ztc_n = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 324 322 ztc_a = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 325 323 ! 324 ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 326 325 ztc_d = ztc_a - 2. * ztc_n + ztc_b 327 326 ! 328 ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk)327 ze3t_f = ze3t_n + rn_atfp * ze3t_d 329 328 ztc_f = ztc_n + rn_atfp * ztc_d 330 329 ! 331 330 IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN ! first level 331 ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj) - emp(ji,jj) ) 332 332 ztc_f = ztc_f - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 333 333 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
