New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

sbcice_cice.F90 in NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcice_cice.F90 @ 11053

Last change on this file since 11053 was 11053, checked in by davestorkey, 5 years ago
2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Merge in latest changes from main branch and finish conversion of "h" variables. NB. This version still doesn't work!
Property svn:keywords set to `Id`
File size: 43.9 KB

Rev	Line
[2874]	1	MODULE sbcice_cice
	2	!!======================================================================
	3	!! * MODULE sbcice_cice *
	4	!! To couple with sea ice model CICE (LANL)
	5	!!=====================================================================
	6	#if defined key_cice
	7	!!----------------------------------------------------------------------
	8	!! 'key_cice' : CICE sea-ice model
	9	!!----------------------------------------------------------------------
	10	!! sbc_ice_cice : sea-ice model time-stepping and update ocean sbc over ice-covered area
	11	!!----------------------------------------------------------------------
	12	USE oce ! ocean dynamics and tracers
	13	USE dom_oce ! ocean space and time domain
[3275]	14	USE domvvl
[9935]	15	USE phycst, only : rcp, rau0, r1_rau0, rhos, rhoi
[2874]	16	USE in_out_manager ! I/O manager
[4990]	17	USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit
[2874]	18	USE lib_mpp ! distributed memory computing library
	19	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	20	USE daymod ! calendar
	21	USE fldread ! read input fields
	22	USE sbc_oce ! Surface boundary condition: ocean fields
	23	USE sbc_ice ! Surface boundary condition: ice fields
[7646]	24	USE sbcblk ! Surface boundary condition: bulk
[2874]	25	USE sbccpl
	26
	27	USE ice_kinds_mod
	28	USE ice_blocks
	29	USE ice_domain
	30	USE ice_domain_size
	31	USE ice_boundary
	32	USE ice_constants
	33	USE ice_gather_scatter
	34	USE ice_calendar, only: dt
[3625]	35	USE ice_state, only: aice,aicen,uvel,vvel,vsno,vsnon,vice,vicen
[4990]	36	# if defined key_cice4
[2874]	37	USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, &
[5133]	38	strocnxT,strocnyT, &
[3189]	39	sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_gbm, &
	40	fresh_gbm,fhocn_gbm,fswthru_gbm,frzmlt, &
[2874]	41	flatn_f,fsurfn_f,fcondtopn_f, &
	42	uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, &
	43	swvdr,swvdf,swidr,swidf
[4990]	44	USE ice_therm_vertical, only: calc_Tsfc
	45	#else
	46	USE ice_flux, only: strax,stray,strocnx,strocny,frain,fsnow, &
[5133]	47	strocnxT,strocnyT, &
[4990]	48	sst,sss,uocn,vocn,ss_tltx,ss_tlty,fsalt_ai, &
	49	fresh_ai,fhocn_ai,fswthru_ai,frzmlt, &
	50	flatn_f,fsurfn_f,fcondtopn_f, &
	51	uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, &
	52	swvdr,swvdf,swidr,swidf
	53	USE ice_therm_shared, only: calc_Tsfc
	54	#endif
[2874]	55	USE ice_forcing, only: frcvdr,frcvdf,frcidr,frcidf
[3176]	56	USE ice_atmo, only: calc_strair
[2874]	57
	58	USE CICE_InitMod
	59	USE CICE_RunMod
	60	USE CICE_FinalMod
	61
	62	IMPLICIT NONE
	63	PRIVATE
	64
	65	PUBLIC cice_sbc_init ! routine called by sbc_init
	66	PUBLIC cice_sbc_final ! routine called by sbc_final
	67	PUBLIC sbc_ice_cice ! routine called by sbc
	68
[4627]	69	INTEGER :: ji_off
	70	INTEGER :: jj_off
[3625]	71
[2874]	72	INTEGER , PARAMETER :: jpfld = 13 ! maximum number of files to read
	73	INTEGER , PARAMETER :: jp_snow = 1 ! index of snow file
	74	INTEGER , PARAMETER :: jp_rain = 2 ! index of rain file
	75	INTEGER , PARAMETER :: jp_sblm = 3 ! index of sublimation file
	76	INTEGER , PARAMETER :: jp_top1 = 4 ! index of category 1 topmelt file
	77	INTEGER , PARAMETER :: jp_top2 = 5 ! index of category 2 topmelt file
	78	INTEGER , PARAMETER :: jp_top3 = 6 ! index of category 3 topmelt file
	79	INTEGER , PARAMETER :: jp_top4 = 7 ! index of category 4 topmelt file
	80	INTEGER , PARAMETER :: jp_top5 = 8 ! index of category 5 topmelt file
	81	INTEGER , PARAMETER :: jp_bot1 = 9 ! index of category 1 botmelt file
	82	INTEGER , PARAMETER :: jp_bot2 = 10 ! index of category 2 botmelt file
	83	INTEGER , PARAMETER :: jp_bot3 = 11 ! index of category 3 botmelt file
	84	INTEGER , PARAMETER :: jp_bot4 = 12 ! index of category 4 botmelt file
	85	INTEGER , PARAMETER :: jp_bot5 = 13 ! index of category 5 botmelt file
	86	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf ! structure of input fields (file informations, fields read)
	87
	88	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:), PRIVATE :: png ! local array used in sbc_cice_ice
	89
[5836]	90	!!----------------------------------------------------------------------
[10068]	91	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[5215]	92	!! $Id$
[10068]	93	!! Software governed by the CeCILL license (see ./LICENSE)
[5836]	94	!!----------------------------------------------------------------------
[2874]	95	CONTAINS
	96
	97	INTEGER FUNCTION sbc_ice_cice_alloc()
	98	!!----------------------------------------------------------------------
	99	!! * FUNCTION sbc_ice_cice_alloc *
	100	!!----------------------------------------------------------------------
	101	ALLOCATE( png(jpi,jpj,jpnij), STAT=sbc_ice_cice_alloc )
[10425]	102	CALL mpp_sum ( 'sbcice_cice', sbc_ice_cice_alloc )
[2874]	103	IF( sbc_ice_cice_alloc > 0 ) CALL ctl_warn('sbc_ice_cice_alloc: allocation of arrays failed.')
	104	END FUNCTION sbc_ice_cice_alloc
	105
[4990]	106	SUBROUTINE sbc_ice_cice( kt, ksbc )
[2874]	107	!!---------------------------------------------------------------------
	108	!! * ROUTINE sbc_ice_cice *
	109	!!
	110	!! ** Purpose : update the ocean surface boundary condition via the
	111	!! CICE Sea Ice Model time stepping
	112	!!
[3040]	113	!! ** Method : - Get any extra forcing fields for CICE
	114	!! - Prepare forcing fields
[2874]	115	!! - CICE model time stepping
	116	!! - call the routine that computes mass and
	117	!! heat fluxes at the ice/ocean interface
	118	!!
	119	!! ** Action : - time evolution of the CICE sea-ice model
	120	!! - update all sbc variables below sea-ice:
[3625]	121	!! utau, vtau, qns , qsr, emp , sfx
[2874]	122	!!---------------------------------------------------------------------
	123	INTEGER, INTENT(in) :: kt ! ocean time step
