- Timestamp:
- 2017-04-28T17:39:22+02:00 (7 years ago)
- Location:
- branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r6204 r7988 65 65 INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 66 66 INTEGER :: scales_t_id 67 # if defined key_zdftke 67 # if defined key_zdftke || defined key_zdfgls 68 68 INTEGER :: avt_id, avm_id, en_id 69 69 # endif -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7973 r7988 42 42 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 43 43 PUBLIC interpe3t, interpumsk, interpvmsk 44 # if defined key_zdftke 45 PUBLIC Agrif_ tke, interpavm44 # if defined key_zdftke || defined key_zdfgls 45 PUBLIC Agrif_avm, interpavm 46 46 # endif 47 47 … … 415 415 416 416 ENDIF 417 ! 418 ua(:,:,:) = ua(:,:,:) * umask(:,:,:) 419 va(:,:,:) = va(:,:,:) * vmask(:,:,:) 417 420 ! 418 421 CALL wrk_dealloc( jpi, jpj, spgv1, spgu1 ) … … 576 579 !!---------------------------------------------------------------------- 577 580 581 IF( Agrif_Root() ) RETURN 582 578 583 IF((nbondi == -1).OR.(nbondi == 2)) THEN 579 584 DO jj=1,jpj … … 602 607 END SUBROUTINE Agrif_ssh_ts 603 608 604 # if defined key_zdftke 605 SUBROUTINE Agrif_ tke606 !!---------------------------------------------------------------------- 607 !! *** ROUTINE Agrif_ tke***609 # if defined key_zdftke || defined key_zdfgls 610 SUBROUTINE Agrif_avm 611 !!---------------------------------------------------------------------- 612 !! *** ROUTINE Agrif_avm *** 608 613 !!---------------------------------------------------------------------- 609 614 REAL(wp) :: zalpha 610 615 ! 611 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 612 IF( zalpha > 1. ) zalpha = 1. 616 617 IF( Agrif_Root() ) RETURN 618 619 ! zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 620 ! IF( zalpha > 1. ) zalpha = 1. 621 zalpha = 1._wp ! JC: proper time interpolation impossible 622 ! => use last available value from parent 613 623 614 624 Agrif_SpecialValue = 0.e0 … … 619 629 Agrif_UseSpecialValue = .FALSE. 620 630 ! 621 END SUBROUTINE Agrif_ tke631 END SUBROUTINE Agrif_avm 622 632 # endif 623 633 … … 762 772 ENDIF 763 773 ! 774 DO jn = 1, jpts 775 tsa(:,:,:,jn) = tsa(:,:,:,jn) * tmask(:,:,:) 776 ENDDO 777 ! 764 778 ENDIF 765 779 ! … … 1332 1346 END SUBROUTINE interpvmsk 1333 1347 1334 # if defined key_zdftke 1348 # if defined key_zdftke || defined key_zdfgls 1335 1349 1336 1350 SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) … … 1346 1360 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1347 1361 ELSE 1348 avm _k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1362 avm(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1349 1363 ENDIF 1350 1364 ! 1351 1365 END SUBROUTINE interpavm 1352 1366 1353 # endif /* key_zdftke */1367 # endif /* key_zdftke key_zdfgls */ 1354 1368 1355 1369 #else -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r7977 r7988 228 228 & Agrif_Fixed(), 'Step', Agrif_Nb_Step() 229 229 230 ! Save "old" scale factor (prior update) for subsequent asselin correction 231 ! of prognostic variables (needed to update initial state only) 232 fse3u_a(:,:,:) = fse3u_n(:,:,:) 233 fse3v_a(:,:,:) = fse3v_n(:,:,:) 234 hu_a(:,:) = hu(:,:) 235 hv_a(:,:) = hv(:,:) 236 237 ! Vertical scale factor interpolations 238 ! ------------------------------------ 239 ! 230 240 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' ) 231 241 CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' ) … … 310 320 DO ji=i1,i2 311 321 IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 312 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &313 & + atfp * ( tabres(ji,jj,jk,jn)&314 315 & * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk)322 tsb(ji,jj,jk,jn) = ( tsb(ji,jj,jk,jn)*fse3t_b(ji,jj,jk) & ! jc: should be fse3t_b prior update 323 & + atfp * ( tabres(ji,jj,jk,jn) & 324 & - tsn(ji,jj,jk,jn)*fse3t_a(ji,jj,jk) ) & 325 & * tmask(ji,jj,jk) ) / fse3t_b(ji,jj,jk) 316 326 ENDIF 317 327 ENDDO … … 367 377 ! 368 378 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 369 ub(ji,jj,jk) = ub(ji,jj,jk) &370 & + atfp * ( tabres(ji,jj,jk) & 379 ub(ji,jj,jk) = ( ub(ji,jj,jk)*fse3u_b(ji,jj,jk) & ! jc: should be fse3u_b prior update 380 & + atfp * ( tabres(ji,jj,jk) & 371 381 & - un(ji,jj,jk)*fse3u_a(ji,jj,jk) ) & 372 & * umask(ji,jj,jk) / fse3u_b(ji,jj,jk)382 & * umask(ji,jj,jk) ) / fse3u_b(ji,jj,jk) 373 383 ENDIF 374 384 ! … … 413 423 ! 414 424 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 415 vb(ji,jj,jk) = vb(ji,jj,jk) &425 vb(ji,jj,jk) = ( vb(ji,jj,jk)*fse3v_b(ji,jj,jk) & ! jc: should be fse3v_b prior update 416 426 & + atfp * ( tabres(ji,jj,jk) & 417 427 & - vn(ji,jj,jk)*fse3v_a(ji,jj,jk) ) & 418 & * vmask(ji,jj,jk) / fse3v_b(ji,jj,jk)428 & * vmask(ji,jj,jk) ) / fse3v_b(ji,jj,jk) 419 429 ENDIF 420 430 ! … … 809 819 fsdept_b(i1:i2,j1:j2,1) = 0.5_wp * fse3w_b(i1:i2,j1:j2,1) 810 820 ! 811 DO jk = 2, jpk m1821 DO jk = 2, jpk 812 822 DO jj = j1,j2 813 823 DO ji = i1,i2 … … 823 833 END DO 824 834 END DO 835 ! 825 836 ENDIF 826 837 ! 827 838 ! 2) Updates at now time step: 828 839 ! ---------------------------- 840 ! 841 ! Save "old" scale factor (prior update) for subsequent asselin correction 842 ! of prognostic variables (needed to update initial state only) 843 fse3t_a(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2) 829 844 ! 830 845 ! Update vertical scale factor at T-points: … … 843 858 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 844 859 ! 845 DO jk = 2, jpk m1860 DO jk = 2, jpk 846 861 DO jj = j1,j2 847 862 DO ji = i1,i2 -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7972 r7988 198 198 CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 199 199 ! reset tsa to zero 200 tsa(:,:,:,:) = 0. 200 tsa(:,:,:,:) = 0. !? JC: ?? 201 201 202 202 Agrif_UseSpecialValue = ln_spc_dyn … … 212 212 Agrif_UseSpecialValue = .TRUE. 213 213 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 214 hbdy_w(:) = 0.e0 ; hbdy_e(:) = 0.e0 ; hbdy_n(:) = 0.e0 ; hbdy_s(:) = 0.e0 215 ssha(:,:) = 0.e0 214 216 215 217 #if defined key_dynspg_ts … … 219 221 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 220 222 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 221 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0222 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0223 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0224 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0223 ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 224 ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 225 ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 226 ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 225 227 #endif 226 228 … … 307 309 ! 308 310 ! JC: I am not sure if Agrif_MaxLevel() is the "relative" 309 ! or the absolute maximum nesting level...TBC 310 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 311 ! or the absolute maximum nesting level...TBC 312 nbcline = 0 313 IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 311 314 ! NB: Order matters below: 312 CALL Agrif_Update_vvl()315 IF ( lk_vvl ) CALL Agrif_Update_vvl() 313 316 CALL Agrif_Update_tra() 314 317 CALL Agrif_Update_dyn() … … 320 323 ! 321 324 Agrif_UseSpecialValueInUpdate = .FALSE. 322 nbcline = 0323 325 lk_agrif_doupd = .FALSE. 324 326 ! … … 366 368 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 367 369 368 # if defined key_zdftke 369 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/), en_id)370 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/),avt_id)371 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/ jpi,jpj,jpk/),avm_id)370 # if defined key_zdftke || defined key_zdfgls 371 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 372 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 373 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avm_id) 372 374 # endif 373 375 … … 395 397 CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 396 398 397 # if defined key_zdftke 399 # if defined key_zdftke || defined key_zdfgls 398 400 CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 399 401 # endif … … 423 425 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 424 426 425 # if defined key_zdftke 427 # if defined key_zdftke || defined key_zdfgls 426 428 CALL Agrif_Set_bc(avm_id ,(/0,1/)) 427 429 # endif … … 441 443 CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 442 444 443 # if defined key_zdftke 445 # if defined key_zdftke || defined key_zdfgls 444 446 CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 445 447 CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) … … 457 459 ! CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 458 460 ! CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 459 461 462 ! CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 460 463 ! 461 464 END SUBROUTINE agrif_declare_var … … 657 660 ENDIF 658 661 ENDIF 659 662 nbcline_trc = 0 660 663 CALL Agrif_Update_trc(0) 661 664 ! 662 665 Agrif_UseSpecialValueInUpdate = .FALSE. 663 nbcline_trc = 0664 666 ! 665 667 END SUBROUTINE Agrif_InitValues_cont_top … … 766 768 IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 767 769 IF (nn_sponge_len > iminspon) CALL ctl_stop('agrif sponge length is too large') 770 IF (MOD((nitend-nit000+1), nbclineupdate).NE.0 ) CALL ctl_stop('number of time steps should be a multiple of nn_cln_update') 768 771 ! 769 772 IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
Note: See TracChangeset
for help on using the changeset viewer.