Changeset 4155 for branches/2013
- Timestamp:
- 2013-11-05T15:24:22+01:00 (10 years ago)
- Location:
- branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r4099 r4155 188 188 REAL(wp), PUBLIC :: alphaevp = 1._wp !: coeficient of the internal stresses !SB 189 189 REAL(wp), PUBLIC :: unit_fac = 1.e+09_wp !: conversion factor for ice / snow enthalpy 190 REAL(wp), PUBLIC :: hminrhg = 0.0 5_wp !: clem : ice thickness (in m) below which ice velocity is set to ocean velocity190 REAL(wp), PUBLIC :: hminrhg = 0.001_wp !: clem : ice volume (a*h, in m) below which ice velocity is set to ocean velocity 191 191 192 192 ! !!** ice-salinity namelist (namicesal) ** -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/iceini.F90
r4099 r4155 135 135 ln_nicep = .FALSE. 136 136 CALL ctl_warn( 'ice_run : specific control print for LIM3 desactivated with MPI' ) 137 ENDIF 137 ENDIF 138 138 ! 139 139 IF(lwp) THEN ! control print -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r4072 r4155 224 224 ENDIF 225 225 ! 226 227 226 ! ------------------------------- 228 227 !- check conservation (C Rousset) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r4072 r4155 161 161 ! ------------------------------- 162 162 !- check conservation (C Rousset) 163 IF (ln_limdiahsb) THEN163 IF( ln_limdiahsb ) THEN 164 164 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 165 165 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r4099 r4155 659 659 DO ji = fs_2, fs_jpim1 660 660 zindb = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 661 zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )662 !zdummy = vt_i(ji,jj)661 !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 662 zdummy = vt_i(ji,jj) 663 663 IF ( zdummy .LE. hminrhg ) THEN 664 664 u_ice(ji,jj) = u_oce(ji,jj) … … 682 682 DO ji = fs_2, fs_jpim1 683 683 zindb = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 684 zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )685 !zdummy = vt_i(ji,jj)684 !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 685 zdummy = vt_i(ji,jj) 686 686 IF ( zdummy .LE. hminrhg ) THEN 687 687 v_ice1(ji,jj) = 0.5*( (v_ice(ji,jj)+v_ice(ji,jj-1))*e1t(ji+1,jj) & … … 707 707 !- zds(:,:): shear on northeast corner of grid cells 708 708 zindb = MAX( 0.0, SIGN( 1.0, at_i(ji,jj) - 1.0e-6 ) ) 709 zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 )710 !zdummy = vt_i(ji,jj)709 !zdummy = zindb * vt_i(ji,jj) / MAX(at_i(ji,jj) , 1.0e-06 ) 710 zdummy = vt_i(ji,jj) 711 711 IF ( zdummy .LE. hminrhg ) THEN 712 712 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r4072 r4155 81 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zs0e 82 82 REAL(wp) :: zchk_v_i, zchk_smv, zchk_fs, zchk_fw, zchk_v_i_b, zchk_smv_b, zchk_fs_b, zchk_fw_b ! Check conservation (C Rousset) 83 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax ! Check errors (C Rousset)83 REAL(wp) :: zchk_vmin, zchk_amin, zchk_amax, zchk_umax ! Check errors (C Rousset) 84 84 ! mass and salt flux (clem) 85 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zviold ! old ice volume... … … 99 99 ! ------------------------------- 100 100 !- check conservation (C Rousset) 101 IF (ln_limdiahsb) THEN101 IF( ln_limdiahsb ) THEN 102 102 zchk_v_i_b = glob_sum( SUM( v_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) 103 103 zchk_smv_b = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * area(:,:) * tms(:,:) ) … … 456 456 457 457 ! Ice salinity and age 458 zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj) , & 459 & zusvoic * zs0sm(ji,jj,jl) ) , s_i_min ) * v_i(ji,jj,jl) 460 IF( num_sal == 2 ) smv_i(ji,jj,jl) = zindic * zsal 461 462 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp ) * a_i(ji,jj,jl) 458 !clem zsal = MAX( MIN( (rhoic-rhosn)/rhoic*sss_m(ji,jj), zusvoic * zs0sm(ji,jj,jl) ), s_i_min ) * v_i(ji,jj,jl) 459 IF( num_sal == 2 ) THEN 460 smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), zsmv ), s_i_min * v_i(ji,jj,jl) ) 461 ENDIF 462 463 zage = MAX( MIN( zbigval, zs0oi(ji,jj,jl) / MAX( a_i(ji,jj,jl), epsi16 ) ), 0._wp ) * a_i(ji,jj,jl) 463 464 oa_i (ji,jj,jl) = zindic * zage 464 465 … … 544 545 ! ------------------------------- 545 546 !- check conservation (C Rousset) 546 IF (ln_limdiahsb) THEN547 IF( ln_limdiahsb ) THEN 547 548 zchk_fs = glob_sum( ( sfx_bri(:,:) + sfx_thd(:,:) + sfx_res(:,:) + sfx_mec(:,:) ) * area(:,:) * tms(:,:) ) - zchk_fs_b 548 549 zchk_fw = glob_sum( rdm_ice(:,:) * area(:,:) * tms(:,:) ) - zchk_fw_b … … 554 555 zchk_amax = glob_max(SUM(a_i,dim=3)) 555 556 zchk_amin = glob_min(a_i) 557 zchk_umax = glob_max(SQRT(u_ice**2 + v_ice**2)) 556 558 557 559 IF(lwp) THEN 558 IF ( ABS( zchk_v_i ) > 1.e-5 ) WRITE(numout,*) 'violation volume [m3/day] (limtrp) = ',(zchk_v_i * rday) 560 IF ( ABS( zchk_v_i ) > 1.e-5 ) THEN 561 WRITE(numout,*) 'violation volume [m3/day] (limtrp) = ',(zchk_v_i * rday) 562 WRITE(numout,*) 'u_ice max [m/s] (limtrp) = ',zchk_umax 563 WRITE(numout,*) 'number of time steps (limtrp) =',kt 564 ENDIF 559 565 IF ( ABS( zchk_smv ) > 1.e-4 ) WRITE(numout,*) 'violation saline [psu*m3/day] (limtrp) = ',(zchk_smv * rday) 560 566 IF ( zchk_vmin < 0. ) WRITE(numout,*) 'violation v_i<0 [mm] (limtrp) = ',(zchk_vmin * 1.e-3) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r4099 r4155 30 30 31 31 PUBLIC sbc_ice_alloc ! called in iceini(_2).F90 32 33 CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none' !: Flux handling over ice categories34 LOGICAL, PUBLIC :: ln_iceflx_ave = .FALSE. ! Average heat fluxes over all ice categories35 LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo36 32 37 33 # if defined key_lim2 -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r4039 r4155 53 53 LOGICAL , PUBLIC :: ln_cdgw = .FALSE. !: true if neutral drag coefficient from wave model 54 54 LOGICAL , PUBLIC :: ln_sdw = .FALSE. !: true if 3d stokes drift from wave model 55 55 ! 56 CHARACTER (len=8), PUBLIC :: cn_iceflx = 'none' !: Flux handling over ice categories 57 LOGICAL, PUBLIC :: ln_iceflx_ave = .FALSE. ! Average heat fluxes over all ice categories 58 LOGICAL, PUBLIC :: ln_iceflx_linear = .FALSE. ! Redistribute mean heat fluxes over all ice categories, using ice temperature and albedo 59 ! 56 60 !!---------------------------------------------------------------------- 57 61 !! Ocean Surface Boundary Condition fields -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r4099 r4155 241 241 ENDIF 242 242 ! 243 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 244 ! 243 245 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 244 246 ! -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90
r4036 r4155 25 25 26 26 PUBLIC glob_sum ! used in many places 27 PUBLIC DDPDD ! also used in closea module 27 28 PUBLIC glob_min, glob_max 28 PUBLIC DDPDD ! also used in closea module29 29 #if defined key_nosignedzero 30 30 PUBLIC SIGN … … 156 156 ! 157 157 END FUNCTION glob_sum_3d_a 158 159 ! --- MIN ---160 FUNCTION glob_min_2d( ptab )161 !!-----------------------------------------------------------------------162 !! *** FUNCTION glob_min_2D ***163 !!164 !! ** Purpose : perform a masked min on the inner global domain of a 2D array165 !!-----------------------------------------------------------------------166 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array167 REAL(wp) :: glob_min_2d ! global masked min168 !!-----------------------------------------------------------------------169 !170 glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) )171 IF( lk_mpp ) CALL mpp_min( glob_min_2d )172 !173 END FUNCTION glob_min_2d174 175 FUNCTION glob_min_3d( ptab )176 !!-----------------------------------------------------------------------177 !! *** FUNCTION glob_min_3D ***178 !!179 !! ** Purpose : perform a masked min on the inner global domain of a 3D array180 !!-----------------------------------------------------------------------181 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array182 REAL(wp) :: glob_min_3d ! global masked min183 !!184 INTEGER :: jk185 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab186 !!-----------------------------------------------------------------------187 !188 ijpk = SIZE(ptab,3)189 !190 glob_min_3d = 0.e0191 DO jk = 1, ijpk192 glob_min_3d = glob_min_3d + MINVAL( ptab(:,:,jk)*tmask_i(:,:) )193 END DO194 IF( lk_mpp ) CALL mpp_min( glob_min_3d )195 !196 END FUNCTION glob_min_3d197 198 199 FUNCTION glob_min_2d_a( ptab1, ptab2 )200 !!-----------------------------------------------------------------------201 !! *** FUNCTION glob_min_2D _a ***202 !!203 !! ** Purpose : perform a masked min on the inner global domain of two 2D array204 !!-----------------------------------------------------------------------205 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array206 REAL(wp) , DIMENSION(2) :: glob_min_2d_a ! global masked min207 !!-----------------------------------------------------------------------208 !209 glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) )210 glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) )211 IF( lk_mpp ) CALL mpp_min( glob_min_2d_a, 2 )212 !213 END FUNCTION glob_min_2d_a214 215 216 FUNCTION glob_min_3d_a( ptab1, ptab2 )217 !!-----------------------------------------------------------------------218 !! *** FUNCTION glob_min_3D_a ***219 !!220 !! ** Purpose : perform a masked min on the inner global domain of two 3D array221 !!-----------------------------------------------------------------------222 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array223 REAL(wp) , DIMENSION(2) :: glob_min_3d_a ! global masked min224 !!225 INTEGER :: jk226 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab227 !!-----------------------------------------------------------------------228 !229 ijpk = SIZE(ptab1,3)230 !231 glob_min_3d_a(:) = 0.e0232 DO jk = 1, ijpk233 glob_min_3d_a(1) = glob_min_3d_a(1) + MINVAL( ptab1(:,:,jk)*tmask_i(:,:) )234 glob_min_3d_a(2) = glob_min_3d_a(2) + MINVAL( ptab2(:,:,jk)*tmask_i(:,:) )235 END DO236 IF( lk_mpp ) CALL mpp_min( glob_min_3d_a, 2 )237 !238 END FUNCTION glob_min_3d_a239 240 ! --- MAX ---241 FUNCTION glob_max_2d( ptab )242 !!-----------------------------------------------------------------------243 !! *** FUNCTION glob_max_2D ***244 !!245 !! ** Purpose : perform a masked max on the inner global domain of a 2D array246 !!-----------------------------------------------------------------------247 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array248 REAL(wp) :: glob_max_2d ! global masked max249 !!-----------------------------------------------------------------------250 !251 glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) )252 IF( lk_mpp ) CALL mpp_max( glob_max_2d )253 !254 END FUNCTION glob_max_2d255 256 FUNCTION glob_max_3d( ptab )257 !!-----------------------------------------------------------------------258 !! *** FUNCTION glob_max_3D ***259 !!260 !! ** Purpose : perform a masked max on the inner global domain of a 3D array261 !!-----------------------------------------------------------------------262 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array263 REAL(wp) :: glob_max_3d ! global masked max264 !!265 INTEGER :: jk266 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab267 !!-----------------------------------------------------------------------268 !269 ijpk = SIZE(ptab,3)270 !271 glob_max_3d = 0.e0272 DO jk = 1, ijpk273 glob_max_3d = glob_max_3d + MAXVAL( ptab(:,:,jk)*tmask_i(:,:) )274 END DO275 IF( lk_mpp ) CALL mpp_max( glob_max_3d )276 !277 END FUNCTION glob_max_3d278 279 280 FUNCTION glob_max_2d_a( ptab1, ptab2 )281 !!-----------------------------------------------------------------------282 !! *** FUNCTION glob_max_2D _a ***283 !!284 !! ** Purpose : perform a masked max on the inner global domain of two 2D array285 !!-----------------------------------------------------------------------286 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array287 REAL(wp) , DIMENSION(2) :: glob_max_2d_a ! global masked max288 !!-----------------------------------------------------------------------289 !290 glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) )291 glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) )292 IF( lk_mpp ) CALL mpp_max( glob_max_2d_a, 2 )293 !294 END FUNCTION glob_max_2d_a295 296 297 FUNCTION glob_max_3d_a( ptab1, ptab2 )298 !!-----------------------------------------------------------------------299 !! *** FUNCTION glob_max_3D_a ***300 !!301 !! ** Purpose : perform a masked max on the inner global domain of two 3D array302 !!-----------------------------------------------------------------------303 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array304 REAL(wp) , DIMENSION(2) :: glob_max_3d_a ! global masked max305 !!306 INTEGER :: jk307 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab308 !!-----------------------------------------------------------------------309 !310 ijpk = SIZE(ptab1,3)311 !312 glob_max_3d_a(:) = 0.e0313 DO jk = 1, ijpk314 glob_max_3d_a(1) = glob_max_3d_a(1) + MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) )315 glob_max_3d_a(2) = glob_max_3d_a(2) + MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) )316 END DO317 IF( lk_mpp ) CALL mpp_max( glob_max_3d_a, 2 )318 !319 END FUNCTION glob_max_3d_a320 321 158 322 159 #else … … 477 314 END FUNCTION glob_sum_3d_a 478 315 316 #endif 479 317 480 318 ! --- MIN --- 481 319 FUNCTION glob_min_2d( ptab ) 482 !!---------------------------------------------------------------------- 483 !! *** FUNCTION glob_min_2 d***484 !! 485 !! ** Purpose : perform a m in in calling DDPDD routine486 !!---------------------------------------------------------------------- 487 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 320 !!----------------------------------------------------------------------- 321 !! *** FUNCTION glob_min_2D *** 322 !! 323 !! ** Purpose : perform a masked min on the inner global domain of a 2D array 324 !!----------------------------------------------------------------------- 325 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array 488 326 REAL(wp) :: glob_min_2d ! global masked min 489 !! 490 COMPLEX(wp):: ctmp 491 REAL(wp) :: ztmp 492 INTEGER :: ji, jj ! dummy loop indices 493 !!----------------------------------------------------------------------- 494 ! 495 ztmp = 0.e0 496 ctmp = CMPLX( 0.e0, 0.e0, wp ) 497 DO jj = 1, jpj 498 DO ji = 1, jpi 499 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 500 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 501 END DO 502 END DO 503 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 504 glob_min_2d = REAL(ctmp,wp) 505 ! 506 END FUNCTION glob_min_2d 507 508 327 !!----------------------------------------------------------------------- 328 ! 329 glob_min_2d = MINVAL( ptab(:,:)*tmask_i(:,:) ) 330 IF( lk_mpp ) CALL mpp_min( glob_min_2d ) 331 ! 332 END FUNCTION glob_min_2d 333 509 334 FUNCTION glob_min_3d( ptab ) 510 !!---------------------------------------------------------------------- 511 !! *** FUNCTION glob_min_3 d***512 !! 513 !! ** Purpose : perform a m in on a 3D array in calling DDPDD routine514 !!---------------------------------------------------------------------- 515 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 335 !!----------------------------------------------------------------------- 336 !! *** FUNCTION glob_min_3D *** 337 !! 338 !! ** Purpose : perform a masked min on the inner global domain of a 3D array 339 !!----------------------------------------------------------------------- 340 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array 516 341 REAL(wp) :: glob_min_3d ! global masked min 517 342 !! 518 COMPLEX(wp):: ctmp 519 REAL(wp) :: ztmp 520 INTEGER :: ji, jj, jk ! dummy loop indices 521 INTEGER :: ijpk ! local variables: size of ptab 343 INTEGER :: jk 344 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 522 345 !!----------------------------------------------------------------------- 523 346 ! 524 347 ijpk = SIZE(ptab,3) 525 348 ! 526 ztmp = 0.e0 527 ctmp = CMPLX( 0.e0, 0.e0, wp ) 528 DO jk = 1, ijpk 529 DO jj = 1, jpj 530 DO ji = 1, jpi 531 ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj) 532 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 533 END DO 534 END DO 535 END DO 536 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 537 glob_min_3d = REAL(ctmp,wp) 538 ! 539 END FUNCTION glob_min_3d 349 glob_min_3d = MINVAL( ptab(:,:,1)*tmask_i(:,:) ) 350 DO jk = 2, ijpk 351 glob_min_3d = MIN( glob_min_3d, MINVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 352 END DO 353 IF( lk_mpp ) CALL mpp_min( glob_min_3d ) 354 ! 355 END FUNCTION glob_min_3d 540 356 541 357 542 358 FUNCTION glob_min_2d_a( ptab1, ptab2 ) 543 !!---------------------------------------------------------------------- 544 !! *** FUNCTION glob_min_2d_a *** 545 !! 546 !! ** Purpose : perform a min on two 2D arrays in calling DDPDD routine 547 !!---------------------------------------------------------------------- 548 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 549 REAL(wp) :: glob_min_2d_a ! global masked min 550 !! 551 COMPLEX(wp):: ctmp 552 REAL(wp) :: ztmp 553 INTEGER :: ji, jj ! dummy loop indices 554 !!----------------------------------------------------------------------- 555 ! 556 ! 557 ztmp = 0.e0 558 ctmp = CMPLX( 0.e0, 0.e0, wp ) 559 DO jj = 1, jpj 560 DO ji = 1, jpi 561 ztmp = ptab1(ji,jj) * tmask_i(ji,jj) 562 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 563 ztmp = ptab2(ji,jj) * tmask_i(ji,jj) 564 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 565 END DO 566 END DO 567 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 568 glob_min_2d_a = REAL(ctmp,wp) 569 ! 570 END FUNCTION glob_min_2d_a 571 572 359 !!----------------------------------------------------------------------- 360 !! *** FUNCTION glob_min_2D _a *** 361 !! 362 !! ** Purpose : perform a masked min on the inner global domain of two 2D array 363 !!----------------------------------------------------------------------- 364 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array 365 REAL(wp) , DIMENSION(2) :: glob_min_2d_a ! global masked min 366 !!----------------------------------------------------------------------- 367 ! 368 glob_min_2d_a(1) = MINVAL( ptab1(:,:)*tmask_i(:,:) ) 369 glob_min_2d_a(2) = MINVAL( ptab2(:,:)*tmask_i(:,:) ) 370 IF( lk_mpp ) CALL mpp_min( glob_min_2d_a, 2 ) 371 ! 372 END FUNCTION glob_min_2d_a 373 374 573 375 FUNCTION glob_min_3d_a( ptab1, ptab2 ) 574 !!---------------------------------------------------------------------- 575 !! *** FUNCTION glob_min_3d_a *** 576 !! 577 !! ** Purpose : perform a min on two 3D array in calling DDPDD routine 578 !!---------------------------------------------------------------------- 579 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 580 REAL(wp) :: glob_min_3d_a ! global masked min 581 !! 582 COMPLEX(wp):: ctmp 583 REAL(wp) :: ztmp 584 INTEGER :: ji, jj, jk ! dummy loop indices 585 INTEGER :: ijpk ! local variables: size of ptab 376 !!----------------------------------------------------------------------- 377 !! *** FUNCTION glob_min_3D_a *** 378 !! 379 !! ** Purpose : perform a masked min on the inner global domain of two 3D array 380 !!----------------------------------------------------------------------- 381 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array 382 REAL(wp) , DIMENSION(2) :: glob_min_3d_a ! global masked min 383 !! 384 INTEGER :: jk 385 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 586 386 !!----------------------------------------------------------------------- 587 387 ! 588 388 ijpk = SIZE(ptab1,3) 589 389 ! 590 ztmp = 0.e0 591 ctmp = CMPLX( 0.e0, 0.e0, wp ) 592 DO jk = 1, ijpk 593 DO jj = 1, jpj 594 DO ji = 1, jpi 595 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj) 596 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 597 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj) 598 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 599 END DO 600 END DO 601 END DO 602 IF( lk_mpp ) CALL mpp_min( ctmp ) ! min over the global domain 603 glob_min_3d_a = REAL(ctmp,wp) 604 ! 605 END FUNCTION glob_min_3d_a 606 607 390 glob_min_3d_a(1) = MINVAL( ptab1(:,:,1)*tmask_i(:,:) ) 391 glob_min_3d_a(2) = MINVAL( ptab2(:,:,1)*tmask_i(:,:) ) 392 DO jk = 2, ijpk 393 glob_min_3d_a(1) = MIN( glob_min_3d_a(1), MINVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 394 glob_min_3d_a(2) = MIN( glob_min_3d_a(2), MINVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 395 END DO 396 IF( lk_mpp ) CALL mpp_min( glob_min_3d_a, 2 ) 397 ! 398 END FUNCTION glob_min_3d_a 399 608 400 ! --- MAX --- 609 401 FUNCTION glob_max_2d( ptab ) 610 !!---------------------------------------------------------------------- 611 !! *** FUNCTION glob_max_2 d***612 !! 613 !! ** Purpose : perform a ma x in calling DDPDD routine614 !!---------------------------------------------------------------------- 615 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab 402 !!----------------------------------------------------------------------- 403 !! *** FUNCTION glob_max_2D *** 404 !! 405 !! ** Purpose : perform a masked max on the inner global domain of a 2D array 406 !!----------------------------------------------------------------------- 407 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab ! input 2D array 616 408 REAL(wp) :: glob_max_2d ! global masked max 617 !! 618 COMPLEX(wp):: ctmp 619 REAL(wp) :: ztmp 620 INTEGER :: ji, jj ! dummy loop indices 621 !!----------------------------------------------------------------------- 622 ! 623 ztmp = 0.e0 624 ctmp = CMPLX( 0.e0, 0.e0, wp ) 625 DO jj = 1, jpj 626 DO ji = 1, jpi 627 ztmp = ptab(ji,jj) * tmask_i(ji,jj) 628 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 629 END DO 630 END DO 631 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 632 glob_max_2d = REAL(ctmp,wp) 633 ! 634 END FUNCTION glob_max_2d 635 636 409 !!----------------------------------------------------------------------- 410 ! 411 glob_max_2d = MAXVAL( ptab(:,:)*tmask_i(:,:) ) 412 IF( lk_mpp ) CALL mpp_max( glob_max_2d ) 413 ! 414 END FUNCTION glob_max_2d 415 637 416 FUNCTION glob_max_3d( ptab ) 638 !!---------------------------------------------------------------------- 639 !! *** FUNCTION glob_max_3 d***640 !! 641 !! ** Purpose : perform a ma x on a 3D array in calling DDPDD routine642 !!---------------------------------------------------------------------- 643 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab 417 !!----------------------------------------------------------------------- 418 !! *** FUNCTION glob_max_3D *** 419 !! 420 !! ** Purpose : perform a masked max on the inner global domain of a 3D array 421 !!----------------------------------------------------------------------- 422 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab ! input 3D array 644 423 REAL(wp) :: glob_max_3d ! global masked max 645 424 !! 646 COMPLEX(wp):: ctmp 647 REAL(wp) :: ztmp 648 INTEGER :: ji, jj, jk ! dummy loop indices 649 INTEGER :: ijpk ! local variables: size of ptab 425 INTEGER :: jk 426 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 650 427 !!----------------------------------------------------------------------- 651 428 ! 652 429 ijpk = SIZE(ptab,3) 653 430 ! 654 ztmp = 0.e0 655 ctmp = CMPLX( 0.e0, 0.e0, wp ) 656 DO jk = 1, ijpk 657 DO jj = 1, jpj 658 DO ji = 1, jpi 659 ztmp = ptab(ji,jj,jk) * tmask_i(ji,jj) 660 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 661 END DO 662 END DO 663 END DO 664 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 665 glob_max_3d = REAL(ctmp,wp) 666 ! 667 END FUNCTION glob_max_3d 431 glob_max_3d = MAXVAL( ptab(:,:,1)*tmask_i(:,:) ) 432 DO jk = 2, ijpk 433 glob_max_3d = MAX( glob_max_3d, MAXVAL( ptab(:,:,jk)*tmask_i(:,:) ) ) 434 END DO 435 IF( lk_mpp ) CALL mpp_max( glob_max_3d ) 436 ! 437 END FUNCTION glob_max_3d 668 438 669 439 670 440 FUNCTION glob_max_2d_a( ptab1, ptab2 ) 671 !!---------------------------------------------------------------------- 672 !! *** FUNCTION glob_max_2d_a *** 673 !! 674 !! ** Purpose : perform a max on two 2D arrays in calling DDPDD routine 675 !!---------------------------------------------------------------------- 676 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 677 REAL(wp) :: glob_max_2d_a ! global masked max 678 !! 679 COMPLEX(wp):: ctmp 680 REAL(wp) :: ztmp 681 INTEGER :: ji, jj ! dummy loop indices 682 !!----------------------------------------------------------------------- 683 ! 684 ! 685 ztmp = 0.e0 686 ctmp = CMPLX( 0.e0, 0.e0, wp ) 687 DO jj = 1, jpj 688 DO ji = 1, jpi 689 ztmp = ptab1(ji,jj) * tmask_i(ji,jj) 690 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 691 ztmp = ptab2(ji,jj) * tmask_i(ji,jj) 692 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 693 END DO 694 END DO 695 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 696 glob_max_2d_a = REAL(ctmp,wp) 697 ! 698 END FUNCTION glob_max_2d_a 699 700 441 !!----------------------------------------------------------------------- 442 !! *** FUNCTION glob_max_2D _a *** 443 !! 444 !! ** Purpose : perform a masked max on the inner global domain of two 2D array 445 !!----------------------------------------------------------------------- 446 REAL(wp), INTENT(in), DIMENSION(:,:) :: ptab1, ptab2 ! input 2D array 447 REAL(wp) , DIMENSION(2) :: glob_max_2d_a ! global masked max 448 !!----------------------------------------------------------------------- 449 ! 450 glob_max_2d_a(1) = MAXVAL( ptab1(:,:)*tmask_i(:,:) ) 451 glob_max_2d_a(2) = MAXVAL( ptab2(:,:)*tmask_i(:,:) ) 452 IF( lk_mpp ) CALL mpp_max( glob_max_2d_a, 2 ) 453 ! 454 END FUNCTION glob_max_2d_a 455 456 701 457 FUNCTION glob_max_3d_a( ptab1, ptab2 ) 702 !!---------------------------------------------------------------------- 703 !! *** FUNCTION glob_max_3d_a *** 704 !! 705 !! ** Purpose : perform a max on two 3D array in calling DDPDD routine 706 !!---------------------------------------------------------------------- 707 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 708 REAL(wp) :: glob_max_3d_a ! global masked max 709 !! 710 COMPLEX(wp):: ctmp 711 REAL(wp) :: ztmp 712 INTEGER :: ji, jj, jk ! dummy loop indices 713 INTEGER :: ijpk ! local variables: size of ptab 458 !!----------------------------------------------------------------------- 459 !! *** FUNCTION glob_max_3D_a *** 460 !! 461 !! ** Purpose : perform a masked max on the inner global domain of two 3D array 462 !!----------------------------------------------------------------------- 463 REAL(wp), INTENT(in), DIMENSION(:,:,:) :: ptab1, ptab2 ! input 3D array 464 REAL(wp) , DIMENSION(2) :: glob_max_3d_a ! global masked max 465 !! 466 INTEGER :: jk 467 INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 714 468 !!----------------------------------------------------------------------- 715 469 ! 716 470 ijpk = SIZE(ptab1,3) 717 471 ! 718 ztmp = 0.e0 719 ctmp = CMPLX( 0.e0, 0.e0, wp ) 720 DO jk = 1, ijpk 721 DO jj = 1, jpj 722 DO ji = 1, jpi 723 ztmp = ptab1(ji,jj,jk) * tmask_i(ji,jj) 724 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 725 ztmp = ptab2(ji,jj,jk) * tmask_i(ji,jj) 726 CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 727 END DO 728 END DO 729 END DO 730 IF( lk_mpp ) CALL mpp_max( ctmp ) ! max over the global domain 731 glob_max_3d_a = REAL(ctmp,wp) 732 ! 733 END FUNCTION glob_max_3d_a 734 735 #endif 472 glob_max_3d_a(1) = MAXVAL( ptab1(:,:,1)*tmask_i(:,:) ) 473 glob_max_3d_a(2) = MAXVAL( ptab2(:,:,1)*tmask_i(:,:) ) 474 DO jk = 2, ijpk 475 glob_max_3d_a(1) = MAX( glob_max_3d_a(1), MAXVAL( ptab1(:,:,jk)*tmask_i(:,:) ) ) 476 glob_max_3d_a(2) = MAX( glob_max_3d_a(2), MAXVAL( ptab2(:,:,jk)*tmask_i(:,:) ) ) 477 END DO 478 IF( lk_mpp ) CALL mpp_max( glob_max_3d_a, 2 ) 479 ! 480 END FUNCTION glob_max_3d_a 481 736 482 737 483 SUBROUTINE DDPDD( ydda, yddb ) -
branches/2013/dev_r4028_CNRS_LIM3/NEMOGCM/NEMO/OPA_SRC/step.F90
r4037 r4155 108 108 ! 109 109 ! VERTICAL PHYSICS 110 ! bg jchanut tschanges 111 ! One need bottom friction parameter in ssh_wzv routine with time splitting. 112 ! The idea could be to move the call below before ssh_wzv. However, "now" scale factors 113 ! at U-V points (which are set thanks to sshu_n, sshv_n) are actually available in sshwzv. 114 ! These are needed for log bottom friction... 115 #if ! defined key_dynspg_ts 110 116 CALL zdf_bfr( kstp ) ! bottom friction 117 #endif 118 ! end jchanut tschanges 111 119 112 120 ! ! Vertical eddy viscosity and diffusivity coefficients … … 206 214 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 207 215 208 ELSE ! centered hpg (eos then time stepping) 216 ELSE 217 ! centered hpg (eos then time stepping) 218 ! bg jchanut tschanges 219 #if ! defined key_dynspg_ts 220 ! eos already called 209 221 CALL eos ( tsn, rhd, rhop ) ! now in situ density for hpg computation 210 222 IF( ln_zps ) CALL zps_hde( kstp, jpts, tsn, gtsu, gtsv, & ! zps: now hor. derivative 211 223 & rhd, gru , grv ) ! of t, s, rd at the last ocean level 224 #endif 225 ! end jchanut tschanges 212 226 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 213 227 CALL tra_nxt( kstp ) ! tracer fields at next time step … … 217 231 ! Dynamics (tsa used as workspace) 218 232 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 233 ! bg jchanut tschanges 234 #if defined key_dynspg_ts 235 ! revert to previously computed tendencies: 236 ! (not using ua, va as temporary arrays during tracers' update could avoid that) 237 ua(:,:,:) = ua_bak(:,:,:) 238 va(:,:,:) = va_bak(:,:,:) 239 CALL dyn_bfr( kstp ) ! bottom friction 240 CALL dyn_zdf( kstp ) ! vertical diffusion 241 #else 242 ! end jchanut tschanges 219 243 ua(:,:,:) = 0.e0 ! set dynamics trends to zero 220 244 va(:,:,:) = 0.e0 … … 236 260 CALL dyn_zdf( kstp ) ! vertical diffusion 237 261 CALL dyn_spg( kstp, indic ) ! surface pressure gradient 262 ! bg jchanut tschanges 263 #endif 264 ! end jchanut tschanges 238 265 CALL dyn_nxt( kstp ) ! lateral velocity at next time step 239 266
Note: See TracChangeset
for help on using the changeset viewer.