[4990]	124	INTEGER, INTENT(in) :: ksbc ! surface forcing type
[2874]	125	!!----------------------------------------------------------------------
[3193]	126	!
[2874]	127	! !----------------------!
	128	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only !
	129	! !----------------------!
	130
	131	! Make sure any fluxes required for CICE are set
[4990]	132	IF ( ksbc == jp_flx ) THEN
[2874]	133	CALL cice_sbc_force(kt)
[5407]	134	ELSE IF ( ksbc == jp_purecpl ) THEN
[9019]	135	CALL sbc_cpl_ice_flx( fr_i )
[2874]	136	ENDIF
	137
[4990]	138	CALL cice_sbc_in ( kt, ksbc )
[2874]	139	CALL CICE_Run
[4990]	140	CALL cice_sbc_out ( kt, ksbc )
[2874]	141
[5407]	142	IF ( ksbc == jp_purecpl ) CALL cice_sbc_hadgam(kt+1)
[2874]	143
	144	ENDIF ! End sea-ice time step only
[3193]	145	!
[2874]	146	END SUBROUTINE sbc_ice_cice
	147
[5836]	148
[11053]	149	SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm )
[2874]	150	!!---------------------------------------------------------------------
	151	!! * ROUTINE cice_sbc_init *
[3040]	152	!! ** Purpose: Initialise ice related fields for NEMO and coupling
[2874]	153	!!
[5836]	154	!!---------------------------------------------------------------------
[4990]	155	INTEGER, INTENT( in ) :: ksbc ! surface forcing type
[11053]	156	INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices
[9125]	157	REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2
[3625]	158	REAL(wp) :: zcoefu, zcoefv, zcoeff ! local scalar
[4990]	159	INTEGER :: ji, jj, jl, jk ! dummy loop indices
[2874]	160	!!---------------------------------------------------------------------
[3193]	161	!
[2874]	162	IF(lwp) WRITE(numout,*)'cice_sbc_init'
	163
[4627]	164	ji_off = INT ( (jpiglo - nx_global) / 2 )
	165	jj_off = INT ( (jpjglo - ny_global) / 2 )
	166
[4990]	167	#if defined key_nemocice_decomp
	168	! Pass initial SST from NEMO to CICE so ice is initialised correctly if
	169	! there is no restart file.
	170	! Values from a CICE restart file would overwrite this
	171	IF ( .NOT. ln_rstart ) THEN
[10922]	172	CALL nemo2cice( ts(:,:,1,jp_tem,Kmm) , sst , 'T' , 1.)
[4990]	173	ENDIF
	174	#endif
	175
[2874]	176	! Initialize CICE
[3176]	177	CALL CICE_Initialize
[2874]	178
[3176]	179	! Do some CICE consistency checks
[5407]	180	IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
[3193]	181	IF ( calc_strair .OR. calc_Tsfc ) THEN
	182	CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=F and calc_Tsfc=F in ice_in' )
	183	ENDIF
[7646]	184	ELSEIF (ksbc == jp_blk) THEN
[3193]	185	IF ( .NOT. (calc_strair .AND. calc_Tsfc) ) THEN
	186	CALL ctl_stop( 'STOP', 'cice_sbc_init : Forcing option requires calc_strair=T and calc_Tsfc=T in ice_in' )
	187	ENDIF
	188	ENDIF
[3176]	189
	190
[2874]	191	! allocate sbc_ice and sbc_cice arrays
	192	IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate arrays' )
	193	IF( sbc_ice_cice_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_ice_cice_alloc : unable to allocate cice arrays' )
	194
	195	! Ensure ocean temperatures are nowhere below freezing if not a NEMO restart
	196	IF( .NOT. ln_rstart ) THEN
[10922]	197	ts(:,:,:,jp_tem,Kmm) = MAX (ts(:,:,:,jp_tem,Kmm),Tocnfrz)
	198	ts(:,:,:,jp_tem,Kbb) = ts(:,:,:,jp_tem,Kmm)
[2874]	199	ENDIF
	200
[3193]	201	fr_iu(:,:)=0.0
	202	fr_iv(:,:)=0.0
[2874]	203
[3193]	204	CALL cice2nemo(aice,fr_i, 'T', 1. )
[5407]	205	IF ( (ksbc == jp_flx) .OR. (ksbc == jp_purecpl) ) THEN
[3625]	206	DO jl=1,ncat
	207	CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
[3193]	208	ENDDO
	209	ENDIF
[2874]	210
	211	! T point to U point
	212	! T point to V point
[3193]	213	DO jj=1,jpjm1
	214	DO ji=1,jpim1
	215	fr_iu(ji,jj)=0.5(fr_i(ji,jj)+fr_i(ji+1,jj))umask(ji,jj,1)
	216	fr_iv(ji,jj)=0.5(fr_i(ji,jj)+fr_i(ji,jj+1))vmask(ji,jj,1)
	217	ENDDO
	218	ENDDO
[2874]	219
[10425]	220	CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. )
[3625]	221
[9019]	222	! set the snow+ice mass
	223	CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
	224	CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
[9935]	225	snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) )
[9019]	226	snwice_mass_b(:,:) = snwice_mass(:,:)
	227
[6140]	228	IF( .NOT.ln_rstart ) THEN
[9019]	229	IF( ln_ice_embd ) THEN ! embedded sea-ice: deplete the initial ssh below sea-ice area
[11053]	230	ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rau0
	231	ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0
[6140]	232
	233	!!gm This should be put elsewhere.... (same remark for limsbc)
	234	!!gm especially here it is assumed zstar coordinate, but it can be ztilde....
	235	IF( .NOT.ln_linssh ) THEN
	236	!
	237	DO jk = 1,jpkm1 ! adjust initial vertical scale factors
[11053]	238	e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)( 1._wp + ssh(:,:,Kmm)tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
	239	e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)( 1._wp + ssh(:,:,Kbb)tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
[6140]	240	ENDDO
[10922]	241	e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb)
[6140]	242	! Reconstruction of all vertical scale factors at now and before time-steps
	243	! =============================================================================
	244	! Horizontal scale factor interpolations
	245	! --------------------------------------
[10922]	246	CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' )
	247	CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' )
	248	CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' )
	249	CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' )
	250	CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' )
[6140]	251	! Vertical scale factor interpolations
	252	! ------------------------------------
[10922]	253	CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' )
	254	CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' )
	255	CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' )
	256	CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' )
	257	CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' )
[6140]	258	! t- and w- points depth
	259	! ----------------------
[10922]	260	gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm)
	261	gdepw(:,:,1,Kmm) = 0.0_wp
[11053]	262	gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm)
[6140]	263	DO jk = 2, jpk
[10922]	264	gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm)
	265	gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm)
	266	gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - sshn (:,:)
[6140]	267	END DO
	268	ENDIF
[4990]	269	ENDIF
[3625]	270	ENDIF
[6140]	271	!
[2874]	272	END SUBROUTINE cice_sbc_init
	273
[3152]	274
[5836]	275	SUBROUTINE cice_sbc_in( kt, ksbc )
[2874]	276	!!---------------------------------------------------------------------
	277	!! * ROUTINE cice_sbc_in *
