Changeset 15129
- Timestamp:
- 2021-07-18T19:07:50+02:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg
- Files:
-
- 4 edited
-
namelist_cfg (modified) (1 diff)
-
namelist_ref (modified) (1 diff)
-
src/mes.F90 (modified) (7 diffs)
-
src/zgrmes.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/namelist_cfg
r15125 r15129 44 44 ! Song & Haidvogel 1994 (1) or 45 45 ! Siddorn & Furner 2012 (2) 46 rn_ebot_min = 2.0 , 27.0 , 670.0 , 2700.0 , 7000.0 ! minimum depth of envelopes (>0, in m) 47 rn_ebot_max = 2.0 , 570.0 , 2300.0 , 5900.0 , 7000.0 ! maximum depth of envelopes (>0, in m) 48 nn_slev = 3 , 33 , 21 , 18 , 0 ! number of s-lev between env(n-1) 46 nn_slev = 3 , 37 , 17 , 18 , 0 ! number of s-lev between env(n-1) 49 47 ! and env(n) 50 rn_e_hc = 0.0 , 0.0 , 0.0 , 0.0 , 0.0 ! critical depth for transition to 48 rn_e_hc = 0.0 , 0.0 , 0.0 , 0.0 , 0.0 ! critical depth for transition to 51 49 ! stretch. coord. 52 rn_e_th = 1.0 , 1.2 , 2.0 , 0.0 , 0.0 ! surf. control param.: 50 rn_e_th = 1.0 , 1.2 , 2.0 , 0.0 , 0.0 ! surf. control param.: 53 51 ! SH94 or MD96: 0<=th<=20 54 52 ! SF12: thickness surf. cell 55 rn_e_bb = 0.9 , 0.9 , 0.85 , 0.0 , 0.0 ! bot. control param.: 53 rn_e_bb = 0.9 , 0.9 , 0.85 , 0.0 , 0.0 ! bot. control param.: 56 54 ! SH94 or MD96: 0<=bb<=1 57 55 ! SF12: offset for calculating Zb -
NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/namelist_ref
r15125 r15129 142 142 ! Song & Haidvogel 1994 (1) or 143 143 ! Siddorn & Furner 2012 (2) 144 rn_ebot_min = 15.0 , 1000.0 , 1800.0 , 0.0 , 0.0 ! minimum depth of envelopes (>0, in m)145 rn_ebot_max = 200.0 , 1000.0 , 2230.0 , 0.0 , 0.0 ! maximum depth of envelopes (>0, in m)146 144 nn_slev = 11 , 10 , 10 , 0 , 0 ! number of s-lev between env(n-1) 147 145 ! and env(n) -
NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/mes.F90
r15126 r15129 26 26 PRIVATE 27 27 28 PUBLIC zgr_mes_build ! called by zgrmes.F90 29 ! Bruciaferri, Shapiro & Wobus (2018) envelopes and stretching parameters 28 PUBLIC mes_build ! called by zgrmes.F90 29 ! 30 ! Envelopes and stretching parameters 30 31 CHARACTER(lc) :: ctlmes ! control message error (lc=256) 31 32 INTEGER, PARAMETER :: max_nn_env = 5 ! Maximum allowed number of envelopes. 32 REAL(wp) :: rn_bot_min ! minimum depth of ocean bottom (>0) (m) 33 REAL(wp) :: rn_bot_max ! maximum depth of ocean bottom (= ocean depth) (>0) (m) 33 INTEGER :: tot_env ! Tot number of requested envelopes 34 34 LOGICAL :: ln_envl(max_nn_env) ! Array with flags (T/F) specifing which envelope is used 35 35 INTEGER :: nn_strt(max_nn_env) ! Array specifing the stretching function for each envelope: 36 36 ! Madec 1996 (0), Song and Haidvogel 1994 (1) 37 REAL(wp) :: rn_ebot_min(max_nn_env) ! minimum depth of envelopes (>0) (m)38 37 REAL(wp) :: rn_ebot_max(max_nn_env) ! maximum depth of envelopes (= envelopes depths) (>0) (m) 39 38 INTEGER :: nn_slev(max_nn_env) ! Array specifing number of levels of each enveloped vertical zone … … 49 48 ! each vertical sub-zone 50 49 LOGICAL, PUBLIC :: ln_loc_mes ! To use localised MEs (.TRUE.) or not (.FALSE. 50 ! 51 REAL(wp), POINTER, DIMENSION(:,:,:) :: envlt ! array for the envelopes 51 52 52 53 !! * Substitutions … … 57 58 ! ===================================================================================================== 58 59 59 SUBROUTINE zgr_mes_build60 SUBROUTINE mes_build 60 61 !!----------------------------------------------------------------------------- 61 !! *** ROUTINE zgr_mes***62 !! *** ROUTINE mes_build *** 62 63 !! 63 64 !! ** Purpose : define the Multi Enveloped S-coordinate (MES) system … … 135 136 136 137 ! 137 CHARACTER(lc) :: env_name ! name of the externally defined envelope138 138 INTEGER :: ji, jj, jk, jl, je ! dummy loop argument 139 INTEGER :: ios ! Local integer output status for namelist read140 INTEGER :: inum ! temporary logical unit141 INTEGER :: tot_env, cor_env142 139 INTEGER :: num_s, s_1st, ind ! for loops over envelopes 143 140 INTEGER :: num_s_up, num_s_dw ! for loops over envelopes … … 164 161 REAL(wp), POINTER, DIMENSION(:,: ) :: env0, env1, env2, env3 ! for loops over envelopes 165 162 ! for cubic splines 166 REAL(wp), POINTER, DIMENSION(:,:,:) :: envlt ! array for the envelopes167 163 INTEGER :: gst_envl(max_nn_env) ! Array to deal with a ghost last envelope 168 164 169 NAMELIST/namzgr_mes/rn_bot_min , rn_bot_max , ln_envl, nn_strt, & 170 rn_ebot_min, rn_ebot_max, nn_slev, rn_e_hc, & 171 rn_e_th, rn_e_bb, rn_e_ba, rn_e_al, ln_loc_mes 172 173 !!---------------------------------------------------------------------- 174 ! 175 IF( nn_timing == 1 ) CALL timing_start('zgr_mes') 176 ! 177 CALL wrk_alloc( jpi, jpj, max_nn_env , envlt ) 165 !!---------------------------------------------------------------------- 166 ! 167 IF( nn_timing == 1 ) CALL timing_start('mes_build') 168 ! 169 CALL mes_init 170 ! 178 171 CALL wrk_alloc( jpi, jpj, env_up, env_dw, env0, env1, env2, env3 ) 179 172 CALL wrk_alloc( jpk, z_gsigw1, z_gsigt1, z_esigw1, z_esigt1 ) 180 173 ! 181 ! Namelist namzgr_mes in reference namelist : envelopes and182 ! sigma-stretching parameters183 REWIND( numnam_ref )184 READ ( numnam_ref, namzgr_mes, IOSTAT = ios, ERR = 901)185 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_mes in reference namelist', lwp )186 ! Namelist namzgr_mes in configuration namelist : envelopes and187 ! sigma-stretching parameters188 REWIND( numnam_cfg )189 READ ( numnam_cfg, namzgr_mes, IOSTAT = ios, ERR = 902 )190 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_mes in configuration namelist', lwp )191 IF(lwm) WRITE ( numond, namzgr_mes )192 193 IF(lwp) THEN ! control print194 WRITE(numout,*)195 WRITE(numout,*) 'domzgr_mes : Multi Enveloped S-coordinate (Bruciaferri, Shapiro and Wobus 2017)'196 WRITE(numout,*) '~~~~~~~~~~~'197 WRITE(numout,*) ' Namelist namzgr_mes'198 WRITE(numout,*) ''199 WRITE(numout,*) ' Minimum depth of the ocean rn_bot_min, ', rn_bot_min200 WRITE(numout,*) ' Maximum depth of the ocean rn_bot_max, ', rn_bot_max201 WRITE(numout,*) ''202 WRITE(numout,*) '-------------------------------------------------------------------------------'203 DO je = 1, max_nn_env204 WRITE(numout,*) 'SUBDOMAIN ', je,':'205 IF ( je == 1) THEN206 WRITE(numout,*) ' Envelope up : envelope 0, free surface'207 WRITE(numout,*) ' Envelope down: envelope ',je,',ln_envl(',je,') = ',ln_envl(je)208 ELSE209 WRITE(numout,*) ' Envelope up : envelope ',je-1,',ln_envl(',je,') = ',ln_envl(je-1)210 WRITE(numout,*) ' Envelope down: envelope ',je ,',ln_envl(',je,') = ',ln_envl(je)211 END IF212 WRITE(numout,*) ' min dep of envlp down rn_ebot_min(',je,') = ',rn_ebot_min(je)213 WRITE(numout,*) ' max dep of envlp down rn_ebot_max(',je,') =',rn_ebot_max(je)214 WRITE(numout,*) ' num. of MEs-lev. nn_slev(',je,') = ',nn_slev(je)215 IF ( isodd(je) ) THEN216 WRITE(numout,*) ' Stretched s-coordinates: '217 ELSE218 WRITE(numout,*) ' Stretched CUBIC SPLINES: '219 END IF220 IF (nn_strt(je) == 0) WRITE(numout,*) ' M96 stretching function'221 IF (nn_strt(je) == 1) WRITE(numout,*) ' SH94 stretching function'222 IF (nn_strt(je) == 2) WRITE(numout,*) ' SF12 stretching function'223 WRITE(numout,*) ' critical depth rn_e_hc(',je,') = ',rn_e_hc(je)224 WRITE(numout,*) ' surface stretc. coef. rn_e_th(',je,') = ',rn_e_th(je)225 IF (nn_strt(je) == 2) THEN226 WRITE(numout,*) ' bottom stretc. coef. rn_e_ba(',je,') = ',rn_e_ba(je)227 END IF228 WRITE(numout,*) ' bottom stretc. coef. rn_e_bb(',je,') = ',rn_e_bb(je)229 IF (nn_strt(je) == 2) THEN230 WRITE(numout,*) ' bottom stretc. coef. rn_e_al(',je,') = ',rn_e_al(je)231 END IF232 WRITE(numout,*) '-------------------------------------------------------------------------------'233 ENDDO234 ENDIF235 236 ! Check if namelist is defined correctly.237 ! Not strictly needed but we force the user238 ! to define the namelist correctly.239 240 tot_env = 0 ! total number of requested envelopes241 cor_env = 0 ! total number of correctly defined envelopes242 DO je = 1, max_nn_env243 IF ( ln_envl(je) ) tot_env = tot_env + 1244 IF ( ln_envl(je) .AND. cor_env == (je-1)) cor_env = cor_env + 1245 ENDDO246 WRITE(ctlmes,*) 'number of REQUESTED envelopes and number of CORRECTLY defined envelopes are DIFFERENT'247 IF ( tot_env /= cor_env ) CALL ctl_stop( ctlmes )248 249 !Checking consistency of user defined parameters250 WRITE(ctlmes,*) 'TOT number of levels (jpk) IS DIFFERENT from sum over nn_slev(:)'251 IF ( SUM(nn_slev(:)) /= jpk ) CALL ctl_stop( ctlmes )252 253 174 ! Determining if there is a "ghost" envelope: 254 175 gst_envl(:) = 0 255 176 IF ( nn_slev(tot_env) == 0 ) gst_envl(tot_env) = 1 256 257 ! Reading bathymetry and envelopes. 258 ! In future should be included in zgr_bat. 259 260 IF( ntopo == 1 ) THEN 261 262 CALL iom_open ( 'bathy_meter.nc', inum ) 263 CALL iom_get ( inum, jpdom_data, 'Bathymetry' , bathy, lrowattr=ln_use_jattr ) 264 265 DO je = 1, tot_env 266 WRITE (env_name, '(A6,I0)') 'hbatt_', je 267 CALL iom_get ( inum, jpdom_data, TRIM(env_name) , envlt(:,:,je), lrowattr=ln_use_jattr ) 268 ENDDO 269 270 CALL iom_close( inum ) 271 272 ELSE 273 274 WRITE(ctlmes,*) 'parameter , ntopo = ', ntopo 275 CALL ctl_stop( ctlmes ) 276 277 ENDIF 278 IF( nn_closea == 0 ) CALL clo_bat( bathy, mbathy ) !== NO closed seas or lakes ==! 279 280 ! Checking consistency of envelopes 281 282 DO je = 1, tot_env-1 283 WRITE(ctlmes,*) 'Envelope ', je+1, ' is shallower that Envelope ', je 284 IF (MAXVAL(envlt(:,:,je+1)) < MAXVAL(envlt(:,:,je))) CALL ctl_stop( ctlmes ) 285 ENDDO 286 287 ! Set maximum and minimum ocean depth 288 bathy(:,:) = MIN( rn_bot_max, bathy(:,:) ) 289 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_bot_min, bathy(ji,jj) ) 293 END DO 294 END DO 295 177 ! 296 178 ! Initializing to 0.0 some arrays: 297 179 ! … … 860 742 s_1st = s_1st + num_s - 1 861 743 num_s = nn_slev(je) + 1 862 max_env_up = rn_ebot_max(je-1) 863 min_env_up = rn_ebot_min(je-1) 744 max_env_up = MAXVAL(envlt(:,:,je-1)) 745 min_env_up = MINVAL(envlt(:,:,je-1)) 746 IF( lk_mpp ) CALL mpp_max( max_env_up ) 747 IF( lk_mpp ) CALL mpp_min( min_env_up ) 864 748 ENDIF 865 749 866 max_env_dw = rn_ebot_max(je) 867 min_env_dw = rn_ebot_min(je) 750 max_env_dw = MAXVAL(envlt(:,:,je)) 751 min_env_dw = MINVAL(envlt(:,:,je)) 752 IF( lk_mpp ) CALL mpp_max( max_env_dw ) 753 IF( lk_mpp ) CALL mpp_min( min_env_dw ) 868 754 869 755 IF ( max_env_up == min_env_up .AND. max_env_dw == min_env_dw ) THEN … … 997 883 CALL wrk_dealloc( jpk, z_gsigw1, z_gsigt1, z_esigw1, z_esigt1 ) 998 884 ! 999 IF( nn_timing == 1 ) CALL timing_stop('zgr_mes') 1000 1001 END SUBROUTINE zgr_mes_build 885 IF( nn_timing == 1 ) CALL timing_stop('mes_build') 886 887 END SUBROUTINE mes_build 888 889 ! ===================================================================================================== 890 891 SUBROUTINE mes_init 892 CHARACTER(lc) :: env_name ! name of the externally defined envelope 893 INTEGER :: ji, jj, je, iiemax, ijemax 894 INTEGER :: cor_env, ios, inum 895 REAL(wp) :: rn_bot_min ! minimum depth of ocean bottom (>0) (m) 896 REAL(wp) :: rn_bot_max ! maximum depth of ocean bottom (= ocean depth) (>0) (m) 897 REAL(wp), DIMENSION(jpi,jpj) :: pmsk ! for loops over envelopes 898 899 NAMELIST/namzgr_mes/rn_bot_min , rn_bot_max , ln_envl, & 900 nn_strt , nn_slev , rn_e_hc, & 901 rn_e_th , rn_e_bb , rn_e_ba, & 902 rn_e_al , ln_loc_mes 903 !!---------------------------------------------------------------------- 904 ! 905 IF( nn_timing == 1 ) CALL timing_start('mes_init') 906 ! 907 CALL wrk_alloc( jpi, jpj, max_nn_env , envlt ) 908 pmsk(:,:) = 1._wp 909 ! 910 ! Namelist namzgr_mes in reference namelist : envelopes and 911 ! sigma-stretching parameters 912 REWIND( numnam_ref ) 913 READ ( numnam_ref, namzgr_mes, IOSTAT = ios, ERR = 901) 914 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_mes in reference namelist', lwp ) 915 ! Namelist namzgr_mes in configuration namelist : envelopes and 916 ! sigma-stretching parameters 917 REWIND( numnam_cfg ) 918 READ ( numnam_cfg, namzgr_mes, IOSTAT = ios, ERR = 902 ) 919 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr_mes in configuration namelist', lwp ) 920 IF(lwm) WRITE ( numond, namzgr_mes ) 921 ! 922 ! 1) Check if namelist is defined correctly. 923 ! Not strictly needed but we force the user 924 ! to define the namelist correctly. 925 tot_env = 0 ! total number of requested envelopes 926 cor_env = 0 ! total number of correctly defined envelopes 927 DO je = 1, max_nn_env 928 IF ( ln_envl(je) ) tot_env = tot_env + 1 929 IF ( ln_envl(je) .AND. cor_env == (je-1)) cor_env = cor_env + 1 930 ENDDO 931 WRITE(ctlmes,*) 'num. of REQUESTED env. and num. of CORRECTLY defined env. are DIFFERENT' 932 IF ( tot_env /= cor_env ) CALL ctl_stop( ctlmes ) 933 ! 934 ! 2) Checking consistency of user defined parameters 935 WRITE(ctlmes,*) 'TOT number of levels (jpk) IS DIFFERENT from sum over nn_slev(:)' 936 IF ( SUM(nn_slev(:)) /= jpk ) CALL ctl_stop( ctlmes ) 937 ! 938 ! 3) Reading Bathymetry and envelopes 939 IF( ntopo == 1 ) THEN 940 CALL iom_open ( 'bathy_meter.nc', inum ) 941 CALL iom_get ( inum, jpdom_data, 'Bathymetry' , bathy, lrowattr=ln_use_jattr ) 942 DO je = 1, tot_env 943 WRITE (env_name, '(A6,I0)') 'hbatt_', je 944 CALL iom_get ( inum, jpdom_data, TRIM(env_name) , envlt(:,:,je), lrowattr=ln_use_jattr ) 945 ENDDO 946 CALL iom_close( inum ) 947 ELSE 948 WRITE(ctlmes,*) 'parameter , ntopo = ', ntopo 949 CALL ctl_stop( ctlmes ) 950 ENDIF 951 IF( nn_closea == 0 ) CALL clo_bat( bathy, mbathy ) !== NO closed seas or lakes ==! 952 ! 953 ! 4) Checking consistency of envelopes 954 DO je = 1, tot_env-1 955 WRITE(ctlmes,*) 'Envelope ', je+1, ' is shallower that Envelope ', je 956 IF (MAXVAL(envlt(:,:,je+1)) < MAXVAL(envlt(:,:,je))) CALL ctl_stop( ctlmes ) 957 ENDDO 958 ! 5) Computing max depth of envelopes in the deepest 959 ! point of the domain for first check of monotonicity 960 ! of transformation and computing 1D MEs-levels depths 961 ! (used by diawri.F90) 962 CALL mpp_maxloc( envlt(:,:,tot_env), pmsk(:,:), rn_ebot_max(tot_env), iiemax, ijemax ) 963 DO je = 1, tot_env 964 rn_ebot_max(je) = envlt(iiemax,ijemax,je) 965 END DO 966 ! 967 ! 6) Set maximum and minimum ocean depth 968 bathy(:,:) = MIN( rn_bot_max, bathy(:,:) ) 969 DO jj = 1, jpj 970 DO ji = 1, jpi 971 IF( bathy(ji,jj) > 0._wp ) bathy(ji,jj) = MAX( rn_bot_min, bathy(ji,jj) ) 972 END DO 973 END DO 974 ! 975 IF(lwp) THEN ! control print 976 WRITE(numout,*) 977 WRITE(numout,*) 'domzgr_mes : Multi Enveloped S-coordinate (Bruciaferri, Shapiro and Wobus 2017)' 978 WRITE(numout,*) '~~~~~~~~~~~' 979 WRITE(numout,*) ' Namelist namzgr_mes' 980 WRITE(numout,*) '' 981 WRITE(numout,*) ' Minimum depth of the ocean rn_bot_min, ', rn_bot_min 982 WRITE(numout,*) ' Maximum depth of the ocean rn_bot_max, ', rn_bot_max 983 WRITE(numout,*) '' 984 WRITE(numout,*) '-------------------------------------------------------------------------------' 985 DO je = 1, max_nn_env 986 WRITE(numout,*) 'SUBDOMAIN ', je,':' 987 IF ( je == 1) THEN 988 WRITE(numout,*) ' Envelope up : envelope 0, free surface' 989 WRITE(numout,*) ' Envelope down: envelope ',je,',ln_envl(',je,') = ',ln_envl(je) 990 ELSE 991 WRITE(numout,*) ' Envelope up : envelope ',je-1,',ln_envl(',je,') = ',ln_envl(je-1) 992 WRITE(numout,*) ' Envelope down: envelope ',je ,',ln_envl(',je,') = ',ln_envl(je) 993 END IF 994 WRITE(numout,*) ' max dep of envlp down rn_ebot_max(',je,') =',rn_ebot_max(je) 995 WRITE(numout,*) ' num. of MEs-lev. nn_slev(',je,') = ',nn_slev(je) 996 IF ( isodd(je) ) THEN 997 WRITE(numout,*) ' Stretched s-coordinates: ' 998 ELSE 999 WRITE(numout,*) ' Stretched CUBIC SPLINES: ' 1000 END IF 1001 IF (nn_strt(je) == 0) WRITE(numout,*) ' M96 stretching function' 1002 IF (nn_strt(je) == 1) WRITE(numout,*) ' SH94 stretching function' 1003 IF (nn_strt(je) == 2) WRITE(numout,*) ' SF12 stretching function' 1004 WRITE(numout,*) ' critical depth rn_e_hc(',je,') = ',rn_e_hc(je) 1005 WRITE(numout,*) ' surface stretc. coef. rn_e_th(',je,') = ',rn_e_th(je) 1006 IF (nn_strt(je) == 2) THEN 1007 WRITE(numout,*) ' bottom stretc. coef. rn_e_ba(',je,') = ',rn_e_ba(je) 1008 END IF 1009 WRITE(numout,*) ' bottom stretc. coef. rn_e_bb(',je,') = ',rn_e_bb(je) 1010 IF (nn_strt(je) == 2) THEN 1011 WRITE(numout,*) ' bottom stretc. coef. rn_e_al(',je,') = ',rn_e_al(je) 1012 END IF 1013 WRITE(numout,*) '-------------------------------------------------------------------------------' 1014 ENDDO 1015 ENDIF 1016 1017 END SUBROUTINE mes_init 1002 1018 1003 1019 ! ===================================================================================================== -
NEMO/branches/UKMO/tools_r4.0-HEAD_dev_MEs/DOMAINcfg/src/zgrmes.F90
r15126 r15129 56 56 ! 57 57 ! Generating a global MEs vertical grid 58 CALL zgr_mes_build58 CALL mes_build 59 59 60 60 ! Local MEs
Note: See TracChangeset
for help on using the changeset viewer.
