Changeset 9498
- Timestamp:
- 2018-04-23T16:38:50+02:00 (7 years ago)
- Location:
- branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90
r9494 r9498 30 30 USE ioipsl ! I/O IPSL library 31 31 USE in_out_manager ! I/O Manager 32 #if defined key_nemocice_decomp33 USE ice_domain_size, only: nx_global, ny_global34 #endif35 32 36 33 IMPLICIT NONE -
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r9494 r9498 88 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iu !: ice fraction at NEMO U point 89 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fr_iv !: ice fraction at NEMO V point 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sstfrz !: sea surface freezing temperature 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tsfc_ice !: sea-ice surface skin temperature (on categories) 92 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: kn_ice !: sea-ice surface layer thermal conductivity (on cats) 93 90 94 91 ! variables used in the coupled interface 95 92 INTEGER , PUBLIC, PARAMETER :: jpl = ncat 96 93 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj 97 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_p, ht_p ! Meltpond fraction and depth98 99 !100 101 !102 #if defined key_asminc103 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ndaice_da !: NEMO fresh water flux to ocean due to data assim104 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfresh_da !: NEMO salt flux to ocean due to data assim105 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfsalt_da !: NEMO ice concentration change/second from data assim106 #endif107 108 94 109 95 ! already defined in ice.F90 for LIM3 -
branches/UKMO/dev_merge_2017_CICE_interface/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r9494 r9498 13 13 USE dom_oce ! ocean space and time domain 14 14 USE domvvl 15 USE eosbn2, only : eos_fzp ! Function to calculate freezing point of seawater 16 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic, rt0 15 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 17 16 USE in_out_manager ! I/O manager 18 17 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit … … 34 33 USE ice_gather_scatter 35 34 USE ice_calendar, only: dt 35 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen 36 36 # if defined key_cice4 37 USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen38 37 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 39 38 strocnxT,strocnyT, & … … 42 41 flatn_f,fsurfn_f,fcondtopn_f, & 43 42 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 44 swvdr,swvdf,swidr,swidf ,Tf43 swvdr,swvdf,swidr,swidf 45 44 USE ice_therm_vertical, only: calc_Tsfc 46 45 #else 47 USE ice_state, only: aice,aicen,uvel,nt_hpnd,trcrn,vvel,vsno,&48 vsnon,vice,vicen,nt_Tsfc49 46 USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, & 50 47 strocnxT,strocnyT, & 51 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, 52 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, 48 sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, & 49 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & 53 50 flatn_f,fsurfn_f,fcondtopn_f, & 54 #ifdef key_asminc55 daice_da,fresh_da,fsalt_da, &56 #endif57 51 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 58 swvdr,swvdf,swidr,swidf,Tf, & 59 !! When using NEMO with CICE, this change requires use of 60 !! one of the following two CICE branches: 61 !! - at CICE5.0, hadax/r1015_GSI8_with_GSI7 62 !! - at CICE5.1.2, hadax/vn5.1.2_GSI8 63 keffn_top,Tn_top 64 65 USE ice_therm_shared, only: calc_Tsfc, heat_capacity 66 USE ice_shortwave, only: apeffn 52 swvdr,swvdf,swidr,swidf 53 USE ice_therm_shared, only: calc_Tsfc 67 54 #endif 68 55 USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf … … 168 155 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 169 156 REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 170 REAL(wp) , DIMENSION(jpi,jpj,jpk) :: ztfrz3d157 REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar 171 158 INTEGER :: ji, jj, jl, jk ! dummy loop indices 172 159 !!--------------------------------------------------------------------- … … 177 164 jj_off = INT ( (jpjglo - ny_global) / 2 ) 178 165 179 ! Initialize CICE 166 #if defined key_nemocice_decomp 167 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 168 ! there is no restart file. 169 ! Values from a CICE restart file would overwrite this 170 IF ( .NOT. ln_rstart ) THEN 171 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 172 ENDIF 173 #endif 174 175 ! Initialize CICE 180 176 CALL CICE_Initialize 181 177 182 178 ! Do some CICE consistency checks 183 179 IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN 184 180 IF ( calc_strair .OR. calc_Tsfc ) THEN … … 192 188 193 189 194 195 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_ alloc : unable to allocate arrays' )190 ! allocate sbc_ice and sbc_cice arrays 191 IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate arrays' ) 196 192 IF( sbc_ice_cice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' ) 197 193 198 ! Ensure that no temperature points are below freezing if not a NEMO restart194 ! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart 199 195 IF( .NOT. ln_rstart ) THEN 200 201 DO jk=1,jpk 202 CALL eos_fzp( tsn(:,:,jk,jp_sal), ztfrz3d(:,:,jk), gdept_n(:,:,jk) ) 203 ENDDO 204 tsn(:,:,:,jp_tem) = MAX( tsn(:,:,:,jp_tem), ztfrz3d ) 196 tsn(:,:,:,jp_tem) = MAX (tsn(:,:,:,jp_tem),Tocnfrz) 205 197 tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 206 207 #if defined key_nemocice_decomp 208 ! Pass initial SST from NEMO to CICE so ice is initialised correctly if 209 ! there is no restart file. 210 ! Values from a CICE restart file would overwrite this 211 CALL nemo2cice( tsn(:,:,1,jp_tem) , sst , 'T' , 1.) 212 #endif 213 214 ENDIF 215 216 ! calculate surface freezing temperature and send to CICE 217 CALL eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1)) 218 CALL nemo2cice(sstfrz,Tf, 'T', 1. ) 198 ENDIF 199 200 fr_iu(:,:)=0.0 201 fr_iv(:,:)=0.0 219 202 220 203 CALL cice2nemo(aice,fr_i, 'T', 1. ) … … 227 210 ! T point to U point 228 211 ! T point to V point 229 fr_iu(:,:)=0.0230 fr_iv(:,:)=0.0231 212 DO jj=1,jpjm1 232 213 DO ji=1,jpim1 … … 287 268 ENDIF 288 269 ENDIF 289 290 #if defined key_asminc 291 ! Initialize fresh water and salt fluxes from data assim 292 ! and data assimilation index to cice 293 nfresh_da(:,:) = 0.0 294 nfsalt_da(:,:) = 0.0 295 ndaice_da(:,:) = 0.0 296 #endif 297 ! 298 ! In coupled mode get extra fields from CICE for passing back to atmosphere 299 300 IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(nit000) 301 ! 270 ! 302 271 END SUBROUTINE cice_sbc_init 303 272 … … 352 321 CALL nemo2cice(ztmp,stray,'F', -1. ) 353 322 354 355 ! Alex West: From configuration GSI8 onwards, when NEMO is used with CICE in356 ! HadGEM3 the 'time-travelling ice' coupling approach is used, whereby357 ! atmosphere-ice fluxes are passed as pseudo-local values, formed by dividing358 ! gridbox mean fluxes in the UM by future ice concentration obtained through359 ! OASIS. This allows for a much more realistic apportionment of energy through360 ! the ice - and conserves energy.361 ! Therefore the fluxes are now divided by ice concentration in the coupled362 ! formulation (jp_purecpl) as well as for jp_flx. This NEMO branch should only363 ! be used at UM10.2 onwards (unless an explicit GSI8 UM branch is included), at364 ! which point the GSI8 UM changes were committed.365 366 323 ! Surface downward latent heat flux (CI_5) 367 324 IF (ksbc == jp_flx) THEN … … 369 326 ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl) 370 327 ENDDO 371 ELSE IF (ksbc == jp_purecpl) THEN 372 DO jl=1,ncat 373 ztmpn(:,:,jl)=qla_ice(:,:,jl)*a_i(:,:,jl) 328 ELSE 329 ! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow 330 qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * Lsub 331 ! End of temporary code 332 DO jj=1,jpj 333 DO ji=1,jpi 334 IF (fr_i(ji,jj).eq.0.0) THEN 335 DO jl=1,ncat 336 ztmpn(ji,jj,jl)=0.0 337 ENDDO 338 ! This will then be conserved in CICE 339 ztmpn(ji,jj,1)=qla_ice(ji,jj,1) 340 ELSE 341 DO jl=1,ncat 342 ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj) 343 ENDDO 344 ENDIF 345 ENDDO 374 346 ENDDO 375 ELSE376 !In coupled mode - qla_ice calculated in sbc_cpl for each category377 ztmpn(:,:,1:ncat)=qla_ice(:,:,1:ncat)378 347 ENDIF 379 380 348 DO jl=1,ncat 381 349 CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. ) … … 383 351 ! GBM conductive flux through ice (CI_6) 384 352 ! Convert to GBM 385 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN353 IF (ksbc == jp_flx) THEN 386 354 ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl) 387 355 ELSE … … 392 360 ! GBM surface heat flux (CI_7) 393 361 ! Convert to GBM 394 IF (ksbc == jp_flx .OR. ksbc == jp_purecpl) THEN362 IF (ksbc == jp_flx) THEN 395 363 ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl) 396 364 ELSE … … 441 409 ENDIF 442 410 443 #if defined key_asminc444 !Ice concentration change (from assimilation)445 ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1)446 Call nemo2cice(ztmp,daice_da,'T', 1. )447 #endif448 449 411 ! Snowfall 450 412 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) … … 458 420 CALL nemo2cice(ztmp,frain,'T', 1. ) 459 421 460 ! Recalculate freezing temperature and send to CICE461 CALL eos_fzp(sss_m(:,:), sstfrz(:,:), gdept_n(:,:,1))462 CALL nemo2cice(sstfrz,Tf,'T', 1. )463 464 422 ! Freezing/melting potential 465 423 ! Calculated over NEMO leapfrog timestep (hence 2*dt) 466 nfrzmlt(:,:)=rau0*rcp*e3t_m(:,:)*(sstfrz(:,:)-sst_m(:,:))/(2.0*dt) 467 CALL nemo2cice(nfrzmlt,frzmlt,'T', 1. ) 424 nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt ) 425 426 ztmp(:,:) = nfrzmlt(:,:) 427 CALL nemo2cice(ztmp,frzmlt,'T', 1. ) 468 428 469 429 ! SST and SSS … … 471 431 CALL nemo2cice(sst_m,sst,'T', 1. ) 472 432 CALL nemo2cice(sss_m,sss,'T', 1. ) 473 474 IF( ksbc == jp_purecpl ) THEN475 ! Sea ice surface skin temperature476 DO jl=1,ncat477 CALL nemo2cice(tsfc_ice(:,:,jl), trcrn(:,:,nt_tsfc,jl,:),'T',1.)478 ENDDO479 ENDIF480 433 481 434 ! x comp and y comp of surface ocean current … … 710 663 INTEGER :: ierror 711 664 !!--------------------------------------------------------------------- 712 #if defined key_asminc 713 ! Import fresh water and salt flux due to seaice da 714 CALL cice2nemo(fresh_da, nfresh_da,'T',1.0) 715 CALL cice2nemo(fsalt_da, nfsalt_da,'T',1.0) 716 #endif 717 718 ! 665 ! 666 IF( kt == nit000 ) THEN 667 IF(lwp) WRITE(numout,*)'cice_sbc_hadgam' 668 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 669 ENDIF 670 719 671 ! ! =========================== ! 720 672 ! ! Prepare Coupling fields ! … … 734 686 CALL cice2nemo( vicen(:,:,jl,:), h_i(:,:,jl),'T', 1. ) 735 687 END DO 736 737 #if ! defined key_cice4738 ! Meltpond fraction and depth739 DO jl = 1,ncat740 CALL cice2nemo(apeffn(:,:,jl,:),a_p(:,:,jl),'T', 1. )741 CALL cice2nemo(trcrn(:,:,nt_hpnd,jl,:),ht_p(:,:,jl),'T', 1. )742 ENDDO743 #endif744 745 746 ! If using multilayers thermodynamics in CICE then get top layer temperature747 ! and effective conductivity748 !! When using NEMO with CICE, this change requires use of749 !! one of the following two CICE branches:750 !! - at CICE5.0, hadax/r1015_GSI8_with_GSI7751 !! - at CICE5.1.2, hadax/vn5.1.2_GSI8752 IF (heat_capacity) THEN753 DO jl = 1,ncat754 CALL cice2nemo(Tn_top(:,:,jl,:),tn_ice(:,:,jl),'T', 1. )755 CALL cice2nemo(keffn_top(:,:,jl,:),kn_ice(:,:,jl),'T', 1. )756 ENDDO757 ! Convert surface temperature to Kelvin758 tn_ice(:,:,:)=tn_ice(:,:,:)+rt0759 ELSE760 tn_ice(:,:,:) = 0.0761 kn_ice(:,:,:) = 0.0762 ENDIF763 764 688 ! 765 689 END SUBROUTINE cice_sbc_hadgam
Note: See TracChangeset
for help on using the changeset viewer.