[3040]	278	!! ** Purpose: Set coupling fields and pass to CICE
[2874]	279	!!---------------------------------------------------------------------
[3152]	280	INTEGER, INTENT(in ) :: kt ! ocean time step
[4990]	281	INTEGER, INTENT(in ) :: ksbc ! surface forcing type
[5836]	282	!
[3625]	283	INTEGER :: ji, jj, jl ! dummy loop indices
[9125]	284	REAL(wp), DIMENSION(jpi,jpj) :: ztmp, zpice
	285	REAL(wp), DIMENSION(jpi,jpj,ncat) :: ztmpn
[3625]	286	REAL(wp) :: zintb, zintn ! dummy argument
[3152]	287	!!---------------------------------------------------------------------
[3193]	288	!
	289	IF( kt == nit000 ) THEN
[2874]	290	IF(lwp) WRITE(numout,*)'cice_sbc_in'
[3193]	291	ENDIF
[2874]	292
[3193]	293	ztmp(:,:)=0.0
[2874]	294
	295	! Aggregate ice concentration already set in cice_sbc_out (or cice_sbc_init on
	296	! the first time-step)
	297
	298	! forced and coupled case
	299
[5407]	300	IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
[2874]	301
[3193]	302	ztmpn(:,:,:)=0.0
[2874]	303
	304	! x comp of wind stress (CI_1)
	305	! U point to F point
[3193]	306	DO jj=1,jpjm1
	307	DO ji=1,jpi
	308	ztmp(ji,jj) = 0.5 * ( fr_iu(ji,jj) * utau(ji,jj) &
	309	+ fr_iu(ji,jj+1) * utau(ji,jj+1) ) * fmask(ji,jj,1)
	310	ENDDO
	311	ENDDO
	312	CALL nemo2cice(ztmp,strax,'F', -1. )
[2874]	313
	314	! y comp of wind stress (CI_2)
	315	! V point to F point
[3193]	316	DO jj=1,jpj
	317	DO ji=1,jpim1
	318	ztmp(ji,jj) = 0.5 * ( fr_iv(ji,jj) * vtau(ji,jj) &
	319	+ fr_iv(ji+1,jj) * vtau(ji+1,jj) ) * fmask(ji,jj,1)
	320	ENDDO
	321	ENDDO
	322	CALL nemo2cice(ztmp,stray,'F', -1. )
[2874]	323
	324	! Surface downward latent heat flux (CI_5)
[4990]	325	IF (ksbc == jp_flx) THEN
[3625]	326	DO jl=1,ncat
	327	ztmpn(:,:,jl)=qla_ice(:,:,1)*a_i(:,:,jl)
[3193]	328	ENDDO
	329	ELSE
[2874]	330	! emp_ice is set in sbc_cpl_ice_flx as sublimation-snow
[9935]	331	qla_ice(:,:,1)= - ( emp_ice(:,:)+sprecip(:,:) ) * rLsub
[2874]	332	! End of temporary code
[3193]	333	DO jj=1,jpj
	334	DO ji=1,jpi
	335	IF (fr_i(ji,jj).eq.0.0) THEN
[3625]	336	DO jl=1,ncat
	337	ztmpn(ji,jj,jl)=0.0
[3193]	338	ENDDO
	339	! This will then be conserved in CICE
	340	ztmpn(ji,jj,1)=qla_ice(ji,jj,1)
	341	ELSE
[3625]	342	DO jl=1,ncat
	343	ztmpn(ji,jj,jl)=qla_ice(ji,jj,1)*a_i(ji,jj,jl)/fr_i(ji,jj)
[3193]	344	ENDDO
	345	ENDIF
	346	ENDDO
	347	ENDDO
	348	ENDIF
[3625]	349	DO jl=1,ncat
	350	CALL nemo2cice(ztmpn(:,:,jl),flatn_f(:,:,jl,:),'T', 1. )
[2874]	351
	352	! GBM conductive flux through ice (CI_6)
	353	! Convert to GBM
[4990]	354	IF (ksbc == jp_flx) THEN
[3625]	355	ztmp(:,:) = botmelt(:,:,jl)*a_i(:,:,jl)
[3193]	356	ELSE
[3625]	357	ztmp(:,:) = botmelt(:,:,jl)
[3193]	358	ENDIF
[3625]	359	CALL nemo2cice(ztmp,fcondtopn_f(:,:,jl,:),'T', 1. )
[2874]	360
	361	! GBM surface heat flux (CI_7)
	362	! Convert to GBM
[4990]	363	IF (ksbc == jp_flx) THEN
[3625]	364	ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))*a_i(:,:,jl)
[3193]	365	ELSE
[3625]	366	ztmp(:,:) = (topmelt(:,:,jl)+botmelt(:,:,jl))
[3193]	367	ENDIF
[3625]	368	CALL nemo2cice(ztmp,fsurfn_f(:,:,jl,:),'T', 1. )
[3193]	369	ENDDO
[2874]	370
[7646]	371	ELSE IF (ksbc == jp_blk) THEN
[2874]	372
[7646]	373	! Pass bulk forcing fields to CICE (which will calculate heat fluxes etc itself)
[2874]	374	! x comp and y comp of atmosphere surface wind (CICE expects on T points)
[3193]	375	ztmp(:,:) = wndi_ice(:,:)
	376	CALL nemo2cice(ztmp,uatm,'T', -1. )
	377	ztmp(:,:) = wndj_ice(:,:)
	378	CALL nemo2cice(ztmp,vatm,'T', -1. )
	379	ztmp(:,:) = SQRT ( wndi_ice(:,:)2 + wndj_ice(:,:)2 )
	380	CALL nemo2cice(ztmp,wind,'T', 1. ) ! Wind speed (m/s)
	381	ztmp(:,:) = qsr_ice(:,:,1)
	382	CALL nemo2cice(ztmp,fsw,'T', 1. ) ! Incoming short-wave (W/m^2)
	383	ztmp(:,:) = qlw_ice(:,:,1)
	384	CALL nemo2cice(ztmp,flw,'T', 1. ) ! Incoming long-wave (W/m^2)
	385	ztmp(:,:) = tatm_ice(:,:)
	386	CALL nemo2cice(ztmp,Tair,'T', 1. ) ! Air temperature (K)
	387	CALL nemo2cice(ztmp,potT,'T', 1. ) ! Potential temp (K)
[2874]	388	! Following line uses MAX(....) to avoid problems if tatm_ice has unset halo rows
[3193]	389	ztmp(:,:) = 101000. / ( 287.04 * MAX(1.0,tatm_ice(:,:)) )
	390	! Constant (101000.) atm pressure assumed
	391	CALL nemo2cice(ztmp,rhoa,'T', 1. ) ! Air density (kg/m^3)
	392	ztmp(:,:) = qatm_ice(:,:)
	393	CALL nemo2cice(ztmp,Qa,'T', 1. ) ! Specific humidity (kg/kg)
	394	ztmp(:,:)=10.0
	395	CALL nemo2cice(ztmp,zlvl,'T', 1. ) ! Atmos level height (m)
