- Timestamp:
- 2015-11-05T15:03:28+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r5845 r5862 875 875 !! *** ROUTINE zgr_zco *** 876 876 !! 877 !! ** Purpose : define the z-coordinate system877 !! ** Purpose : define the reference z-coordinate system 878 878 !! 879 879 !! ** Method : set 3D coord. arrays to reference 1D array … … 907 907 !! 908 908 !! ** Purpose : the depth and vertical scale factor in partial step 909 !! z-coordinate case909 !! reference z-coordinate case 910 910 !! 911 911 !! ** Method : Partial steps : computes the 3D vertical scale factors … … 959 959 IF( nn_timing == 1 ) CALL timing_start('zgr_zps') 960 960 ! 961 CALL wrk_alloc( jpi, jpj, jpk,zprt )961 CALL wrk_alloc( jpi,jpj,jpk, zprt ) 962 962 ! 963 963 IF(lwp) WRITE(numout,*) … … 1197 1197 END IF 1198 1198 ! 1199 CALL wrk_dealloc( jpi, jpj, jpk,zprt )1199 CALL wrk_dealloc( jpi,jpj,jpk, zprt ) 1200 1200 ! 1201 1201 IF( nn_timing == 1 ) CALL timing_stop('zgr_zps') … … 1234 1234 IF( nn_timing == 1 ) CALL timing_start('zgr_isf') 1235 1235 ! 1236 CALL wrk_alloc( jpi, jpj,zbathy, zmask, zrisfdep)1237 CALL wrk_alloc( jpi, jpj,zmisfdep, zmbathy )1236 CALL wrk_alloc( jpi,jpj, zbathy, zmask, zrisfdep) 1237 CALL wrk_alloc( jpi,jpj, zmisfdep, zmbathy ) 1238 1238 1239 1239 … … 1251 1251 WHERE( 0._wp < risfdep(:,:) .AND. risfdep(:,:) >= zdepth ) misfdep(:,:) = jk+1 1252 1252 END DO 1253 WHERE (risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) .GT.0._wp)1254 risfdep(:,:) = 0. ;misfdep(:,:) = 11253 WHERE (risfdep(:,:) <= e3t_1d(1) .AND. risfdep(:,:) > 0._wp) 1254 risfdep(:,:) = 0. ; misfdep(:,:) = 1 1255 1255 END WHERE 1256 1256 … … 1259 1259 ! run the bathy check 10 times to be sure all the modif in the bathy or iceshelf draft are compatible together 1260 1260 DO jl = 1, 10 1261 WHERE (bathy(:,:) .EQ.risfdep(:,:) )1261 WHERE (bathy(:,:) == risfdep(:,:) ) 1262 1262 misfdep(:,:) = 0 ; risfdep(:,:) = 0._wp 1263 1263 mbathy (:,:) = 0 ; bathy (:,:) = 0._wp … … 1266 1266 misfdep(:,:) = 0; risfdep(:,:) = 0._wp 1267 1267 mbathy (:,:) = 0; bathy (:,:) = 0._wp 1268 END WHERE1268 END WHERE 1269 1269 IF( lk_mpp ) THEN 1270 1270 zbathy(:,:) = FLOAT( misfdep(:,:) ) … … 1311 1311 ! find the minimum change option: 1312 1312 ! test bathy 1313 IF (risfdep(ji,jj) .GT.1) THEN1313 IF (risfdep(ji,jj) > 1) THEN 1314 1314 zbathydiff =ABS(bathy(ji,jj) - (gdepw_1d(mbathy (ji,jj)+1) & 1315 1315 & + MIN( e3zps_min, e3t_1d(mbathy (ji,jj)+1)*e3zps_rat ))) … … 1317 1317 & - MIN( e3zps_min, e3t_1d(misfdep(ji,jj)-1)*e3zps_rat ))) 1318 1318 1319 IF (bathy(ji,jj) .GT. risfdep(ji,jj) .AND. mbathy(ji,jj) .LT.misfdep(ji,jj)) THEN1319 IF (bathy(ji,jj) > risfdep(ji,jj) .AND. mbathy(ji,jj) < misfdep(ji,jj)) THEN 1320 1320 IF (zbathydiff .LE. zrisfdepdiff) THEN 1321 1321 bathy(ji,jj) = gdepw_1d(mbathy(ji,jj)) + MIN( e3zps_min, e3t_1d(mbathy(ji,jj)+1)*e3zps_rat ) … … 1768 1768 IF( nn_timing == 1 ) CALL timing_start('zgr_sco') 1769 1769 ! 1770 CALL wrk_alloc( jpi, jpj,zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 )1770 CALL wrk_alloc( jpi,jpj, zenv, ztmp, zmsk, zri, zrj, zhbat , ztmpi1, ztmpi2, ztmpj1, ztmpj2 ) 1771 1771 ! 1772 1772 REWIND( numnam_ref ) ! Namelist namzgr_sco in reference namelist : Sigma-stretching parameters … … 2046 2046 #endif 2047 2047 2048 !!gm I don't like that HERE we are supposed to set the reference coordinate (i.e. _0 arrays) 2049 !!gm and only that !!!!! 2050 !!gm THIS should be removed from here ! 2048 2051 gdept_n(:,:,:) = gdept_0(:,:,:) 2049 2052 gdepw_n(:,:,:) = gdepw_0(:,:,:) … … 2056 2059 e3uw_n (:,:,:) = e3uw_0 (:,:,:) 2057 2060 e3vw_n (:,:,:) = e3vw_0 (:,:,:) 2061 !! gm end 2058 2062 !! 2059 2063 ! HYBRID : … … 2063 2067 IF( scobot(ji,jj) >= gdept_n(ji,jj,jk) ) mbathy(ji,jj) = MAX( 2, jk ) 2064 2068 END DO 2065 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 02069 IF( scobot(ji,jj) == 0._wp ) mbathy(ji,jj) = 0 2066 2070 END DO 2067 2071 END DO … … 2114 2118 END DO 2115 2119 ENDIF 2116 2117 !================================================================================2118 ! check the coordinate makes sense2119 !================================================================================2120 ! 2121 !================================================================================ 2122 ! check the coordinate makes sense 2123 !================================================================================ 2120 2124 DO ji = 1, jpi 2121 2125 DO jj = 1, jpj 2122 2126 ! 2123 2127 IF( hbatt(ji,jj) > 0._wp) THEN 2124 2128 DO jk = 1, mbathy(ji,jj) … … 2147 2151 ENDIF 2148 2152 END DO 2149 2153 ! 2150 2154 DO jk = 1, mbathy(ji,jj)-1 2151 2155 ! and check it never exceeds the total depth … … 2157 2161 ENDIF 2158 2162 END DO 2159 2160 2163 ENDIF 2161 2162 2164 END DO 2163 2165 END DO … … 2169 2171 END SUBROUTINE zgr_sco 2170 2172 2171 !!====================================================================== 2173 2172 2174 SUBROUTINE s_sh94() 2173 2174 2175 !!---------------------------------------------------------------------- 2175 2176 !! *** ROUTINE s_sh94 *** … … 2182 2183 !! Reference : Song and Haidvogel 1994. 2183 2184 !!---------------------------------------------------------------------- 2184 !2185 2185 INTEGER :: ji, jj, jk ! dummy loop argument 2186 2186 REAL(wp) :: zcoeft, zcoefw ! temporary scalars … … 2188 2188 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2189 2189 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2190 2191 CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2192 CALL wrk_alloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2190 !!---------------------------------------------------------------------- 2191 2192 CALL wrk_alloc( jpi,jpj,jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2193 CALL wrk_alloc( jpi,jpj,jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2193 2194 2194 2195 z_gsigw3 = 0._wp ; z_gsigt3 = 0._wp ; z_gsi3w3 = 0._wp … … 2196 2197 z_esigtu3 = 0._wp ; z_esigtv3 = 0._wp ; z_esigtf3 = 0._wp 2197 2198 z_esigwu3 = 0._wp ; z_esigwv3 = 0._wp 2198 2199 ! 2199 2200 DO ji = 1, jpi 2200 2201 DO jj = 1, jpj 2201 2202 ! 2202 2203 IF( hbatt(ji,jj) > rn_hc ) THEN !deep water, stretched sigma 2203 2204 DO jk = 1, jpk … … 2262 2263 END DO 2263 2264 END DO 2264 2265 CALL wrk_dealloc( jpi, jpj, jpk,z_gsigw3, z_gsigt3, z_gsi3w3 )2266 CALL wrk_dealloc( jpi, jpj, jpk,z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 )2267 2265 ! 2266 CALL wrk_dealloc( jpi,jpj,jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2267 CALL wrk_dealloc( jpi,jpj,jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2268 ! 2268 2269 END SUBROUTINE s_sh94 2269 2270 2271 2270 2272 SUBROUTINE s_sf12 2271 2272 2273 !!---------------------------------------------------------------------- 2273 2274 !! *** ROUTINE s_sf12 *** … … 2285 2286 !! Reference : Siddorn and Furner 2012 (submitted Ocean modelling). 2286 2287 !!---------------------------------------------------------------------- 2287 !2288 2288 INTEGER :: ji, jj, jk ! dummy loop argument 2289 2289 REAL(wp) :: zsmth ! smoothing around critical depth … … 2292 2292 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_gsigw3, z_gsigt3, z_gsi3w3 2293 2293 REAL(wp), POINTER, DIMENSION(:,:,:) :: z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 2294 2294 !!---------------------------------------------------------------------- 2295 2295 ! 2296 2296 CALL wrk_alloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) … … 2385 2385 e3f_0(ji,jj,jk)=(scosrf(ji,jj)+hbatf(ji,jj))*z_esigtf3(ji,jj,jk) 2386 2386 ! 2387 e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk)2387 e3w_0 (ji,jj,jk)=hbatt(ji,jj)*z_esigw3(ji,jj,jk) 2388 2388 e3uw_0(ji,jj,jk)=hbatu(ji,jj)*z_esigwu3(ji,jj,jk) 2389 2389 e3vw_0(ji,jj,jk)=hbatv(ji,jj)*z_esigwv3(ji,jj,jk) … … 2398 2398 CALL lbc_lnk(e3uw_0,'T',1.) ; CALL lbc_lnk(e3vw_0,'T',1.) 2399 2399 ! 2400 ! ! ============= 2401 2402 CALL wrk_dealloc( jpi, jpj, jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2403 CALL wrk_dealloc( jpi, jpj, jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2404 2400 CALL wrk_dealloc( jpi,jpj,jpk, z_gsigw3, z_gsigt3, z_gsi3w3 ) 2401 CALL wrk_dealloc( jpi,jpj,jpk, z_esigt3, z_esigw3, z_esigtu3, z_esigtv3, z_esigtf3, z_esigwu3, z_esigwv3 ) 2402 ! 2405 2403 END SUBROUTINE s_sf12 2406 2404 2405 2407 2406 SUBROUTINE s_tanh() 2408 2409 2407 !!---------------------------------------------------------------------- 2410 2408 !! *** ROUTINE s_tanh***
Note: See TracChangeset
for help on using the changeset viewer.
