Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r2528 r2715 25 25 USE restart ! only for lrst_oce 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE lib_mpp ! MPP manager 27 28 USE prtctl ! Print control 28 29 USE in_out_manager ! I/O manager … … 36 37 PUBLIC gls_rst ! routine called in step module 37 38 38 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 39 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: en !: now turbulent kinetic energy 40 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mxln !: now mixing length 41 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: zwall !: wall function 42 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ustars2 !: Squared surface velocity scale at T-points 43 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ustarb2 !: Squared bottom velocity scale at T-points 39 LOGICAL , PUBLIC, PARAMETER :: lk_zdfgls = .TRUE. !: TKE vertical mixing flag 40 ! 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: en !: now turbulent kinetic energy 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: mxln !: now mixing length 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zwall !: wall function 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustars2 !: Squared surface velocity scale at T-points 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ustarb2 !: Squared bottom velocity scale at T-points 44 46 45 47 ! !!! ** Namelist namzdf_gls ** … … 105 107 !!---------------------------------------------------------------------- 106 108 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 107 !! $Id 109 !! $Id$ 108 110 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 109 111 !!---------------------------------------------------------------------- 110 112 CONTAINS 113 114 INTEGER FUNCTION zdf_gls_alloc() 115 !!---------------------------------------------------------------------- 116 !! *** FUNCTION zdf_gls_alloc *** 117 !!---------------------------------------------------------------------- 118 ALLOCATE( en(jpi,jpj,jpk), mxln(jpi,jpj,jpk), zwall(jpi,jpj,jpk) , & 119 & ustars2(jpi,jpj), ustarb2(jpi,jpj) , STAT= zdf_gls_alloc ) 120 ! 121 IF( lk_mpp ) CALL mpp_sum ( zdf_gls_alloc ) 122 IF( zdf_gls_alloc /= 0 ) CALL ctl_warn('zdf_gls_alloc: failed to allocate arrays') 123 END FUNCTION zdf_gls_alloc 124 111 125 112 126 SUBROUTINE zdf_gls( kt ) … … 121 135 USE oce, z_elem_c => ta ! use ta as workspace 122 136 USE oce, psi => sa ! use sa as workspace 137 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 138 USE wrk_nemo, ONLY: zdep => wrk_2d_1 139 USE wrk_nemo, ONLY: zflxs => wrk_2d_2 ! Turbulence fluxed induced by internal waves 140 USE wrk_nemo, ONLY: zhsro => wrk_2d_3 ! Surface roughness (surface waves) 141 USE wrk_nemo, ONLY: eb => wrk_3d_1 ! tke at time before 142 USE wrk_nemo, ONLY: mxlb => wrk_3d_2 ! mixing length at time before 143 USE wrk_nemo, ONLY: shear => wrk_3d_3 ! vertical shear 144 USE wrk_nemo, ONLY: eps => wrk_3d_4 ! dissipation rate 145 USE wrk_nemo, ONLY: zwall_psi => wrk_3d_5 ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T) 123 146 ! 124 147 INTEGER, INTENT(in) :: kt ! ocean time step … … 129 152 REAL(wp) :: prod, buoy, diss, zdiss, sm ! - - 130 153 REAL(wp) :: gh, gm, shr, dif, zsqen, zav ! - - 131 REAL(wp), DIMENSION(jpi,jpj) :: zdep !132 REAL(wp), DIMENSION(jpi,jpj) :: zflxs ! Turbulence fluxed induced by internal waves133 REAL(wp), DIMENSION(jpi,jpj) :: zhsro ! Surface roughness (surface waves)134 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eb ! tke at time before135 REAL(wp), DIMENSION(jpi,jpj,jpk) :: mxlb ! mixing length at time before136 REAL(wp), DIMENSION(jpi,jpj,jpk) :: shear ! vertical shear137 REAL(wp), DIMENSION(jpi,jpj,jpk) :: eps ! dissipation rate138 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwall_psi ! Wall function use in the wb case (ln_sigpsi.AND.ln_crban=T)139 154 !!-------------------------------------------------------------------- 155 156 IF( wrk_in_use(2, 1,2,3) .OR. wrk_in_use(3, 1,2,3,4,5) ) THEN 157 CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.') ; RETURN 158 END IF 140 159 141 160 ! Preliminary computing … … 864 883 ENDIF 865 884 ! 885 IF( wrk_not_released(2, 1,2,3) .OR. & 886 wrk_not_released(3, 1,2,3,4,5) ) CALL ctl_stop('zdf_gls: failed to release workspace arrays') 887 ! 866 888 END SUBROUTINE zdf_gls 867 889 … … 896 918 !!---------------------------------------------------------- 897 919 898 REWIND ( numnam )!* Read Namelist namzdf_gls899 READ 920 REWIND( numnam ) !* Read Namelist namzdf_gls 921 READ ( numnam, namzdf_gls ) 900 922 901 923 IF(lwp) THEN !* Control print … … 923 945 ENDIF 924 946 947 ! !* allocate gls arrays 948 IF( zdf_gls_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_gls_init : unable to allocate arrays' ) 949 925 950 ! !* Check of some namelist values 926 951 IF( nn_tkebc_surf < 0 .OR. nn_tkebc_surf > 1 ) CALL ctl_stop( 'bad flag: nn_tkebc_surf is 0 or 1' ) … … 931 956 IF( nn_clos < 0 .OR. nn_clos > 3 ) CALL ctl_stop( 'bad flag: nn_clos is 0, 1, 2 or 3' ) 932 957 933 ! Initialisation of the parameters for the choosen closure 934 ! -------------------------------------------------------- 935 ! 936 SELECT CASE ( nn_clos ) 937 ! 938 CASE( 0 ) ! k-kl (Mellor-Yamada) 958 SELECT CASE ( nn_clos ) !* set the parameters for the chosen closure 959 ! 960 CASE( 0 ) ! k-kl (Mellor-Yamada) 939 961 ! 940 962 IF(lwp) WRITE(numout,*) 'The choosen closure is k-kl closed to the classical Mellor-Yamada' … … 954 976 END SELECT 955 977 ! 956 CASE( 1 ) ! k-eps978 CASE( 1 ) ! k-eps 957 979 ! 958 980 IF(lwp) WRITE(numout,*) 'The choosen closure is k-eps' … … 972 994 END SELECT 973 995 ! 974 CASE( 2 ) ! k-omega996 CASE( 2 ) ! k-omega 975 997 ! 976 998 IF(lwp) WRITE(numout,*) 'The choosen closure is k-omega' … … 990 1012 END SELECT 991 1013 ! 992 CASE( 3 ) ! generic1014 CASE( 3 ) ! generic 993 1015 ! 994 1016 IF(lwp) WRITE(numout,*) 'The choosen closure is generic' … … 1010 1032 END SELECT 1011 1033 1012 ! Initialisation of the parameters of the stability functions 1013 ! ----------------------------------------------------------- 1014 ! 1015 SELECT CASE ( nn_stab_func ) 1016 ! 1017 CASE ( 0 ) ! Galperin stability functions 1034 ! 1035 SELECT CASE ( nn_stab_func ) !* set the parameters of the stability functions 1036 ! 1037 CASE ( 0 ) ! Galperin stability functions 1018 1038 ! 1019 1039 IF(lwp) WRITE(numout,*) 'Stability functions from Galperin' … … 1027 1047 rghcri = 0.02_wp 1028 1048 ! 1029 CASE ( 1 ) ! Kantha-Clayson stability functions1049 CASE ( 1 ) ! Kantha-Clayson stability functions 1030 1050 ! 1031 1051 IF(lwp) WRITE(numout,*) 'Stability functions from Kantha-Clayson' … … 1039 1059 rghcri = 0.02_wp 1040 1060 ! 1041 CASE ( 2 ) ! Canuto A stability functions1061 CASE ( 2 ) ! Canuto A stability functions 1042 1062 ! 1043 1063 IF(lwp) WRITE(numout,*) 'Stability functions from Canuto A' … … 1063 1083 rghcri = 0.03_wp 1064 1084 ! 1065 CASE ( 3 ) ! Canuto B stability functions1085 CASE ( 3 ) ! Canuto B stability functions 1066 1086 ! 1067 1087 IF(lwp) WRITE(numout,*) 'Stability functions from Canuto B' … … 1088 1108 END SELECT 1089 1109 1090 ! Set Schmidt number for psi diffusion in the wave breaking case1091 ! See equation 13 of Carniel et al, Ocean modelling, 30, 225-239, 20091092 ! or equation(17) of Burchard, JPO, 31, 3133-3145, 20011110 ! !* Set Schmidt number for psi diffusion in the wave breaking case 1111 ! ! See Eq. (13) of Carniel et al, OM, 30, 225-239, 2009 1112 ! ! or Eq. (17) of Burchard, JPO, 31, 3133-3145, 2001 1093 1113 IF( ln_sigpsi .AND. ln_crban ) THEN 1094 1114 zcr = SQRT( 1.5_wp*rsc_tke ) * rcm_sf / vkarmn … … 1100 1120 ENDIF 1101 1121 1102 ! Shear free turbulence parameters:1122 ! !* Shear free turbulence parameters 1103 1123 ! 1104 1124 ra_sf = -4._wp * rnn * SQRT( rsc_tke ) / ( (1._wp+4._wp*rmm) * SQRT( rsc_tke ) & … … 1111 1131 1112 1132 ! 1113 IF(lwp) THEN !Control print1133 IF(lwp) THEN !* Control print 1114 1134 WRITE(numout,*) 1115 1135 WRITE(numout,*) 'Limit values' … … 1134 1154 ENDIF 1135 1155 1136 ! Constants initialization1156 ! !* Constants initialization 1137 1157 rc02 = rc0 * rc0 ; rc02r = 1. / rc02 1138 1158 rc03 = rc02 * rc0 … … 1161 1181 avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk) 1162 1182 END DO 1163 ! !* read or initialize all required files1164 CALL gls_rst( nit000, 'READ' ) 1183 ! 1184 CALL gls_rst( nit000, 'READ' ) !* read or initialize all required files 1165 1185 ! 1166 1186 END SUBROUTINE zdf_gls_init
Note: See TracChangeset
for help on using the changeset viewer.