[2874]	396
	397	! May want to check all values are physically realistic (as in CICE routine
	398	! prepare_forcing)?
	399
	400	! Divide shortwave into spectral bands (as in prepare_forcing)
[3193]	401	ztmp(:,:)=qsr_ice(:,:,1)*frcvdr ! visible direct
[2874]	402	CALL nemo2cice(ztmp,swvdr,'T', 1. )
[3193]	403	ztmp(:,:)=qsr_ice(:,:,1)*frcvdf ! visible diffuse
[2874]	404	CALL nemo2cice(ztmp,swvdf,'T', 1. )
[3193]	405	ztmp(:,:)=qsr_ice(:,:,1)*frcidr ! near IR direct
[2874]	406	CALL nemo2cice(ztmp,swidr,'T', 1. )
[3193]	407	ztmp(:,:)=qsr_ice(:,:,1)*frcidf ! near IR diffuse
[2874]	408	CALL nemo2cice(ztmp,swidf,'T', 1. )
	409
	410	ENDIF
	411
	412	! Snowfall
[4990]	413	! Ensure fsnow is positive (as in CICE routine prepare_forcing)
	414	IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit
[3193]	415	ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0)
	416	CALL nemo2cice(ztmp,fsnow,'T', 1. )
[2874]	417
	418	! Rainfall
[4990]	419	IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit
[3193]	420	ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
	421	CALL nemo2cice(ztmp,frain,'T', 1. )
[2874]	422
	423	! Freezing/melting potential
[3275]	424	! Calculated over NEMO leapfrog timestep (hence 2*dt)
[6140]	425	nfrzmlt(:,:) = rau0 * rcp * e3t_m(:,:) * ( Tocnfrz-sst_m(:,:) ) / ( 2.0*dt )
[2874]	426
[3193]	427	ztmp(:,:) = nfrzmlt(:,:)
	428	CALL nemo2cice(ztmp,frzmlt,'T', 1. )
[2874]	429
	430	! SST and SSS
	431
[3193]	432	CALL nemo2cice(sst_m,sst,'T', 1. )
	433	CALL nemo2cice(sss_m,sss,'T', 1. )
[2874]	434
	435	! x comp and y comp of surface ocean current
	436	! U point to F point
[3193]	437	DO jj=1,jpjm1
	438	DO ji=1,jpi
	439	ztmp(ji,jj)=0.5(ssu_m(ji,jj)+ssu_m(ji,jj+1))fmask(ji,jj,1)
	440	ENDDO
	441	ENDDO
	442	CALL nemo2cice(ztmp,uocn,'F', -1. )
[2874]	443
	444	! V point to F point
[3193]	445	DO jj=1,jpj
	446	DO ji=1,jpim1
	447	ztmp(ji,jj)=0.5(ssv_m(ji,jj)+ssv_m(ji+1,jj))fmask(ji,jj,1)
	448	ENDDO
	449	ENDDO
	450	CALL nemo2cice(ztmp,vocn,'F', -1. )
[2874]	451
[9019]	452	IF( ln_ice_embd ) THEN !== embedded sea ice: compute representative ice top surface ==!
[3625]	453	!
	454	! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[n/nn_fsbc], n=0,nn_fsbc-1}
	455	! = (1/nn_fsbc)^2 * {SUM[n], n=0,nn_fsbc-1}
	456	zintn = REAL( nn_fsbc - 1 ) / REAL( nn_fsbc ) * 0.5_wp
	457	!
	458	! average interpolation coeff as used in dynspg = (1/nn_fsbc) * {SUM[1-n/nn_fsbc], n=0,nn_fsbc-1}
	459	! = (1/nn_fsbc)^2 * (nn_fsbc^2 - {SUM[n], n=0,nn_fsbc-1})
	460	zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp
	461	!
	462	zpice(:,:) = ssh_m(:,:) + ( zintn * snwice_mass(:,:) + zintb * snwice_mass_b(:,:) ) * r1_rau0
	463	!
	464	!
	465	ELSE !== non-embedded sea ice: use ocean surface for slope calculation ==!
	466	zpice(:,:) = ssh_m(:,:)
	467	ENDIF
	468
[3189]	469	! x comp and y comp of sea surface slope (on F points)
	470	! T point to F point
[5836]	471	DO jj = 1, jpjm1
	472	DO ji = 1, jpim1
	473	ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) &
	474	& + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1)
	475	END DO
	476	END DO
	477	CALL nemo2cice( ztmp,ss_tltx,'F', -1. )
[3189]	478
	479	! T point to F point
[5836]	480	DO jj = 1, jpjm1
	481	DO ji = 1, jpim1
	482	ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) &
	483	& + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1)
	484	END DO
	485	END DO
[3193]	486	CALL nemo2cice(ztmp,ss_tlty,'F', -1. )
	487	!
[2874]	488	END SUBROUTINE cice_sbc_in
	489
[3152]	490
[5836]	491	SUBROUTINE cice_sbc_out( kt, ksbc )
[2874]	492	!!---------------------------------------------------------------------
	493	!! * ROUTINE cice_sbc_out *
[3040]	494	!! ** Purpose: Get fields from CICE and set surface fields for NEMO
[3152]	495	!!---------------------------------------------------------------------
[2874]	496	INTEGER, INTENT( in ) :: kt ! ocean time step
[4990]	497	INTEGER, INTENT( in ) :: ksbc ! surface forcing type
[3152]	498
[3625]	499	INTEGER :: ji, jj, jl ! dummy loop indices
[9125]	500	REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2
[2874]	501	!!---------------------------------------------------------------------
[3193]	502	!
[3152]	503	IF( kt == nit000 ) THEN
[2874]	504	IF(lwp) WRITE(numout,*)'cice_sbc_out'
[3152]	505	ENDIF
	506
[2874]	507	! x comp of ocean-ice stress
[3625]	508	CALL cice2nemo(strocnx,ztmp1,'F', -1. )
[3193]	509	ss_iou(:,:)=0.0
[2874]	510	! F point to U point
[3193]	511	DO jj=2,jpjm1
	512	DO ji=2,jpim1
[3625]	513	ss_iou(ji,jj) = 0.5 * ( ztmp1(ji,jj-1) + ztmp1(ji,jj) ) * umask(ji,jj,1)
[3193]	514	ENDDO
	515	ENDDO
[10425]	516	CALL lbc_lnk( 'sbcice_cice', ss_iou , 'U', -1. )
[2874]	517
	518	! y comp of ocean-ice stress
[3625]	519	CALL cice2nemo(strocny,ztmp1,'F', -1. )
[3193]	520	ss_iov(:,:)=0.0
[2874]	521	! F point to V point
	522
[3193]	523	DO jj=1,jpjm1
	524	DO ji=2,jpim1
[3625]	525	ss_iov(ji,jj) = 0.5 * ( ztmp1(ji-1,jj) + ztmp1(ji,jj) ) * vmask(ji,jj,1)
[3193]	526	ENDDO
	527	ENDDO
