Changeset 4427 for branches/2011/DEV_r2739_STFC_dCSE
- Timestamp:
- 2014-02-04T13:14:00+01:00 (10 years ago)
- Location:
- branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 8 edited
-
DOM/dommsk.F90 (modified) (1 diff)
-
DOM/domzgr.F90 (modified) (3 diffs)
-
DYN/dynkeg.F90 (modified) (2 diffs)
-
DYN/dynldf_lap.F90 (modified) (1 diff)
-
DYN/dynzad.F90 (modified) (3 diffs)
-
DYN/sshwzv.F90 (modified) (6 diffs)
-
LDF/ldfslp.F90 (modified) (3 diffs)
-
TRA/traldf_iso.F90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r3211 r4427 203 203 #endif 204 204 !!gm end 205 206 !! smp FINISS 207 #if defined key_z_first 208 ! Reset mbkmax to be the first level for which tmask is zero 209 DO jj = 1, jpj 210 DO ji = 1, jpi 211 mbkmax(ji,jj) = 1 212 kloop: DO jk = 1, jpkorig 213 IF (tmask(ji,jj,jk) == 0.0_wp) THEN 214 mbkmax(ji,jj) = jk 215 EXIT kloop 216 END IF 217 END DO kloop 218 IF (mbkmax(ji,jj) > jpk) THEN 219 WRITE (*,*) 'FINISS error: mbkmax(',ji,',',jj,') > jpk (',jpk,') on subdomain ',narea 220 mbkmax(ji,jj) = jpk 221 END IF 222 END DO 223 END DO 224 #endif 205 225 206 226 ! Interior domain mask (used for global sum) -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r4409 r4427 131 131 ! ----------------------------------- 132 132 IF( lzoom ) CALL zgr_bat_zoom ! correct mbathy in case of zoom subdomain 133 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress iso ated ocean points133 IF( .NOT.lk_c1d ) CALL zgr_bat_ctl ! check bathymetry (mbathy) and suppress isolated ocean points 134 134 CALL zgr_bot_level ! deepest ocean level for t-, u- and v-points 135 135 ! … … 819 819 jpkorig = jpk 820 820 IF( domtrim_z ) THEN 821 mbkmax(:,:) = MAX(mbkt(:,:)+1, mbku(:,:), mbkv(:,:)) 822 ! jpkf = MIN(jpk, 1 + MAXVAL( mbkmax(:,:) ) ) 821 ! mbkmax(:,:) = MAX(mbkt(:,:)+1, mbku(:,:), mbkv(:,:)) 822 ! write(*,*) narea, ': SMPDBG: ji, jj, mbkt(ji,jj), mbku(ji,jj), mbkv(ji,jj), mbkmax(ji,jj)' 823 DO jj = 1, jpj 824 DO ji = 1, jpi 825 mbkmax(ji,jj) = MIN(jpk, MAX(mbkt(ji,jj)+1, mbku(ji,jj), mbkv(ji,jj))) 826 ! write(*,*) narea, ': SMPDBG: ', ji, jj, mbkt(ji,jj), mbku(ji,jj), mbkv(ji,jj), mbkmax(ji,jj) 827 END DO 828 END DO 823 829 jpkf = MAXVAL( mbkmax(:,:) ) 824 830 WRITE(*,*) narea,': ARPDBG: shallowest pt and jpkf = ', & … … 830 836 ELSE 831 837 WRITE(*,*) narea,': ARPDBG: NOT trimming domain in z' 838 mbkmax(:,:) = jpk 832 839 jpkf = jpk 833 840 END IF -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90
r3432 r4427 87 87 DO jj = 2, jpj ! Horizontal kinetic energy at T-point 88 88 DO ji = 2, jpi 89 DO jk = 1, jpkm189 DO jk = 1, mbkmax(ji,jj)-1 90 90 zhke(ji,jj,jk) = 0.25 * ( un(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 91 91 & + un(ji ,jj ,jk) * un(ji ,jj ,jk) & 92 92 & + vn(ji ,jj-1,jk) * vn(ji ,jj-1,jk) & 93 93 & + vn(ji ,jj ,jk) * vn(ji ,jj ,jk) ) 94 94 END DO … … 97 97 DO jj = 2, jpjm1 ! add the gradient of kinetic energy to the general momentum trends 98 98 DO ji = 2, jpim1 99 DO jk = 1, jpkm199 DO jk = 1, mbkmax(ji,jj)-1 100 100 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 101 101 va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r3211 r4427 83 83 DO jj = 2, jpjm1 84 84 DO ji = 2, jpim1 85 DO jk = 1, jpkm185 DO jk = 1, mbkmax(ji,jj)-1 86 86 #else 87 87 ! ! =============== -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r3837 r4427 99 99 zwuw(ji,jj, 1 ) = 0.e0 ! Surface values set to zero 100 100 zwvw(ji,jj, 1 ) = 0.e0 101 DO jk = 2, jpkm1101 DO jk = 2, mbkmax(ji,jj)-1 102 102 zwuw(ji,jj,jk) = ( zww(ji+1,jj )*wn(ji+1,jj ,jk) + zww(ji,jj)*wn(ji,jj,jk) ) & 103 103 & * ( un(ji,jj,jk-1)-un(ji,jj,jk) ) … … 105 105 & * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) ) 106 106 END DO 107 zwuw(ji,jj, jpk) = 0.e0 ! Bottom values set to zero108 zwvw(ji,jj, jpk) = 0.e0107 zwuw(ji,jj,mbkmax(ji,jj)) = 0.e0 ! Bottom values set to zero 108 zwvw(ji,jj,mbkmax(ji,jj)) = 0.e0 109 109 END DO 110 110 END DO … … 136 136 DO jj = 2, jpjm1 ! Vertical momentum advection at u- and v-points 137 137 DO ji = 2, jpim1 138 DO jk = 1, jpkm1138 DO jk = 1, mbkmax(ji,jj)-1 139 139 #else 140 140 DO jk = 1, jpkm1 ! Vertical momentum advection at u- and v-points -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4415 r4427 94 94 ! 95 95 INTEGER :: ji, jj, jk ! dummy loop indices 96 #if defined key_z_first 97 INTEGER :: klim ! upper bound on k loop 98 #endif 96 99 REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars 97 100 !!---------------------------------------------------------------------- … … 107 110 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 108 111 ! 112 #if defined key_z_first 113 DO jj=1,jpj 114 DO ji=1,jpi 115 DO jk=mbkmax(ji,jj), jpk 116 wn(ji,jj,jk) = 0._wp 117 END DO 118 END DO 119 END DO 120 #else 109 121 wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all) 122 #endif 110 123 ! 111 124 IF( lk_vvl ) THEN ! before and now Sea SSH at u-, v-, f-points (vvl case only) … … 161 174 ! gdept_1(1:jpkm1,:,:) = (gdept(1:jpkm1,:,:)*(1.+sshn(:,:)*mut(1:jpkm1,:,:))) 162 175 ! which contains non-conforming array expressions. 163 DO jj=1,jpj,1 164 DO ji=1,jpi,1 165 DO jk=1,jpk,1 166 fsdept(ji,jj,jk) = fsdept_n(ji,jj,jk) ! now local depths stored in fsdep. arrays 167 END DO 168 END DO 169 END DO 170 DO jj=1,jpj,1 171 DO ji=1,jpi,1 172 DO jk=1,jpk,1 173 fsdepw(ji,jj,jk) = fsdepw_n(ji,jj,jk) 174 END DO 175 END DO 176 END DO 177 DO jj=1,jpj,1 178 DO ji=1,jpi,1 179 DO jk=1,jpk,1 180 fsde3w(ji,jj,jk) = fsde3w_n(ji,jj,jk) 181 END DO 182 END DO 183 END DO 184 ! 185 DO jj=1,jpj,1 186 DO ji=1,jpi,1 187 DO jk=1,jpk,1 188 fse3t (ji,jj,jk) = fse3t_n (ji,jj,jk) ! vertical scale factors stored in fse3. arrays 189 END DO 190 END DO 191 END DO 192 DO jj=1,jpj,1 193 DO ji=1,jpi,1 194 DO jk=1,jpk,1 195 fse3u (ji,jj,jk) = fse3u_n (ji,jj,jk) 196 END DO 197 END DO 198 END DO 199 DO jj=1,jpj,1 200 DO ji=1,jpi,1 201 DO jk=1,jpk,1 202 fse3v (ji,jj,jk) = fse3v_n (ji,jj,jk) 203 END DO 204 END DO 205 END DO 206 DO jj=1,jpj,1 207 DO ji=1,jpi,1 208 DO jk=1,jpk,1 209 fse3f (ji,jj,jk) = fse3f_n (ji,jj,jk) 210 END DO 211 END DO 212 END DO 213 DO jj=1,jpj,1 214 DO ji=1,jpi,1 215 DO jk=1,jpk,1 216 fse3w (ji,jj,jk) = fse3w_n (ji,jj,jk) 217 END DO 218 END DO 219 END DO 220 221 222 DO jj=1,jpj,1 223 DO ji=1,jpi,1 224 DO jk=1,jpk,1 225 fse3uw(ji,jj,jk) = fse3uw_n(ji,jj,jk) 226 END DO 227 END DO 228 END DO 229 230 DO jj=1,jpj,1 231 DO ji=1,jpi,1 232 DO jk=1,jpk,1 233 fse3vw(ji,jj,jk) = fse3vw_n(ji,jj,jk) 234 END DO 176 DO jj=1,jpj 177 DO ji=1,jpi 178 klim=mbkmax(ji,jj) 179 ! now local depths stored in fsdep. arrays 180 fsdept(ji,jj,1:klim) = fsdept_n(ji,jj,1:klim) 181 fsdepw(ji,jj,1:klim) = fsdepw_n(ji,jj,1:klim) 182 fsde3w(ji,jj,1:klim) = fsde3w_n(ji,jj,1:klim) 183 ! vertical scale factors stored in fse3. arrays 184 fse3t (ji,jj,1:klim) = fse3t_n (ji,jj,1:klim) 185 fse3u (ji,jj,1:klim) = fse3u_n (ji,jj,1:klim) 186 fse3v (ji,jj,1:klim) = fse3v_n (ji,jj,1:klim) 187 fse3f (ji,jj,1:klim) = fse3f_n (ji,jj,1:klim) 188 fse3w (ji,jj,1:klim) = fse3w_n (ji,jj,1:klim) 189 fse3uw(ji,jj,1:klim) = fse3uw_n(ji,jj,1:klim) 190 fse3vw(ji,jj,1:klim) = fse3vw_n(ji,jj,1:klim) 235 191 END DO 236 192 END DO … … 279 235 DO jj = 1, jpj 280 236 DO ji = 1, jpi 281 DO jk = 1, jpkm1! Horizontal divergence of barotropic transports237 DO jk = 1, mbkmax(ji,jj)-1 ! Horizontal divergence of barotropic transports 282 238 zhdiv(ji,jj) = zhdiv(ji,jj) + fse3t(ji,jj,jk) * hdivn(ji,jj,jk) 283 239 END DO … … 355 311 DO jj = 1, jpj 356 312 DO ji = 1, jpi 357 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence313 DO jk = mbkmax(ji,jj)-1, 1, -1 ! integrate from the bottom the hor. divergence 358 314 wn(ji,jj,jk) = wn(ji,jj,jk+1) & 359 315 & - fse3t_n(ji,jj,jk) * hdivn(ji,jj,jk) & … … 390 346 DO jj = 1, jpj 391 347 DO ji = 1, jpi 392 DO jk = 1, jpk348 DO jk = 1, mbkmax(ji,jj) 393 349 z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 394 350 END DO -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4409 r4427 815 815 ! 816 816 ! !== surface mixed layer mask ! 817 #if defined key_z_first 818 DO jj = 1, jpj 819 DO ji = 1, jpi 820 DO jk = 1, jpkf ! =1 inside the mixed layer, =0 otherwise 821 #else 817 822 DO jk = 1, jpkf ! =1 inside the mixed layer, =0 otherwise 818 # if ( defined key_vectopt_loop ) && ! ( defined key_z_first )823 # if defined key_vectopt_loop 819 824 DO jj = 1, 1 820 825 DO ji = 1, jpij ! vector opt. (forced unrolling) … … 823 828 DO ji = 1, jpi 824 829 # endif 830 #endif 825 831 ik = nmln(ji,jj) - 1 826 832 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp … … 967 973 DO jj = 2, jpjm1 968 974 DO ji = 2, jpim1 969 DO jk = 1, jpkf975 DO jk = 1, mbkmax(ji,jj) 970 976 #else 971 977 DO jk = 1, jpkf -
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r4401 r4427 146 146 147 147 #if defined key_z_first 148 !! SMP Should not need to reserve or release 9 and 10 any more. 148 149 IF( wrk_in_use(3, 6,7,8,9,10) .OR. wrk_in_use(2, 3) ) THEN 149 150 #else … … 162 163 ! ! =========== 163 164 !DIR$ SHORTLOOP 165 166 #if defined key_z_first 167 zdit(:,:,:) = 0.0_wp 168 zdjt(:,:,:) = 0.0_wp 169 #endif 170 164 171 DO jn = 1, kjpt ! tracer loop 165 172 ! ! =========== … … 169 176 !!---------------------------------------------------------------------- 170 177 !CALL timing_start('traldf_iso_I') 178 179 ! Horizontal tracer gradient 180 #if defined key_z_first 181 DO jj = 1, jpjm1 182 DO ji = 1, jpim1 183 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 184 zdit(ji,jj,jk) = ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 185 zdjt(ji,jj,jk) = ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 186 END DO 187 END DO 188 END DO 189 #else 171 190 !!bug ajout.... why? ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 172 #if defined key_z_first173 DO jj=1,jpj,1174 DO jk=1,jpkf,1175 zdit(1 ,jj,jk) = 0.0_wp176 zdit(jpi,jj,jk) = 0.0_wp177 zdjt(1 ,jj,jk) = 0.0_wp178 zdjt(jpi,jj,jk) = 0.0_wp179 END DO180 END DO181 #else182 191 zdit (1,:,1:jpkf) = 0.e0 ; zdit (jpi,:,1:jpkf) = 0.e0 183 192 zdjt (1,:,1:jpkf) = 0.e0 ; zdjt (jpi,:,1:jpkf) = 0.e0 184 #endif185 193 !!end 186 187 ! Horizontal tracer gradient188 #if defined key_z_first189 DO jj = 1, jpjm1190 DO ji = 1, jpim1191 DO jk = 1, jpkfm1 ! jpkm1192 #else193 194 DO jk = 1, jpkfm1 ! jpkm1 194 195 DO jj = 1, jpjm1 195 196 DO ji = 1, fs_jpim1 ! vector opt. 196 #endif197 197 zdit(ji,jj,jk) = ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 198 198 zdjt(ji,jj,jk) = ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) … … 200 200 END DO 201 201 END DO 202 #endif 202 203 IF( ln_zps ) THEN ! partial steps correction at the last ocean level 203 204 DO jj = 1, jpjm1 … … 257 258 DO jj = 2 , jpjm1 258 259 DO ji = 2, jpim1 259 DO jk = 1, jpkfm1 ! jpkm1260 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 260 261 261 262 ! 1. Vertical tracer gradient at level jk and jk+1 … … 392 393 DO jj = 2, jpjm1 393 394 DO ji = 2, jpim1 394 DO jk = 1, jpkfm1 ! jpkm1395 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 395 396 #else 396 397 DO jk = 1, jpkfm1 ! jpkm1 … … 409 410 DO jj = 2, jpjm1 410 411 DO ji = 2, jpim1 411 DO jk = 1, jpkfm1 ! jpkm1412 DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 412 413 #else 413 414 DO jk = 1, jpkfm1 ! jpkm1 … … 433 434 ! Local constant initialization 434 435 ! ----------------------------- 435 #if defined key_z_first436 DO jj=1,jpj,1437 DO jk=1,jpkf,1438 ztfw(1 ,jj,jk) = 0.0_wp439 ztfw(jpi,jj,jk) = 0.0_wp440 END DO441 END DO442 #else443 ztfw(1,:,1:jpkf) = 0.e0 ; ztfw(jpi,:,1:jpkf) = 0.e0444 #endif445 436 ! Vertical fluxes 446 437 ! --------------- … … 448 439 ! Surface and bottom vertical fluxes set to zero 449 440 #if defined key_z_first 450 DO ji=1,jpi,1 451 DO jj=1,jpj,1 452 ztfw(ji,jj,1 ) = 0.0_wp 453 ztfw(ji,jj,jpkf) = 0.0_wp ! ARPDBG - should this be jpk anyway 454 ! since may be below ocean floor? 455 END DO 456 END DO 457 #else 441 ztfw(:,:,:) = 0.0_wp 442 #else 443 ztfw(1,:,1:jpkf) = 0.e0 ; ztfw(jpi,:,1:jpkf) = 0.e0 458 444 ztfw(:,:, 1 ) = 0.e0 ; ztfw(:,:,jpkf) = 0.e0 459 445 #endif … … 463 449 DO jj = 2, jpjm1 464 450 DO ji = 2, jpim1 465 DO jk = 2, jpkfm1451 DO jk = 2, mbkmax(ji,jj)-1 466 452 #else 467 453 DO jk = 2, jpkfm1 … … 493 479 DO jj = 2, jpjm1 494 480 DO ji = 2, jpim1 495 DO jk = 1, jpkfm1481 DO jk = 1, mbkmax(ji,jj)-1 496 482 #else 497 483 DO jk = 1, jpkfm1
Note: See TracChangeset
for help on using the changeset viewer.
