Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r2528 r2715 49 49 USE in_out_manager ! I/O manager 50 50 USE iom ! I/O manager library 51 USE lib_mpp ! MPP library 51 52 52 53 IMPLICIT NONE … … 57 58 PUBLIC tke_rst ! routine called in step module 58 59 59 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag 60 61 #if defined key_c1d 62 ! !!** 1D cfg only ** ('key_c1d') 63 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e_dis, e_mix !: dissipation and mixing turbulent lengh scales 64 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: e_pdl, e_ric !: prandl and local Richardson numbers 65 #endif 60 LOGICAL , PUBLIC, PARAMETER :: lk_zdftke = .TRUE. !: TKE vertical mixing flag 66 61 67 62 ! !!** Namelist namzdf_tke ** … … 87 82 REAL(wp) :: rhftau_scl = 1.0_wp ! scale factor applied to HF part of taum (nn_etau=3) 88 83 89 REAL(wp), DIMENSION(jpi,jpj,jpk), PUBLIC :: en ! now turbulent kinetic energy [m2/s2] 90 91 REAL(wp), DIMENSION(jpi,jpj) :: htau ! depth of tke penetration (nn_htau) 92 REAL(wp), DIMENSION(jpi,jpj,jpk) :: dissl ! now mixing lenght of dissipation 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy [m2/s2] 85 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: htau ! depth of tke penetration (nn_htau) 86 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dissl ! now mixing lenght of dissipation 87 #if defined key_c1d 88 ! !!** 1D cfg only ** ('key_c1d') 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_dis, e_mix !: dissipation and mixing turbulent lengh scales 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: e_pdl, e_ric !: prandl and local Richardson numbers 91 #endif 93 92 94 93 !! * Substitutions … … 96 95 # include "vectopt_loop_substitute.h90" 97 96 !!---------------------------------------------------------------------- 98 !! NEMO/OPA 3.3 , NEMO Consortium (2010)97 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 99 98 !! $Id$ 100 99 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 101 100 !!---------------------------------------------------------------------- 102 101 CONTAINS 102 103 INTEGER FUNCTION zdf_tke_alloc() 104 !!---------------------------------------------------------------------- 105 !! *** FUNCTION zdf_tke_alloc *** 106 !!---------------------------------------------------------------------- 107 ALLOCATE( & 108 #if defined key_c1d 109 & e_dis(jpi,jpj,jpk) , e_mix(jpi,jpj,jpk) , & 110 & e_pdl(jpi,jpj,jpk) , e_ric(jpi,jpj,jpk) , & 111 #endif 112 & en (jpi,jpj,jpk) , htau (jpi,jpj) , dissl(jpi,jpj,jpk) , STAT= zdf_tke_alloc ) 113 ! 114 IF( lk_mpp ) CALL mpp_sum ( zdf_tke_alloc ) 115 IF( zdf_tke_alloc /= 0 ) CALL ctl_warn('zdf_tke_alloc: failed to allocate arrays') 116 ! 117 END FUNCTION zdf_tke_alloc 118 103 119 104 120 SUBROUTINE zdf_tke( kt ) … … 174 190 !! (= Kz dz[Ub] * dz[Un] ) 175 191 !! --------------------------------------------------------------------- 176 USE oce, zdiag => ua ! use ua as workspace 177 USE oce, zd_up => va ! use va as workspace 178 USE oce, zd_lw => ta ! use ta as workspace 179 !! 192 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 193 USE oce , ONLY: zdiag => ua , zd_up => va , zd_lw => ta ! (ua,va,ta) used as workspace 194 USE wrk_nemo, ONLY: imlc => iwrk_2d_1 ! 2D INTEGER workspace 195 USE wrk_nemo, ONLY: zhlc => wrk_2d_1 ! 2D REAL workspace 196 USE wrk_nemo, ONLY: zpelc => wrk_3d_1 ! 3D REAL workspace 197 ! 180 198 INTEGER :: ji, jj, jk ! dummy loop arguments 181 199 !!bfr INTEGER :: ikbu, ikbv, ikbum1, ikbvm1 ! temporary scalar … … 190 208 REAL(wp) :: zzd_up, zzd_lw ! - - 191 209 !!bfr REAL(wp) :: zebot ! - - 192 INTEGER , DIMENSION(jpi,jpj) :: imlc ! 2D workspace193 REAL(wp), DIMENSION(jpi,jpj) :: zhlc ! - -194 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zpelc ! 3D workspace195 210 !!-------------------------------------------------------------------- 196 211 ! 212 IF( iwrk_in_use(2, 1) .OR. & 213 wrk_in_use(2, 1) .OR. & 214 wrk_in_use(3, 1) ) THEN 215 CALL ctl_stop('tke_tke: requested workspace arrays unavailable') ; RETURN 216 END IF 217 197 218 zbbrau = rn_ebb / rau0 ! Local constant initialisation 198 219 zfact1 = -.5_wp * rdt … … 406 427 END DO 407 428 ENDIF 408 !409 429 CALL lbc_lnk( en, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 430 ! 431 IF( iwrk_not_released(2 ,1) .OR. & 432 wrk_not_released(2, 1) .OR. & 433 wrk_not_released(3, 1) ) CALL ctl_stop( 'tke_tke: failed to release workspace arrays' ) 410 434 ! 411 435 END SUBROUTINE tke_tke … … 447 471 !! - avmu, avmv : now vertical eddy viscosity at uw- and vw-points 448 472 !!---------------------------------------------------------------------- 449 USE oce, zmpdl => ua ! use ua as workspace 450 USE oce, zmxlm => va ! use va as workspace 451 USE oce, zmxld => ta ! use ta as workspace 452 !! 453 INTEGER :: ji, jj, jk ! dummy loop arguments 454 REAL(wp) :: zrn2, zraug ! temporary scalars 455 REAL(wp) :: zdku ! - - 456 REAL(wp) :: zdkv ! - - 457 REAL(wp) :: zcoef, zav ! - - 458 REAL(wp) :: zpdlr, zri, zsqen ! - - 459 REAL(wp) :: zemxl, zemlm, zemlp ! - - 473 USE oce, ONLY: zmpdl => ua , zmxlm => va , zmxld => ta ! (ua,va,ta) used as workspace 474 !! 475 INTEGER :: ji, jj, jk ! dummy loop indices 476 REAL(wp) :: zrn2, zraug, zcoef, zav ! local scalars 477 REAL(wp) :: zdku, zpdlr, zri, zsqen ! - - 478 REAL(wp) :: zdkv, zemxl, zemlm, zemlp ! - - 460 479 !!-------------------------------------------------------------------- 461 480 … … 485 504 END DO 486 505 END DO 487 !488 506 ! 489 507 ! !* Physical limits for the mixing length … … 656 674 & nn_etau , nn_htau , rn_efr 657 675 !!---------------------------------------------------------------------- 658 676 ! 659 677 REWIND ( numnam ) !* Read Namelist namzdf_tke : Turbulente Kinetic Energy 660 678 READ ( numnam, namzdf_tke ) 661 679 ! 662 680 ri_cri = 2._wp / ( 2._wp + rn_ediss / rn_ediff ) ! resulting critical Richardson number 663 681 rmxl_min = 1.e-6_wp / ( rn_ediff * SQRT( rn_emin ) ) ! resulting minimum length to recover molecular viscosity 664 682 ! 665 683 IF(lwp) THEN !* Control print 666 684 WRITE(numout,*) … … 686 704 WRITE(numout,*) ' critical Richardson nb with your parameters ri_cri = ', ri_cri 687 705 ENDIF 688 706 ! 707 ! ! allocate tke arrays 708 IF( zdf_tke_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_tke_init : unable to allocate arrays' ) 709 ! 689 710 ! !* Check of some namelist values 690 711 IF( nn_mxl < 0 .OR. nn_mxl > 3 ) CALL ctl_stop( 'bad flag: nn_mxl is 0, 1 or 2 ' ) … … 711 732 END SELECT 712 733 ENDIF 713 714 734 ! !* set vertical eddy coef. to the background value 715 735 DO jk = 1, jpk … … 720 740 END DO 721 741 dissl(:,:,:) = 1.e-12_wp 722 ! !* read or initialize all required files723 CALL tke_rst( nit000, 'READ' ) 742 ! 743 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files 724 744 ! 725 745 END SUBROUTINE zdf_tke_init … … 736 756 !! set to rn_emin or recomputed 737 757 !!---------------------------------------------------------------------- 738 INTEGER , INTENT(in) :: kt 739 CHARACTER(len=*), INTENT(in) :: cdrw 758 INTEGER , INTENT(in) :: kt ! ocean time-step 759 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 740 760 ! 741 761 INTEGER :: jit, jk ! dummy loop indices 742 INTEGER :: id1, id2, id3, id4, id5, id6 762 INTEGER :: id1, id2, id3, id4, id5, id6 ! local integers 743 763 !!---------------------------------------------------------------------- 744 764 !
Note: See TracChangeset
for help on using the changeset viewer.