[10425]	528	CALL lbc_lnk( 'sbcice_cice', ss_iov , 'V', -1. )
[2874]	529
	530	! x and y comps of surface stress
	531	! Combine wind stress and ocean-ice stress
	532	! [Note that fr_iu hasn't yet been updated, so still from start of CICE timestep]
[5133]	533	! strocnx and strocny already weighted by ice fraction in CICE so not done here
[2874]	534
[3193]	535	utau(:,:)=(1.0-fr_iu(:,:))*utau(:,:)-ss_iou(:,:)
	536	vtau(:,:)=(1.0-fr_iv(:,:))*vtau(:,:)-ss_iov(:,:)
[5133]	537
	538	! Also need ice/ocean stress on T points so that taum can be updated
	539	! This interpolation is already done in CICE so best to use those values
	540	CALL cice2nemo(strocnxT,ztmp1,'T',-1.)
	541	CALL cice2nemo(strocnyT,ztmp2,'T',-1.)
	542
	543	! Update taum with modulus of ice-ocean stress
	544	! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here
[5836]	545	taum(:,:)=(1.0-fr_i(:,:))taum(:,:)+fr_i(:,:)SQRT(ztmp1ztmp1 + ztmp2ztmp2)
[2874]	546
	547	! Freshwater fluxes
	548
[4990]	549	IF (ksbc == jp_flx) THEN
[2874]	550	! Note that emp from the forcing files is evap(1-aice)-(tprecip-aicesprecip)
	551	! What we want here is evap(1-aice)-tprecip(1-aice) hence manipulation below
	552	! Not ideal since aice won't be the same as in the atmosphere.
	553	! Better to use evap and tprecip? (but for now don't read in evap in this case)
[3193]	554	emp(:,:) = emp(:,:)+fr_i(:,:)*(tprecip(:,:)-sprecip(:,:))
[7646]	555	ELSE IF (ksbc == jp_blk) THEN
[3193]	556	emp(:,:) = (1.0-fr_i(:,:))*emp(:,:)
[5407]	557	ELSE IF (ksbc == jp_purecpl) THEN
[3625]	558	! emp_tot is set in sbc_cpl_ice_flx (called from cice_sbc_in above)
	559	! This is currently as required with the coupling fields from the UM atmosphere
[3193]	560	emp(:,:) = emp_tot(:,:)+tprecip(:,:)*fr_i(:,:)
	561	ENDIF
[2874]	562
[4990]	563	#if defined key_cice4
[3625]	564	CALL cice2nemo(fresh_gbm,ztmp1,'T', 1. )
	565	CALL cice2nemo(fsalt_gbm,ztmp2,'T', 1. )
[4990]	566	#else
	567	CALL cice2nemo(fresh_ai,ztmp1,'T', 1. )
	568	CALL cice2nemo(fsalt_ai,ztmp2,'T', 1. )
	569	#endif
[2874]	570
[3625]	571	! Check to avoid unphysical expression when ice is forming (ztmp1 negative)
	572	! Otherwise we are effectively allowing ice of higher salinity than the ocean to form
	573	! which has to be compensated for by the ocean salinity potentially going negative
	574	! This check breaks conservation but seems reasonable until we have prognostic ice salinity
	575	! Note the 1000.0 below is to convert from kg salt to g salt (needed for PSU)
	576	WHERE (ztmp1(:,:).lt.0.0) ztmp2(:,:)=MAX(ztmp2(:,:),ztmp1(:,:)*sss_m(:,:)/1000.0)
	577	sfx(:,:)=ztmp2(:,:)*1000.0
	578	emp(:,:)=emp(:,:)-ztmp1(:,:)
[4990]	579	fmmflx(:,:) = ztmp1(:,:) !!Joakim edit
	580
[10425]	581	CALL lbc_lnk_multi( 'sbcice_cice', emp , 'T', 1., sfx , 'T', 1. )
[2874]	582
	583	! Solar penetrative radiation and non solar surface heat flux
	584
	585	! Scale qsr and qns according to ice fraction (bulk formulae only)
	586
[7646]	587	IF (ksbc == jp_blk) THEN
[3193]	588	qsr(:,:)=qsr(:,:)*(1.0-fr_i(:,:))
	589	qns(:,:)=qns(:,:)*(1.0-fr_i(:,:))
	590	ENDIF
[2874]	591	! Take into account snow melting except for fully coupled when already in qns_tot
[5407]	592	IF (ksbc == jp_purecpl) THEN
[3193]	593	qsr(:,:)= qsr_tot(:,:)
	594	qns(:,:)= qns_tot(:,:)
	595	ELSE
	596	qns(:,:)= qns(:,:)-sprecip(:,:)Lfresh(1.0-fr_i(:,:))
	597	ENDIF
[2874]	598
	599	! Now add in ice / snow related terms
	600	! [fswthru will be zero unless running with calc_Tsfc=T in CICE]
[4990]	601	#if defined key_cice4
[3625]	602	CALL cice2nemo(fswthru_gbm,ztmp1,'T', 1. )
[4990]	603	#else
	604	CALL cice2nemo(fswthru_ai,ztmp1,'T', 1. )
	605	#endif
[3625]	606	qsr(:,:)=qsr(:,:)+ztmp1(:,:)
[10425]	607	CALL lbc_lnk( 'sbcice_cice', qsr , 'T', 1. )
[2874]	608
[3193]	609	DO jj=1,jpj
	610	DO ji=1,jpi
[2874]	611	nfrzmlt(ji,jj)=MAX(nfrzmlt(ji,jj),0.0)
[3193]	612	ENDDO
	613	ENDDO
[2874]	614
[4990]	615	#if defined key_cice4
[3625]	616	CALL cice2nemo(fhocn_gbm,ztmp1,'T', 1. )
[4990]	617	#else
	618	CALL cice2nemo(fhocn_ai,ztmp1,'T', 1. )
	619	#endif
[3625]	620	qns(:,:)=qns(:,:)+nfrzmlt(:,:)+ztmp1(:,:)
[2874]	621
[10425]	622	CALL lbc_lnk( 'sbcice_cice', qns , 'T', 1. )
[2874]	623
	624	! Prepare for the following CICE time-step
	625
[3193]	626	CALL cice2nemo(aice,fr_i,'T', 1. )
[5407]	627	IF ( (ksbc == jp_flx).OR.(ksbc == jp_purecpl) ) THEN
[3625]	628	DO jl=1,ncat
	629	CALL cice2nemo(aicen(:,:,jl,:),a_i(:,:,jl), 'T', 1. )
[3193]	630	ENDDO
	631	ENDIF
[2874]	632
	633	! T point to U point
	634	! T point to V point
[3193]	635	DO jj=1,jpjm1
	636	DO ji=1,jpim1
	637	fr_iu(ji,jj)=0.5(fr_i(ji,jj)+fr_i(ji+1,jj))umask(ji,jj,1)
	638	fr_iv(ji,jj)=0.5(fr_i(ji,jj)+fr_i(ji,jj+1))vmask(ji,jj,1)
	639	ENDDO
	640	ENDDO
[2874]	641
[10425]	642	CALL lbc_lnk_multi( 'sbcice_cice', fr_iu , 'U', 1., fr_iv , 'V', 1. )
[2874]	643
[9019]	644	! set the snow+ice mass
	645	CALL cice2nemo(vsno(:,:,:),ztmp1,'T', 1. )
	646	CALL cice2nemo(vice(:,:,:),ztmp2,'T', 1. )
[9935]	647	snwice_mass (:,:) = ( rhos * ztmp1(:,:) + rhoi * ztmp2(:,:) )
[9019]	648	snwice_mass_b(:,:) = snwice_mass(:,:)
	649	snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt
[3193]	650	!
[2874]	651	END SUBROUTINE cice_sbc_out
	652
[3152]	653
[2874]	654	SUBROUTINE cice_sbc_hadgam( kt )
	655	!!---------------------------------------------------------------------
	656	!! * ROUTINE cice_sbc_hadgam *
[3040]	657	!! ** Purpose: Prepare fields needed to pass to HadGAM3 atmosphere
[2874]	658	!!
	659	!!
[9124]	660	!!---------------------------------------------------------------------
[2874]	661	INTEGER, INTENT( in ) :: kt ! ocean time step
[9124]	662	!!
[3625]	663	INTEGER :: jl ! dummy loop index
[3193]	664	INTEGER :: ierror
[9124]	665	!!---------------------------------------------------------------------
[3193]	666	!
	667	IF( kt == nit000 ) THEN
[2874]	668	IF(lwp) WRITE(numout,*)'cice_sbc_hadgam'
	669	IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )
[3193]	670	ENDIF
[2874]	671
	672	! ! =========================== !
	673	! ! Prepare Coupling fields !
	674	! ! =========================== !
[9019]	675	!
	676	! x and y comp of ice velocity
	677	!
[3193]	678	CALL cice2nemo(uvel,u_ice,'F', -1. )
	679	CALL cice2nemo(vvel,v_ice,'F', -1. )
	680	!
[9019]	681	! Ice concentration (CO_1) = a_i calculated at end of cice_sbc_out
	682	!
	683	! Snow and ice thicknesses (CO_2 and CO_3)
	684	!
	685	DO jl = 1, ncat
	686	CALL cice2nemo( vsnon(:,:,jl,:), h_s(:,:,jl),'T', 1. )
	687	CALL cice2nemo( vicen(:,:,jl,:), h_i(:,:,jl),'T', 1. )
	688	END DO
	689	!
[2874]	690	END SUBROUTINE cice_sbc_hadgam
	691
	692
	693	SUBROUTINE cice_sbc_final
	694	!!---------------------------------------------------------------------
	695	!! * ROUTINE cice_sbc_final *
	696	!! ** Purpose: Finalize CICE
	697	!!---------------------------------------------------------------------
[9124]	698	!
[2874]	699	IF(lwp) WRITE(numout,*)'cice_sbc_final'
[9124]	700	!
[3193]	701	CALL CICE_Finalize
[9124]	702	!
[2874]	703	END SUBROUTINE cice_sbc_final
	704
[9124]	705
[2874]	706	SUBROUTINE cice_sbc_force (kt)
	707	!!---------------------------------------------------------------------
	708	!! * ROUTINE cice_sbc_force *
	709	!! ** Purpose : Provide CICE forcing from files
	710	!!
	711	!!---------------------------------------------------------------------
	712	!! ** Method : READ monthly flux file in NetCDF files
	713	!!
	714	!! snowfall
	715	!! rainfall
	716	!! sublimation rate
	717	!! topmelt (category)
	718	!! botmelt (category)
	719	!!
	720	!! History :
	721	!!----------------------------------------------------------------------
	722	USE iom
[9124]	723	!!
	724	INTEGER, INTENT( in ) :: kt ! ocean time step
	725	!!
[2874]	726	INTEGER :: ierror ! return error code
	727	INTEGER :: ifpr ! dummy loop index
	728	!!
	729	CHARACTER(len=100) :: cn_dir ! Root directory for location of CICE forcing files
	730	TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read
	731	TYPE(FLD_N) :: sn_snow, sn_rain, sn_sblm ! informations about the fields to be read
	732	TYPE(FLD_N) :: sn_top1, sn_top2, sn_top3, sn_top4, sn_top5
	733	TYPE(FLD_N) :: sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5
	734	!!
	735	NAMELIST/namsbc_cice/ cn_dir, sn_snow, sn_rain, sn_sblm, &
	736	& sn_top1, sn_top2, sn_top3, sn_top4, sn_top5, &
	737	& sn_bot1, sn_bot2, sn_bot3, sn_bot4, sn_bot5
[4230]	738	INTEGER :: ios
[2874]	739	!!---------------------------------------------------------------------
	740
	741	! ! ====================== !
	742	IF( kt == nit000 ) THEN ! First call kt=nit000 !
	743	! ! ====================== !
[4990]	744	! namsbc_cice is not yet in the reference namelist
	745	! set file information (default values)
	746	cn_dir = './' ! directory in which the model is executed
	747
	748	! (NB: frequency positive => hours, negative => months)
	749	! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! landmask
	750	! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! file
	751	sn_snow = FLD_N( 'snowfall_1m' , -1. , 'snowfall' , .true. , .true. , ' yearly' , '' , '' , '' )
	752	sn_rain = FLD_N( 'rainfall_1m' , -1. , 'rainfall' , .true. , .true. , ' yearly' , '' , '' , '' )
	753	sn_sblm = FLD_N( 'sublim_1m' , -1. , 'sublim' , .true. , .true. , ' yearly' , '' , '' , '' )
	754	sn_top1 = FLD_N( 'topmeltn1_1m' , -1. , 'topmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' )
	755	sn_top2 = FLD_N( 'topmeltn2_1m' , -1. , 'topmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' )
	756	sn_top3 = FLD_N( 'topmeltn3_1m' , -1. , 'topmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' )
	757	sn_top4 = FLD_N( 'topmeltn4_1m' , -1. , 'topmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' )
	758	sn_top5 = FLD_N( 'topmeltn5_1m' , -1. , 'topmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' )
	759	sn_bot1 = FLD_N( 'botmeltn1_1m' , -1. , 'botmeltn1' , .true. , .true. , ' yearly' , '' , '' , '' )
	760	sn_bot2 = FLD_N( 'botmeltn2_1m' , -1. , 'botmeltn2' , .true. , .true. , ' yearly' , '' , '' , '' )
	761	sn_bot3 = FLD_N( 'botmeltn3_1m' , -1. , 'botmeltn3' , .true. , .true. , ' yearly' , '' , '' , '' )
	762	sn_bot4 = FLD_N( 'botmeltn4_1m' , -1. , 'botmeltn4' , .true. , .true. , ' yearly' , '' , '' , '' )
	763	sn_bot5 = FLD_N( 'botmeltn5_1m' , -1. , 'botmeltn5' , .true. , .true. , ' yearly' , '' , '' , '' )
	764
[4230]	765	REWIND( numnam_ref ) ! Namelist namsbc_cice in reference namelist :
	766	READ ( numnam_ref, namsbc_cice, IOSTAT = ios, ERR = 901)
[9168]	767	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_cice in reference namelist', lwp )
[2874]	768
[4230]	769	REWIND( numnam_cfg ) ! Namelist namsbc_cice in configuration namelist : Parameters of the run
	770	READ ( numnam_cfg, namsbc_cice, IOSTAT = ios, ERR = 902 )
[9168]	771	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc_cice in configuration namelist', lwp )
[4624]	772	IF(lwm) WRITE ( numond, namsbc_cice )
[2874]	773
	774	! store namelist information in an array
	775	slf_i(jp_snow) = sn_snow ; slf_i(jp_rain) = sn_rain ; slf_i(jp_sblm) = sn_sblm
	776	slf_i(jp_top1) = sn_top1 ; slf_i(jp_top2) = sn_top2 ; slf_i(jp_top3) = sn_top3
	777	slf_i(jp_top4) = sn_top4 ; slf_i(jp_top5) = sn_top5 ; slf_i(jp_bot1) = sn_bot1
	778	slf_i(jp_bot2) = sn_bot2 ; slf_i(jp_bot3) = sn_bot3 ; slf_i(jp_bot4) = sn_bot4
	779	slf_i(jp_bot5) = sn_bot5
	780
	781	! set sf structure
	782	ALLOCATE( sf(jpfld), STAT=ierror )
	783	IF( ierror > 0 ) THEN
	784	CALL ctl_stop( 'cice_sbc_force: unable to allocate sf structure' ) ; RETURN
	785	ENDIF
	786
	787	DO ifpr= 1, jpfld
	788	ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) )
	789	ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) )
	790	END DO
	791
	792	! fill sf with slf_i and control print
	793	CALL fld_fill( sf, slf_i, cn_dir, 'cice_sbc_force', 'flux formulation for CICE', 'namsbc_cice' )
	794	!
	795	ENDIF
	796
	797	CALL fld_read( kt, nn_fsbc, sf ) ! Read input fields and provides the
	798	! ! input fields at the current time-step
	799
	800	! set the fluxes from read fields
	801	sprecip(:,:) = sf(jp_snow)%fnow(:,:,1)
	802	tprecip(:,:) = sf(jp_snow)%fnow(:,:,1)+sf(jp_rain)%fnow(:,:,1)
