Changeset 9819
- Timestamp:
- 2018-06-21T12:48:26+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r9675 r9819 38 38 LOGICAL , PUBLIC, PARAMETER :: lk_cice = .TRUE. !: CICE ice model 39 39 CHARACTER(len=1), PUBLIC :: cp_ice_msh = 'F' !: 'F'-grid ice-velocity 40 41 ! Parameters imported from LIM to get CICE to work with NEMO4 42 INTEGER , PUBLIC, PARAMETER :: np_jules_OFF = 0 !: no Jules coupling (ice thermodynamics forced via qsr and qns) 43 INTEGER , PUBLIC, PARAMETER :: np_jules_EMULE = 1 !: emulated Jules coupling via icethd_zdf.F90 (BL99) (1st round compute qcn and qsr_tr, 2nd round use it) 44 INTEGER , PUBLIC, PARAMETER :: np_jules_ACTIVE = 2 !: active Jules coupling (SM0L) (compute qcn and qsr_tr via sbcblk.F90 or sbccpl.F90) 45 INTEGER , PUBLIC, PARAMETER :: nice_jules = np_jules_ACTIVE !: Choice of jules coupling 40 46 # endif 41 47 … … 56 62 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_ice !: sublimation - precip over sea ice [kg/m2/s] 57 63 58 #if defined key_lim3 64 #if defined key_lim3 || defined key_cice 59 65 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: evap_ice !: sublimation [kg/m2/s] 60 66 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: devap_ice !: sublimation sensitivity [kg/m2/s/K] -
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r9803 r9819 1246 1246 ! ! ice skin temp. ! 1247 1247 ! ! ================== ! 1248 #if defined key_lim3 1248 #if defined key_lim3 || defined key_cice 1249 1249 ! needed by Met Office 1250 1250 IF( srcv(jpr_ts_ice)%laction ) THEN … … 1715 1715 REAL(wp), DIMENSION(jpi,jpj) :: zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip , zevap_oce, zdevap_ice 1716 1716 REAL(wp), DIMENSION(jpi,jpj) :: zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice 1717 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice, zevap_ice !!gm , zfrqsr_tr_i 1717 REAL(wp), DIMENSION(jpi,jpj,jpl) :: zqns_ice, zqsr_ice, zdqns_ice, zqevap_ice !!gm , zfrqsr_tr_i 1718 REAL(wp), DIMENSION(jpi,jpj) :: ztmp 1718 1719 !!---------------------------------------------------------------------- 1719 1720 ! … … 1735 1736 ztprecip(:,:) = frcv(jpr_rain)%z3(:,:,1) + zsprecip(:,:) ! May need to ensure positive here 1736 1737 zemp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - ztprecip(:,:) 1738 1739 #if defined key_cice 1740 IF ( TRIM(sn_rcv_emp%clcat) == 'yes' ) THEN 1741 ! zemp_ice is the sum of frcv(jpr_ievp)%z3(:,:,1) over all layers - snow 1742 zemp_ice(:,:) = - frcv(jpr_snow)%z3(:,:,1) 1743 DO jl=1,jpl 1744 zemp_ice(:,: ) = zemp_ice(:,:) + frcv(jpr_ievp)%z3(:,:,jl) 1745 ENDDO 1746 ! latent heat coupled for each category in CICE 1747 zevap_ice(:,:,1:jpl) = - frcv(jpr_ievp)%z3(:,:,1:jpl) 1748 ELSE 1749 ! If CICE has multicategories it still expects coupling fields for 1750 ! each even if we treat as a single field 1751 ! The latent heat flux is split between the ice categories according 1752 ! to the fraction of the ice in each category 1753 zemp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1754 WHERE ( ziceld(:,:) /= 0._wp ) 1755 ztmp(:,:) = 1./ziceld(:,:) 1756 ELSEWHERE 1757 ztmp(:,:) = 0.e0 1758 END WHERE 1759 DO jl=1,jpl 1760 zevap_ice(:,:,jl) = - a_i(:,:,jl) * ztmp(:,:) * frcv(jpr_ievp)%z3(:,:,1) 1761 END DO 1762 WHERE ( ziceld(:,:) == 0._wp ) zevap_ice(:,:,1) = -frcv(jpr_ievp)%z3(:,:,1) 1763 ENDIF 1764 1765 #else 1737 1766 zemp_ice(:,:) = ( frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) ) * picefr(:,:) 1767 #endif 1768 1738 1769 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1739 1770 zemp_tot(:,:) = ziceld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + picefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1961 1992 ELSE 1962 1993 qns_tot(:,: ) = zqns_tot(:,: ) 1963 qns_ice(:,:,:) = zqns_ice(:,:,:)1994 IF ( TRIM( sn_rcv_qsr%cldes ) /= 'oce only' ) qns_ice(:,:,:) = zqns_ice(:,:,:) 1964 1995 ENDIF 1965 1996 … … 2043 2074 ELSE 2044 2075 qsr_tot(:,: ) = zqsr_tot(:,: ) 2045 IF ( TRIM( sn_rcv_qsr%cldes ) /= 'oce only' ) THEN 2046 qsr_ice(:,:,:) = zqsr_ice(:,:,:) 2047 ENDIF 2076 IF ( TRIM( sn_rcv_qsr%cldes ) /= 'oce only' ) qsr_ice(:,:,:) = zqsr_ice(:,:,:) 2048 2077 ENDIF 2049 2078 … … 2070 2099 ENDIF 2071 2100 2072 #if defined key_lim3 2101 #if defined key_lim3 || defined key_cice 2073 2102 ! ! ========================= ! 2074 2103 SELECT CASE( TRIM( sn_rcv_iceflx%cldes ) ) ! ice topmelt and botmelt ! -
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r9695 r9819 209 209 ! there is no restart file. 210 210 ! Values from a CICE restart file would overwrite this 211 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1. )211 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.,'sst1') 212 212 #endif 213 213 … … 216 216 ! calculate surface freezing temperature and send to CICE 217 217 CALL eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1)) 218 CALL nemo2cice(sstfrz,Tf, 'T', 1. )218 CALL nemo2cice(sstfrz,Tf, 'T', 1.,'tf1' ) 219 219 220 220 CALL cice2nemo(aice,fr_i, 'T', 1. ) … … 320 320 IF(lwp) WRITE(numout,*)'cice_sbc_in' 321 321 ENDIF 322 WRITE(numout,*)'zevap_ice 7: min, max = ', MINVAL(zevap_ice(:,:,:)), MAXVAL(zevap_ice(:,:,:)) 322 323 323 324 ztmp(:,:)=0.0 … … 340 341 ENDDO 341 342 ENDDO 342 CALL nemo2cice(ztmp,strax,'F', -1. ) 343 344 CALL nemo2cice(ztmp,strax,'F', -1.,'strax' ) 343 345 344 346 ! y comp of wind stress (CI_2) … … 350 352 ENDDO 351 353 ENDDO 352 CALL nemo2cice(ztmp,stray,'F', -1. )354 CALL nemo2cice(ztmp,stray,'F', -1.,'stray' ) 353 355 354 356 … … 379 381 380 382 DO jl=1,ncat 381 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. )383 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1.,'flatn' ) 382 384 383 385 ! GBM conductive flux through ice (CI_6) … … 388 390 ztmp(:,:) = qcn_ice(:,:,jl) 389 391 ENDIF 390 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. )392 CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1.,'fcondtopn' ) 391 393 392 394 ! GBM surface heat flux (CI_7) … … 397 399 ztmp(:,:) = (qml_ice(:,:,jl)+qcn_ice(:,:,jl)) 398 400 ENDIF 399 CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. )401 CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. ,'fsurfn_f') 400 402 ENDDO 401 403 … … 405 407 ! x comp and y comp of atmosphere surface wind (CICE expects on T points) 406 408 ztmp(:,:) = wndi_ice(:,:) 407 CALL nemo2cice(ztmp,uatm,'T', -1. )409 CALL nemo2cice(ztmp,uatm,'T', -1. ,'uatm') 408 410 ztmp(:,:) = wndj_ice(:,:) 409 CALL nemo2cice(ztmp,vatm,'T', -1. )411 CALL nemo2cice(ztmp,vatm,'T', -1.,'vatm' ) 410 412 ztmp(:,:) = SQRT ( wndi_ice(:,:)**2 + wndj_ice(:,:)**2 ) 411 CALL nemo2cice(ztmp,wind,'T', 1. ) ! Wind speed (m/s)413 CALL nemo2cice(ztmp,wind,'T', 1.,'wind' ) ! Wind speed (m/s) 412 414 ztmp(:,:) = qsr_ice(:,:,1) 413 CALL nemo2cice(ztmp,fsw,'T', 1. ) ! Incoming short-wave (W/m^2)415 CALL nemo2cice(ztmp,fsw,'T', 1.,'fsw' ) ! Incoming short-wave (W/m^2) 414 416 ztmp(:,:) = qlw_ice(:,:,1) 415 CALL nemo2cice(ztmp,flw,'T', 1. ) ! Incoming long-wave (W/m^2)417 CALL nemo2cice(ztmp,flw,'T', 1.,'flw' ) ! Incoming long-wave (W/m^2) 416 418 ztmp(:,:) = tatm_ice(:,:) 417 CALL nemo2cice(ztmp,Tair,'T', 1. ) ! Air temperature (K)418 CALL nemo2cice(ztmp,potT,'T', 1. ) ! Potential temp (K)419 CALL nemo2cice(ztmp,Tair,'T', 1.,'tair' ) ! Air temperature (K) 420 CALL nemo2cice(ztmp,potT,'T', 1.,'pott' ) ! Potential temp (K) 419 421 ! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows 420 422 ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) ) 421 423 ! Constant (101000.) atm pressure assumed 422 CALL nemo2cice(ztmp,rhoa,'T', 1. ) ! Air density (kg/m^3)424 CALL nemo2cice(ztmp,rhoa,'T', 1.,'rhoa' ) ! Air density (kg/m^3) 423 425 ztmp(:,:) = qatm_ice(:,:) 424 CALL nemo2cice(ztmp,Qa,'T', 1. ) ! Specific humidity (kg/kg)426 CALL nemo2cice(ztmp,Qa,'T', 1.,'qa' ) ! Specific humidity (kg/kg) 425 427 ztmp(:,:)=10.0 426 CALL nemo2cice(ztmp,zlvl,'T', 1. ) ! Atmos level height (m)428 CALL nemo2cice(ztmp,zlvl,'T', 1.,'zlvl' ) ! Atmos level height (m) 427 429 428 430 ! May want to check all values are physically realistic (as in CICE routine … … 431 433 ! Divide shortwave into spectral bands (as in prepare_forcing) 432 434 ztmp(:,:)=qsr_ice(:,:,1)*frcvdr ! visible direct 433 CALL nemo2cice(ztmp,swvdr,'T', 1. )435 CALL nemo2cice(ztmp,swvdr,'T', 1.,'swvdr' ) 434 436 ztmp(:,:)=qsr_ice(:,:,1)*frcvdf ! visible diffuse 435 CALL nemo2cice(ztmp,swvdf,'T', 1. )437 CALL nemo2cice(ztmp,swvdf,'T', 1.,'swvdf' ) 436 438 ztmp(:,:)=qsr_ice(:,:,1)*frcidr ! near IR direct 437 CALL nemo2cice(ztmp,swidr,'T', 1. )439 CALL nemo2cice(ztmp,swidr,'T', 1.,'swidr' ) 438 440 ztmp(:,:)=qsr_ice(:,:,1)*frcidf ! near IR diffuse 439 CALL nemo2cice(ztmp,swidf,'T', 1. )441 CALL nemo2cice(ztmp,swidf,'T', 1. ,'swidf') 440 442 441 443 ENDIF … … 444 446 !Ice concentration change (from assimilation) 445 447 ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1) 446 Call nemo2cice(ztmp,daice_da,'T', 1. )448 Call nemo2cice(ztmp,daice_da,'T', 1. ,'daice_da') 447 449 #endif 448 450 … … 451 453 IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit 452 454 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0) 453 CALL nemo2cice(ztmp,fsnow,'T', 1. )455 CALL nemo2cice(ztmp,fsnow,'T', 1.,'fsnow' ) 454 456 455 457 ! Rainfall 456 458 IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 457 459 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 458 CALL nemo2cice(ztmp,frain,'T', 1. )460 CALL nemo2cice(ztmp,frain,'T', 1.,'frain' ) 459 461 460 462 ! Recalculate freezing temperature and send to CICE 461 463 CALL eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1)) 462 CALL nemo2cice(sstfrz,Tf,'T', 1. )464 CALL nemo2cice(sstfrz,Tf,'T', 1. ,'Tf') 463 465 464 466 ! Freezing/melting potential 465 467 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 466 468 nfrzmlt(:,:)=rau0*rcp*e3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt) 467 CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. )469 CALL nemo2cice(nfrzmlt,frzmlt,'T', 1.,'frzmlt' ) 468 470 469 471 ! SST and SSS 470 472 471 CALL nemo2cice(sst_m,sst,'T', 1. )472 CALL nemo2cice(sss_m,sss,'T', 1. )473 CALL nemo2cice(sst_m,sst,'T', 1.,'sst' ) 474 CALL nemo2cice(sss_m,sss,'T', 1.,'sss' ) 473 475 474 476 IF( ksbc == jp_purecpl ) THEN 475 477 ! Sea ice surface skin temperature 476 478 DO jl=1,ncat 477 CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1. )479 CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1., 'trcrn') 478 480 ENDDO 479 481 ENDIF … … 486 488 ENDDO 487 489 ENDDO 488 CALL nemo2cice(ztmp,uocn,'F', -1. )490 CALL nemo2cice(ztmp,uocn,'F', -1., 'uocn' ) 489 491 490 492 ! V point to F point … … 494 496 ENDDO 495 497 ENDDO 496 CALL nemo2cice(ztmp,vocn,'F', -1. )498 CALL nemo2cice(ztmp,vocn,'F', -1. ,'vocn') 497 499 498 500 IF( ln_ice_embd ) THEN !== embedded sea ice: compute representative ice top surface ==! … … 521 523 END DO 522 524 END DO 523 CALL nemo2cice( ztmp,ss_tltx,'F', -1. )525 CALL nemo2cice( ztmp,ss_tltx,'F', -1. , 'ss_tltx') 524 526 525 527 ! T point to F point … … 530 532 END DO 531 533 END DO 532 CALL nemo2cice(ztmp,ss_tlty,'F', -1. )534 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ,'ss_tlty') 533 535 ! 534 536 END SUBROUTINE cice_sbc_in … … 900 902 END SUBROUTINE cice_sbc_force 901 903 902 SUBROUTINE nemo2cice( pn, pc, cd_type, psgn )904 SUBROUTINE nemo2cice( pn, pc, cd_type, psgn, varname) 903 905 !!--------------------------------------------------------------------- 904 906 !! *** ROUTINE nemo2cice *** … … 931 933 #endif 932 934 REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc 935 CHARACTER(len=10), INTENT( in ) :: varname 933 936 INTEGER (int_kind) :: & 934 937 field_type, &! id for type of field (scalar, vector, angle) … … 1010 1013 #endif 1011 1014 1015 IF ( ln_ctl ) THEN 1016 WRITE(numout,*)'nemo2cice: ',varname,' min,max = ',MINVAL(pc(:,:,:)), MAXVAL(pc(:,:,:)) 1017 CALL flush(numout) 1018 ENDIF 1012 1019 END SUBROUTINE nemo2cice 1013 1020
Note: See TracChangeset
for help on using the changeset viewer.