source: branches/2012/dev_r3385_NOCS04_HAMF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90 @ 3488

Last change on this file since 3488 was 3488, checked in by acc, 9 years ago

Branch: dev_r3385_NOCS04_HAMF; #665. Stage 3 of 2012 development: Rationalisation of code. Added LIM3 changes, corrected coupled changes and highlighted areas of concern in CICE interface

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