Changeset 10026 for branches/UKMO
- Timestamp:
- 2018-08-02T16:11:22+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_isf_flx_UKESM_r9321/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
-
DOM/dom_oce.F90 (modified) (2 diffs)
-
DOM/dommsk.F90 (modified) (1 diff)
-
DOM/domwri.F90 (modified) (1 diff)
-
SBC/sbcisf.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_isf_flx_UKESM_r9321/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r8427 r10026 259 259 INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mikt, miku, mikv, mikf !: first wet T-, U-, V-, F- ocean level (ISF) 260 260 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: risfdep !: Iceshelf draft (ISF) 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask 261 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ssmask, ssisfmask !: surface domain T-point mask 262 262 263 263 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask !: land/ocean mask at T-, U-, V- and F-pts … … 403 403 ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj), & 404 404 & mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) , & 405 & mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) )405 & mikf(jpi,jpj), ssmask(jpi,jpj), ssisfmask(jpi,jpj), STAT=ierr(10) ) 406 406 407 407 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk), & -
branches/UKMO/dev_isf_flx_UKESM_r9321/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r8280 r10026 218 218 ENDIF 219 219 #endif 220 221 ! in case of iceshelf definition of iceshelf surface mask (1 under 222 ! iceshelf and 0 elsewhere 223 ssisfmask = (1._wp - tmask(:,:,1)) * ssmask(:,:) 224 220 225 !!gm end 221 226 -
branches/UKMO/dev_isf_flx_UKESM_r9321/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r9321 r10026 197 197 198 198 ! note that mbkt is set to 1 over land ==> use surface tmask 199 zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp ) 199 zprt(:,:) = ssisfmask(:,:) 200 CALL iom_rstput( 0, 0, inum4, 'maskisf', zprt, ktype = jp_i1 ) ! ! surface ice shelf mask 201 zprt(:,:) = ssmask(:,:) * mbkt(:,:) 200 202 CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i2 ) ! ! nb of ocean T-points 201 203 zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp ) -
branches/UKMO/dev_isf_flx_UKESM_r9321/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r9936 r10026 36 36 37 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: risf_tsc_b, risf_tsc !: before and now T & S isf contents [K.m/s & PSU.m/s] 38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf !: net heat flux from ice shelf[W/m2]38 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qisf, qhcisf !: latent heat and heat content flux from ice shelf [W/m2] 39 39 REAL(wp), PUBLIC :: rn_hisf_tbl !: thickness of top boundary layer [m] 40 40 INTEGER , PUBLIC :: nn_isfblk !: flag to choose the bulk formulation to compute the ice shelf melting … … 101 101 102 102 REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 103 REAL(wp), DIMENSION(:,: ), POINTER :: zqhcisf2d 104 REAL(wp), DIMENSION(:,: ), POINTER :: zt_frz, zdep ! freezing temperature (zt_frz) at depth (zdep) 103 REAL(wp), DIMENSION(:,: ), POINTER :: ztfrz, zdep ! freezing temperature (ztfrz) at depth (zdep) 105 104 ! 106 105 !!--------------------------------------------------------------------- … … 208 207 IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 209 208 ! allocation 210 CALL wrk_alloc( jpi,jpj, zt _frz, zdep )209 CALL wrk_alloc( jpi,jpj, ztfrz, zdep ) 211 210 212 211 ! compute bottom level of isf tbl and thickness of tbl below the ice shelf … … 347 346 END SELECT 348 347 348 ! compute heat content 349 ! heat content flux for nn_isf==1 is done in sbcisf_cav 350 SELECT CASE ( nn_isf ) 351 CASE ( 2, 3, 4 ) 352 DO jj = 1,jpj 353 DO ji = 1,jpi 354 zdep(ji,jj)=fsdepw_n(ji,jj,misfkt(ji,jj)) 355 END DO 356 END DO 357 CALL eos_fzp( stbl(:,:), ztfrz(:,:), zdep(:,:) ) 358 qhcisf(:,:) = - fwfisf(:,:) * ztfrz(:,:) * rcp 359 END SELECT 360 349 361 ! compute tsc due to isf 350 ! isf melting implemented as a volume flux and we assume that melt water is at 0 PSU. 351 ! WARNING water add at temp = 0C, need to add a correction term (fwfisf * tfreez / rau0). 352 ! compute freezing point beneath ice shelf (or top cell if nn_isf = 3) 353 DO jj = 1,jpj 354 DO ji = 1,jpi 355 zdep(ji,jj)=fsdepw_n(ji,jj,misfkt(ji,jj)) 356 END DO 357 END DO 358 CALL eos_fzp( stbl(:,:), zt_frz(:,:), zdep(:,:) ) 359 360 risf_tsc(:,:,jp_tem) = qisf(:,:) * r1_rau0_rcp - fwfisf(:,:) * zt_frz(:,:) * r1_rau0 ! 362 risf_tsc(:,:,jp_tem) = (qisf(:,:) + qhcisf(:,:)) * r1_rau0_rcp 361 363 risf_tsc(:,:,jp_sal) = 0.0_wp 362 364 363 365 ! output 364 IF( iom_use('qlatisf' ) ) CALL iom_put('qlatisf', qisf )366 IF( iom_use('qlatisf' ) ) CALL iom_put('qlatisf', qisf ) 365 367 IF( iom_use('fwfisf' ) ) CALL iom_put('fwfisf' , fwfisf) 368 IF( iom_use('qhcisf' ) ) CALL iom_put('qhcisf' , qhcisf) 366 369 367 370 ! lbclnk … … 372 375 373 376 !============================================================================================================================================= 374 IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d') .OR. iom_use('qhcisf')) THEN377 IF ( iom_use('fwfisf3d') .OR. iom_use('qlatisf3d') .OR. iom_use('qhcisf3d')) THEN 375 378 CALL wrk_alloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 376 CALL wrk_alloc( jpi,jpj, zqhcisf2d )377 379 378 380 zfwfisf3d(:,:,:) = 0.0_wp ! 3d ice shelf melting (kg/m2/s) 379 381 zqhcisf3d(:,:,:) = 0.0_wp ! 3d heat content flux (W/m2) 380 382 zqlatisf3d(:,:,:)= 0.0_wp ! 3d ice shelf melting latent heat flux (W/m2) 381 zqhcisf2d(:,:) = fwfisf(:,:) * zt_frz(:,:) * rcp ! 2d heat content flux (W/m2)382 383 383 384 DO jj = 1,jpj … … 386 387 ikb = misfkb(ji,jj) 387 388 DO jk = ikt, ikb - 1 388 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf 389 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk)390 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf 389 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 390 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + qhcisf(ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 391 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * fse3t(ji,jj,jk) 391 392 END DO 392 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf 393 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + zqhcisf2d(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk)394 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf 393 zfwfisf3d (ji,jj,jk) = zfwfisf3d (ji,jj,jk) + fwfisf(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 394 zqhcisf3d (ji,jj,jk) = zqhcisf3d (ji,jj,jk) + qhcisf(ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 395 zqlatisf3d(ji,jj,jk) = zqlatisf3d(ji,jj,jk) + qisf (ji,jj) * r1_hisf_tbl(ji,jj) * ralpha(ji,jj) * fse3t(ji,jj,jk) 395 396 END DO 396 397 END DO … … 399 400 CALL iom_put('qlatisf3d', zqlatisf3d(:,:,:)) 400 401 CALL iom_put('qhcisf3d' , zqhcisf3d (:,:,:)) 401 CALL iom_put('qhcisf' , zqhcisf2d (:,: ))402 402 403 403 CALL wrk_dealloc( jpi,jpj,jpk, zfwfisf3d, zqhcisf3d, zqlatisf3d ) 404 CALL wrk_dealloc( jpi,jpj, zqhcisf2d )405 404 END IF 406 405 !============================================================================================================================================= … … 420 419 ! 421 420 ! deallocation 422 CALL wrk_dealloc( jpi,jpj, zt _frz, zdep )421 CALL wrk_dealloc( jpi,jpj, ztfrz, zdep ) 423 422 END IF 424 423 ! … … 437 436 & vtbl(jpi, jpj) , risfLeff(jpi,jpj) , rhisf_tbl_0(jpi,jpj), & 438 437 & ralpha(jpi,jpj) , misfkt(jpi,jpj) , misfkb(jpi,jpj) , & 439 & STAT= sbc_isf_alloc )438 & qhcisf(jpi,jpj), STAT= sbc_isf_alloc ) 440 439 ! 441 440 IF( lk_mpp ) CALL mpp_sum ( sbc_isf_alloc ) … … 466 465 REAL(wp) :: zt_sum ! sum of the temperature between 200m and 600m 467 466 REAL(wp) :: zt_ave ! averaged temperature between 200m and 600m 468 REAL(wp) :: zt _frz ! freezing point temperature at depth z467 REAL(wp) :: ztfrz ! freezing point temperature at depth z 469 468 REAL(wp) :: zpress ! pressure to compute the freezing point in depth 470 469 !!---------------------------------------------------------------------- … … 483 482 ! after verif with UNESCO, wrong sign in BG eq. 2 484 483 ! Calculate freezing temperature 485 CALL eos_fzp(stbl(ji,jj), zt _frz, gdept_n(ji,jj,jk))486 zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-zt _frz) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) ! sum temp484 CALL eos_fzp(stbl(ji,jj), ztfrz, gdept_n(ji,jj,jk)) 485 zt_sum = zt_sum + (tsn(ji,jj,jk,jp_tem)-ztfrz) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) ! sum temp 487 486 END DO 488 487 zt_ave = zt_sum/rhisf_tbl(ji,jj) ! calcul mean value … … 574 573 575 574 ! Compute heat flux and upward fresh water flux 576 qisf (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)577 fwfisf(:,:) = zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)575 qisf (:,:) = - zhtflx(:,:) * ssisfmask(:,:) 576 fwfisf(:,:) = zfwflx(:,:) * ssisfmask(:,:) 578 577 579 578 CASE ( 2 ) ! ISOMIP+ formulation (3 equations) for volume flux (Asay-Davis et al., 2015) … … 604 603 605 604 ! compute t freeze (eq. 22) 606 ztfrz(ji,jj)= zeps4+zlamb1*zsfrz(ji,jj)605 ztfrz(ji,jj)=( zeps4+zlamb1*zsfrz(ji,jj) ) * ssisfmask(ji,jj) 607 606 608 607 ! zfwflx is upward water flux … … 613 612 END DO 614 613 END DO 615 616 ! compute heat and water flux 617 qisf (:,:) = - zhtflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:) 618 fwfisf(:,:) = zfwflx(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:) 614 ! 615 ! mask heat and water flux 616 fwfisf(:,:) = zfwflx(:,:) * ssisfmask(:,:) 617 qisf (:,:) = - zhtflx(:,:) * ssisfmask(:,:) 618 ! 619 ! compute heat content flux 620 qhcisf(:,:) = - fwfisf(:,:) * ztfrz(:,:) * rcp 619 621 620 622 END SELECT … … 637 639 END DO 638 640 ! 639 CALL iom_put('isftfrz' , ztfrz * (1._wp - tmask(:,:,1)) * ssmask(:,:))640 CALL iom_put('isfsfrz' , zsfrz * (1._wp - tmask(:,:,1)) * ssmask(:,:))641 CALL iom_put('isftfrz' , ztfrz ) 642 CALL iom_put('isfsfrz' , zsfrz ) 641 643 CALL iom_put('isfgammat', zgammat) 642 644 CALL iom_put('isfgammas', zgammas) … … 876 878 877 879 ! mask mean tbl value 878 pvarout(:,:) = pvarout(:,:) * (1._wp - tmask(:,:,1)) * ssmask(:,:)880 pvarout(:,:) = pvarout(:,:) * ssisfmask(:,:) 879 881 880 882 ! deallocation
Note: See TracChangeset
for help on using the changeset viewer.
