- Timestamp:
- 2019-09-30T11:07:57+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_momentum_trends/src/OCE/DYN/dynspg_ts.F90
r10888 r11613 63 63 USE restart ! only for lrst_oce 64 64 USE diatmb ! Top,middle,bottom output 65 USE trd_oce ! trends: ocean variables 66 USE trddyn ! trend manager: dynamics 65 67 66 68 IMPLICIT NONE … … 172 174 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points 173 175 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2 ! averages over the sub-steps of zuwdmask and zvwdmask 176 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv ! SPG and PVO trends (if l_trddyn) 177 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zbfrtrdu, zbfrtrdv ! BFR trends (if l_trddyn) 174 178 !!---------------------------------------------------------------------- 175 179 ! … … 177 181 ! !* Allocate temporary arrays 178 182 IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj)) 183 ! 184 IF( l_trddyn ) THEN 185 ALLOCATE( zspgtrdu(jpi,jpj), zspgtrdv(jpi,jpj), zpvotrdu(jpi,jpj), zpvotrdv(jpi,jpj), zbfrtrdu(jpi,jpj), zbfrtrdv(jpi,jpj) ) 186 zspgtrdu(:,:) = 0._wp 187 zspgtrdv(:,:) = 0._wp 188 zpvotrdu(:,:) = 0._wp 189 zpvotrdv(:,:) = 0._wp 190 zbfrtrdu(:,:) = 0._wp 191 zbfrtrdv(:,:) = 0._wp 192 ENDIF 179 193 ! 180 194 zmdi=1.e+20 ! missing data indicator for masking … … 381 395 !!gm Is it correct to do so ? I think so... 382 396 383 397 384 398 ! !* barotropic Coriolis trends (vorticity scheme dependent) 385 399 ! ! -------------------------------------------------------- … … 387 401 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 388 402 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 403 ! 404 zu_trd(:,:) = 0._wp 405 zv_trd(:,:) = 0._wp 389 406 ! 390 407 SELECT CASE( nvor_scheme ) … … 393 410 DO ji = 2, jpim1 ! vector opt. 394 411 zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj) & 395 & * ( e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) ) &396 & + e1e2t(ji ,jj)*ht_n(ji ,jj)*ff_t(ji ,jj) * ( vn_b(ji ,jj) + vn_b(ji ,jj-1) ) )397 412 & * ( e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) ) & 413 & + e1e2t(ji ,jj)*ht_n(ji ,jj)*ff_t(ji ,jj) * ( vn_b(ji ,jj) + vn_b(ji ,jj-1) ) ) 414 ! 398 415 zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj) & 399 & * ( e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) ) &400 & + e1e2t(ji,jj )*ht_n(ji,jj )*ff_t(ji,jj ) * ( un_b(ji,jj ) + un_b(ji-1,jj ) ) )401 END DO 402 END DO 416 & * ( e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) ) & 417 & + e1e2t(ji,jj )*ht_n(ji,jj )*ff_t(ji,jj ) * ( un_b(ji,jj ) + un_b(ji-1,jj ) ) ) 418 END DO 419 END DO 403 420 ! 404 421 CASE( np_ENE , np_MIX ) ! energy conserving scheme (t-point) ENE or MIX … … 443 460 END SELECT 444 461 ! 462 IF( l_trddyn ) THEN 463 ! send correction to baroclinic planetary vorticity trend to trd_dyn 464 CALL trd_dyn( zu_trd, zv_trd, jpdyn_pvo_corr, kt ) 465 ENDIF 445 466 ! !* Right-Hand-Side of the barotropic momentum equation 446 467 ! ! ---------------------------------------------------- 447 468 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 469 IF( l_trddyn ) THEN 470 zspgtrdu(:,:) = zu_trd(:,:) 471 zspgtrdv(:,:) = zv_trd(:,:) 472 ENDIF 448 473 IF( ln_wd_il ) THEN ! Calculating and applying W/D gravity filters 449 474 DO jj = 2, jpjm1 … … 505 530 END DO 506 531 END DO 532 ENDIF 533 ! 534 IF( l_trddyn ) THEN 535 zspgtrdu(:,:) = zu_trd(:,:) - zspgtrdu(:,:) 536 zspgtrdv(:,:) = zv_trd(:,:) - zspgtrdv(:,:) 537 ! send correction to HPG trend to trd_dyn 538 CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_hpg_corr, kt ) 539 ! reset temporary arrays for use later 540 zspgtrdu(:,:) = 0._wp 541 zspgtrdv(:,:) = 0._wp 507 542 ENDIF 508 543 ! … … 1056 1091 END SELECT 1057 1092 ! 1093 IF( l_trddyn ) THEN 1094 za2 = wgtbtp2(jn) 1095 zpvotrdu(:,:) = zpvotrdu(:,:) + za2 * zu_trd(:,:) * ssumask(:,:) 1096 zpvotrdv(:,:) = zpvotrdv(:,:) + za2 * zv_trd(:,:) * ssvmask(:,:) 1097 ENDIF 1098 ! 1058 1099 ! Add tidal astronomical forcing if defined 1059 1100 IF ( ln_tide .AND. ln_tide_pot ) THEN … … 1077 1118 END DO 1078 1119 END DO 1120 ! 1121 IF( l_trddyn ) THEN 1122 za2 = wgtbtp2(jn) 1123 zbfrtrdu(:,:) = zbfrtrdu(:,:) + za2 * zCdU_u(:,:) * un_e(:,:) * hur_e(:,:) 1124 zbfrtrdv(:,:) = zbfrtrdv(:,:) + za2 * zCdU_v(:,:) * vn_e(:,:) * hvr_e(:,:) 1125 ENDIF 1079 1126 ENDIF 1080 1127 ! … … 1101 1148 END DO 1102 1149 END IF 1103 1150 ! 1151 IF( l_trddyn ) THEN 1152 za2 = wgtbtp2(jn) 1153 zspgtrdu(:,:) = zspgtrdu(:,:) + za2 * zwx(:,:) * ssumask(:,:) 1154 zspgtrdv(:,:) = zspgtrdv(:,:) + za2 * zwy(:,:) * ssvmask(:,:) 1155 ENDIF 1104 1156 ! 1105 1157 ! Set next velocities: … … 1302 1354 IF( ln_wd_il ) DEALLOCATE( zcpx, zcpy ) 1303 1355 IF( ln_wd_dl ) DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 1356 IF( l_trddyn ) THEN 1357 CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_spg, kt ) 1358 CALL trd_dyn( zpvotrdu, zpvotrdv, jpdyn_pvo, kt ) 1359 CALL trd_dyn( zbfrtrdu, zbfrtrdv, jpdyn_bfr, kt ) 1360 DEALLOCATE( zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv, zbfrtrdu, zbfrtrdv ) 1361 ENDIF 1304 1362 ! 1305 1363 IF( ln_diatmb ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
