Changeset 7971 for branches/2017
- Timestamp:
- 2017-04-26T12:03:26+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r6204 r7971 137 137 DO jk=1,jpkm1 138 138 DO jj=1,jpj 139 spgu(2,jj)=spgu(2,jj)+fse3u (2,jj,jk)*ua(2,jj,jk)139 spgu(2,jj)=spgu(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 140 140 END DO 141 141 END DO … … 143 143 DO jj=1,jpj 144 144 IF (umask(2,jj,1).NE.0.) THEN 145 spgu(2,jj)=spgu(2,jj) /hu(2,jj)145 spgu(2,jj)=spgu(2,jj)*hur_a(2,jj) 146 146 ENDIF 147 147 END DO … … 161 161 DO jk=1,jpkm1 162 162 DO jj=1,jpj 163 spgu1(2,jj)=spgu1(2,jj)+fse3u (2,jj,jk)*ua(2,jj,jk)163 spgu1(2,jj)=spgu1(2,jj)+fse3u_a(2,jj,jk)*ua(2,jj,jk) 164 164 END DO 165 165 END DO … … 167 167 DO jj=1,jpj 168 168 IF (umask(2,jj,1).NE.0.) THEN 169 spgu1(2,jj)=spgu1(2,jj) /hu(2,jj)169 spgu1(2,jj)=spgu1(2,jj)*hur_a(2,jj) 170 170 ENDIF 171 171 END DO … … 207 207 DO jk=1,jpkm1 208 208 DO jj=1,jpj 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u (nlci-2,jj,jk)*ua(nlci-2,jj,jk)209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 210 210 ENDDO 211 211 ENDDO 212 212 DO jj=1,jpj 213 213 IF (umask(nlci-2,jj,1).NE.0.) THEN 214 spgu(nlci-2,jj)=spgu(nlci-2,jj) /hu(nlci-2,jj)214 spgu(nlci-2,jj)=spgu(nlci-2,jj)*hur_a(nlci-2,jj) 215 215 ENDIF 216 216 END DO … … 229 229 DO jk=1,jpkm1 230 230 DO jj=1,jpj 231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u (nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk)231 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u_a(nlci-2,jj,jk)*ua(nlci-2,jj,jk)*umask(nlci-2,jj,jk) 232 232 END DO 233 233 END DO 234 234 DO jj=1,jpj 235 235 IF (umask(nlci-2,jj,1).NE.0.) THEN 236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj) /hu(nlci-2,jj)236 spgu1(nlci-2,jj)=spgu1(nlci-2,jj)*hur_a(nlci-2,jj) 237 237 ENDIF 238 238 END DO … … 278 278 DO jk=1,jpkm1 279 279 DO ji=1,jpi 280 spgv(ji,2)=spgv(ji,2)+fse3v (ji,2,jk)*va(ji,2,jk)280 spgv(ji,2)=spgv(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk) 281 281 END DO 282 282 END DO … … 284 284 DO ji=1,jpi 285 285 IF (vmask(ji,2,1).NE.0.) THEN 286 spgv(ji,2)=spgv(ji,2) /hv(ji,2)286 spgv(ji,2)=spgv(ji,2)*hvr_a(ji,2) 287 287 ENDIF 288 288 END DO … … 302 302 DO jk=1,jpkm1 303 303 DO ji=1,jpi 304 spgv1(ji,2)=spgv1(ji,2)+fse3v (ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk)304 spgv1(ji,2)=spgv1(ji,2)+fse3v_a(ji,2,jk)*va(ji,2,jk)*vmask(ji,2,jk) 305 305 END DO 306 306 END DO … … 308 308 DO ji=1,jpi 309 309 IF (vmask(ji,2,1).NE.0.) THEN 310 spgv1(ji,2)=spgv1(ji,2) /hv(ji,2)310 spgv1(ji,2)=spgv1(ji,2)*hvr_a(ji,2) 311 311 ENDIF 312 312 END DO … … 353 353 DO jk=1,jpkm1 354 354 DO ji=1,jpi 355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v (ji,nlcj-2,jk)*va(ji,nlcj-2,jk)355 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 356 356 END DO 357 357 END DO … … 359 359 DO ji=1,jpi 360 360 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2) /hv(ji,nlcj-2)361 spgv(ji,nlcj-2)=spgv(ji,nlcj-2)*hvr_a(ji,nlcj-2) 362 362 ENDIF 363 363 END DO … … 378 378 DO jk=1,jpkm1 379 379 DO ji=1,jpi 380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v (ji,nlcj-2,jk)*va(ji,nlcj-2,jk)380 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v_a(ji,nlcj-2,jk)*va(ji,nlcj-2,jk) 381 381 END DO 382 382 END DO … … 384 384 DO ji=1,jpi 385 385 IF (vmask(ji,nlcj-2,1).NE.0.) THEN 386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2) /hv(ji,nlcj-2)386 spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)*hvr_a(ji,nlcj-2) 387 387 ENDIF 388 388 END DO … … 503 503 zt = REAL(Agrif_NbStepint(),wp) / zrhot 504 504 ENDIF 505 506 ! Linear interpolation of sea level507 Agrif_SpecialValue = 0.e0508 Agrif_UseSpecialValue = .TRUE.509 CALL Agrif_Bc_variable(sshn_id,calledweight=zt, procname=interpsshn )510 Agrif_UseSpecialValue = .FALSE.511 505 512 506 ! Interpolate barotropic fluxes … … 539 533 SUBROUTINE Agrif_ssh( kt ) 540 534 !!---------------------------------------------------------------------- 541 !! *** ROUTINE Agrif_ DYN***535 !! *** ROUTINE Agrif_ssh *** 542 536 !!---------------------------------------------------------------------- 543 537 INTEGER, INTENT(in) :: kt 544 538 !! 539 INTEGER :: ji, jj 545 540 !!---------------------------------------------------------------------- 546 541 547 542 IF( Agrif_Root() ) RETURN 548 543 544 ! Linear interpolation of sea level 545 Agrif_SpecialValue = 0.e0 546 Agrif_UseSpecialValue = .TRUE. 547 CALL Agrif_Bc_variable(sshn_id, procname=interpsshn ) 548 Agrif_UseSpecialValue = .FALSE. 549 549 550 IF((nbondi == -1).OR.(nbondi == 2)) THEN 550 ssha(2,:)=ssha(3,:) 551 sshn(2,:)=sshn(3,:) 551 DO jj=1,jpj 552 ssha(2,jj) = hbdy_w(jj) 553 END DO 552 554 ENDIF 553 555 554 556 IF((nbondi == 1).OR.(nbondi == 2)) THEN 555 ssha(nlci-1,:)=ssha(nlci-2,:) 556 sshn(nlci-1,:)=sshn(nlci-2,:) 557 DO jj=1,jpj 558 ssha(nlci-1,jj) = hbdy_e(jj) 559 END DO 557 560 ENDIF 558 561 559 562 IF((nbondj == -1).OR.(nbondj == 2)) THEN 560 ssha(:,2)=ssha(:,3) 561 sshn(:,2)=sshn(:,3) 563 DO ji=1,jpi 564 ssha(ji,2) = hbdy_s(ji) 565 END DO 562 566 ENDIF 563 567 564 568 IF((nbondj == 1).OR.(nbondj == 2)) THEN 565 ssha(:,nlcj-1)=ssha(:,nlcj-2) 566 sshn(:,nlcj-1)=sshn(:,nlcj-2) 569 DO ji=1,jpi 570 ssha(ji,nlcj-1) = hbdy_n(ji) 571 END DO 567 572 ENDIF 568 573 … … 812 817 DO ji=i1,i2 813 818 ptab(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 814 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u (ji,jj,jk)819 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3u_n(ji,jj,jk) 815 820 END DO 816 821 END DO … … 821 826 DO jj=j1,j2 822 827 ua(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj))) 823 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u (i1:i2,jj,jk)828 ua(i1:i2,jj,jk) = ua(i1:i2,jj,jk) / fse3u_a(i1:i2,jj,jk) 824 829 END DO 825 830 END DO … … 880 885 DO ji=i1,i2 881 886 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 882 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v (ji,jj,jk)887 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v_n(ji,jj,jk) 883 888 END DO 884 889 END DO … … 889 894 DO jj=j1,j2 890 895 va(i1:i2,jj,jk) = (ptab(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj))) 891 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v (i1:i2,jj,jk)896 va(i1:i2,jj,jk) = va(i1:i2,jj,jk) / fse3v_a(i1:i2,jj,jk) 892 897 END DO 893 898 END DO … … 1110 1115 ! Polynomial interpolation coefficients: 1111 1116 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1112 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) )1117 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1113 1118 ! 1114 1119 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) … … 1151 1156 ! Polynomial interpolation coefficients: 1152 1157 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1153 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) )1158 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1154 1159 ! 1155 1160 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r6204 r7971 13 13 USE dynspg_oce 14 14 USE zdf_oce ! vertical physics: ocean variables 15 USE domvvl ! Need interpolation routines 15 16 16 17 IMPLICIT NONE 17 18 PRIVATE 18 19 19 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn,Update_Scales 20 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales, Agrif_Update_vvl 21 20 22 # if defined key_zdftke 21 23 PUBLIC Agrif_Update_Tke … … 177 179 # endif /* key_zdftke */ 178 180 181 RECURSIVE SUBROUTINE Agrif_Update_vvl( ) 182 !!--------------------------------------------- 183 !! *** ROUTINE Agrif_Update_vvl *** 184 !!--------------------------------------------- 185 ! 186 IF (Agrif_Root()) RETURN 187 ! 188 #if defined TWO_WAY 189 ! 190 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step() 191 ! 192 Agrif_UseSpecialValueInUpdate = .FALSE. 193 Agrif_SpecialValueFineGrid = 0. 194 ! 195 # if ! defined DECAL_FEEDBACK 196 CALL Agrif_Update_Variable(e3t_id, procname=updatee3t) 197 # else 198 CALL Agrif_Update_Variable(e3t_id, locupdate=(/1,0/), procname=updatee3t) 199 # endif 200 ! 201 Agrif_UseSpecialValueInUpdate = .FALSE. 202 ! 203 CALL Agrif_ChildGrid_To_ParentGrid() 204 CALL dom_vvl_update_UVF 205 CALL Agrif_ParentGrid_To_ChildGrid() 206 ! 207 IF ( lk_agrif_doupd ) THEN ! Initialisation: do recursive update: 208 CALL Agrif_ChildGrid_To_ParentGrid() 209 CALL Agrif_Update_vvl() 210 CALL Agrif_ParentGrid_To_ChildGrid() 211 ENDIF 212 ! 213 #endif 214 ! 215 END SUBROUTINE Agrif_Update_vvl 216 217 SUBROUTINE dom_vvl_update_UVF 218 !!--------------------------------------------- 219 !! *** ROUTINE dom_vvl_update_UVF *** 220 !!--------------------------------------------- 221 # include "domzgr_substitute.h90" 222 !! 223 INTEGER :: jk 224 REAL(wp):: zcoef 225 !!--------------------------------------------- 226 227 IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', & 228 & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 229 230 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 231 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) 232 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' ) 233 234 CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' ) 235 CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' ) 236 237 ! Update total depths: 238 hu(:,:) = 0._wp ! Ocean depth at U-points 239 hv(:,:) = 0._wp ! Ocean depth at V-points 240 DO jk = 1, jpkm1 241 hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk) 242 hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk) 243 END DO 244 ! ! Inverse of the local depth 245 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 246 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 247 248 #if ! defined key_dynspg_ts 249 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 250 #else 251 IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN 252 #endif 253 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' ) 254 CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' ) 255 256 CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' ) 257 CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' ) 258 259 hu_b(:,:) = 0._wp ! Ocean depth at U-points 260 hv_b(:,:) = 0._wp ! Ocean depth at V-points 261 DO jk = 1, jpkm1 262 hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) 263 hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) 264 END DO 265 ! ! Inverse of the local depth 266 hur_b(:,:) = 1._wp / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:) 267 hvr_b(:,:) = 1._wp / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:) 268 ENDIF 269 270 ! 271 END SUBROUTINE dom_vvl_update_UVF 272 179 273 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 180 274 !!--------------------------------------------- 181 275 !! *** ROUTINE updateT *** 182 276 !!--------------------------------------------- 183 # include "domzgr_substitute.h90"184 277 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 185 278 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 188 281 INTEGER :: ji,jj,jk,jn 189 282 !!--------------------------------------------- 283 ! 190 284 ! 191 285 IF (before) THEN … … 194 288 DO jj=j1,j2 195 289 DO ji=i1,i2 196 tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 290 !> jc tmp 291 tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 292 ! tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) * fse3t_n(ji,jj,jk) 293 !< jc tmp 197 294 END DO 198 295 END DO … … 200 297 END DO 201 298 ELSE 299 !> jc tmp 300 DO jn = n1,n2 301 tabres(i1:i2,j1:j2,k1:k2,jn) = tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) 302 ENDDO 303 !< jc tmp 304 202 305 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 203 306 ! Add asselin part … … 209 312 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 210 313 & + atfp * ( tabres(ji,jj,jk,jn) & 211 & - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 314 & - tsn(ji,jj,jk,jn)*fse3t_a(ji,jj,jk) ) & 315 & * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk) 212 316 ENDIF 213 317 ENDDO … … 221 325 DO ji=i1,i2 222 326 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 223 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 327 #if defined key_vvl 328 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / fse3t_n(ji,jj,jk) 329 #else 330 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) 331 #endif 224 332 END IF 225 333 END DO … … 260 368 DO jj=j1,j2 261 369 DO ji=i1,i2 262 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk)370 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) 263 371 ! 264 372 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 265 373 ub(ji,jj,jk) = ub(ji,jj,jk) & 266 & + atfp * ( tabres(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 374 & + atfp * ( tabres(ji,jj,jk) & 375 & - un(ji,jj,jk)*fse3u_a(ji,jj,jk) ) & 376 & * umask(ji,jj,jk) / fse3u_b(ji,jj,jk) 267 377 ENDIF 268 378 ! 269 un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) 379 un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) / fse3u_n(ji,jj,jk) 270 380 END DO 271 381 END DO … … 304 414 DO jj=j1,j2 305 415 DO ji=i1,i2 306 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk)416 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) 307 417 ! 308 418 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 309 419 vb(ji,jj,jk) = vb(ji,jj,jk) & 310 & + atfp * ( tabres(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 420 & + atfp * ( tabres(ji,jj,jk) & 421 & - vn(ji,jj,jk)*fse3v_a(ji,jj,jk) ) & 422 & * vmask(ji,jj,jk) / fse3v_b(ji,jj,jk) 311 423 ENDIF 312 424 ! 313 vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) 425 vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) / fse3v_n(ji,jj,jk) 314 426 END DO 315 427 END DO … … 345 457 DO jj=j1,j2 346 458 DO ji=i1,i2 347 tabres(ji,jj) = tabres(ji,jj) * hur(ji,jj)/ e2u(ji,jj)459 tabres(ji,jj) = tabres(ji,jj) / e2u(ji,jj) 348 460 ! 349 461 ! Update "now" 3d velocities: … … 352 464 spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk) 353 465 END DO 354 spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)355 466 ! 356 zcorr = tabres(ji,jj) - spgu(ji,jj)467 zcorr = (tabres(ji,jj) - spgu(ji,jj)) * hur(ji,jj) 357 468 DO jk=1,jpkm1 358 469 un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk) … … 360 471 ! 361 472 ! Update barotropic velocities: 362 #if defined key_dynspg_ts 363 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 364 zcorr = tabres(ji,jj) - un_b(ji,jj) 473 #if ! defined key_dynspg_ts 474 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 475 #else 476 IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN 477 #endif 478 zcorr = (tabres(ji,jj) - un_b(ji,jj) * hu_a(ji,jj)) * hur_b(ji,jj) 365 479 ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 366 END IF 367 #endif 368 un_b(ji,jj) = tabres(ji,jj) * umask(ji,jj,1) 480 END IF 481 un_b(ji,jj) = tabres(ji,jj) * hur(ji,jj) * umask(ji,jj,1) 369 482 ! 370 483 ! Correct "before" velocities to hold correct bt component: … … 373 486 spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk) 374 487 END DO 375 spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)376 488 ! 377 zcorr = ub_b(ji,jj) - spgu(ji,jj) 489 zcorr = ub_b(ji,jj) - spgu(ji,jj) * hur_b(ji,jj) 378 490 DO jk=1,jpkm1 379 491 ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk) … … 410 522 DO jj=j1,j2 411 523 DO ji=i1,i2 412 tabres(ji,jj) = tabres(ji,jj) * hvr(ji,jj)/ e1v(ji,jj)524 tabres(ji,jj) = tabres(ji,jj) / e1v(ji,jj) 413 525 ! 414 526 ! Update "now" 3d velocities: … … 417 529 spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk) 418 530 END DO 419 spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)420 531 ! 421 zcorr = tabres(ji,jj) - spgv(ji,jj)532 zcorr = (tabres(ji,jj) - spgv(ji,jj)) * hvr(ji,jj) 422 533 DO jk=1,jpkm1 423 534 vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk) … … 425 536 ! 426 537 ! Update barotropic velocities: 427 #if defined key_dynspg_ts 428 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 429 zcorr = tabres(ji,jj) - vn_b(ji,jj) 538 #if ! defined key_dynspg_ts 539 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 540 #else 541 IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN 542 #endif 543 zcorr = (tabres(ji,jj) - vn_b(ji,jj)*hv_a(ji,jj)) * hvr_b(ji,jj) 430 544 vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 431 END IF 432 #endif 433 vn_b(ji,jj) = tabres(ji,jj) * vmask(ji,jj,1) 545 END IF 546 vn_b(ji,jj) = tabres(ji,jj) * hvr(ji,jj) * vmask(ji,jj,1) 434 547 ! 435 548 ! Correct "before" velocities to hold correct bt component: … … 438 551 spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk) 439 552 END DO 440 spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)441 553 ! 442 zcorr = vb_b(ji,jj) - spgv(ji,jj) 554 zcorr = vb_b(ji,jj) - spgv(ji,jj) * hvr_b(ji,jj) 443 555 DO jk=1,jpkm1 444 556 vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk) … … 471 583 ELSE 472 584 #if ! defined key_dynspg_ts 473 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 585 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 586 #else 587 IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN 588 #endif 474 589 DO jj=j1,j2 475 590 DO ji=i1,i2 … … 479 594 END DO 480 595 ENDIF 481 #endif 596 ! 482 597 DO jj=j1,j2 483 598 DO ji=i1,i2 … … 655 770 # endif /* key_zdftke */ 656 771 772 SUBROUTINE updatee3t( ptab, i1, i2, j1, j2, k1, k2, before ) 773 !!--------------------------------------------- 774 !! *** ROUTINE updatee3t *** 775 !!--------------------------------------------- 776 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 777 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 778 LOGICAL, INTENT(in) :: before 779 INTEGER :: ji,jj,jk 780 REAL(wp) :: zcoef 781 !!--------------------------------------------- 782 ! 783 IF (before) THEN 784 !> jc tmp: 785 ! ptab(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2) 786 ptab(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2) / e3t_0(i1:i2,j1:j2,k1:k2) 787 !< jc tmp: 788 ELSE 789 ! 790 ! 1) Updates at before time step: 791 ! ------------------------------- 792 ! 793 !> jc tmp: 794 ptab(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 795 !< jc tmp: 796 797 #if ! defined key_dynspg_ts 798 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 799 #else 800 IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN 801 #endif 802 DO jk = 1, jpkm1 803 DO jj=j1,j2 804 DO ji=i1,i2 805 fse3t_b(ji,jj,jk) = fse3t_b(ji,jj,jk) & 806 & + atfp * ( ptab(ji,jj,jk) - fse3t_n(ji,jj,jk) ) 807 END DO 808 END DO 809 END DO 810 ! 811 fse3w_b (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + fse3t_b(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 812 fsdepw_b(i1:i2,j1:j2,1) = 0.0_wp 813 fsdept_b(i1:i2,j1:j2,1) = 0.5_wp * fse3w_b(i1:i2,j1:j2,1) 814 ! 815 DO jk = 2, jpkm1 816 DO jj = j1,j2 817 DO ji = i1,i2 818 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 819 fse3w_b(ji,jj,jk) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * & 820 & ( fse3t_b(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) ) & 821 & + 0.5_wp * tmask(ji,jj,jk) * & 822 & ( fse3t_b(ji,jj,jk ) - e3t_0(ji,jj,jk ) ) 823 fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1) 824 fsdept_b(ji,jj,jk) = zcoef * ( fsdepw_b(ji,jj,jk ) + 0.5 * fse3w_b(ji,jj,jk)) & 825 & + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) + fse3w_b(ji,jj,jk)) 826 END DO 827 END DO 828 END DO 829 ENDIF 830 ! 831 ! 2) Updates at now time step: 832 ! ---------------------------- 833 ! 834 ! Update vertical scale factor at T-points: 835 fse3t_n(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) 836 ! 837 ! Update total depth: 838 ht(i1:i2,j1:j2) = 0._wp 839 DO jk = 1, jpkm1 840 ht(i1:i2,j1:j2) = ht(i1:i2,j1:j2) + fse3t_n(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk) 841 END DO 842 ! 843 ! Update vertical scale factor at W-points and depths: 844 fse3w_n (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + fse3t_n(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 845 fsdept_n(i1:i2,j1:j2,1) = 0.5_wp * fse3w_n(i1:i2,j1:j2,1) 846 fsdepw_n(i1:i2,j1:j2,1) = 0.0_wp 847 fsde3w_n(i1:i2,j1:j2,1) = fsdept_n(i1:i2,j1:j2,1) - (ht(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh 848 ! 849 DO jk = 2, jpkm1 850 DO jj = j1,j2 851 DO ji = i1,i2 852 zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 853 fse3w_n(ji,jj,jk) = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( fse3t_n(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) ) & 854 & + 0.5_wp * tmask(ji,jj,jk) * ( fse3t_n(ji,jj,jk ) - e3t_0(ji,jj,jk ) ) 855 fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1) 856 fsdept_n(ji,jj,jk) = zcoef * ( fsdepw_n(ji,jj,jk ) + 0.5 * fse3w_n(ji,jj,jk)) & 857 & + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) + fse3w_n(ji,jj,jk)) 858 fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - (ht(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 859 END DO 860 END DO 861 END DO 862 ! 863 ENDIF 864 ! 865 END SUBROUTINE updatee3t 866 657 867 #else 658 868 CONTAINS -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r6204 r7971 309 309 ! or the absolute maximum nesting level...TBC 310 310 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 311 ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 311 ! NB: Order matters below: 312 CALL Agrif_Update_vvl() 312 313 CALL Agrif_Update_tra() 313 314 CALL Agrif_Update_dyn() … … 445 446 CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 446 447 # endif 448 449 CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 447 450 448 451 ! High order updates -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6348 r7971 1006 1006 1007 1007 #if defined key_agrif 1008 IF ( .NOT.Agrif_Root()) CALL ctl_stop( 'AGRIF not implemented with non-linear free surface(key_vvl)' )1008 IF ((.NOT.Agrif_Root()).AND.(.NOT.ln_vvl_zstar)) CALL ctl_stop( 'AGRIF implemented with zstar coordinate only (key_vvl)' ) 1009 1009 #endif 1010 1010 -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/step.F90
r7494 r7971 350 350 351 351 IF ( Agrif_NbStepint().EQ.0 ) THEN 352 IF( lk_vvl ) CALL Agrif_Update_vvl() ! Update vert. grid 352 353 CALL Agrif_Update_Tra() ! Update active tracers 353 354 CALL Agrif_Update_Dyn() ! Update momentum
Note: See TracChangeset
for help on using the changeset viewer.