- Timestamp:
- 2015-10-26T10:08:06+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF
- Files:
-
- 6 edited
-
ldfdyn_c2d.h90 (modified) (8 diffs)
-
ldfdyn_c3d.h90 (modified) (5 diffs)
-
ldfdyn_smag.F90 (modified) (2 diffs, 1 prop)
-
ldfeiv.F90 (modified) (4 diffs)
-
ldfslp.F90 (modified) (26 diffs)
-
ldftra_smag.F90 (modified) (1 diff, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c2d.h90
r4325 r5832 140 140 !!---------------------------------------------------------------------- 141 141 USE ldftra_oce, ONLY: aht0 142 USE iom 142 143 ! 143 144 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout … … 146 147 INTEGER :: inum, iim, ijm ! local integers 147 148 INTEGER :: ifreq, il1, il2, ij, ii 148 INTEGER :: ijpt0,ijpt1 149 INTEGER :: ijpt0,ijpt1, ierror 149 150 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk 150 151 CHARACTER (len=15) :: clexp 151 INTEGER, POINTER, DIMENSION(:,:) :: icof152 INTEGER, POINTER, DIMENSION(:,:) :: idata152 INTEGER, POINTER, DIMENSION(:,:) :: icof 153 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file 153 154 !!---------------------------------------------------------------------- 154 155 ! 155 156 CALL wrk_alloc( jpi , jpj , icof ) 156 CALL wrk_alloc( jpidta, jpjdta, idata )157 157 ! 158 158 IF(lwp) WRITE(numout,*) … … 233 233 ! Read 2d integer array to specify western boundary increase in the 234 234 ! ===================== equatorial strip (20N-20S) defined at t-points 235 236 CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 237 READ(inum,9101) clexp, iim, ijm 238 READ(inum,'(/)') 239 ifreq = 40 240 il1 = 1 241 DO jn = 1, jpidta/ifreq+1 242 READ(inum,'(/)') 243 il2 = MIN( jpidta, il1+ifreq-1 ) 244 READ(inum,9201) ( ii, ji = il1, il2, 5 ) 245 READ(inum,'(/)') 246 DO jj = jpjdta, 1, -1 247 READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 248 END DO 249 il1 = il1 + ifreq 250 END DO 251 252 DO jj = 1, nlcj 253 DO ji = 1, nlci 254 icof(ji,jj) = idata( mig(ji), mjg(jj) ) 255 END DO 256 END DO 257 DO jj = nlcj+1, jpj 258 DO ji = 1, nlci 259 icof(ji,jj) = icof(ji,nlcj) 260 END DO 261 END DO 262 DO jj = 1, jpj 263 DO ji = nlci+1, jpi 264 icof(ji,jj) = icof(nlci,jj) 265 END DO 266 END DO 267 268 9101 FORMAT(1x,a15,2i8) 269 9201 FORMAT(3x,13(i3,12x)) 270 9202 FORMAT(i3,41i3) 271 235 ! 236 ALLOCATE( ztemp2d(jpi,jpj) ) 237 ztemp2d(:,:) = 0. 238 CALL iom_open ( 'ahmcoef.nc', inum ) 239 CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d) 240 icof(:,:) = NINT(ztemp2d(:,:)) 241 CALL iom_close( inum ) 242 DEALLOCATE(ztemp2d) 272 243 273 244 ! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator) … … 346 317 ! 347 318 CALL wrk_dealloc( jpi , jpj , icof ) 348 CALL wrk_dealloc( jpidta, jpjdta, idata )349 319 ! 350 320 END SUBROUTINE ldf_dyn_c2d_orca … … 367 337 !!---------------------------------------------------------------------- 368 338 USE ldftra_oce, ONLY: aht0 339 USE iom 369 340 ! 370 341 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout … … 374 345 INTEGER :: iim, ijm 375 346 INTEGER :: ifreq, il1, il2, ij, ii 376 INTEGER :: ijpt0,ijpt1 347 INTEGER :: ijpt0,ijpt1, ierror 377 348 REAL(wp) :: zahmeq, zcoft, zcoff, zmsk, zam20s 378 349 CHARACTER (len=15) :: clexp 379 INTEGER, POINTER, DIMENSION(:,:) :: icof380 INTEGER, POINTER, DIMENSION(:,:) :: idata350 INTEGER, POINTER, DIMENSION(:,:) :: icof 351 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file 381 352 !!---------------------------------------------------------------------- 382 353 ! 383 354 CALL wrk_alloc( jpi , jpj , icof ) 384 CALL wrk_alloc( jpidta, jpjdta, idata )385 355 ! 386 387 356 IF(lwp) WRITE(numout,*) 388 357 IF(lwp) WRITE(numout,*) 'inildf: 2d eddy viscosity coefficient' … … 463 432 ! Read 2d integer array to specify western boundary increase in the 464 433 ! ===================== equatorial strip (20N-20S) defined at t-points 465 466 CALL ctl_opn( inum, 'ahmcoef', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', & 467 & 1, numout, lwp ) 468 REWIND inum 469 READ(inum,9101) clexp, iim, ijm 470 READ(inum,'(/)') 471 ifreq = 40 472 il1 = 1 473 DO jn = 1, jpidta/ifreq+1 474 READ(inum,'(/)') 475 il2 = MIN( jpidta, il1+ifreq-1 ) 476 READ(inum,9201) ( ii, ji = il1, il2, 5 ) 477 READ(inum,'(/)') 478 DO jj = jpjdta, 1, -1 479 READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 480 END DO 481 il1 = il1 + ifreq 482 END DO 483 484 DO jj = 1, nlcj 485 DO ji = 1, nlci 486 icof(ji,jj) = idata( mig(ji), mjg(jj) ) 487 END DO 488 END DO 489 DO jj = nlcj+1, jpj 490 DO ji = 1, nlci 491 icof(ji,jj) = icof(ji,nlcj) 492 END DO 493 END DO 494 DO jj = 1, jpj 495 DO ji = nlci+1, jpi 496 icof(ji,jj) = icof(nlci,jj) 497 END DO 498 END DO 499 500 9101 FORMAT(1x,a15,2i8) 501 9201 FORMAT(3x,13(i3,12x)) 502 9202 FORMAT(i3,41i3) 503 434 ALLOCATE( ztemp2d(jpi,jpj) ) 435 ztemp2d(:,:) = 0. 436 CALL iom_open ( 'ahmcoef.nc', inum ) 437 CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d) 438 icof(:,:) = NINT(ztemp2d(:,:)) 439 CALL iom_close( inum ) 440 DEALLOCATE(ztemp2d) 504 441 505 442 ! Set ahm1 and ahm2 ( T- and F- points) (used for laplacian operator) … … 583 520 ! 584 521 CALL wrk_dealloc( jpi , jpj , icof ) 585 CALL wrk_dealloc( jpidta, jpjdta, idata )586 522 ! 587 523 END SUBROUTINE ldf_dyn_c2d_orca_R1 -
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_c3d.h90
r4292 r5832 27 27 !!---------------------------------------------------------------------- 28 28 USE ldftra_oce, ONLY : aht0 29 USE iom 29 30 !! 30 31 LOGICAL, INTENT (in) :: ld_print ! If true, output arrays on numout … … 193 194 !!---------------------------------------------------------------------- 194 195 USE ldftra_oce, ONLY: aht0 196 USE iom 195 197 !! 196 198 LOGICAL, INTENT(in) :: ld_print ! If true, output arrays on numout … … 204 206 CHARACTER (len=15) :: clexp 205 207 INTEGER , POINTER, DIMENSION(:,:) :: icof 206 INTEGER , POINTER, DIMENSION(:,:) :: idata207 208 REAL(wp), POINTER, DIMENSION(: ) :: zcoef 208 209 REAL(wp), POINTER, DIMENSION(:,:) :: zahm0 210 ! 211 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ztemp2d ! temporary array to read ahmcoef file 209 212 !!---------------------------------------------------------------------- 210 213 ! 211 214 CALL wrk_alloc( jpi , jpj , icof ) 212 CALL wrk_alloc( jpidta, jpjdta, idata )213 215 CALL wrk_alloc( jpk , zcoef ) 214 216 CALL wrk_alloc( jpi , jpj , zahm0 ) … … 221 223 ! Read 2d integer array to specify western boundary increase in the 222 224 ! ===================== equatorial strip (20N-20S) defined at t-points 223 224 CALL ctl_opn( inum, 'ahmcoef', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp ) 225 READ(inum,9101) clexp, iim, ijm 226 READ(inum,'(/)') 227 ifreq = 40 228 il1 = 1 229 DO jn = 1, jpidta/ifreq+1 230 READ(inum,'(/)') 231 il2 = MIN( jpidta, il1+ifreq-1 ) 232 READ(inum,9201) ( ii, ji = il1, il2, 5 ) 233 READ(inum,'(/)') 234 DO jj = jpjdta, 1, -1 235 READ(inum,9202) ij, ( idata(ji,jj), ji = il1, il2 ) 236 END DO 237 il1 = il1 + ifreq 238 END DO 239 240 DO jj = 1, nlcj 241 DO ji = 1, nlci 242 icof(ji,jj) = idata( mig(ji), mjg(jj) ) 243 END DO 244 END DO 245 DO jj = nlcj+1, jpj 246 DO ji = 1, nlci 247 icof(ji,jj) = icof(ji,nlcj) 248 END DO 249 END DO 250 DO jj = 1, jpj 251 DO ji = nlci+1, jpi 252 icof(ji,jj) = icof(nlci,jj) 253 END DO 254 END DO 255 256 9101 FORMAT(1x,a15,2i8) 257 9201 FORMAT(3x,13(i3,12x)) 258 9202 FORMAT(i3,41i3) 259 225 ALLOCATE( ztemp2d(jpi,jpj) ) 226 ztemp2d(:,:) = 0. 227 CALL iom_open ( 'ahmcoef.nc', inum ) 228 CALL iom_get ( inum, jpdom_data, 'icof', ztemp2d) 229 icof(:,:) = NINT(ztemp2d(:,:)) 230 CALL iom_close( inum ) 231 DEALLOCATE(ztemp2d) 232 260 233 ! Set ahm1 and ahm2 261 234 ! ================= … … 455 428 ! 456 429 CALL wrk_dealloc( jpi , jpj , icof ) 457 CALL wrk_dealloc( jpidta, jpjdta, idata )458 430 CALL wrk_dealloc( jpk , zcoef ) 459 431 CALL wrk_dealloc( jpi , jpj , zahm0 ) -
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldfdyn_smag.F90
- Property svn:keywords set to Id
r3634 r5832 31 31 !!---------------------------------------------------------------------- 32 32 !! OPA 9.0 , LOCEAN-IPSL (2005) 33 !! $Id : ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z$33 !! $Id$ 34 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 35 !!---------------------------------------------------------------------- … … 51 51 !!---------------------------------------------------------------------- 52 52 !! OPA 9.0 , LOCEAN-IPSL (2005) 53 !! $Id : ldfdyn_c3d.h90 1581 2009-08-05 14:53:12Z smasson$53 !! $Id$ 54 54 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 55 55 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldfeiv.F90
r3294 r5832 84 84 IF( ln_traldf_grif ) THEN 85 85 DO jk = 1, jpk 86 # if defined key_vectopt_loop87 !CDIR NOVERRCHK88 DO ji = 1, jpij ! vector opt.89 ! Take the max of N^2 and zero then take the vertical sum90 ! of the square root of the resulting N^2 ( required to compute91 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f92 zn2 = MAX( rn2b(ji,1,jk), 0._wp )93 zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)94 ! Compute elements required for the inverse time scale of baroclinic95 ! eddies using the isopycnal slopes calculated in ldfslp.F :96 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))97 ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)98 zah(ji,1) = zah(ji,1) + zn2 * wslp2(ji,1,jk) * ze3w99 zhw(ji,1) = zhw(ji,1) + ze3w100 END DO101 # else102 86 DO jj = 2, jpjm1 103 !CDIR NOVERRCHK104 87 DO ji = 2, jpim1 105 88 ! Take the max of N^2 and zero then take the vertical sum … … 116 99 END DO 117 100 END DO 118 # endif119 101 END DO 120 102 ELSE 121 103 DO jk = 1, jpk 122 # if defined key_vectopt_loop123 !CDIR NOVERRCHK124 DO ji = 1, jpij ! vector opt.125 ! Take the max of N^2 and zero then take the vertical sum126 ! of the square root of the resulting N^2 ( required to compute127 ! internal Rossby radius Ro = .5 * sum_jpk(N) / f128 zn2 = MAX( rn2b(ji,1,jk), 0._wp )129 zn(ji,1) = zn(ji,1) + SQRT( zn2 ) * fse3w(ji,1,jk)130 ! Compute elements required for the inverse time scale of baroclinic131 ! eddies using the isopycnal slopes calculated in ldfslp.F :132 ! T^-1 = sqrt(m_jpk(N^2*(r1^2+r2^2)*e3w))133 ze3w = fse3w(ji,1,jk) * tmask(ji,1,jk)134 zah(ji,1) = zah(ji,1) + zn2 * ( wslpi(ji,1,jk) * wslpi(ji,1,jk) &135 & + wslpj(ji,1,jk) * wslpj(ji,1,jk) ) * ze3w136 zhw(ji,1) = zhw(ji,1) + ze3w137 END DO138 # else139 104 DO jj = 2, jpjm1 140 !CDIR NOVERRCHK141 105 DO ji = 2, jpim1 142 106 ! Take the max of N^2 and zero then take the vertical sum … … 154 118 END DO 155 119 END DO 156 # endif157 120 END DO 158 121 END IF 159 122 160 123 DO jj = 2, jpjm1 161 !CDIR NOVERRCHK162 124 DO ji = fs_2, fs_jpim1 ! vector opt. 163 125 zfw = MAX( ABS( 2. * omega * SIN( rad * gphit(ji,jj) ) ) , 1.e-10 ) … … 165 127 zross(ji,jj) = MAX( MIN( .4 * zn(ji,jj) / zfw, 40.e3 ), 2.e3 ) 166 128 ! Compute aeiw by multiplying Ro^2 and T^-1 167 aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * tmask(ji,jj,1)129 aeiw(ji,jj) = zross(ji,jj) * zross(ji,jj) * SQRT( zah(ji,jj) / zhw(ji,jj) ) * ssmask(ji,jj) 168 130 END DO 169 131 END DO -
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r4488 r5832 28 28 USE zdfmxl ! mixed layer depth 29 29 USE eosbn2 ! equation of states 30 ! 31 USE in_out_manager ! I/O manager 30 32 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 31 USE in_out_manager ! I/O manager32 33 USE prtctl ! Print control 33 34 USE wrk_nemo ! work arrays … … 108 109 REAL(wp) :: zcj, zfj, zav, zbv, zaj, zbj ! - - 109 110 REAL(wp) :: zck, zfk, zbw ! - - 111 REAL(wp) :: zdepv, zdepu ! - - 110 112 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwz, zww 111 113 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdzr 112 114 REAL(wp), POINTER, DIMENSION(:,:,:) :: zgru, zgrv 115 REAL(wp), POINTER, DIMENSION(:,: ) :: zhmlpu, zhmlpv 113 116 !!---------------------------------------------------------------------- 114 117 ! … … 116 119 ! 117 120 CALL wrk_alloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 121 CALL wrk_alloc( jpi,jpj, zhmlpu, zhmlpv ) 118 122 119 123 IF ( ln_traldf_iso .OR. ln_dynldf_iso ) THEN … … 136 140 END DO 137 141 IF( ln_zps ) THEN ! partial steps correction at the bottom ocean level 138 # if defined key_vectopt_loop139 DO jj = 1, 1140 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)141 # else142 142 DO jj = 1, jpjm1 143 143 DO ji = 1, jpim1 144 # endif145 144 zgru(ji,jj,mbku(ji,jj)) = gru(ji,jj) 146 145 zgrv(ji,jj,mbkv(ji,jj)) = grv(ji,jj) … … 148 147 END DO 149 148 ENDIF 150 ! 151 zdzr(:,:,1) = 0._wp !== Local vertical density gradient at T-point == ! (evaluated from N^2) 149 IF( ln_zps .AND. ln_isfcav ) THEN ! partial steps correction at the bottom ocean level 150 DO jj = 1, jpjm1 151 DO ji = 1, jpim1 152 IF ( miku(ji,jj) > 1 ) zgru(ji,jj,miku(ji,jj)) = grui(ji,jj) 153 IF ( mikv(ji,jj) > 1 ) zgrv(ji,jj,mikv(ji,jj)) = grvi(ji,jj) 154 END DO 155 END DO 156 ENDIF 157 ! 158 !== Local vertical density gradient at T-point == ! (evaluated from N^2) 159 ! interior value 152 160 DO jk = 2, jpkm1 153 161 ! ! zdzr = d/dz(prd)= - ( prd ) / grav * mk(pn2) -- at t point … … 159 167 & * ( pn2(:,:,jk) + pn2(:,:,jk+1) ) * ( 1._wp - 0.5_wp * tmask(:,:,jk+1) ) 160 168 END DO 169 ! surface initialisation 170 zdzr(:,:,1) = 0._wp 171 IF ( ln_isfcav ) THEN 172 ! if isf need to overwrite the interior value at at the first ocean point 173 DO jj = 1, jpjm1 174 DO ji = 1, jpim1 175 zdzr(ji,jj,1:mikt(ji,jj)) = 0._wp 176 END DO 177 END DO 178 END IF 161 179 ! 162 180 ! !== Slopes just below the mixed layer ==! … … 167 185 ! =========================== | vslp = d/dj( prd ) / d/dz( prd ) 168 186 ! 187 IF ( ln_isfcav ) THEN 188 DO jj = 2, jpjm1 189 DO ji = fs_2, fs_jpim1 ! vector opt. 190 IF (miku(ji,jj) .GT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp) 191 IF (miku(ji,jj) .LT. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji+1,jj ), 5._wp) 192 IF (miku(ji,jj) .EQ. miku(ji+1,jj)) zhmlpu(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji+1,jj ), 5._wp) 193 IF (mikv(ji,jj) .GT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), 5._wp) 194 IF (mikv(ji,jj) .LT. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj+1), 5._wp) 195 IF (mikv(ji,jj) .EQ. miku(ji,jj+1)) zhmlpv(ji,jj) = MAX(hmlpt(ji ,jj ), hmlpt(ji ,jj+1), 5._wp) 196 ENDDO 197 ENDDO 198 ELSE 199 DO jj = 2, jpjm1 200 DO ji = fs_2, fs_jpim1 ! vector opt. 201 zhmlpu(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji+1,jj ), 5._wp) 202 zhmlpv(ji,jj) = MAX(hmlpt(ji,jj), hmlpt(ji ,jj+1), 5._wp) 203 ENDDO 204 ENDDO 205 END IF 169 206 DO jk = 2, jpkm1 !* Slopes at u and v points 170 207 DO jj = 2, jpjm1 … … 180 217 zbv = MIN( zbv, -100._wp* ABS( zav ) , -7.e+3_wp/fse3v(ji,jj,jk)* ABS( zav ) ) 181 218 ! ! uslp and vslp output in zwz and zww, resp. 182 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj,jk) ) 183 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji,jj+1,jk) ) 184 zwz(ji,jj,jk) = ( ( 1. - zfi) * zau / ( zbu - zeps ) & 185 & + zfi * uslpml(ji,jj) & 186 & * 0.5_wp * ( fsdept(ji+1,jj,jk)+fsdept(ji,jj,jk)-fse3u(ji,jj,1) ) & 187 & / MAX( hmlpt(ji,jj), hmlpt(ji+1,jj), 5._wp ) ) * umask(ji,jj,jk) 188 zww(ji,jj,jk) = ( ( 1. - zfj) * zav / ( zbv - zeps ) & 189 & + zfj * vslpml(ji,jj) & 190 & * 0.5_wp * ( fsdept(ji,jj+1,jk)+fsdept(ji,jj,jk)-fse3v(ji,jj,1) ) & 191 & / MAX( hmlpt(ji,jj), hmlpt(ji,jj+1), 5. ) ) * vmask(ji,jj,jk) 219 zfi = MAX( omlmask(ji,jj,jk), omlmask(ji+1,jj ,jk) ) 220 zfj = MAX( omlmask(ji,jj,jk), omlmask(ji ,jj+1,jk) ) 221 ! thickness of water column between surface and level k at u/v point 222 zdepu = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji+1,jj ,jk) ) & 223 - 2 * MAX( risfdep(ji,jj), risfdep(ji+1,jj ) ) - fse3u(ji,jj,miku(ji,jj)) ) 224 zdepv = 0.5_wp * ( ( fsdept(ji,jj,jk) + fsdept(ji ,jj+1,jk) ) & 225 - 2 * MAX( risfdep(ji,jj), risfdep(ji ,jj+1) ) - fse3v(ji,jj,mikv(ji,jj)) ) 226 ! 227 zwz(ji,jj,jk) = ( 1. - zfi) * zau / ( zbu - zeps ) & 228 & + zfi * uslpml(ji,jj) * zdepu / zhmlpu(ji,jj) 229 zwz(ji,jj,jk) = zwz(ji,jj,jk) * wumask(ji,jj,jk) 230 zww(ji,jj,jk) = ( 1. - zfj) * zav / ( zbv - zeps ) & 231 & + zfj * vslpml(ji,jj) * zdepv / zhmlpv(ji,jj) 232 zww(ji,jj,jk) = zww(ji,jj,jk) * wvmask(ji,jj,jk) 233 234 192 235 !!gm modif to suppress omlmask.... (as in Griffies case) 193 236 ! ! ! jk must be >= ML level for zf=1. otherwise zf=0. … … 238 281 DO ji = fs_2, fs_jpim1 ! vector opt. 239 282 uslp(ji,jj,jk) = uslp(ji,jj,jk) * ( umask(ji,jj+1,jk) + umask(ji,jj-1,jk ) ) * 0.5_wp & 240 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp 283 & * ( umask(ji,jj ,jk) + umask(ji,jj ,jk+1) ) * 0.5_wp & 284 & * umask(ji,jj,jk-1) 241 285 vslp(ji,jj,jk) = vslp(ji,jj,jk) * ( vmask(ji+1,jj,jk) + vmask(ji-1,jj,jk ) ) * 0.5_wp & 242 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp 286 & * ( vmask(ji ,jj,jk) + vmask(ji ,jj,jk+1) ) * 0.5_wp & 287 & * vmask(ji,jj,jk-1) 243 288 END DO 244 289 END DO … … 253 298 DO ji = fs_2, fs_jpim1 ! vector opt. 254 299 ! !* Local vertical density gradient evaluated from N^2 255 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) 300 zbw = zm1_2g * pn2 (ji,jj,jk) * ( prd (ji,jj,jk) + prd (ji,jj,jk-1) + 2. ) * wmask(ji,jj,jk) 256 301 ! !* Slopes at w point 257 302 ! ! i- & j-gradient of density at w-points … … 261 306 & + vmask(ji,jj-1,jk-1) + vmask(ji,jj,jk ) , zeps ) * e2t(ji,jj) 262 307 zai = ( zgru (ji-1,jj,jk ) + zgru (ji,jj,jk-1) & 263 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci * tmask (ji,jj,jk)308 & + zgru (ji-1,jj,jk-1) + zgru (ji,jj,jk ) ) / zci 264 309 zaj = ( zgrv (ji,jj-1,jk ) + zgrv (ji,jj,jk-1) & 265 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj * tmask (ji,jj,jk)310 & + zgrv (ji,jj-1,jk-1) + zgrv (ji,jj,jk ) ) / zcj 266 311 ! ! bound the slopes: abs(zw.)<= 1/100 and zb..<0. 267 312 ! ! + kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 270 315 ! ! wslpi and wslpj with ML flattening (output in zwz and zww, resp.) 271 316 zfk = MAX( omlmask(ji,jj,jk), omlmask(ji,jj,jk-1) ) ! zfk=1 in the ML otherwise zfk=0 272 zck = fsdepw(ji,jj,jk) / MAX( hmlp(ji,jj), 10._wp ) 273 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) + zck * wslpiml(ji,jj) * zfk ) * tmask(ji,jj,jk) 274 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) + zck * wslpjml(ji,jj) * zfk ) * tmask(ji,jj,jk) 317 zck = ( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj) ) ) / MAX( hmlp(ji,jj), 10._wp ) 318 zwz(ji,jj,jk) = ( zai / ( zbi - zeps ) * ( 1._wp - zfk ) & 319 & + zck * wslpiml(ji,jj) * zfk ) * wmask(ji,jj,jk) 320 zww(ji,jj,jk) = ( zaj / ( zbj - zeps ) * ( 1._wp - zfk ) & 321 & + zck * wslpjml(ji,jj) * zfk ) * wmask(ji,jj,jk) 275 322 276 323 !!gm modif to suppress omlmask.... (as in Griffies operator) … … 325 372 zck = ( umask(ji,jj,jk) + umask(ji-1,jj,jk) ) & 326 373 & * ( vmask(ji,jj,jk) + vmask(ji,jj-1,jk) ) * 0.25 327 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck 328 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck 374 wslpi(ji,jj,jk) = wslpi(ji,jj,jk) * zck * wmask(ji,jj,jk) 375 wslpj(ji,jj,jk) = wslpj(ji,jj,jk) * zck * wmask(ji,jj,jk) 329 376 END DO 330 377 END DO … … 377 424 ! set the slope of diffusion to the slope of s-surfaces 378 425 ! ( c a u t i o n : minus sign as fsdep has positive value ) 379 DO jk = 1, jpk 426 DO jj = 2, jpjm1 427 DO ji = fs_2, fs_jpim1 ! vector opt. 428 uslp(ji,jj,1) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1) 429 vslp(ji,jj,1) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1) 430 wslpi(ji,jj,1) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5 431 wslpj(ji,jj,1) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5 432 END DO 433 END DO 434 435 DO jk = 2, jpk 380 436 DO jj = 2, jpjm1 381 437 DO ji = fs_2, fs_jpim1 ! vector opt. 382 438 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 383 439 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 384 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.5 385 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.5 440 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 441 & * wmask(ji,jj,jk) * 0.5 442 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 443 & * wmask(ji,jj,jk) * 0.5 386 444 END DO 387 445 END DO … … 405 463 406 464 CALL wrk_dealloc( jpi,jpj,jpk, zwz, zww, zdzr, zgru, zgrv ) 465 CALL wrk_dealloc( jpi,jpj, zhmlpu, zhmlpv) 407 466 ! 408 467 IF( nn_timing == 1 ) CALL timing_stop('ldf_slp') … … 435 494 REAL(wp) :: zdyrho_raw, ztj_coord, ztj_raw, ztj_lim, ztj_g_raw, ztj_g_lim 436 495 REAL(wp) :: zdzrho_raw 437 REAL(wp) :: zbeta0438 496 REAL(wp), POINTER, DIMENSION(:,:) :: z1_mlbw 439 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalbet440 497 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zdxrho , zdyrho, zdzrho ! Horizontal and vertical density gradients 441 498 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zti_mlb, ztj_mlb ! for Griffies operator only … … 445 502 ! 446 503 CALL wrk_alloc( jpi,jpj, z1_mlbw ) 447 CALL wrk_alloc( jpi,jpj,jpk, zalbet )448 504 CALL wrk_alloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 449 505 CALL wrk_alloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 452 508 ! Some preliminary calculation ! 453 509 !--------------------------------! 454 !455 CALL eos_alpbet( tsb, zalbet, zbeta0 ) !== before local thermal/haline expension ratio at T-points ==!456 510 ! 457 511 DO jl = 0, 1 !== unmasked before density i- j-, k-gradients ==! … … 465 519 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 466 520 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 467 zdxrho_raw = ( - zalbet(ji+ip,jj ,jk) * zdit + zbeta0*zdis ) / e1u(ji,jj)468 zdyrho_raw = ( - zalbet(ji ,jj+jp,jk) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)469 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( 521 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) / e1u(ji,jj) 522 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) / e2v(ji,jj) 523 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 470 524 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 471 525 END DO … … 473 527 END DO 474 528 ! 475 IF( ln_zps.and.l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 476 # if defined key_vectopt_loop 477 DO jj = 1, 1 478 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling) 479 # else 529 IF( ln_zps .AND. l_grad_zps ) THEN ! partial steps: correction of i- & j-grad on bottom 480 530 DO jj = 1, jpjm1 481 531 DO ji = 1, jpim1 482 # endif483 532 iku = mbku(ji,jj) ; ikv = mbkv(ji,jj) ! last ocean level (u- & v-points) 484 533 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 485 534 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 486 zdxrho_raw = ( - zalbet(ji+ip,jj ,iku) * zdit + zbeta0*zdis ) / e1u(ji,jj)487 zdyrho_raw = ( - zalbet(ji ,jj+jp,ikv) * zdjt + zbeta0*zdjs ) / e2v(ji,jj)535 zdxrho_raw = ( - rab_b(ji+ip,jj ,iku,jp_tem) * zdit + rab_b(ji+ip,jj ,iku,jp_sal) * zdis ) / e1u(ji,jj) 536 zdyrho_raw = ( - rab_b(ji ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji ,jj+jp,ikv,jp_sal) * zdjs ) / e2v(ji,jj) 488 537 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 489 538 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 505 554 zdks = 0._wp 506 555 ENDIF 507 zdzrho_raw = ( - zalbet(ji ,jj ,jk) * zdkt + zbeta0*zdks ) / fse3w(ji,jj,jk+kp)508 zdzrho(ji ,jj ,jk, kp) = - MIN( - repsln,zdzrho_raw ) ! force zdzrho >= repsln556 zdzrho_raw = ( - rab_b(ji,jj,jk,jp_tem) * zdkt + rab_b(ji,jj,jk,jp_sal) * zdks ) / fse3w(ji,jj,jk+kp) 557 zdzrho(ji,jj,jk,kp) = - MIN( - repsln, zdzrho_raw ) ! force zdzrho >= repsln 509 558 END DO 510 559 END DO … … 650 699 ! 651 700 CALL wrk_dealloc( jpi,jpj, z1_mlbw ) 652 CALL wrk_dealloc( jpi,jpj,jpk, zalbet )653 701 CALL wrk_dealloc( jpi,jpj,jpk,2, zdxrho , zdyrho, zdzrho, klstart = 0 ) 654 702 CALL wrk_dealloc( jpi,jpj, 2,2, zti_mlb, ztj_mlb, kkstart = 0, klstart = 0 ) … … 701 749 ! !== surface mixed layer mask ! 702 750 DO jk = 1, jpk ! =1 inside the mixed layer, =0 otherwise 703 # if defined key_vectopt_loop704 DO jj = 1, 1705 DO ji = 1, jpij ! vector opt. (forced unrolling)706 # else707 751 DO jj = 1, jpj 708 752 DO ji = 1, jpi 709 # endif710 753 ik = nmln(ji,jj) - 1 711 IF( jk <= ik ) THEN ; omlmask(ji,jj,jk) = 1._wp 712 ELSE ; omlmask(ji,jj,jk) = 0._wp 754 IF( jk <= ik .AND. jk >= mikt(ji,jj) ) THEN 755 omlmask(ji,jj,jk) = 1._wp 756 ELSE 757 omlmask(ji,jj,jk) = 0._wp 713 758 ENDIF 714 759 END DO … … 727 772 !----------------------------------------------------------------------- 728 773 ! 729 # if defined key_vectopt_loop730 DO jj = 1, 1731 DO ji = jpi+2, jpij-jpi-1 ! vector opt. (forced unrolling)732 # else733 774 DO jj = 2, jpjm1 734 775 DO ji = 2, jpim1 735 # endif736 776 ! !== Slope at u- & v-points just below the Mixed Layer ==! 737 777 ! 738 778 ! !- vertical density gradient for u- and v-slopes (from dzr at T-point) 739 iku = MIN( MAX( 1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1)740 ikv = MIN( MAX( 1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) !779 iku = MIN( MAX( miku(ji,jj)+1, nmln(ji,jj) , nmln(ji+1,jj) ) , jpkm1 ) ! ML (MAX of T-pts, bound by jpkm1) 780 ikv = MIN( MAX( mikv(ji,jj)+1, nmln(ji,jj) , nmln(ji,jj+1) ) , jpkm1 ) ! 741 781 zbu = 0.5_wp * ( p_dzr(ji,jj,iku) + p_dzr(ji+1,jj ,iku) ) 742 782 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) … … 772 812 zbj = MIN( zbw , -100._wp* ABS( zaj ) , -7.e+3_wp/fse3w(ji,jj,ik)* ABS( zaj ) ) 773 813 ! !- i- & j-slope at w-points (wslpiml, wslpjml) 774 wslpiml(ji,jj) = zai / ( zbi - zeps ) * tmask (ji,jj,ik)775 wslpjml(ji,jj) = zaj / ( zbj - zeps ) * tmask (ji,jj,ik)814 wslpiml(ji,jj) = zai / ( zbi - zeps ) * wmask (ji,jj,ik) 815 wslpjml(ji,jj) = zaj / ( zbj - zeps ) * wmask (ji,jj,ik) 776 816 END DO 777 817 END DO … … 825 865 wslpj(:,:,:) = 0._wp ; wslpjml(:,:) = 0._wp 826 866 827 IF( ln_traldf_hor .OR. ln_dynldf_hor) THEN867 IF(ln_sco .AND. (ln_traldf_hor .OR. ln_dynldf_hor )) THEN 828 868 IF(lwp) WRITE(numout,*) ' Horizontal mixing in s-coordinate: slope = slope of s-surfaces' 829 869 -
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/LDF/ldftra_smag.F90
- Property svn:keywords set to Id
r3634 r5832 31 31 !!---------------------------------------------------------------------- 32 32 !! OPA 9.0 , LOCEAN-IPSL (2005) 33 !! $Id : ldf_tra_smag.F90 1482 2010-06-13 15:28:06Z$33 !! $Id$ 34 34 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 35 35 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
