Changeset 8866
- Timestamp:
- 2017-12-01T07:22:09+01:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8863 r8866 4 4 !! AGRIF: interpolation package for the ocean dynamics (OPA) 5 5 !!====================================================================== 6 !! History : 2.0 ! 2002-06 (XXX) Original cade 7 !! - ! 2005-11 (XXX) 6 !! History : 2.0 ! 2002-06 (L. Debreu) Original cade 8 7 !! 3.2 ! 2009-04 (R. Benshila) 9 8 !! 3.6 ! 2014-09 (R. Benshila) … … 15 14 !! Agrif_tra : 16 15 !! Agrif_dyn : 16 !! Agrif_ssh : 17 !! Agrif_dyn_ts : 18 !! Agrif_dta_ts : 19 !! Agrif_ssh_ts : 20 !! Agrif_avm : 17 21 !! interpu : 18 22 !! interpv : … … 37 41 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 38 42 PUBLIC interpe3t, interpumsk, interpvmsk 39 PUBLIC Agrif_ tke, interpavm43 PUBLIC Agrif_avm, interpavm 40 44 41 45 INTEGER :: bdy_tinterp = 0 … … 595 599 596 600 597 SUBROUTINE Agrif_ tke598 !!---------------------------------------------------------------------- 599 !! *** ROUTINE Agrif_ tke***601 SUBROUTINE Agrif_avm 602 !!---------------------------------------------------------------------- 603 !! *** ROUTINE Agrif_avm *** 600 604 !!---------------------------------------------------------------------- 601 605 REAL(wp) :: zalpha 602 606 !!---------------------------------------------------------------------- 603 607 ! 604 zalpha = 1._wp ! JC: proper time interpolation impossible 605 ! => use last available value from parent 606 ! 607 Agrif_SpecialValue = 0.e0 608 zalpha = 1._wp ! proper time interpolation impossible ==> use last available value from parent 609 ! 610 Agrif_SpecialValue = 0._wp 608 611 Agrif_UseSpecialValue = .TRUE. 609 612 ! 610 CALL Agrif_Bc_variable( avm_id ,calledweight=zalpha, procname=interpavm)613 CALL Agrif_Bc_variable( avm_id, calledweight=zalpha, procname=interpavm ) 611 614 ! 612 615 Agrif_UseSpecialValue = .FALSE. 613 616 ! 614 END SUBROUTINE Agrif_ tke617 END SUBROUTINE Agrif_avm 615 618 616 619 … … 630 633 !!---------------------------------------------------------------------- 631 634 ! 632 IF (before) THEN635 IF( before ) THEN 633 636 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 634 637 ELSE 635 638 ! 636 western_side = (nb == 1).AND.(ndir == 1) ;eastern_side = (nb == 1).AND.(ndir == 2)637 southern_side = (nb == 2).AND.(ndir == 1) ;northern_side = (nb == 2).AND.(ndir == 2)639 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 640 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 638 641 ! 639 642 IF( nbghostcells > 1 ) THEN ! no smoothing -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r8586 r8866 7 7 !! AGRIF: update package for the ocean dynamics (OPA) 8 8 !!====================================================================== 9 !! History : 2.0 ! 2002-06 (XXX) Original cade 10 !! - ! 2005-11 (XXX) 9 !! History : 2.0 ! 2002-06 (L. Debreu) Original code 11 10 !! 3.2 ! 2009-04 (R. Benshila) 12 11 !! 3.6 ! 2014-09 (R. Benshila) … … 29 28 30 29 PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales 31 PUBLIC Agrif_Update_Tke32 30 33 31 !!---------------------------------------------------------------------- … … 160 158 END SUBROUTINE Agrif_Update_Dyn 161 159 162 !!gm Missing GLS case !!!!!163 164 SUBROUTINE Agrif_Update_Tke( kt )165 !!----------------------------------------------------------------------166 !! *** ROUTINE Agrif_Update_Tke ***167 !!----------------------------------------------------------------------168 INTEGER, INTENT(in) :: kt ! timestep index169 !!----------------------------------------------------------------------170 !171 !!gm test on kt/=0 ???? why not nit000-1 ? doesn't seem logic172 IF( ( Agrif_NbStepint() /= 0 ) .AND. kt /= 0 ) RETURN173 # if defined TWO_WAY174 !175 Agrif_UseSpecialValueInUpdate = .TRUE.176 Agrif_SpecialValueFineGrid = 0._wp177 !178 CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN )179 CALL Agrif_Update_Variable( avt_id, locupdate=(/0,0/), procname=updateAVT )180 CALL Agrif_Update_Variable( avm_id, locupdate=(/0,0/), procname=updateAVM )181 !182 Agrif_UseSpecialValueInUpdate = .FALSE.183 !184 # endif185 !186 END SUBROUTINE Agrif_Update_Tke187 188 160 189 161 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) … … 215 187 DO jj = j1, j2 216 188 DO ji = i1, i2 217 IF( tabres(ji,jj,jk,jn) .NE. 0.) THEN189 IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 218 190 tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) & 219 191 & + atfp * ( tabres(ji,jj,jk,jn) - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) … … 228 200 DO jj=j1,j2 229 201 DO ji=i1,i2 230 IF( tabres(ji,jj,jk,jn) .NE. 0.) THEN202 IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 231 203 tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 232 204 END IF -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfphy.F90
r8863 r8866 28 28 USE sbcrnf ! surface boundary condition: runoff variables 29 29 #if defined key_agrif 30 USE agrif_opa_interp 30 USE agrif_opa_interp ! interpavm 31 31 #endif 32 32 ! … … 279 279 280 280 #if defined key_agrif 281 ! interpolation parent grid => child grid for avm_k ( ex : at west border: 282 ! update column 1 and 2) 283 CALL Agrif_tke 281 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 282 IF( l_zdfsh2 ) CALL Agrif_avm 284 283 #endif 285 284 286 285 ! !* Lateral boundary conditions (sign unchanged) 287 CALL lbc_lnk( avm_k, 'W', 1. ) ! needed to compute the shear production term 288 CALL lbc_lnk( avt_k, 'W', 1. ) !!gm a priori useless ==>> to be tested 286 IF( l_zdfsh2 ) THEN 287 CALL lbc_lnk( avm_k, 'W', 1. ) ! needed to compute the shear production term 288 CALL lbc_lnk( avt_k, 'W', 1. ) !!gm a priori useless ==>> to be tested 289 ENDIF 289 290 CALL lbc_lnk( avm , 'W', 1. ) ! needed to compute avm at u- and v-points 290 291 CALL lbc_lnk( avt , 'W', 1. ) !!gm a priori only avm_k and avm are required 291 CALL lbc_lnk( avs , 'W', 1. ) !!gm To be tested292 CALL lbc_lnk( avs , 'W', 1. ) !!gm for calculation, keeped here for output only 292 293 ! 293 294 IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases) … … 297 298 ! 298 299 CALL zdf_mxl( kt ) !* mixed layer depth, and level 299 300 ! 300 301 IF( lrst_oce ) THEN !* write TKE, GLS or RIC fields in the restart file 301 302 IF( ln_zdftke ) CALL tke_rst( kt, 'WRITE' ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r8863 r8866 46 46 USE zdfdrg ! vertical physics: top/bottom drag coef. 47 47 USE zdfmxl ! vertical physics: mixed layer 48 #if defined key_agrif49 USE agrif_opa_interp50 USE agrif_opa_update51 #endif52 48 ! 53 49 USE in_out_manager ! I/O manager … … 107 103 !!---------------------------------------------------------------------- 108 104 ALLOCATE( htau(jpi,jpj) , dissl(jpi,jpj,jpk) , apdlr(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 109 105 ! 110 106 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 111 107 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') … … 171 167 172 168 173 SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2 & 174 & , p_avm, p_avt ) 169 SUBROUTINE tke_tke( pdepw, p_e3t, p_e3w, p_sh2, p_avm, p_avt ) 175 170 !!---------------------------------------------------------------------- 176 171 !! *** ROUTINE tke_tke *** … … 217 212 zfact3 = 0.5_wp * rn_ediss 218 213 ! 219 !220 214 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 221 215 ! ! Surface/top/bottom boundary condition on tke … … 234 228 END DO 235 229 ENDIF 236 230 ! 237 231 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 238 232 ! ! Bottom boundary condition on tke … … 395 389 END DO 396 390 END DO 397 391 ! 398 392 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 399 393 ! ! TKE due to surface and internal wave breaking … … 483 477 REAL(wp) :: zdku, zdkv, zsqen ! - - 484 478 REAL(wp) :: zemxl, zemlm, zemlp ! - - 485 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld 479 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmxlm, zmxld ! 3D workspace 486 480 !!-------------------------------------------------------------------- 487 481 ! 488 482 IF( ln_timing ) CALL timing_start('tke_avn') 489 483 ! 490 484 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 491 485 ! ! Mixing length … … 597 591 END SELECT 598 592 ! 599 600 593 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 601 594 ! ! Vertical eddy viscosity and diffusivity (avm and avt) … … 623 616 END DO 624 617 ENDIF 625 618 ! 626 619 IF(ln_ctl) THEN 627 620 CALL prt_ctl( tab3d_1=en , clinfo1=' tke - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk)
Note: See TracChangeset
for help on using the changeset viewer.