[3040]	803	! May be better to do this conversion somewhere else
[9935]	804	qla_ice(:,:,1) = -rLsub*sf(jp_sblm)%fnow(:,:,1)
[2874]	805	topmelt(:,:,1) = sf(jp_top1)%fnow(:,:,1)
	806	topmelt(:,:,2) = sf(jp_top2)%fnow(:,:,1)
	807	topmelt(:,:,3) = sf(jp_top3)%fnow(:,:,1)
	808	topmelt(:,:,4) = sf(jp_top4)%fnow(:,:,1)
	809	topmelt(:,:,5) = sf(jp_top5)%fnow(:,:,1)
	810	botmelt(:,:,1) = sf(jp_bot1)%fnow(:,:,1)
	811	botmelt(:,:,2) = sf(jp_bot2)%fnow(:,:,1)
	812	botmelt(:,:,3) = sf(jp_bot3)%fnow(:,:,1)
	813	botmelt(:,:,4) = sf(jp_bot4)%fnow(:,:,1)
	814	botmelt(:,:,5) = sf(jp_bot5)%fnow(:,:,1)
	815
	816	! control print (if less than 100 time-step asked)
	817	IF( nitend-nit000 <= 100 .AND. lwp ) THEN
	818	WRITE(numout,*)
	819	WRITE(numout,*) ' read forcing fluxes for CICE OK'
	820	CALL FLUSH(numout)
	821	ENDIF
	822
	823	END SUBROUTINE cice_sbc_force
	824
	825	SUBROUTINE nemo2cice( pn, pc, cd_type, psgn)
	826	!!---------------------------------------------------------------------
	827	!! * ROUTINE nemo2cice *
	828	!! ** Purpose : Transfer field in NEMO array to field in CICE array.
	829	#if defined key_nemocice_decomp
	830	!!
	831	!! NEMO and CICE PE sub domains are identical, hence
	832	!! there is no need to gather or scatter data from
	833	!! one PE configuration to another.
	834	#else
	835	!! Automatically gather/scatter between
	836	!! different processors and blocks
	837	!! ** Method : A. Ensure all haloes are filled in NEMO field (pn)
	838	!! B. Gather pn into global array (png)
	839	!! C. Map png into CICE global array (pcg)
	840	!! D. Scatter pcg to CICE blocks (pc) + update haloes
	841	#endif
	842	!!---------------------------------------------------------------------
