- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DYN/dynatf.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/dynatf.F90
r12511 r13540 34 34 USE dynspg_ts ! surface pressure gradient: split-explicit scheme 35 35 USE domvvl ! variable volume 36 USE bdy_oce , ONLY: ln_bdy36 USE bdy_oce , ONLY : ln_bdy 37 37 USE bdydta ! ocean open boundary conditions 38 38 USE bdydyn ! ocean open boundary conditions … … 50 50 USE prtctl ! Print control 51 51 USE timing ! Timing 52 USE zdfdrg , ONLY : ln_drgice_imp, rCdU_top 52 53 #if defined key_agrif 53 54 USE agrif_oce_interp … … 58 59 59 60 PUBLIC dyn_atf ! routine called by step.F90 61 62 #if defined key_qco 63 !!---------------------------------------------------------------------- 64 !! 'key_qco' EMPTY ROUTINE Quasi-Eulerian vertical coordonate 65 !!---------------------------------------------------------------------- 66 CONTAINS 67 68 SUBROUTINE dyn_atf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 69 INTEGER , INTENT(in ) :: kt ! ocean time-step index 70 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! before and after time level indices 71 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities to be time filtered 72 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 73 74 WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt 75 END SUBROUTINE dyn_atf 76 77 #else 60 78 61 79 !! * Substitutions … … 103 121 REAL(wp) :: zve3a, zve3n, zve3b, z1_2dt ! - - 104 122 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve, zwfld 123 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau 105 124 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ze3t_f, ze3u_f, ze3v_f, zua, zva 106 125 !!---------------------------------------------------------------------- … … 148 167 # endif 149 168 ! 150 CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1. , pvv(:,:,:,Kaa), 'V', -1.) !* local domain boundaries169 CALL lbc_lnk_multi( 'dynatf', puu(:,:,:,Kaa), 'U', -1.0_wp, pvv(:,:,:,Kaa), 'V', -1.0_wp ) !* local domain boundaries 151 170 ! 152 171 ! !* BDY open boundaries … … 180 199 IF( ln_linssh ) THEN ! Fixed volume ! 181 200 ! ! =============! 182 DO_3D _11_11(1, jpkm1 )201 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 183 202 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 184 203 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 198 217 zwfld(:,:) = emp_b(:,:) - emp(:,:) 199 218 IF ( ln_rnf ) zwfld(:,:) = zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) ) 219 200 220 DO jk = 1, jpkm1 201 221 ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & … … 215 235 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3u(:,:,:,Kmm), 'U' ) 216 236 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), pe3v(:,:,:,Kmm), 'V' ) 217 DO_3D _11_11(1, jpkm1 )237 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 218 238 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 219 239 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 226 246 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3u_f, 'U' ) 227 247 CALL dom_vvl_interpol( pe3t(:,:,:,Kmm), ze3v_f, 'V' ) 228 DO_3D _11_11(1, jpkm1 )248 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 229 249 zue3a = pe3u(ji,jj,jk,Kaa) * puu(ji,jj,jk,Kaa) 230 250 zve3a = pe3v(ji,jj,jk,Kaa) * pvv(ji,jj,jk,Kaa) … … 303 323 ENDIF 304 324 ! 325 IF ( iom_use("utau") ) THEN 326 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 327 ALLOCATE(zutau(jpi,jpj)) 328 DO_2D( 0, 0, 0, 0 ) 329 jk = miku(ji,jj) 330 zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 331 END_2D 332 CALL iom_put( "utau", zutau(:,:) ) 333 DEALLOCATE(zutau) 334 ELSE 335 CALL iom_put( "utau", utau(:,:) ) 336 ENDIF 337 ENDIF 338 ! 339 IF ( iom_use("vtau") ) THEN 340 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 341 ALLOCATE(zvtau(jpi,jpj)) 342 DO_2D( 0, 0, 0, 0 ) 343 jk = mikv(ji,jj) 344 zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa) 345 END_2D 346 CALL iom_put( "vtau", zvtau(:,:) ) 347 DEALLOCATE(zvtau) 348 ELSE 349 CALL iom_put( "vtau", vtau(:,:) ) 350 ENDIF 351 ENDIF 352 ! 305 353 IF(sn_cfctl%l_prtctl) CALL prt_ctl( tab3d_1=puu(:,:,:,Kaa), clinfo1=' nxt - puu(:,:,:,Kaa): ', mask1=umask, & 306 354 & tab3d_2=pvv(:,:,:,Kaa), clinfo2=' pvv(:,:,:,Kaa): ' , mask2=vmask ) … … 312 360 END SUBROUTINE dyn_atf 313 361 362 #endif 363 314 364 !!========================================================================= 315 365 END MODULE dynatf
Note: See TracChangeset
for help on using the changeset viewer.
