Changeset 14789 for NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynatf_qco.F90
- Timestamp:
- 2021-05-05T13:18:04+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev _r12970_AGRIF_CMEMSext/AGRIF5 ^/vendors/AGRIF/dev@HEAD ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 ^/vendors/PPR@HEAD ext/PPR 8 9 9 10 # SETTE 10 ^/utils/CI/sette@1 3559sette11 ^/utils/CI/sette@14244 sette
-
- Property svn:externals
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/src/OCE/DYN/dynatf_qco.F90
r13295 r14789 1 MODULE dynatf qco1 MODULE dynatf_qco 2 2 !!========================================================================= 3 !! *** MODULE dynatf qco ***3 !! *** MODULE dynatf_qco *** 4 4 !! Ocean dynamics: time filtering 5 5 !!========================================================================= … … 43 43 USE isf_oce , ONLY: ln_isf ! ice shelf 44 44 USE isfdynatf , ONLY: isf_dynatf ! ice shelf volume filter correction subroutine 45 USE zdfdrg , ONLY: ln_drgice_imp, rCdU_top 45 46 ! 46 47 USE in_out_manager ! I/O manager … … 50 51 USE prtctl ! Print control 51 52 USE timing ! Timing 52 #if defined key_agrif53 USE agrif_oce_interp54 #endif55 53 56 54 IMPLICIT NONE … … 69 67 CONTAINS 70 68 71 SUBROUTINE dyn_atf_qco 69 SUBROUTINE dyn_atf_qco( kt, Kbb, Kmm, Kaa, puu, pvv ) 72 70 !!---------------------------------------------------------------------- 73 71 !! *** ROUTINE dyn_atf_qco *** … … 101 99 INTEGER :: ji, jj, jk ! dummy loop indices 102 100 REAL(wp) :: zue3a, zue3n, zue3b, zcoef ! local scalars 103 REAL(wp) :: zve3a, zve3n, zve3b , z1_2dt! - -101 REAL(wp) :: zve3a, zve3n, zve3b ! - - 104 102 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zue, zve 105 103 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zua, zva 104 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zutau, zvtau 106 105 !!---------------------------------------------------------------------- 107 106 ! … … 199 198 ! JC: Would be more clever to swap variables than to make a full vertical 200 199 ! integration 201 ! 200 ! CAUTION : calculation need to be done in the same way than see GM 201 #if defined key_linssh 202 202 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 203 203 uu_b(:,:,Kmm) = e3u(:,:,1,Kmm) * puu(:,:,1,Kmm) * umask(:,:,1) … … 214 214 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 215 215 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 216 #else 217 uu_b(:,:,Kaa) = e3u(:,:,1,Kaa) * puu(:,:,1,Kaa) * umask(:,:,1) 218 uu_b(:,:,Kmm) = (e3u_0(:,:,1) * ( 1._wp + r3u_f(:,:) * umask(:,:,1) )) * puu(:,:,1,Kmm) * umask(:,:,1) 219 vv_b(:,:,Kaa) = e3v(:,:,1,Kaa) * pvv(:,:,1,Kaa) * vmask(:,:,1) 220 vv_b(:,:,Kmm) = (e3v_0(:,:,1) * ( 1._wp + r3v_f(:,:) * vmask(:,:,1))) * pvv(:,:,1,Kmm) * vmask(:,:,1) 221 DO jk = 2, jpkm1 222 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) + e3u(:,:,jk,Kaa) * puu(:,:,jk,Kaa) * umask(:,:,jk) 223 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + (e3u_0(:,:,jk) * ( 1._wp + r3u_f(:,:) * umask(:,:,jk) )) * puu(:,:,jk,Kmm) * umask(:,:,jk) 224 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 225 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + (e3v_0(:,:,jk) * ( 1._wp + r3v_f(:,:) * vmask(:,:,jk) )) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 226 END DO 227 uu_b(:,:,Kaa) = uu_b(:,:,Kaa) * r1_hu(:,:,Kaa) 228 vv_b(:,:,Kaa) = vv_b(:,:,Kaa) * r1_hv(:,:,Kaa) 229 uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * (r1_hu_0(:,:)/( 1._wp + r3u_f(:,:) )) 230 vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * (r1_hv_0(:,:)/( 1._wp + r3v_f(:,:) )) 231 #endif 216 232 ! 217 233 IF( .NOT.ln_dynspg_ts ) THEN ! output the barotropic currents … … 220 236 ENDIF 221 237 IF( l_trddyn ) THEN ! 3D output: asselin filter trends on momentum 222 zua(:,:,:) = ( puu(:,:,:,Kmm) - zua(:,:,:) ) * z1_2dt223 zva(:,:,:) = ( pvv(:,:,:,Kmm) - zva(:,:,:) ) * z1_2dt238 zua(:,:,:) = ( puu(:,:,:,Kmm) - zua(:,:,:) ) * r1_Dt 239 zva(:,:,:) = ( pvv(:,:,:,Kmm) - zva(:,:,:) ) * r1_Dt 224 240 CALL trd_dyn( zua, zva, jpdyn_atf, kt, Kmm ) 241 ENDIF 242 ! 243 IF ( iom_use("utau") ) THEN 244 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 245 ALLOCATE(zutau(jpi,jpj)) 246 DO_2D( 0, 0, 0, 0 ) 247 jk = miku(ji,jj) 248 zutau(ji,jj) = utau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * puu(ji,jj,jk,Kaa) 249 END_2D 250 CALL iom_put( "utau", zutau(:,:) ) 251 DEALLOCATE(zutau) 252 ELSE 253 CALL iom_put( "utau", utau(:,:) ) 254 ENDIF 255 ENDIF 256 ! 257 IF ( iom_use("vtau") ) THEN 258 IF ( ln_drgice_imp.OR.ln_isfcav ) THEN 259 ALLOCATE(zvtau(jpi,jpj)) 260 DO_2D( 0, 0, 0, 0 ) 261 jk = mikv(ji,jj) 262 zvtau(ji,jj) = vtau(ji,jj) + 0.5_wp * rho0 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * pvv(ji,jj,jk,Kaa) 263 END_2D 264 CALL iom_put( "vtau", zvtau(:,:) ) 265 DEALLOCATE(zvtau) 266 ELSE 267 CALL iom_put( "vtau", vtau(:,:) ) 268 ENDIF 225 269 ENDIF 226 270 ! … … 235 279 236 280 !!========================================================================= 237 END MODULE dynatf qco281 END MODULE dynatf_qco
Note: See TracChangeset
for help on using the changeset viewer.