source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 4161

Last change on this file since 4161 was 4161, checked in by cetlod, 7 years ago

dev_LOCEAN_2013 : merge in the 3rd dev branch dev_r4028_CNRS_LIM3, see ticket #1169

  • Property svn:keywords set to Id
File size: 29.6 KB
Line 
1MODULE limwri
2   !!======================================================================
3   !!                     ***  MODULE  limwri  ***
4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                      LIM3 sea-ice model
9   !!----------------------------------------------------------------------
10   !!   lim_wri      : write of the diagnostics variables in ouput file
11   !!   lim_wri_init : initialization and namelist read
12   !!   lim_wri_state : write for initial state or/and abandon
13   !!----------------------------------------------------------------------
14   USE ioipsl
15   USE dianam          ! build name of file (routine)
16   USE phycst
17   USE dom_oce
18   USE sbc_oce         ! Surface boundary condition: ocean fields
19   USE sbc_ice         ! Surface boundary condition: ice fields
20   USE dom_ice
21   USE ice
22   USE limvar
23   USE in_out_manager
24   USE lbclnk
25   USE lib_mpp         ! MPP library
26   USE wrk_nemo        ! work arrays
27   USE par_ice
28   USE iom
29   USE timing          ! Timing
30   USE lib_fortran     ! Fortran utilities
31
32   IMPLICIT NONE
33   PRIVATE
34
35   PUBLIC lim_wri        ! routine called by lim_step.F90
36   PUBLIC lim_wri_state  ! called by dia_wri_state
37
38   INTEGER, PARAMETER ::   jpnoumax = 43   !: maximum number of variable for ice output
39   
40   INTEGER  ::   noumef             ! number of fields
41   INTEGER  ::   noumefa            ! number of additional fields
42   INTEGER  ::   add_diag_swi       ! additional diagnostics
43   INTEGER  ::   nz                                         ! dimension for the itd field
44
45   REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant
46   REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant
47   REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant
48   REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant
49   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field
50   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field
51   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field
52   INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 )
53
54   REAL(wp)  ::   epsi06 = 1e-6_wp
55   REAL(wp)  ::   zzero  = 0._wp
56   REAL(wp)  ::   zone   = 1._wp     
57   !!----------------------------------------------------------------------
58   !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
59   !! $Id$
60   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
61   !!----------------------------------------------------------------------
62CONTAINS
63
64#if defined key_dimgout
65# include "limwri_dimg.h90"
66#else
67
68   SUBROUTINE lim_wri( kindic )
69      !!-------------------------------------------------------------------
70      !!  This routine computes the average of some variables and write it
71      !!  on the ouput files.
72      !!  ATTENTION cette routine n'est valable que si le pas de temps est
73      !!  egale a une fraction entiere de 1 jours.
74      !!  Diff 1-D 3-D : suppress common also included in etat
75      !!                 suppress cmoymo 11-18
76      !!  modif : 03/06/98
77      !!-------------------------------------------------------------------
78      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
79      !
80      INTEGER ::  ji, jj, jk, jl, jf, ipl ! dummy loop indices
81      INTEGER ::  ierr
82      REAL(wp),DIMENSION(1) ::   zdept
83      REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb, zindc
84      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa
85      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield
86      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei
87
88      CHARACTER(len = 60) ::   clhstnam, clop, clhstnama
89
90      INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
91      INTEGER , SAVE ::   nicea, nhorida, ndimitd
92      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51
93      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd
94      !!-------------------------------------------------------------------
95
96      IF( nn_timing == 1 )  CALL timing_start('limwri')
97
98      CALL wrk_alloc( jpi, jpj, zfield )
99      CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
100      CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
101
102      ipl = jpl
103
104      IF( numit == nstart ) THEN
105
106         ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr )
107         IF( lk_mpp    )   CALL mpp_sum ( ierr )
108         IF( ierr /= 0 ) THEN
109            CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN
110         ENDIF
111
112         CALL lim_wri_init 
113
114         IF(lwp) WRITE(numout,*) ' lim_wri, first time step '
115         IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi
116
117         !--------------------
118         !  1) Initialization
119         !--------------------
120
121         !-------------
122         ! Normal file
123         !-------------
124         niter    = ( nit000 - 1 ) / nn_fsbc
125         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
126         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
127!clem
128!         zsto     = rdt_ice
129!         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
130!         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
131!         ENDIF
132!         zout     = nwrite * rdt_ice / nn_fsbc
133!         zdept(1) = 0.
134!
135!         CALL dia_nam ( clhstnam, nwrite, 'icemod_old' )
136!         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   &
137!            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set )
138!         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
139!         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
140!
141!         DO jf = 1 , noumef
142!            IF(lwp) WRITE(numout,*) 'jf', jf
143!            IF ( nc(jf) == 1 ) THEN
144!               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
145!                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
146!               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout'
147!               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout
148!            ENDIF
149!         END DO
150!
151!         CALL histend(nice, snc4set)
152!clem
153         !
154         !-----------------
155         ! ITD file output
156         !-----------------
157         zsto     = rdt_ice
158         clop     = "ave(x)"
159         zout     = nwrite * rdt_ice / nn_fsbc
160         zdept(1) = 0.
161
162         CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
163         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         &
164            1, jpi, 1, jpj,            & ! zoom
165            niter, zjulian, rdt_ice,   & ! time
166            nhorida,                   & ! ? linked with horizontal ...
167            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file
168         CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz )
169         DO jl = 1, jpl
170            zmaskitd(:,:,jl) = tmask(:,:,1)
171         END DO
172         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
173         CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  ) 
174         CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   & 
175            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
176         CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   & 
177            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
178         CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   & 
179            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
180         CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   & 
181            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
182         CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   & 
183            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
184         CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   & 
185            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
186         CALL histend(nicea, snc4set)
187      ENDIF
188
189      !     !-----------------------------------------------------------------------!
190      !     !--2. Computation of instantaneous values                               !
191      !     !-----------------------------------------------------------------------!
192
193      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
194      IF( ln_nicep ) THEN
195         WRITE(numout,*)
196         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
197         WRITE(numout,*) '~~~~~~~ '
198         WRITE(numout,*) ' kindic = ', kindic
199      ENDIF
200      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
201
202      !-- calculs des valeurs instantanees
203      zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
204      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
205
206      ! Ice surface temperature and some fluxes
207      DO jl = 1, jpl
208         DO jj = 1, jpj
209            DO ji = 1, jpi
210               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
211               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 
212               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 
213               zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda*(t_su(ji,jj,jl)-rtt)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)
214               zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
215            END DO
216         END DO
217      END DO
218
219      ! Mean sea ice temperature
220      CALL lim_var_icetm
221
222      ! Brine volume
223      CALL lim_var_bv
224
225      DO jj = 2 , jpjm1
226         DO ji = 2 , jpim1
227            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
228            zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) )
229
230            zcmo(ji,jj,1)  = at_i(ji,jj)
231            zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
232            zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
233            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * rday     ! Bottom thermodynamic ice production
234            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * rday     ! Dynamic ice production (rid/raft)
235            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday     ! Lateral thermodynamic ice production
236            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday     ! Snow ice production ice production
237            zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda
238
239            zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj)
240            zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
241            zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
242            zcmo(ji,jj,9)  = sst_m(ji,jj)
243            zcmo(ji,jj,10) = sss_m(ji,jj)
244
245            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
246            zcmo(ji,jj,12) = qsr(ji,jj)
247            zcmo(ji,jj,13) = qns(ji,jj)
248            zcmo(ji,jj,14) = fhbri(ji,jj)
249            zcmo(ji,jj,15) = utau_ice(ji,jj)
250            zcmo(ji,jj,16) = vtau_ice(ji,jj)
251            zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj)
252            zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj)
253            zcmo(ji,jj,19) = sprecip(ji,jj)
254            zcmo(ji,jj,20) = smt_i(ji,jj)
255            zcmo(ji,jj,25) = et_i(ji,jj)
256            zcmo(ji,jj,26) = et_s(ji,jj)
257            zcmo(ji,jj,28) = sfx_bri(ji,jj)
258            zcmo(ji,jj,29) = sfx_thd(ji,jj)
259
260            zcmo(ji,jj,30) = bv_i(ji,jj)
261            zcmo(ji,jj,31) = hicol(ji,jj) * zindb
262            zcmo(ji,jj,32) = strength(ji,jj)
263            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  )
264            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday     ! Surface melt
265            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday     ! Bottom melt
266            zcmo(ji,jj,36) = divu_i(ji,jj)
267            zcmo(ji,jj,37) = shear_i(ji,jj)
268            zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday     ! Bottom melt
269            zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume
270            zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume
271
272            zcmo(ji,jj,41) = sfx_mec(ji,jj)
273            zcmo(ji,jj,42) = sfx_res(ji,jj)
274
275            zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday     ! transport of ice volume
276
277        END DO
278      END DO
279
280      !
281      ! ecriture d'un fichier netcdf
282      !
283      niter = niter + 1
284!clem
285!      DO jf = 1 , noumef
286!         !
287!         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf)
288!         !
289!         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. )
290!         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. )
291!         ENDIF
292!         !
293!         IF( ln_nicep ) THEN
294!            WRITE(numout,*)
295!            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
296!            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
297!         ENDIF
298!         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
299!         !
300!      END DO
301!
302!      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
303!         IF( lwp) WRITE(numout,*) ' Closing the icemod file '
304!         CALL histclo( nice )
305!      ENDIF
306!clem
307      !
308       CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration
309       CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:))
310       CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness
311       CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production
312       CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production
313       CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base
314       CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component
315       CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component
316       CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature
317       CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity
318       CALL iom_put ('qt_oce', zcmo(:,:,11) )           ! field 11: total flux at ocean surface
319       CALL iom_put ('qsr_oce', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface
320       CALL iom_put ('qns_oce', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface
321       !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release
322       CALL iom_put( 'utau_ice', zcmo(:,:,15)  )     ! Wind stress over ice along i-axis at I-point
323       CALL iom_put( 'vtau_ice', zcmo(:,:,16) )     ! Wind stress over ice along j-axis at I-point
324       CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface
325       CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface
326       !CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip         
327       CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity
328       CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age
329       CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod.
330       CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod.
331       CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature
332       CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content
333       CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content
334       CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature
335       CALL iom_put ('sfxbri', zcmo(:,:,28) * rday )           ! field 28: brine salt flux
336       CALL iom_put ('sfxthd', zcmo(:,:,29) * rday )           ! field 29: equivalent FW salt flux
337       CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume
338       CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness
339       CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength
340       CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity
341       CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt
342       CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt
343       CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence
344       CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear
345       CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate
346       CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume
347       CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume
348       CALL iom_put ('sfxmec', zcmo(:,:,41) * rday )           ! field 41: salt flux from ridging rafting
349       CALL iom_put ('sfxres', zcmo(:,:,42) * rday )           ! field 42: salt flux from limupdate (resultant)
350       CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport
351
352      !-----------------------------
353      ! Thickness distribution file
354      !-----------------------------
355      IF( add_diag_swi == 1 ) THEN
356
357         DO jl = 1, jpl 
358            CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. )
359            CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. )
360            CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. )
361            CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. )
362            CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. )
363         END DO
364
365         ! Compute ice age
366         DO jl = 1, jpl 
367            DO jj = 1, jpj
368               DO ji = 1, jpi
369                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
370                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda
371               END DO
372            END DO
373         END DO
374
375         ! Compute brine volume
376         zei(:,:,:) = 0._wp
377         DO jl = 1, jpl 
378            DO jk = 1, nlay_i
379               DO jj = 1, jpj
380                  DO ji = 1, jpi
381                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
382                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
383                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
384                        zinda / nlay_i
385                  END DO
386               END DO
387            END DO
388         END DO
389
390         DO jl = 1, jpl 
391            CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. )
392         END DO
393
394         CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area
395         CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness
396         CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth
397         CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity
398         CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age
399         CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume
400
401         !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
402         !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
403         !     not yet implemented
404
405         IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
406            IF(lwp) WRITE(numout,*) ' Closing the icemod file '
407            CALL histclo( nicea ) 
408         ENDIF
409         !
410      ENDIF
411
412      CALL wrk_dealloc( jpi, jpj, zfield )
413      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
414      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
415
416      IF( nn_timing == 1 )  CALL timing_stop('limwri')
417     
418   END SUBROUTINE lim_wri
419#endif
420
421   SUBROUTINE lim_wri_init
422      !!-------------------------------------------------------------------
423      !!                    ***   ROUTINE lim_wri_init  ***
424      !!               
425      !! ** Purpose :   ???
426      !!
427      !! ** Method  : Read the namicewri namelist and check the parameter
428      !!       values called at the first timestep (nit000)
429      !!
430      !! ** input   :   Namelist namicewri
431      !!-------------------------------------------------------------------
432      INTEGER ::   nf      ! ???
433      INTEGER ::   ios     ! Local integer output status for namelist read
434
435      TYPE FIELD 
436         CHARACTER(len = 35) :: ztitle 
437         CHARACTER(len = 8 ) :: zname         
438         CHARACTER(len = 8 ) :: zunit
439         INTEGER             :: znc   
440         REAL                :: zcmulti 
441         REAL                :: zcadd       
442      END TYPE FIELD
443
444      TYPE(FIELD) ::  &
445         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
446         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
447         field_13, field_14, field_15, field_16, field_17, field_18,   &
448         field_19, field_20, field_21, field_22, field_23, field_24,   &
449         field_25, field_26, field_27, field_28, field_29, field_30,   &
450         field_31, field_32, field_33, field_34, field_35, field_36,   &
451         field_37, field_38, field_39, field_40, field_41, field_42, field_43
452
453      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
454      !
455      NAMELIST/namiceout/ noumef, &
456         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
457         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
458         field_13, field_14, field_15, field_16, field_17, field_18,   &
459         field_19, field_20, field_21, field_22, field_23, field_24,   &
460         field_25, field_26, field_27, field_28, field_29, field_30,   &
461         field_31, field_32, field_33, field_34, field_35, field_36,   &
462         field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi
463      !!-------------------------------------------------------------------
464      REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs
465      READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
466901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
467
468      REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs
469      READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
470902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
471      WRITE ( numoni, namiceout )
472
473      zfield(1)  = field_1
474      zfield(2)  = field_2
475      zfield(3)  = field_3
476      zfield(4)  = field_4
477      zfield(5)  = field_5
478      zfield(6)  = field_6
479      zfield(7)  = field_7
480      zfield(8)  = field_8
481      zfield(9)  = field_9
482      zfield(10) = field_10
483      zfield(11) = field_11
484      zfield(12) = field_12
485      zfield(13) = field_13
486      zfield(14) = field_14
487      zfield(15) = field_15
488      zfield(16) = field_16
489      zfield(17) = field_17
490      zfield(18) = field_18
491      zfield(19) = field_19
492      zfield(20) = field_20
493      zfield(21) = field_21
494      zfield(22) = field_22
495      zfield(23) = field_23
496      zfield(24) = field_24
497      zfield(25) = field_25
498      zfield(26) = field_26
499      zfield(27) = field_27
500      zfield(28) = field_28
501      zfield(29) = field_29
502      zfield(30) = field_30
503      zfield(31) = field_31
504      zfield(32) = field_32
505      zfield(33) = field_33
506      zfield(34) = field_34
507      zfield(35) = field_35
508      zfield(36) = field_36
509      zfield(37) = field_37
510      zfield(38) = field_38
511      zfield(39) = field_39
512      zfield(40) = field_40
513      zfield(41) = field_41
514      zfield(42) = field_42
515      zfield(43) = field_43
516
517      DO nf = 1, noumef
518         titn  (nf) = zfield(nf)%ztitle
519         nam   (nf) = zfield(nf)%zname
520         uni   (nf) = zfield(nf)%zunit
521         nc    (nf) = zfield(nf)%znc
522         cmulti(nf) = zfield(nf)%zcmulti
523         cadd  (nf) = zfield(nf)%zcadd
524      END DO
525
526      IF(lwp) THEN                        ! control print
527         WRITE(numout,*)
528         WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
529         WRITE(numout,*) '~~~~~~~~~~~~'
530         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
531         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
532            &            '    multiplicative constant       additive constant '
533         DO nf = 1 , noumef         
534            WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   &
535               &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf)
536         END DO
537         WRITE(numout,*) ' add_diag_swi ', add_diag_swi
538      ENDIF
539      !
540   END SUBROUTINE lim_wri_init
541 
542   SUBROUTINE lim_wri_state( kt, kid, kh_i )
543      !!---------------------------------------------------------------------
544      !!                 ***  ROUTINE lim_wri_state  ***
545      !!       
546      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
547      !!      the instantaneous ice state and forcing fields for ice model
548      !!        Used to find errors in the initial state or save the last
549      !!      ocean state in case of abnormal end of a simulation
550      !!
551      !! History :
552      !!   4.1  !  2013-06  (C. Rousset)
553      !!----------------------------------------------------------------------
554      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
555      INTEGER, INTENT( in ) ::   kid , kh_i       
556      !!----------------------------------------------------------------------
557      !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz )
558
559      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
560      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
561      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
562      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
563      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
564      CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
565      CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
566      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
567      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
568      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
569      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
570      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
571      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
572
573      !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
574      !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
575      !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
576      !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
577
578      CALL histend( kid, snc4set )   ! end of the file definition
579
580      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )   
581      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) )
582      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) )
583      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
584      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
585      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
586      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
587      CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) )
588      CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) )
589      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
590      CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) )
591      CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) )
592      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
593
594      !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area
595      !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness
596      !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth
597      !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity
598
599    END SUBROUTINE lim_wri_state
600
601#else
602   !!----------------------------------------------------------------------
603   !!   Default option :         Empty module          NO LIM sea-ice model
604   !!----------------------------------------------------------------------
605CONTAINS
606   SUBROUTINE lim_wri          ! Empty routine
607   END SUBROUTINE lim_wri
608#endif
609
610   !!======================================================================
611END MODULE limwri
Note: See TracBrowser for help on using the repository browser.