Changeset 7988
- Timestamp:
- 2017-04-28T17:39:22+02:00 (8 years ago)
- Location:
- branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO
- Files:
-
- 6 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') -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r6204 r7988 31 31 USE iom ! I/O manager library 32 32 USE timing ! Timing 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 #if defined key_agrif 35 USE agrif_opa_interp ! Set bc on avm 36 #endif 34 37 35 38 IMPLICIT NONE … … 204 207 DO jj = 2, jpjm1 205 208 DO ji = fs_2, fs_jpim1 ! vector opt. 206 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) &207 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) &208 & / ( fse3uw_n(ji,jj,jk) &209 & * fse3uw_b(ji,jj,jk) )210 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) &211 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) &212 & / ( fse3vw_n(ji,jj,jk) &213 & * fse3vw_b(ji,jj,jk) )209 avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 210 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 211 & / ( fse3uw_n(ji,jj,jk) & 212 & * fse3uw_b(ji,jj,jk) ) 213 avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 214 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & 215 & / ( fse3vw_n(ji,jj,jk) & 216 & * fse3vw_b(ji,jj,jk) ) 214 217 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT(en(ji,jj,jk)) / mxln(ji,jj,jk) 215 218 END DO … … 809 812 ! 810 813 ! Lateral boundary conditions (sign unchanged) 814 #if defined key_agrif 815 CALL Agrif_avm 816 #endif 811 817 avt(:,:,1) = 0._wp 812 818 CALL lbc_lnk( avm, 'W', 1. ) ; CALL lbc_lnk( avt, 'W', 1. ) -
branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r7785 r7988 192 192 #if defined key_agrif 193 193 ! Update child grid f => parent grid 194 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 194 !!! JC: suppress update since this hampers restartability 195 !!! IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 195 196 #endif 196 197 ! … … 659 660 END DO 660 661 END DO 662 663 #if defined key_agrif 664 CALL Agrif_avm 665 #endif 661 666 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 662 667 !
Note: See TracChangeset
for help on using the changeset viewer.