- Timestamp:
- 2013-11-20T11:17:17+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r3862 r4280 25 25 26 26 PUBLIC dom_rea ! routine called by inidom.F90 27 !! * Substitutions 28 # include "domzgr_substitute.h90" 27 29 !!---------------------------------------------------------------------- 28 30 !! NEMO/OFF 3.3 , NEMO Consortium (2010) … … 173 175 CALL iom_get( inum4, jpdom_unknown, 'esigw', esigw ) 174 176 175 CALL iom_get( inum4, jpdom_data, 'e3t', e3t) ! scale factors176 CALL iom_get( inum4, jpdom_data, 'e3u', e3u)177 CALL iom_get( inum4, jpdom_data, 'e3v', e3v)178 CALL iom_get( inum4, jpdom_data, 'e3w', e3w)177 CALL iom_get( inum4, jpdom_data, 'e3t', fse3t_n(:,:,:) ) ! scale factors 178 CALL iom_get( inum4, jpdom_data, 'e3u', fse3u_n(:,:,:) ) 179 CALL iom_get( inum4, jpdom_data, 'e3v', fse3v_n(:,:,:) ) 180 CALL iom_get( inum4, jpdom_data, 'e3w', fse3w_n(:,:,:) ) 179 181 180 182 CALL iom_get( inum4, jpdom_unknown, 'gdept_1d', gdept_1d ) ! depth … … 190 192 ! 191 193 IF( nmsh <= 6 ) THEN ! 3D vertical scale factors 192 CALL iom_get( inum4, jpdom_data, 'e3t', e3t)193 CALL iom_get( inum4, jpdom_data, 'e3u', e3u)194 CALL iom_get( inum4, jpdom_data, 'e3v', e3v)195 CALL iom_get( inum4, jpdom_data, 'e3w', e3w)194 CALL iom_get( inum4, jpdom_data, 'e3t', fse3t_n(:,:,:) ) 195 CALL iom_get( inum4, jpdom_data, 'e3u', fse3u_n(:,:,:) ) 196 CALL iom_get( inum4, jpdom_data, 'e3v', fse3v_n(:,:,:) ) 197 CALL iom_get( inum4, jpdom_data, 'e3w', fse3w_n(:,:,:) ) 196 198 ELSE ! 2D bottom scale factors 197 199 CALL iom_get( inum4, jpdom_data, 'e3t_ps', e3tp ) … … 199 201 ! ! deduces the 3D scale factors 200 202 DO jk = 1, jpk 201 e3t(:,:,jk) = e3t_1d(jk) ! set to the ref. factors202 e3u(:,:,jk) = e3t_1d(jk)203 e3v(:,:,jk) = e3t_1d(jk)204 e3w(:,:,jk) = e3w_1d(jk)203 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 204 fse3u_n(:,:,jk) = e3t_1d(jk) 205 fse3v_n(:,:,jk) = e3t_1d(jk) 206 fse3w_n(:,:,jk) = e3w_1d(jk) 205 207 END DO 206 208 DO jj = 1,jpj ! adjust the deepest values 207 209 DO ji = 1,jpi 208 210 ik = mbkt(ji,jj) 209 e3t(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) )210 e3w(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) )211 fse3t_n(ji,jj,ik) = e3tp(ji,jj) * tmask(ji,jj,1) + e3t_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 212 fse3w_n(ji,jj,ik) = e3wp(ji,jj) * tmask(ji,jj,1) + e3w_1d(1) * ( 1._wp - tmask(ji,jj,1) ) 211 213 END DO 212 214 END DO … … 214 216 DO jj = 1, jpjm1 215 217 DO ji = 1, jpim1 216 e3u(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji+1,jj,jk) )217 e3v(ji,jj,jk) = MIN( e3t(ji,jj,jk), e3t(ji,jj+1,jk) )218 fse3u_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji+1,jj,jk) ) 219 fse3v_n(ji,jj,jk) = MIN( fse3t_n(ji,jj,jk), fse3t_n(ji,jj+1,jk) ) 218 220 END DO 219 221 END DO 220 222 END DO 221 CALL lbc_lnk( e3u , 'U', 1._wp ) ; CALL lbc_lnk( e3uw, 'U', 1._wp ) ! lateral boundary conditions222 CALL lbc_lnk( e3v , 'V', 1._wp ) ; CALL lbc_lnk( e3vw, 'V', 1._wp )223 CALL lbc_lnk( fse3u_n(:,:,:) , 'U', 1._wp ) ; CALL lbc_lnk( fse3uw_n(:,:,:), 'U', 1._wp ) ! lateral boundary conditions 224 CALL lbc_lnk( fse3v_n(:,:,:) , 'V', 1._wp ) ; CALL lbc_lnk( fse3vw_n(:,:,:), 'V', 1._wp ) 223 225 ! 224 226 DO jk = 1, jpk ! set to z-scale factor if zero (i.e. along closed boundaries) 225 WHERE( e3u(:,:,jk) == 0._wp ) e3u(:,:,jk) = e3t_1d(jk)226 WHERE( e3v(:,:,jk) == 0._wp ) e3v(:,:,jk) = e3t_1d(jk)227 WHERE( fse3u_n(:,:,jk) == 0._wp ) fse3u_n(:,:,jk) = e3t_1d(jk) 228 WHERE( fse3v_n(:,:,jk) == 0._wp ) fse3v_n(:,:,jk) = e3t_1d(jk) 227 229 END DO 228 230 END IF 229 231 230 232 IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN ! 3D depth of t- and w-level 231 CALL iom_get( inum4, jpdom_data, 'gdept', gdept)232 CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw)233 CALL iom_get( inum4, jpdom_data, 'gdept', fsdept_n(:,:,:) ) 234 CALL iom_get( inum4, jpdom_data, 'gdepw', fsdepw_n(:,:,:) ) 233 235 ELSE ! 2D bottom depth 234 236 CALL iom_get( inum4, jpdom_data, 'hdept', zprt ) … … 236 238 ! 237 239 DO jk = 1, jpk ! deduces the 3D depth 238 gdept(:,:,jk) = gdept_1d(jk)239 gdepw(:,:,jk) = gdepw_1d(jk)240 fsdept_n(:,:,jk) = gdept_1d(jk) 241 fsdepw_n(:,:,jk) = gdepw_1d(jk) 240 242 END DO 241 243 DO jj = 1, jpj … … 243 245 ik = mbkt(ji,jj) 244 246 IF( ik > 0 ) THEN 245 gdepw(ji,jj,ik+1) = zprw(ji,jj)246 gdept(ji,jj,ik ) = zprt(ji,jj)247 gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik)247 fsdepw_n(ji,jj,ik+1) = zprw(ji,jj) 248 fsdept_n(ji,jj,ik ) = zprt(ji,jj) 249 fsdept_n(ji,jj,ik+1) = fsdept_n(ji,jj,ik) + fse3t_n(ji,jj,ik) 248 250 ENDIF 249 251 END DO … … 259 261 CALL iom_get( inum4, jpdom_unknown, 'e3w_1d' , e3w_1d ) 260 262 DO jk = 1, jpk 261 e3t(:,:,jk) = e3t_1d(jk) ! set to the ref. factors262 e3u(:,:,jk) = e3t_1d(jk)263 e3v(:,:,jk) = e3t_1d(jk)264 e3w(:,:,jk) = e3w_1d(jk)265 gdept(:,:,jk) = gdept_1d(jk)266 gdepw(:,:,jk) = gdepw_1d(jk)263 fse3t_n(:,:,jk) = e3t_1d(jk) ! set to the ref. factors 264 fse3u_n(:,:,jk) = e3t_1d(jk) 265 fse3v_n(:,:,jk) = e3t_1d(jk) 266 fse3w_n(:,:,jk) = e3w_1d(jk) 267 fsdept_n(:,:,jk) = gdept_1d(jk) 268 fsdepw_n(:,:,jk) = gdepw_1d(jk) 267 269 END DO 268 270 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.