Changeset 5081 for branches/2014
- Timestamp:
- 2015-02-13T10:51:27+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4765_CNRS_agrif/NEMOGCM
- Files:
-
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/CONFIG/SHARED/1_namelist_ref
r4790 r5081 524 524 rn_sponge_dyn = 2880. ! coefficient for dynamics sponge layer [m2/s] 525 525 ln_chk_bathy = .FALSE. ! 526 ln_agrif_tke = .FALSE.527 526 / 528 527 !----------------------------------------------------------------------- -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r4984 r5081 25 25 REAL(wp), PUBLIC :: rn_sponge_dyn = 2800. !: sponge coeff. for dynamics 26 26 LOGICAL , PUBLIC :: ln_chk_bathy = .FALSE. !: check of parent bathymetry 27 LOGICAL , PUBLIC :: ln_agrif_tke = .FALSE. !: interp/extrap for TKE28 27 29 28 ! !!! OLD namelist names … … 66 65 INTEGER :: e3t_id, e1u_id, e2v_id, sshn_id 67 66 INTEGER :: scales_t_id 68 INTEGER :: avt_id, avm_id, avmu_id, avmv_id 67 # if defined key_zdftke 68 INTEGER :: avt_id, avm_id, en_id 69 # endif 69 70 INTEGER :: umsk_id, vmsk_id 70 71 INTEGER :: kindic_agr -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r4984 r5081 43 43 PUBLIC interpe3t, interpumsk, interpvmsk 44 44 # if defined key_zdftke 45 PUBLIC Agrif_tke, interpav t, interpavm, interpavmu, interpavmv45 PUBLIC Agrif_tke, interpavm 46 46 # endif 47 47 … … 609 609 !! *** ROUTINE Agrif_tke *** 610 610 !!---------------------------------------------------------------------- 611 ! 612 IF( Agrif_Root() ) RETURN 613 611 REAL(wp) :: zalpha 612 ! 613 zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp ) 614 IF( zalpha > 1. ) zalpha = 1. 614 615 615 616 Agrif_SpecialValue = 0.e0 616 617 Agrif_UseSpecialValue = .TRUE. 617 618 618 CALL Agrif_Bc_variable(avt_id , procname=interpavt) 619 CALL Agrif_Bc_variable(avm_id , procname=interpavm) 620 CALL Agrif_Bc_variable(avmu_id, procname=interpavmu) 621 CALL Agrif_Bc_variable(avmv_id, procname=interpavmv) 619 CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm) 622 620 623 621 Agrif_UseSpecialValue = .FALSE. … … 1321 1319 1322 1320 # if defined key_zdftke 1323 SUBROUTINE interpavt(ptab,i1,i2,j1,j2,k1,k2,before)1324 !!----------------------------------------------------------------------1325 !! *** ROUTINE interavt ***1326 !!----------------------------------------------------------------------1327 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k21328 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1329 LOGICAL, INTENT(in) :: before1330 !!----------------------------------------------------------------------1331 !1332 IF( before) THEN1333 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)1334 ELSE1335 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1336 ENDIF1337 !1338 1339 END SUBROUTINE interpavt1340 1341 1321 1342 1322 SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) … … 1357 1337 END SUBROUTINE interpavm 1358 1338 1359 1360 SUBROUTINE interpavmu(ptab,i1,i2,j1,j2,k1,k2,before)1361 !!----------------------------------------------------------------------1362 !! *** ROUTINE interavmu ***1363 !!----------------------------------------------------------------------1364 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k21365 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1366 LOGICAL, INTENT(in) :: before1367 !!----------------------------------------------------------------------1368 !1369 IF( before) THEN1370 ptab (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2)1371 ELSE1372 avmu_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1373 ENDIF1374 !1375 END SUBROUTINE interpavmu1376 1377 1378 SUBROUTINE interpavmv(ptab,i1,i2,j1,j2,k1,k2,before)1379 !!----------------------------------------------------------------------1380 !! *** ROUTINE interavmv ***1381 !!----------------------------------------------------------------------1382 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k21383 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab1384 LOGICAL, INTENT(in) :: before1385 !!----------------------------------------------------------------------1386 !1387 IF( before) THEN1388 ptab (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2)1389 ELSE1390 avmv_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)1391 ENDIF1392 !1393 END SUBROUTINE interpavmv1394 1339 # endif /* key_zdftke */ 1395 1340 -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r4980 r5081 160 160 INTEGER, INTENT(in) :: kt 161 161 ! 162 IF( (Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN162 IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN 163 163 # if defined TWO_WAY 164 164 … … 166 166 Agrif_SpecialValueFineGrid = 0. 167 167 168 CALL Agrif_Update_Variable(avt_id ,locupdate=(/0,0/), procname=updateAVT ) 169 CALL Agrif_Update_Variable(avm_id ,locupdate=(/0,0/), procname=updateAVM ) 170 CALL Agrif_Update_Variable(avmu_id,locupdate=(/0,0/), procname=updateAVMu) 171 CALL Agrif_Update_Variable(avmv_id,locupdate=(/0,0/), procname=updateAVMv) 168 CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN ) 169 CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT ) 170 CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM ) 172 171 173 172 Agrif_UseSpecialValueInUpdate = .FALSE. … … 601 600 602 601 # if defined key_zdftke 603 SUBROUTINE update AVT( ptab, i1, i2, j1, j2, k1, k2, before )604 !!--------------------------------------------- 605 !! *** ROUTINE update avt***602 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 603 !!--------------------------------------------- 604 !! *** ROUTINE updateen *** 606 605 !!--------------------------------------------- 607 606 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 … … 611 610 ! 612 611 IF (before) THEN 613 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)614 ELSE 615 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)616 ENDIF 617 ! 618 END SUBROUTINE update AVT619 620 621 SUBROUTINE updateAV M( ptab, i1, i2, j1, j2, k1, k2, before )622 !!--------------------------------------------- 623 !! *** ROUTINE updateav m***612 ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2) 613 ELSE 614 en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 615 ENDIF 616 ! 617 END SUBROUTINE updateEN 618 619 620 SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before ) 621 !!--------------------------------------------- 622 !! *** ROUTINE updateavt *** 624 623 !!--------------------------------------------- 625 624 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 … … 629 628 ! 630 629 IF (before) THEN 631 ptab (i1:i2,j1:j2,k1:k2) = av m_k(i1:i2,j1:j2,k1:k2)632 ELSE 633 av m_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)634 ENDIF 635 ! 636 END SUBROUTINE updateAV M637 638 639 SUBROUTINE updateAVM u( ptab, i1, i2, j1, j2, k1, k2, before )640 !!--------------------------------------------- 641 !! *** ROUTINE updateavm u***630 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 631 ELSE 632 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 633 ENDIF 634 ! 635 END SUBROUTINE updateAVT 636 637 638 SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before ) 639 !!--------------------------------------------- 640 !! *** ROUTINE updateavm *** 642 641 !!--------------------------------------------- 643 642 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 … … 647 646 ! 648 647 IF (before) THEN 649 ptab (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2) 650 ELSE 651 avmu_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 652 ENDIF 653 ! 654 END SUBROUTINE updateAVMu 655 656 657 SUBROUTINE updateAVMv( ptab, i1, i2, j1, j2, k1, k2, before ) 658 !!--------------------------------------------- 659 !! *** ROUTINE updateavmv *** 660 !!--------------------------------------------- 661 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 662 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 663 LOGICAL, INTENT(in) :: before 664 !!--------------------------------------------- 665 ! 666 IF (before) THEN 667 ptab (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2) 668 ELSE 669 avmv_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 670 ENDIF 671 ! 672 END SUBROUTINE updateAVMv 648 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 649 ELSE 650 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 651 ENDIF 652 ! 653 END SUBROUTINE updateAVM 673 654 674 655 # endif /* key_zdftke */ -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r4984 r5081 316 316 ! 317 317 # if defined key_zdftke 318 IF( ln_agrif_tke ) THEN319 318 CALL Agrif_Update_tke(0) 320 ENDIF321 319 # endif 322 320 ! … … 369 367 370 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) 371 370 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 372 371 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 373 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avmu_id)374 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avmv_id)375 372 # endif 376 373 … … 399 396 400 397 # if defined key_zdftke 401 CALL Agrif_Set_bcinterp(avt_id ,interp=AGRIF_linear)402 398 CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 403 CALL Agrif_Set_bcinterp(avmu_id,interp=AGRIF_linear)404 CALL Agrif_Set_bcinterp(avmv_id,interp=AGRIF_linear)405 399 # endif 406 400 … … 430 424 431 425 # if defined key_zdftke 432 CALL Agrif_Set_bc(avt_id ,(/0,1/))433 426 CALL Agrif_Set_bc(avm_id ,(/0,1/)) 434 CALL Agrif_Set_bc(avmu_id,(/0,1/))435 CALL Agrif_Set_bc(avmv_id,(/0,1/))436 427 # endif 437 428 … … 451 442 452 443 # if defined key_zdftke 444 CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 453 445 CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 454 446 CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 455 CALL Agrif_Set_Updatetype(avmu_id, update = AGRIF_Update_Average)456 CALL Agrif_Set_Updatetype(avmv_id, update = AGRIF_Update_Average)457 447 # endif 458 448 … … 740 730 INTEGER :: ios ! Local integer output status for namelist read 741 731 INTEGER :: iminspon 742 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy, & 743 & ln_agrif_tke 732 NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 744 733 !!-------------------------------------------------------------------------------------- 745 734 ! … … 763 752 WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn 764 753 WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy 765 WRITE(numout,*) ' use TKE interpolation/update ln_agrif_tke = ', ln_agrif_tke766 754 WRITE(numout,*) 767 755 ENDIF -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r4624 r5081 114 114 INTEGER :: numnam_ref = -1 !: logical unit for reference namelist 115 115 INTEGER :: numnam_cfg = -1 !: logical unit for configuration specific namelist 116 INTEGER :: numond = 7!: logical unit for Output Namelist Dynamics116 INTEGER :: numond = -1 !: logical unit for Output Namelist Dynamics 117 117 INTEGER :: numnam_ice_ref = -1 !: logical unit for ice reference namelist 118 118 INTEGER :: numnam_ice_cfg = -1 !: logical unit for ice reference namelist 119 INTEGER :: numoni = 8!: logical unit for Output Namelist Ice119 INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice 120 120 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 121 121 INTEGER :: numsol = -1 !: logical unit for solver statistics -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4785 r5081 1438 1438 END DO 1439 1439 1440 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1440 1441 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1441 1442 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdf_oce.F90
r4789 r5081 44 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avt_k , avm_k ! not enhanced Kz 45 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: avmu_k, avmv_k ! not enhanced Kz 46 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 46 47 47 48 !!---------------------------------------------------------------------- … … 62 63 & avmv (jpi,jpj,jpk), avt (jpi,jpj,jpk), & 63 64 & avt_k (jpi,jpj,jpk), avm_k (jpi,jpj,jpk), & 64 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), STAT = zdf_oce_alloc ) 65 & avmu_k(jpi,jpj,jpk), avmv_k(jpi,jpj,jpk), & 66 & en (jpi,jpj,jpk), STAT = zdf_oce_alloc ) 65 67 ! 66 68 IF( zdf_oce_alloc /= 0 ) CALL ctl_warn('zdf_oce_alloc: failed to allocate arrays') -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r4789 r5081 41 41 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 42 42 ! 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy44 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 45 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function … … 118 117 !! *** FUNCTION zdf_gls_alloc *** 119 118 !!---------------------------------------------------------------------- 120 ALLOCATE( en(jpi,jpj,jpk),mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , &119 ALLOCATE( mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 121 120 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 122 121 ! -
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4861 r5081 88 88 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 89 89 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2]91 90 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 92 91 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 92 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: apdlr ! now mixing lenght of dissipation 93 93 #if defined key_c1d 94 94 ! !!** 1D cfg only ** ('key_c1d') … … 96 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers 97 97 #endif 98 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wei3d !99 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,: ) :: wmix !100 98 101 99 !! * Substitutions … … 118 116 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 119 117 #endif 120 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) ,&118 & apdlr(jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , & 121 119 & STAT= zdf_tke_alloc ) 122 120 ! 123 121 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 124 122 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 125 !126 IF(.NOT. Agrif_Root()) THEN127 ALLOCATE( wei3d(jpi,jpj,jpk), wmix(jpi,jpj), STAT= zdf_tke_alloc )128 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc )129 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc2: failed to allocate arrays')130 ENDIF131 123 ! 132 124 END FUNCTION zdf_tke_alloc … … 181 173 !!---------------------------------------------------------------------- 182 174 ! 175 #if defined key_agrif 176 ! interpolation parent grid => child grid for avm_k ( ex : at west border: update column 1 and 2) 177 IF( .NOT.Agrif_Root() ) CALL Agrif_Tke 178 #endif 179 ! 183 180 IF( kt /= nit000 ) THEN ! restore before value to compute tke 184 #if defined key_agrif185 ! interpolation parent grid => child grid for avt_k, avm_k, avmu_k, avmv_k186 !( ex : at west border: update column 1 and 2)187 IF(ln_agrif_tke) CALL Agrif_Tke188 #endif189 181 avt (:,:,:) = avt_k (:,:,:) 190 182 avm (:,:,:) = avm_k (:,:,:) … … 204 196 #if defined key_agrif 205 197 ! Update child grid f => parent grid 206 IF( .NOT.Agrif_Root() .AND. ln_agrif_tke) CALL Agrif_Update_Tke( kt ) ! children only 198 IF(lwp) WRITE(numout,*) 'sebseb', Agrif_Root(), kt, Agrif_NbStepint() 199 IF( .NOT.Agrif_Root() ) CALL Agrif_Update_Tke( kt ) ! children only 207 200 #endif 208 201 ! … … 241 234 INTEGER , POINTER, DIMENSION(:,: ) :: imlc 242 235 REAL(wp), POINTER, DIMENSION(:,: ) :: zhlc 243 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw 236 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpelc, zdiag, zd_up, zd_lw, z3du, z3dv 237 REAL(wp) :: zri ! local Richardson number 244 238 !!-------------------------------------------------------------------- 245 239 ! … … 248 242 CALL wrk_alloc( jpi,jpj, imlc ) ! integer 249 243 CALL wrk_alloc( jpi,jpj, zhlc ) 250 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )244 CALL wrk_alloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 251 245 ! 252 246 zbbrau = rn_ebb / rau0 ! Local constant initialisation … … 347 341 ! 348 342 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 349 DO jj = 1, jpj ! here avmu, avmv used as workspace 350 DO ji = 1, jpi 351 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 352 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 353 & / ( fse3uw_n(ji,jj,jk) & 354 & * fse3uw_b(ji,jj,jk) ) 355 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 356 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & 357 & / ( fse3vw_n(ji,jj,jk) & 358 & * fse3vw_b(ji,jj,jk) ) 359 END DO 360 END DO 361 END DO 362 ! 343 DO jj = 1, jpjm1 344 DO ji = 1, fs_jpim1 ! vector opt. 345 z3du(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji+1,jj,jk) ) & 346 & * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 347 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) / ( fse3uw_n(ji,jj,jk) * fse3uw_b(ji,jj,jk) ) 348 z3dv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk ) + avm(ji,jj+1,jk) ) & 349 & * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 350 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) / ( fse3vw_n(ji,jj,jk) * fse3vw_b(ji,jj,jk) ) 351 END DO 352 END DO 353 END DO 354 ! 355 IF( nn_pdl == 1 ) THEN !* Prandtl number case: compute apdlr 356 ! Note that zesh2 is also computed in the next loop. 357 ! We decided to compute it twice to keep code readability and avoid an IF case in the DO loops 358 DO jk = 2, jpkm1 359 DO jj = 2, jpjm1 360 DO ji = fs_2, fs_jpim1 ! vector opt. 361 ! ! shear prod. at w-point weightened by mask 362 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 363 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 364 ! ! local Richardson number 365 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * avm(ji,jj,jk) / ( zesh2 + rn_bshear ) 366 apdlr(ji,jj,jk) = MAX( 0.1_wp, ri_cri / MAX( ri_cri , zri ) ) 367 368 END DO 369 END DO 370 END DO 371 ! 372 ENDIF 373 ! 363 374 DO jk = 2, jpkm1 !* Matrix and right hand side in en 364 375 DO jj = 2, jpjm1 … … 369 380 zzd_lw = zcof * ( avm (ji,jj,jk ) + avm (ji,jj,jk-1) ) & ! lower diagonal 370 381 & / ( fse3t(ji,jj,jk-1) * fse3w(ji,jj,jk ) ) 371 !! shear prod. at w-point weightened by mask372 zesh2 = ( avmu(ji-1,jj,jk) + avmu(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) &373 & + ( avmv(ji,jj-1,jk) + avmv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) )374 382 ! ! shear prod. at w-point weightened by mask 383 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 384 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 385 ! 375 386 zd_up(ji,jj,jk) = zzd_up ! Matrix (zdiag, zd_up, zd_lw) 376 387 zd_lw(ji,jj,jk) = zzd_lw … … 465 476 CALL wrk_dealloc( jpi,jpj, imlc ) ! integer 466 477 CALL wrk_dealloc( jpi,jpj, zhlc ) 467 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw )478 CALL wrk_dealloc( jpi,jpj,jpk, zpelc, zdiag, zd_up, zd_lw, z3du, z3dv ) 468 479 ! 469 480 IF( nn_timing == 1 ) CALL timing_stop('tke_tke') … … 509 520 INTEGER :: ji, jj, jk ! dummy loop indices 510 521 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 511 REAL(wp) :: zdku, z pdlr, zri, zsqen ! - -522 REAL(wp) :: zdku, zri, zsqen ! - - 512 523 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 513 REAL(wp), POINTER, DIMENSION(:,: ) :: ztmp2d514 524 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmpdl, zmxlm, zmxld 515 525 !!-------------------------------------------------------------------- … … 517 527 IF( nn_timing == 1 ) CALL timing_start('tke_avn') 518 528 519 CALL wrk_alloc( jpi,jpj, ztmp2d )520 529 CALL wrk_alloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 521 530 … … 649 658 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 650 659 ! 651 # if defined key_agrif652 IF( .NOT. AGRIF_Root() ) THEN653 IF( ln_agrif_tke ) THEN654 DO jk = 1, jpkm1655 DO jj = 2, jpjm1656 DO ji = 2, jpim1657 ztmp2d(ji,jj) = 1. * avm(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk) &658 & + 2. * avm(ji ,jj-1,jk) * tmask(ji ,jj-1,jk) &659 & + 1. * avm(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk) &660 & + 2. * avm(ji-1,jj ,jk) * tmask(ji-1,jj ,jk) &661 & + 4. * avm(ji ,jj ,jk) * tmask(ji ,jj ,jk) &662 & + 2. * avm(ji+1,jj ,jk) * tmask(ji+1,jj ,jk) &663 & + 1. * avm(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk) &664 & + 2. * avm(ji ,jj+1,jk) * tmask(ji ,jj+1,jk) &665 & + 1. * avm(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk)666 END DO667 END DO668 DO jj = 2, jpjm1669 DO ji = 2, jpim1670 avm(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avm(ji,jj,jk) * ( 1. - wmix(ji,jj) )671 END DO672 END DO673 END DO674 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged)675 DO jk = 1, jpkm1676 DO jj = 2, jpjm1677 DO ji = 2, jpim1678 ztmp2d(ji,jj) = 1. * avt(ji-1,jj-1,jk) * tmask(ji-1,jj-1,jk) &679 & + 2. * avt(ji ,jj-1,jk) * tmask(ji ,jj-1,jk) &680 & + 1. * avt(ji+1,jj-1,jk) * tmask(ji+1,jj-1,jk) &681 & + 2. * avt(ji-1,jj ,jk) * tmask(ji-1,jj ,jk) &682 & + 4. * avt(ji ,jj ,jk) * tmask(ji ,jj ,jk) &683 & + 2. * avt(ji+1,jj ,jk) * tmask(ji+1,jj ,jk) &684 & + 1. * avt(ji-1,jj+1,jk) * tmask(ji-1,jj+1,jk) &685 & + 2. * avt(ji ,jj+1,jk) * tmask(ji ,jj+1,jk) &686 & + 1. * avt(ji+1,jj+1,jk) * tmask(ji+1,jj+1,jk)687 END DO688 END DO689 DO jj = 2, jpjm1690 DO ji = 2, jpim1691 avt(ji,jj,jk) = ztmp2d(ji,jj) * wei3d(ji,jj,jk) * wmix(ji,jj) + avt(ji,jj,jk) * ( 1. - wmix(ji,jj) )692 END DO693 END DO694 END DO695 CALL lbc_lnk( avt, 'W', 1. ) ! Lateral boundary conditions (sign unchanged)696 ELSE697 DO jk = 1, jpkm1698 IF ((nbondi == 1).OR.(nbondi == 2)) avmu(nlci-1 , : ,jk) = avmu(nlci-2 , : ,jk) ! east699 IF ((nbondi == -1).OR.(nbondi == 2)) avmu(1 , : ,jk) = avmu(2 , : ,jk) ! west700 IF ((nbondj == 1).OR.(nbondj == 2)) avmv(: ,nlcj-1 ,jk) = avmv(: ,nlcj-2 ,jk) ! north701 IF ((nbondj == -1).OR.(nbondj == 2)) avmv(: ,1 ,jk) = avmv(: ,2 ,jk) ! south702 END DO703 ENDIF704 ENDIF705 # endif /* key_Agrif */706 !707 660 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 708 661 DO jj = 2, jpjm1 … … 719 672 DO jj = 2, jpjm1 720 673 DO ji = fs_2, fs_jpim1 ! vector opt. 721 zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 722 ! ! shear 723 zdku = avmu(ji-1,jj,jk) * ( un(ji-1,jj,jk-1) - un(ji-1,jj,jk) ) * ( ub(ji-1,jj,jk-1) - ub(ji-1,jj,jk) ) & 724 & + avmu(ji ,jj,jk) * ( un(ji ,jj,jk-1) - un(ji ,jj,jk) ) * ( ub(ji ,jj,jk-1) - ub(ji ,jj,jk) ) 725 zdkv = avmv(ji,jj-1,jk) * ( vn(ji,jj-1,jk-1) - vn(ji,jj-1,jk) ) * ( vb(ji,jj-1,jk-1) - vb(ji,jj-1,jk) ) & 726 & + avmv(ji,jj ,jk) * ( vn(ji,jj ,jk-1) - vn(ji,jj ,jk) ) * ( vb(ji,jj ,jk-1) - vb(ji,jj ,jk) ) 727 ! ! local Richardson number 728 zri = MAX( rn2b(ji,jj,jk), 0._wp ) * zcoef / (zdku + zdkv + rn_bshear ) 729 zpdlr = MAX( 0.1_wp, 0.2 / MAX( 0.2 , zri ) ) 730 !!gm and even better with the use of the "true" ri_crit=0.22222... (this change the results!) 731 !!gm zpdlr = MAX( 0.1_wp, ri_crit / MAX( ri_crit , zri ) ) 732 avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 674 avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk) 733 675 # if defined key_c1d 734 e_pdl(ji,jj,jk) = zpdlr* tmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number676 e_pdl(ji,jj,jk) = apdlr(ji,jj,jk) * tmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number 735 677 e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk) ! c1d config. : save Ri 736 678 # endif … … 747 689 ENDIF 748 690 ! 749 CALL wrk_dealloc( jpi,jpj, ztmp2d )750 691 CALL wrk_dealloc( jpi,jpj,jpk, zmpdl, zmxlm, zmxld ) 751 692 ! … … 852 793 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files 853 794 ! 854 IF(.NOT. Agrif_Root()) THEN855 wei3d(:,:,:) = 1.856 DO jk = 1, jpkm1857 DO jj = 2, jpjm1858 DO ji = 2, jpim1859 wei3d(ji,jj,jk) = &860 & 1.*tmask(ji-1,jj-1,jk) + 2.*tmask(ji,jj-1,jk) + 1.*tmask(ji+1,jj-1,jk)&861 & + 2.*tmask(ji-1,jj ,jk) + 4.*tmask(ji,jj ,jk) + 2.*tmask(ji+1,jj ,jk)&862 & + 1.*tmask(ji-1,jj+1,jk) + 2.*tmask(ji,jj+1,jk) + 1.*tmask(ji+1,jj+1,jk)863 wei3d(ji,jj,jk) = tmask(ji,jj,jk) / MAX( 1., wei3d(ji,jj,jk) )864 END DO865 END DO866 END DO867 CALL lbc_lnk( wei3d, 'T', 1. )868 869 wmix(:,:) = 0.870 wmix(mi0(2):mi1(jpiglo-1),mj0(2):mj1(jpjglo-1)) = 1.871 wmix(mi0(6):mi1(jpiglo-5),mj0(6):mj1(jpjglo-5)) = 0.75872 wmix(mi0(7):mi1(jpiglo-6),mj0(7):mj1(jpjglo-6)) = 0.5873 wmix(mi0(8):mi1(jpiglo-7),mj0(8):mj1(jpjglo-7)) = 0.25874 wmix(mi0(9):mi1(jpiglo-8),mj0(9):mj1(jpjglo-8)) = 0.875 END IF876 !877 795 END SUBROUTINE zdf_tke_init 878 796
Note: See TracChangeset
for help on using the changeset viewer.