[3193]	843	CHARACTER(len=1), INTENT( in ) :: &
	844	cd_type ! nature of pn grid-point
	845	! ! = T or F gridpoints
	846	REAL(wp), INTENT( in ) :: &
	847	psgn ! control of the sign change
	848	! ! =-1 , the sign is modified following the type of b.c. used
	849	! ! = 1 , no sign change
	850	REAL(wp), DIMENSION(jpi,jpj) :: pn
[2874]	851	#if !defined key_nemocice_decomp
[3625]	852	REAL(wp), DIMENSION(jpiglo,jpjglo) :: png2
[3193]	853	REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg
[2874]	854	#endif
[3193]	855	REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc
	856	INTEGER (int_kind) :: &
	857	field_type, &! id for type of field (scalar, vector, angle)
	858	grid_loc ! id for location on horizontal grid
[2874]	859	! (center, NEcorner, Nface, Eface)
	860
[3193]	861	INTEGER :: ji, jj, jn ! dummy loop indices
[5836]	862	!!---------------------------------------------------------------------
[2874]	863
[3193]	864	! A. Ensure all haloes are filled in NEMO field (pn)
[2874]	865
[10425]	866	CALL lbc_lnk( 'sbcice_cice', pn , cd_type, psgn )
[2874]	867
	868	#if defined key_nemocice_decomp
	869
[3193]	870	! Copy local domain data from NEMO to CICE field
	871	pc(:,:,1)=0.0
[3625]	872	DO jj=2,ny_block-1
	873	DO ji=2,nx_block-1
	874	pc(ji,jj,1)=pn(ji-1+ji_off,jj-1+jj_off)
[3193]	875	ENDDO
	876	ENDDO
[2874]	877
	878	#else
	879
[3193]	880	! B. Gather pn into global array (png)
[2874]	881
[3193]	882	IF ( jpnij > 1) THEN
	883	CALL mppsync
	884	CALL mppgather (pn,0,png)
	885	CALL mppsync
	886	ELSE
	887	png(:,:,1)=pn(:,:)
	888	ENDIF
[2874]	889
[3193]	890	! C. Map png into CICE global array (pcg)
[2874]	891
	892	! Need to make sure this is robust to changes in NEMO halo rows....
	893	! (may be OK but not 100% sure)
	894
[3193]	895	IF (nproc==0) THEN
[2874]	896	! pcg(:,:)=0.0
[3193]	897	DO jn=1,jpnij
[3625]	898	DO jj=nldjt(jn),nlejt(jn)
	899	DO ji=nldit(jn),nleit(jn)
	900	png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn)
[3193]	901	ENDDO
	902	ENDDO
	903	ENDDO
[3625]	904	DO jj=1,ny_global
	905	DO ji=1,nx_global
	906	pcg(ji,jj)=png2(ji+ji_off,jj+jj_off)
	907	ENDDO
	908	ENDDO
