Changeset 6973
- Timestamp:
- 2016-10-03T14:09:01+02:00 (8 years ago)
- Location:
- branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r6904 r6973 106 106 CALL dom_msk( ik_top, ik_bot ) ! Masks 107 107 ! 108 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency109 !110 108 DO jj = 1, jpj ! depth of the iceshelves 111 109 DO ji = 1, jpj -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r6923 r6973 171 171 CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 ) 172 172 173 CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 ) 173 CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 ) ! ! coriolis factor 174 174 CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 ) 175 175 … … 180 180 CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 ) ! ! nb of ocean T-points 181 181 zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp ) 182 CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 ) 182 CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 ) ! ! nb of ocean T-points 183 183 184 CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0 ) ! ! scale factors 185 CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0 ) 186 CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0 ) 187 CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0 ) 188 ! 189 CALL dom_stiff( zprt ) 190 CALL iom_rstput( 0, 0, inum, 'stiffness', zprt ) ! ! Max. grid stiffness ratio 191 ! 192 CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d ) ! ! stretched system 193 CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d ) 194 CALL iom_rstput( 0, 0, inum, 'gdept_0', gdept_0, ktype = jp_r8 ) 195 CALL iom_rstput( 0, 0, inum, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 196 184 ! ! vertical mesh 185 CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0, ktype = jp_r8 ) ! ! scale factors 186 CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0, ktype = jp_r8 ) 187 CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0, ktype = jp_r8 ) 188 CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0, ktype = jp_r8 ) 189 ! 190 CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d , ktype = jp_r8 ) ! stretched system 191 CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d , ktype = jp_r8 ) 192 CALL iom_rstput( 0, 0, inum, 'gdept_0' , gdept_0 , ktype = jp_r8 ) 193 CALL iom_rstput( 0, 0, inum, 'gdepw_0' , gdepw_0 , ktype = jp_r8 ) 194 ! 195 IF( ln_sco ) THEN ! s-coordinate stiffness 196 CALL dom_stiff( zprt ) 197 CALL iom_rstput( 0, 0, inum, 'stiffness', zprt ) ! ! Max. grid stiffness ratio 198 ENDIF 199 ! 197 200 ! ! ============================ 198 201 CALL iom_close( inum ) ! close the files -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/TOOLS/DOMAINcfg/src/dom_oce.f90
r6951 r6973 222 222 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hifv , hiff !: interface depth between stretching at v--f 223 223 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hift , hifu !: and quasi-uniform spacing t--u points (m) 224 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rx1 !: Maximum grid stiffness ratio225 224 !!gm end 226 225 … … 362 361 & scosrf(jpi,jpj) , scobot(jpi,jpj) , & 363 362 & hifv (jpi,jpj) , hiff (jpi,jpj) , & 364 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1(jpi,jpj) ,STAT=ierr(8) )363 & hift (jpi,jpj) , hifu (jpi,jpj) , STAT=ierr(8) ) 365 364 366 365 ALLOCATE( mbathy(jpi,jpj) , bathy (jpi,jpj) , & -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/TOOLS/DOMAINcfg/src/domain.f90
r6951 r6973 20 20 !! dom_nam : read and contral domain namelists 21 21 !! dom_ctl : control print for the ocean domain 22 !! dom_stiff : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate)23 22 !!---------------------------------------------------------------------- 24 23 USE oce ! ocean variables … … 88 87 CALL dom_zgr ! Vertical mesh and bathymetry 89 88 CALL dom_msk ! Masks 90 IF( ln_sco ) CALL dom_stiff ! Maximum stiffness ratio/hydrostatic consistency91 89 ! 92 90 ht_0(:,:) = e3t_0(:,:,1) * tmask(:,:,1) ! Reference ocean thickness … … 370 368 371 369 372 SUBROUTINE dom_stiff373 !!----------------------------------------------------------------------374 !! *** ROUTINE dom_stiff ***375 !!376 !! ** Purpose : Diagnose maximum grid stiffness/hydrostatic consistency377 !!378 !! ** Method : Compute Haney (1991) hydrostatic condition ratio379 !! Save the maximum in the vertical direction380 !! (this number is only relevant in s-coordinates)381 !!382 !! Haney, R. L., 1991: On the pressure gradient force383 !! over steep topography in sigma coordinate ocean models.384 !! J. Phys. Oceanogr., 21, 610???619.385 !!----------------------------------------------------------------------386 INTEGER :: ji, jj, jk387 REAL(wp) :: zrxmax388 REAL(wp), DIMENSION(4) :: zr1389 !!----------------------------------------------------------------------390 rx1(:,:) = 0._wp391 zrxmax = 0._wp392 zr1(:) = 0._wp393 !394 DO ji = 2, jpim1395 DO jj = 2, jpjm1396 DO jk = 1, jpkm1397 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) &398 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) &399 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) &400 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk)401 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) &402 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) &403 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) &404 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk)405 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) &406 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) &407 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) &408 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk)409 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) &410 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) &411 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) &412 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk)413 zrxmax = MAXVAL( zr1(1:4) )414 rx1(ji,jj) = MAX( rx1(ji,jj) , zrxmax )415 END DO416 END DO417 END DO418 CALL lbc_lnk( rx1, 'T', 1. )419 !420 zrxmax = MAXVAL( rx1 )421 !422 IF( lk_mpp ) CALL mpp_max( zrxmax ) ! max over the global domain423 !424 IF(lwp) THEN425 WRITE(numout,*)426 WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax427 WRITE(numout,*) '~~~~~~~~~'428 ENDIF429 !430 END SUBROUTINE dom_stiff431 432 433 370 SUBROUTINE cfg_write 434 371 !!---------------------------------------------------------------------- … … 537 474 CALL iom_rstput( 0, 0, inum, 'top level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF) 538 475 ! 539 IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway) 540 !SF CALL dom_stiff( z2d ) !commented because at compilation error: The 541 !number of actual arguments cannot be greater than the number of dummy 542 !arguments. [DOM_STIFF] 543 !CALL dom_stiff( z2d ) 544 ! --------------^ compilation aborted for 545 !/workgpfs/rech/gzi/rgzi011/commit-simplif2-TOOLS/NEMOGCM/CONFIG/TEST/BLD/ppsrc/nemo/domain.f90 476 IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway) 477 CALL dom_stiff( z2d ) 546 478 CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio 547 479 ENDIF -
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/TOOLS/DOMAINcfg/src/domwri.f90
r6951 r6973 13 13 !! dom_wri : create and write mesh and mask file(s) 14 14 !! dom_uniq : identify unique point of a grid (TUVF) 15 !! dom_stiff : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 15 16 !!---------------------------------------------------------------------- 16 17 USE dom_oce ! ocean space and time domain … … 27 28 PUBLIC dom_wri ! routine called by inidom.F90 28 29 PUBLIC dom_wri_coordinate ! routine called by domhgr.F90 29 !! * Substitutions 30 !!---------------------------------------------------------------------- 31 !! *** vectopt_loop_substitute *** 32 !!---------------------------------------------------------------------- 33 !! ** purpose : substitute the inner loop start/end indices with CPP macro 34 !! allow unrolling of do-loop (useful with vector processors) 35 !!---------------------------------------------------------------------- 30 PUBLIC dom_stiff ! routine called by inidom.F90 31 36 32 !!---------------------------------------------------------------------- 37 33 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 38 34 !! $Id: vectopt_loop_substitute.h90 4990 2014-12-15 16:42:49Z timgraham $ 39 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 40 !!----------------------------------------------------------------------41 !!----------------------------------------------------------------------42 !! NEMO/OPA 3.3 , NEMO Consortium (2010)43 !! $Id: domwri.F90 6689 2016-06-13 14:24:43Z flavoni $44 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)45 36 !!---------------------------------------------------------------------- 46 37 CONTAINS … … 286 277 CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 287 278 CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 288 CALL iom_rstput( 0, 0, inum4, 'rx1', rx1 ) ! ! Max. grid stiffness ratio289 279 ! 290 280 CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d ) ! ! stretched system … … 292 282 CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 ) 293 283 CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 284 CALL dom_stiff( zprt ) 285 CALL iom_rstput( 0, 0, inum, 'stiffness', zprt ) ! ! Max. grid stiffness ratio 294 286 ENDIF 295 287 … … 416 408 END SUBROUTINE dom_uniq 417 409 410 411 SUBROUTINE dom_stiff( px1 ) 412 !!---------------------------------------------------------------------- 413 !! *** ROUTINE dom_stiff *** 414 !! 415 !! ** Purpose : Diagnose maximum grid stiffness/hydrostatic consistency 416 !! 417 !! ** Method : Compute Haney (1991) hydrostatic condition ratio 418 !! Save the maximum in the vertical direction 419 !! (this number is only relevant in s-coordinates) 420 !! 421 !! Haney, 1991, J. Phys. Oceanogr., 21, 610-619. 422 !!---------------------------------------------------------------------- 423 REAL(wp), DIMENSION(:,:), INTENT(out), OPTIONAL :: px1 ! stiffness 424 ! 425 INTEGER :: ji, jj, jk 426 REAL(wp) :: zrxmax 427 REAL(wp), DIMENSION(4) :: zr1 428 REAL(wp), DIMENSION(jpi,jpj) :: zx1 429 !!---------------------------------------------------------------------- 430 zx1(:,:) = 0._wp 431 zrxmax = 0._wp 432 zr1(:) = 0._wp 433 ! 434 DO ji = 2, jpim1 435 DO jj = 2, jpjm1 436 DO jk = 1, jpkm1 437 !!gm remark: dk(gdepw) = e3t ===>>> possible simplification of the following calculation.... 438 !! especially since it is gde3w which is used to compute the pressure gradient 439 !! furthermore, I think gdept_0 should be used below instead of w point in the numerator 440 !! so that the ratio is computed at the same point (i.e. uw and vw) .... 441 zr1(1) = ABS( ( gdepw_0(ji ,jj,jk )-gdepw_0(ji-1,jj,jk ) & 442 & +gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) ) & 443 & / ( gdepw_0(ji ,jj,jk )+gdepw_0(ji-1,jj,jk ) & 444 & -gdepw_0(ji ,jj,jk+1)-gdepw_0(ji-1,jj,jk+1) + rsmall ) ) * umask(ji-1,jj,jk) 445 zr1(2) = ABS( ( gdepw_0(ji+1,jj,jk )-gdepw_0(ji ,jj,jk ) & 446 & +gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) ) & 447 & / ( gdepw_0(ji+1,jj,jk )+gdepw_0(ji ,jj,jk ) & 448 & -gdepw_0(ji+1,jj,jk+1)-gdepw_0(ji ,jj,jk+1) + rsmall ) ) * umask(ji ,jj,jk) 449 zr1(3) = ABS( ( gdepw_0(ji,jj+1,jk )-gdepw_0(ji,jj ,jk ) & 450 & +gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) ) & 451 & / ( gdepw_0(ji,jj+1,jk )+gdepw_0(ji,jj ,jk ) & 452 & -gdepw_0(ji,jj+1,jk+1)-gdepw_0(ji,jj ,jk+1) + rsmall ) ) * vmask(ji,jj ,jk) 453 zr1(4) = ABS( ( gdepw_0(ji,jj ,jk )-gdepw_0(ji,jj-1,jk ) & 454 & +gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) ) & 455 & / ( gdepw_0(ji,jj ,jk )+gdepw_0(ji,jj-1,jk ) & 456 & -gdepw_0(ji,jj ,jk+1)-gdepw_0(ji,jj-1,jk+1) + rsmall ) ) * vmask(ji,jj-1,jk) 457 zrxmax = MAXVAL( zr1(1:4) ) 458 zx1(ji,jj) = MAX( zx1(ji,jj) , zrxmax ) 459 END DO 460 END DO 461 END DO 462 CALL lbc_lnk( zx1, 'T', 1. ) 463 ! 464 IF( PRESENT( px1 ) ) px1 = zx1 465 ! 466 zrxmax = MAXVAL( zx1 ) 467 ! 468 IF( lk_mpp ) CALL mpp_max( zrxmax ) ! max over the global domain 469 ! 470 IF(lwp) THEN 471 WRITE(numout,*) 472 WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax 473 WRITE(numout,*) '~~~~~~~~~' 474 ENDIF 475 ! 476 END SUBROUTINE dom_stiff 477 418 478 !!====================================================================== 419 479 END MODULE domwri
Note: See TracChangeset
for help on using the changeset viewer.