Changeset 4812 for branches/2014/dev_r4650_UKMO2_ice_shelves
- Timestamp:
- 2014-10-09T19:31:07+02:00 (10 years ago)
- Location:
- branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OFF_SRC/domain.F90
r4624 r4812 335 335 INTEGER :: ios 336 336 !! 337 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco 337 NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 338 338 !!---------------------------------------------------------------------- 339 339 … … 352 352 WRITE(numout,*) '~~~~~~~' 353 353 WRITE(numout,*) ' Namelist namzgr : set vertical coordinate' 354 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 355 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps 356 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 354 WRITE(numout,*) ' z-coordinate - full steps ln_zco = ', ln_zco 355 WRITE(numout,*) ' z-coordinate - partial steps ln_zps = ', ln_zps 356 WRITE(numout,*) ' s- or hybrid z-s-coordinate ln_sco = ', ln_sco 357 WRITE(numout,*) ' ice shelf cavity ln_isfcav = ', ln_isfcav 357 358 ENDIF 358 359 … … 361 362 IF( ln_zps ) ioptio = ioptio + 1 362 363 IF( ln_sco ) ioptio = ioptio + 1 363 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 364 IF( ln_isfcav ) ioptio = 33 365 IF ( ioptio /= 1 ) CALL ctl_stop( ' none or several vertical coordinate options used' ) 366 IF ( ioptio == 33 ) CALL ctl_stop( ' isf cavity with off line module not yet done ' ) 364 367 365 368 END SUBROUTINE dom_zgr -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r4569 r4812 164 164 165 165 CALL iom_get( inum4, jpdom_data, 'mbathy', zmbk ) ! number of ocean t-points 166 mbathy(:,:) = INT( zmbk(:,:) ) 166 mbathy (:,:) = INT( zmbk(:,:) ) 167 misfdep(:,:) = 1 ! ice shelf case not yet done 167 168 168 169 CALL zgr_bot_level ! mbk. arrays (deepest ocean t-, u- & v-points … … 371 372 ! 372 373 mbkt(:,:) = MAX( mbathy(:,:) , 1 ) ! bottom k-index of T-level (=1 over land) 374 mikt(:,:) = 1 ; miku(:,:) = 1; mikv(:,:) = 1; ! top k-index of T-level (=1 over open ocean; >1 beneath ice shelf) 373 375 ! ! bottom k-index of W-level = mbkt+1 374 376 DO jj = 1, jpjm1 ! bottom k-index of u- (v-) level -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r4624 r4812 537 537 CALL eos( pts, rhd, rhop, gdept_0(:,:,:) ) ! Time-filtered in situ density 538 538 CALL bn2( pts, rn2 ) ! before Brunt-Vaisala frequency 539 IF( ln_zps ) & 540 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, rhd, gru, grv ) ! Partial steps: before Horizontal DErivative 539 IF( ln_zps ) & ! Partial steps: before Horizontal DErivative 540 & CALL zps_hde( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient 541 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & ! 542 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 543 ! only gtsu, gtsv, rhd, gru , grv are used 544 545 541 546 ! ! of t, s, rd at the bottom ocean level 542 547 CALL zdf_mxl( kt ) ! mixed layer depth -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r4292 r4812 17 17 USE timing ! Timing 18 18 USE oce ! ocean dynamics and tracers 19 USE sbcisf ! ice shelf 19 20 USE dom_oce ! ocean space and time domain 20 21 USE phycst ! physical constants … … 90 91 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 91 92 ! ----------------------------------------------------------------------- 92 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau093 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 93 94 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 94 95 -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90
r4704 r4812 114 114 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 115 115 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 116 IF (ikbu .GE. 2) avmu(ji,jj,ikbu -1) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu-1)117 IF (ikbv .GE. 2) avmv(ji,jj,ikbv -1) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv-1)116 IF (ikbu .GE. 2) avmu(ji,jj,ikbu) = -tfrua(ji,jj) * fse3uw(ji,jj,ikbu) 117 IF (ikbv .GE. 2) avmv(ji,jj,ikbv) = -tfrva(ji,jj) * fse3vw(ji,jj,ikbv) 118 118 END DO 119 119 END DO … … 176 176 zzwi = zcoef * avmu (ji,jj,jk ) / fse3uw(ji,jj,jk ) 177 177 zwi(ji,jj,jk) = zzwi * umask(ji,jj,jk) 178 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 178 zzws = zcoef * avmu (ji,jj,jk+1) / fse3uw(ji,jj,jk+1) 179 179 zws(ji,jj,jk) = zzws * umask(ji,jj,jk+1) 180 180 zwd(ji,jj,jk) = 1._wp - zwi(ji,jj,jk) - zzws … … 184 184 DO jj = 2, jpjm1 ! Surface boundary conditions 185 185 DO ji = fs_2, fs_jpim1 ! vector opt. 186 zwi(ji,jj, miku(ji,jj)) = 0._wp187 zwd(ji,jj, miku(ji,jj)) = 1._wp - zws(ji,jj,miku(ji,jj))186 zwi(ji,jj,1) = 0._wp 187 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 188 188 END DO 189 189 END DO … … 275 275 DO jj = 2, jpjm1 ! Surface boundary conditions 276 276 DO ji = fs_2, fs_jpim1 ! vector opt. 277 zwi(ji,jj, mikv(ji,jj)) = 0._wp278 zwd(ji,jj, mikv(ji,jj)) = 1._wp - zws(ji,jj,mikv(ji,jj))277 zwi(ji,jj,1) = 0._wp 278 zwd(ji,jj,1) = 1._wp - zws(ji,jj,1) 279 279 END DO 280 280 END DO … … 306 306 DO jj = 2, jpjm1 !== second recurrence: SOLk = RHSk - Lk / Dk-1 Lk-1 == 307 307 DO ji = fs_2, fs_jpim1 ! vector opt. 308 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj, 1) + r_vvl * fse3v_a(ji,jj,1)308 ze3va = ( 1._wp - r_vvl ) * fse3v_n(ji,jj,mikv(ji,jj)) + r_vvl * fse3v_a(ji,jj,mikv(ji,jj)) 309 309 #if defined key_dynspg_ts 310 310 va(ji,jj,mikv(ji,jj)) = va(ji,jj,mikv(ji,jj)) + p2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & … … 349 349 IF( ln_bfrimp ) THEN 350 350 # if defined key_vectopt_loop 351 DO jj = 1, 1352 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)351 DO jj = 1, 1 352 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling) 353 353 # else 354 DO jj = 2, jpjm1355 DO ji = 2, jpim1354 DO jj = 2, jpjm1 355 DO ji = 2, jpim1 356 356 # endif 357 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points358 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points)359 avmu(ji,jj,ikbu+1) = 0.e0360 avmv(ji,jj,ikbv+1) = 0.e0361 ikbu = miku(ji,jj) ! ocean top level at u- and v-points362 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points)363 avmu(ji,jj,ikbu-1) = 0.e0364 avmv(ji,jj,ikbv-1) = 0.e0365 END DO366 END DO357 ikbu = mbku(ji,jj) ! ocean bottom level at u- and v-points 358 ikbv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 359 avmu(ji,jj,ikbu+1) = 0.e0 360 avmv(ji,jj,ikbv+1) = 0.e0 361 ikbu = miku(ji,jj) ! ocean top level at u- and v-points 362 ikbv = mikv(ji,jj) ! (first wet ocean u- and v-points) 363 IF (ikbu > 1) avmu(ji,jj,ikbu) = 0.e0 364 IF (ikbv > 1) avmv(ji,jj,ikbv) = 0.e0 365 END DO 366 END DO 367 367 ENDIF 368 368 ! -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4704 r4812 108 108 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 109 109 REAL(wp) :: zck, zfk, zbw ! - - 110 REAL(wp) :: zdepv, zdepu ! - - 110 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 111 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr 112 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv 114 REAL(wp), POINTER, DIMENSION(:,: ) :: zhmlpu, zhmlpv 113 115 !!---------------------------------------------------------------------- 114 116 ! … … 116 118 ! 117 119 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 120 CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv ) 118 121 119 122 IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN … … 153 156 ! 154 157 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 155 DO jk = 2, jpkm1158 DO jk = 1, jpkm1 156 159 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point 157 160 ! ! trick: tmask(ik ) = 0 => all pn2 = 0 => zdzr = 0 … … 162 165 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 163 166 END DO 167 ! surface initialisation 168 DO jj = 1, jpjm1 169 DO ji = 1, jpim1 170 zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 171 END DO 172 END DO 164 173 ! 165 174 ! !== Slopes just below the mixed layer ==! … … 170 179 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 171 180 ! 181 DO jj = 2, jpjm1 182 DO ji = fs_2, fs_jpim1 ! vector opt. 183 IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji ,jj) 184 IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = hmlpt(ji+1,jj) 185 IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj), hmlpt(ji+1,jj)) 186 IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji ,jj) 187 IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = hmlpt(ji,jj+1) 188 IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji,jj+1)) 189 ENDDO 190 ENDDO 172 191 DO jk = 2, jpkm1 !* Slopes at u and v points 173 192 DO jj = 2, jpjm1 … … 183 202 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 184 203 ! ! uslp and vslp output in zwz and zww, resp. 185 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 186 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 187 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 188 & + zfi * uslpml(ji,jj) & 189 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 190 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 191 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 192 & + zfj * vslpml(ji,jj) & 193 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 194 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 204 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 205 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 206 ! thickness of water column between surface and level k at u/v point 207 zdepu = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) & 208 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) & 209 - fse3u(ji,jj,miku(ji,jj)) ) 210 zdepv = 0.5_wp * (( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) & 211 - 2 * MAX( risfdep(ji,jj), risfdep(ji,jj+1) ) & 212 - fse3v(ji,jj,mikv(ji,jj)) ) 213 zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) & 214 & + zfi * uslpml(ji,jj) & 215 & * zdepu / MAX( zhmlpu(ji,jj), 5._wp ) 216 zwz(ji,jj,jk) = zwz(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj,jk-1) 217 zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) & 218 & + zfj * vslpml(ji,jj) & 219 & * zdepv / MAX( zhmlpv(ji,jj), 5._wp ) 220 zww(ji,jj,jk) = zww(ji,jj,jk) * vmask(ji,jj,jk) * vmask(ji,jj,jk-1) 221 222 195 223 !!gm modif to suppress omlmask.... (as in Griffies case) 196 224 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. … … 242 270 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 243 271 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp & 244 & * tmask(ji,jj,jk-1)272 & * umask(ji,jj,jk-1) !* umask(ji,jj,jk) * umask(ji,jj,jk+1) 245 273 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 246 274 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp & 247 & * tmask(ji,jj,jk-1)275 & * vmask(ji,jj,jk-1) !* vmask(ji,jj,jk) * vmask(ji,jj,jk+1) 248 276 END DO 249 277 END DO … … 258 286 DO ji = fs_2, fs_jpim1 ! vector opt. 259 287 ! !* Local vertical density gradient evaluated from N^2 260 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 288 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 261 289 ! !* Slopes at w point 262 290 ! ! i- & j-gradient of density at w-points … … 266 294 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 267 295 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 268 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk)296 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci 269 297 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 270 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk)298 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj 271 299 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 272 300 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 274 302 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,jk)* ABS( zaj ) ) 275 303 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 276 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0277 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp )278 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 279 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 304 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 305 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 306 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 307 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 280 308 281 309 !!gm modif to suppress omlmask.... (as in Griffies operator) … … 330 358 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 331 359 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 332 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) 333 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) 360 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 361 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * tmask(ji,jj,jk-1) * tmask(ji,jj,jk) 334 362 END DO 335 363 END DO … … 387 415 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 388 416 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 389 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5390 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5417 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 418 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * 0.5 391 419 END DO 392 420 END DO … … 410 438 411 439 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 440 CALL wrk_dealloc( jpi,jpj, zhmlpu, zhmlpv) 412 441 ! 413 442 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 714 743 # endif 715 744 ik = nmln(ji,jj) - 1 716 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp745 IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN ; omlmask(ji,jj,jk) = 1._wp 717 746 ELSE ; omlmask(ji,jj,jk) = 0._wp 718 747 ENDIF … … 742 771 ! 743 772 ! !- vertical density gradient for u- and v-slopes (from dzr at T-point) 744 iku = MIN( MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1)745 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) !773 iku = MIN( MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1) 774 ikv = MIN( MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 746 775 zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj ,iku) ) 747 776 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r4747 r4812 116 116 CALL wrk_alloc( jpi, jpj, kjpt, zti, ztj ) 117 117 ! 118 pg ru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp ; pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ;118 pgtu(:,:,:)=0.0_wp ; pgtv(:,:,:)=0.0_wp ; 119 119 ! 120 120 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! … … 144 144 ! gradient of tracers 145 145 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 146 pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku)147 146 ELSE ! case 2 148 147 zmaxu = -ze3wu / fse3w(ji,jj,iku) … … 151 150 ! gradient of tracers 152 151 pgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 153 pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu)154 152 ENDIF 155 153 ENDIF … … 163 161 ! gradient of tracers 164 162 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 165 pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv)166 163 ELSE ! case 2 167 164 zmaxv = -ze3wv / fse3w(ji,jj,ikv) … … 170 167 ! gradient of tracers 171 168 pgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 172 pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv)173 169 ENDIF 174 170 ENDIF … … 183 179 ! horizontal derivative of density anomalies (rd) 184 180 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 181 pgru(:,:)=0.0_wp ; pgrv(:,:)=0.0_wp 185 182 # if defined key_vectopt_loop 186 183 jj = 1 … … 224 221 ze3wv = (gdept_0(ji,jj+1,ikv) - gdepw_0(ji,jj+1,ikv)) - (gdept_0(ji,jj,ikv) - gdepw_0(ji,jj,ikv)) 225 222 IF( ze3wu >= 0._wp ) THEN 223 pgzu(ji,jj) = (fsde3w(ji+1,jj,iku) - ze3wu) - fsde3w(ji,jj,iku) 226 224 pgru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 227 225 pmru(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj) + prd(ji,jj,iku) ) ! i: 1 … … 230 228 - fse3w(ji ,jj,iku) * ( prd(ji ,jj,iku) + prd(ji ,jj,ikum1) + 2._wp) ) ! j: 2 231 229 ELSE 230 pgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) + ze3wu) 232 231 pgru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 233 232 pmru(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 … … 237 236 ENDIF 238 237 IF( ze3wv >= 0._wp ) THEN 238 pgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) - ze3wv) - fsde3w(ji,jj,ikv) 239 239 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 240 240 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 … … 243 243 - fse3w(ji,jj ,ikv) * ( prd(ji,jj ,ikv) + prd(ji,jj ,ikvm1) + 2._wp) ) ! j: 2 244 244 ELSE 245 pgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) + ze3wv) 245 246 pgrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 246 247 pmrv(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 … … 284 285 ! gradient of tracers 285 286 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 286 sgzu(ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku)287 287 ELSE ! case 2 288 288 zmaxu = - ze3wu / fse3w(ji,jj,iku+1) 289 289 ! interpolated values of tracers 290 290 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku+1,jn) - pta(ji,jj,iku,jn) ) 291 ! gradient of tracers 291 292 sgtu(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 292 ! gradient of tracers293 sgzu(ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu)294 293 ENDIF 295 294 ! … … 301 300 ! gradient of tracers 302 301 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 303 sgzv(ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv)304 302 ELSE ! case 2 305 303 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1) … … 308 306 ! gradient of tracers 309 307 sgtv(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 310 sgzv(ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv)311 308 ENDIF 312 309 # if ! defined key_vectopt_loop … … 361 358 ze3wv = (gdepw_0(ji,jj+1,ikv+1) - gdept_0(ji,jj+1,ikv)) - (gdepw_0(ji,jj,ikv+1) - gdept_0(ji,jj,ikv)) 362 359 IF( ze3wu >= 0._wp ) THEN 360 sgzu (ji,jj) = (fsde3w(ji+1,jj,iku) + ze3wu) - fsde3w(ji,jj,iku) 363 361 sgru (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) - prd(ji,jj,iku) ) ! i: 1 364 362 smru (ji,jj) = umask(ji,jj,iku) * ( zri(ji,jj) + prd(ji,jj,iku) ) ! i: 1 … … 367 365 - fse3w(ji ,jj,iku+1) * (prd(ji,jj,iku) + prd(ji ,jj,iku+1) + 2._wp) ) ! i: 1 368 366 ELSE 367 sgzu (ji,jj) = fsde3w(ji+1,jj,iku) - (fsde3w(ji,jj,iku) - ze3wu) 369 368 sgru (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 370 369 smru (ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj,iku) + zri(ji,jj) ) ! i: 2 … … 374 373 ENDIF 375 374 IF( ze3wv >= 0._wp ) THEN 375 sgzv (ji,jj) = (fsde3w(ji,jj+1,ikv) + ze3wv) - fsde3w(ji,jj,ikv) 376 376 sgrv (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 377 377 smrv (ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji,jj ) + prd(ji,jj,ikv) ) ! j: 1 … … 381 381 ! + 2 due to the formulation in density and not in anomalie in hpg sco 382 382 ELSE 383 sgzv (ji,jj) = fsde3w(ji,jj+1,ikv) - (fsde3w(ji,jj,ikv) - ze3wv) 383 384 sgrv (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 384 385 smrv (ji,jj) = vmask(ji,jj,ikv) * ( prd(ji,jj+1,ikv) + zrj(ji,jj) ) ! j: 2 -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r4666 r4812 138 138 ENDIF 139 139 ! mask zmsk in order to have avt and avs masked 140 zmsks( :,:) = zmsks(:,:) * tmask(:,:,jk)140 zmsks(ji,jj) = zmsks(ji,jj) * tmask(ji,jj,jk) 141 141 142 142 -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfmxl.F90
r4245 r4812 99 99 DO jj = 1, jpj 100 100 DO ji = 1, jpi 101 IF( rhop(ji,jj,jk) > rhop(ji,jj, nla10) + rho_c ) nmln(ji,jj) = jk! Mixed layer102 IF( avt (ji,jj,jk) < avt_c ) imld(ji,jj) = jk! Turbocline101 IF( rhop(ji,jj,jk) > rhop(ji,jj,MAX(mikt(ji,jj),nla10)) + rho_c ) nmln(ji,jj) = MAX(jk,mikt(ji,jj)) ! Mixed layer 102 IF( avt (ji,jj,jk) < avt_c ) imld(ji,jj) = MAX(mikt(ji,jj),jk) ! Turbocline 103 103 END DO 104 104 END DO … … 109 109 iiki = imld(ji,jj) 110 110 iikn = nmln(ji,jj) 111 hmld (ji,jj) = fsdepw(ji,jj,iiki ) * tmask(ji,jj,1) ! Turbocline depth112 hmlp (ji,jj) = fsdepw(ji,jj,iikn ) * tmask(ji,jj,1) ! Mixed layer depth113 hmlpt(ji,jj) = fsdept(ji,jj,iikn-1)! depth of the last T-point inside the mixed layer111 hmld (ji,jj) = ( fsdepw(ji,jj,iiki ) - fsdepw(ji,jj,mikt(ji,jj) ) ) * ssmask(ji,jj) ! Turbocline depth 112 hmlp (ji,jj) = ( fsdepw(ji,jj,iikn ) - fsdepw(ji,jj,MAX(mikt(ji,jj),nla10) ) ) * ssmask(ji,jj) ! Mixed layer depth 113 hmlpt(ji,jj) = ( fsdept(ji,jj,iikn-1) - fsdepw(ji,jj,mikt(ji,jj) ) ) * ssmask(ji,jj) ! depth of the last T-point inside the mixed layer 114 114 END DO 115 115 END DO -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90
r3294 r4812 73 73 74 74 SELECT CASE ( nldf ) ! compute lateral mixing trend and add it to the general trend 75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra) ! iso-level laplacian75 CASE ( 0 ) ; CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level laplacian 76 76 CASE ( 1 ) ! rotated laplacian 77 77 IF( ln_traldf_grif ) THEN 78 78 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 79 79 ELSE 80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )80 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 81 81 ENDIF 82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra ) ! iso-level bilaplacian82 CASE ( 2 ) ; CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) ! iso-level bilaplacian 83 83 CASE ( 3 ) ; CALL tra_ldf_bilapg( kt, nittrc000, 'TRC', trb, tra, jptra ) ! s-coord. horizontal bilaplacian 84 84 ! 85 85 CASE ( -1 ) ! esopa: test all possibility with control print 86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra )86 CALL tra_ldf_lap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 87 87 WRITE(charout, FMT="('ldf0 ')") ; CALL prt_ctl_trc_info(charout) 88 88 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) … … 90 90 CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 91 91 ELSE 92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )92 CALL tra_ldf_iso ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra, rn_ahtb_0 ) 93 93 ENDIF 94 94 WRITE(charout, FMT="('ldf1 ')") ; CALL prt_ctl_trc_info(charout) 95 95 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra )96 CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, gtrui, gtrvi, trb, tra, jptra ) 97 97 WRITE(charout, FMT="('ldf2 ')") ; CALL prt_ctl_trc_info(charout) 98 98 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r4148 r4812 82 82 IF( .NOT. Agrif_Root()) CALL Agrif_Update_Trc( kstp ) ! Update tracer at AGRIF zoom boundaries : children only 83 83 #endif 84 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, gtru, gtrv) ! Partial steps: now horizontal gradient of passive84 IF( ln_zps ) CALL zps_hde( kstp, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) ! Partial steps: now horizontal gradient of passive 85 85 ! tracers at the bottom ocean level 86 86 ! -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/TOP_SRC/trc.F90
r4611 r4812 42 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtru !: hor. gradient at u-points at bottom ocean level 43 43 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrv !: hor. gradient at v-points at bottom ocean level 44 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrui !: hor. gradient at u-points at top ocean level 45 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gtrvi !: hor. gradient at v-points at top ocean level 44 46 45 47 !! passive tracers (input and output) … … 183 185 ! 184 186 ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra), & 185 & gtru(jpi,jpj,jpk) , gtrv(jpi,jpj,jpk) , & 187 & gtru (jpi,jpj,jptra) , gtrv (jpi,jpj,jptra) , & 188 & gtrui(jpi,jpj,jptra) , gtrvi(jpi,jpj,jptra) , & 186 189 & cvol(jpi,jpj,jpk) , rdttrc(jpk) , trai(jptra) , & 187 190 & ctrcnm(jptra) , ctrcln(jptra) , ctrcun(jptra) , & -
branches/2014/dev_r4650_UKMO2_ice_shelves/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r4607 r4812 143 143 144 144 tra(:,:,:,:) = 0._wp 145 146 145 IF( ln_zps .AND. .NOT. lk_c1d ) & ! Partial steps: before horizontal gradient of passive 147 & CALL zps_hde( nit000, jptra, trn, gtru, gtrv) ! tracers at the bottom ocean level146 & CALL zps_hde( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, sgtu=gtrui, sgtv=gtrvi ) ! tracers at the bottom ocean level 148 147 149 148 !
Note: See TracChangeset
for help on using the changeset viewer.