[3193]	909	ENDIF
[2874]	910
	911	#endif
	912
[3193]	913	SELECT CASE ( cd_type )
	914	CASE ( 'T' )
	915	grid_loc=field_loc_center
	916	CASE ( 'F' )
	917	grid_loc=field_loc_NEcorner
	918	END SELECT
[2874]	919
[3193]	920	SELECT CASE ( NINT(psgn) )
	921	CASE ( -1 )
	922	field_type=field_type_vector
	923	CASE ( 1 )
	924	field_type=field_type_scalar
	925	END SELECT
[2874]	926
	927	#if defined key_nemocice_decomp
[3193]	928	! Ensure CICE halos are up to date
	929	CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type)
[2874]	930	#else
[3193]	931	! D. Scatter pcg to CICE blocks (pc) + update halos
	932	CALL scatter_global(pc, pcg, 0, distrb_info, grid_loc, field_type)
[2874]	933	#endif
	934
	935	END SUBROUTINE nemo2cice
	936
	937	SUBROUTINE cice2nemo ( pc, pn, cd_type, psgn )
	938	!!---------------------------------------------------------------------
	939	!! * ROUTINE cice2nemo *
	940	!! ** Purpose : Transfer field in CICE array to field in NEMO array.
	941	#if defined key_nemocice_decomp
	942	!!
	943	!! NEMO and CICE PE sub domains are identical, hence
	944	!! there is no need to gather or scatter data from
	945	!! one PE configuration to another.
	946	#else
	947	!! Automatically deal with scatter/gather between
	948	!! different processors and blocks
	949	!! ** Method : A. Gather CICE blocks (pc) into global array (pcg)
	950	!! B. Map pcg into NEMO global array (png)
	951	!! C. Scatter png into NEMO field (pn) for each processor
	952	!! D. Ensure all haloes are filled in pn
	953	#endif
	954	!!---------------------------------------------------------------------
	955
[3193]	956	CHARACTER(len=1), INTENT( in ) :: &
	957	cd_type ! nature of pn grid-point
	958	! ! = T or F gridpoints
	959	REAL(wp), INTENT( in ) :: &
	960	psgn ! control of the sign change
	961	! ! =-1 , the sign is modified following the type of b.c. used
	962	! ! = 1 , no sign change
	963	REAL(wp), DIMENSION(jpi,jpj) :: pn
[2874]	964
	965	#if defined key_nemocice_decomp
[3193]	966	INTEGER (int_kind) :: &
	967	field_type, & ! id for type of field (scalar, vector, angle)
	968	grid_loc ! id for location on horizontal grid
	969	! (center, NEcorner, Nface, Eface)
[2874]	970	#else
[3193]	971	REAL (kind=dbl_kind), dimension(nx_global,ny_global) :: pcg
[2874]	972	#endif
	973
[3193]	974	REAL (kind=dbl_kind), dimension(nx_block,ny_block,max_blocks) :: pc
[2874]	975
[3193]	976	INTEGER :: ji, jj, jn ! dummy loop indices
[2874]	977
	978
	979	#if defined key_nemocice_decomp
	980
[3193]	981	SELECT CASE ( cd_type )
	982	CASE ( 'T' )
	983	grid_loc=field_loc_center
	984	CASE ( 'F' )
	985	grid_loc=field_loc_NEcorner
	986	END SELECT
[2874]	987
[3193]	988	SELECT CASE ( NINT(psgn) )
	989	CASE ( -1 )
	990	field_type=field_type_vector
	991	CASE ( 1 )
	992	field_type=field_type_scalar
	993	END SELECT
[2874]	994
[3193]	995	CALL ice_HaloUpdate (pc, halo_info, grid_loc, field_type)
[2874]	996
	997
[3193]	998	pn(:,:)=0.0
	999	DO jj=1,jpjm1
	1000	DO ji=1,jpim1
[3625]	1001	pn(ji,jj)=pc(ji+1-ji_off,jj+1-jj_off,1)
[3193]	1002	ENDDO
	1003	ENDDO
[2874]	1004
	1005	#else
	1006
[3193]	1007	! A. Gather CICE blocks (pc) into global array (pcg)
[2874]	1008
[3193]	1009	CALL gather_global(pcg, pc, 0, distrb_info)
[2874]	1010
	1011	! B. Map pcg into NEMO global array (png)
	1012
	1013	! Need to make sure this is robust to changes in NEMO halo rows....
	1014	! (may be OK but not spent much time thinking about it)
[3625]	1015	! Note that non-existent pcg elements may be used below, but
	1016	! the lbclnk call on pn will replace these with sensible values
[2874]	1017
[3193]	1018	IF (nproc==0) THEN
	1019	png(:,:,:)=0.0
	1020	DO jn=1,jpnij
[3625]	1021	DO jj=nldjt(jn),nlejt(jn)
	1022	DO ji=nldit(jn),nleit(jn)
	1023	png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off)
[3193]	1024	ENDDO
	1025	ENDDO
	1026	ENDDO
	1027	ENDIF
[2874]	1028
[3193]	1029	! C. Scatter png into NEMO field (pn) for each processor
[2874]	1030
[3193]	1031	IF ( jpnij > 1) THEN
	1032	CALL mppsync
	1033	CALL mppscatter (png,0,pn)
	1034	CALL mppsync
	1035	ELSE
	1036	pn(:,:)=png(:,:,1)
	1037	ENDIF
[2874]	1038
	1039	#endif
	1040
[3193]	1041	! D. Ensure all haloes are filled in pn
[2874]	1042
[10425]	1043	CALL lbc_lnk( 'sbcice_cice', pn , cd_type, psgn )
[2874]	1044
	1045	END SUBROUTINE cice2nemo
	1046
	1047	#else
	1048	!!----------------------------------------------------------------------
	1049	!! Default option Dummy module NO CICE sea-ice model
	1050	!!----------------------------------------------------------------------
	1051	CONTAINS
	1052
[4990]	1053	SUBROUTINE sbc_ice_cice ( kt, ksbc ) ! Dummy routine
[9927]	1054	IMPLICIT NONE
	1055	INTEGER, INTENT( in ) :: kt, ksbc
[2874]	1056	WRITE(,) 'sbc_ice_cice: You should not have seen this print! error?', kt
	1057	END SUBROUTINE sbc_ice_cice
	1058
[11053]	1059	SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm) ! Dummy routine
[9927]	1060	IMPLICIT NONE
	1061	INTEGER, INTENT( in ) :: ksbc
[11053]	1062	INTEGER, INTENT( in ) :: Kbb, Kmm
[9927]	1063	WRITE(,) 'cice_sbc_init: You should not have seen this print! error?', ksbc
[2874]	1064	END SUBROUTINE cice_sbc_init
	1065
	1066	SUBROUTINE cice_sbc_final ! Dummy routine
[9927]	1067	IMPLICIT NONE
[2874]	1068	WRITE(,) 'cice_sbc_final: You should not have seen this print! error?'
	1069	END SUBROUTINE cice_sbc_final
	1070
	1071	#endif
	1072
	1073	!!======================================================================
	1074	END MODULE sbcice_cice

Note: See TracBrowser for help on using the repository browser.

Download in other formats: