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.
limwri.F90 in branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2013/dev_r3406_CNRS_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 3938

Last change on this file since 3938 was 3938, checked in by flavoni, 11 years ago

dev_r3406_CNRS_LIM3: update LIM3, see ticket #1116

  • Property svn:keywords set to Id
File size: 28.8 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 = 40) ::   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
125         zsto     = rdt_ice
126         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
127         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
128         ENDIF
129         zout     = nwrite * rdt_ice / nn_fsbc
130         niter    = ( nit000 - 1 ) / nn_fsbc
131         zdept(1) = 0.
132
133         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
134         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
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
153         !-----------------
154         ! ITD file output
155         !-----------------
156         zsto     = rdt_ice
157         clop     = "ave(x)"
158         zout     = nwrite * rdt_ice / nn_fsbc
159         zdept(1) = 0.
160
161         CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
162         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         &
163            1, jpi, 1, jpj,            & ! zoom
164            niter, zjulian, rdt_ice,   & ! time
165            nhorida,                   & ! ? linked with horizontal ...
166            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file
167         CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz )
168         DO jl = 1, jpl
169            zmaskitd(:,:,jl) = tmask(:,:,1)
170         END DO
171         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
172         CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  ) 
173         CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   & 
174            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
175         CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   & 
176            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
177         CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   & 
178            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
179         CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   & 
180            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
181         CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   & 
182            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
183         CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   & 
184            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
185         CALL histend(nicea, snc4set)
186      ENDIF
187
188      !     !-----------------------------------------------------------------------!
189      !     !--2. Computation of instantaneous values                               !
190      !     !-----------------------------------------------------------------------!
191
192      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
193      IF( ln_nicep ) THEN
194         WRITE(numout,*)
195         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
196         WRITE(numout,*) '~~~~~~~ '
197         WRITE(numout,*) ' kindic = ', kindic
198      ENDIF
199      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
200
201      !-- calculs des valeurs instantanees
202      zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
203      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
204
205      ! Ice surface temperature and some fluxes
206      DO jl = 1, jpl
207         DO jj = 1, jpj
208            DO ji = 1, jpi
209               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
210               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 
211               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 
212               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)
213               zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06) 
214            END DO
215         END DO
216      END DO
217
218      ! Mean sea ice temperature
219      CALL lim_var_icetm
220
221      ! Brine volume
222      CALL lim_var_bv
223
224      DO jj = 2 , jpjm1
225         DO ji = 2 , jpim1
226            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
227            zindb  = MAX( zzero , SIGN( zone , at_i(ji,jj) ) )
228
229            zcmo(ji,jj,1)  = at_i(ji,jj)
230            zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
231            zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
232            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0     ! Bottom thermodynamic ice production
233            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0     ! Dynamic ice production (rid/raft)
234            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0     ! Lateral thermodynamic ice production
235            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0     ! Snow ice production ice production
236            zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda
237
238            zcmo(ji,jj,6)  = fbif(ji,jj)*at_i(ji,jj)
239            zcmo(ji,jj,7)  = (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
240            zcmo(ji,jj,8)  = (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
241            zcmo(ji,jj,9)  = sst_m(ji,jj)
242            zcmo(ji,jj,10) = sss_m(ji,jj)
243
244            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
245            zcmo(ji,jj,12) = qsr(ji,jj)
246            zcmo(ji,jj,13) = qns(ji,jj)
247            zcmo(ji,jj,14) = fhbri(ji,jj)
248            zcmo(ji,jj,15) = utau_ice(ji,jj)
249            zcmo(ji,jj,16) = vtau_ice(ji,jj)
250            zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj)
251            zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj)
252            zcmo(ji,jj,19) = sprecip(ji,jj)
253            zcmo(ji,jj,20) = smt_i(ji,jj)
254            zcmo(ji,jj,25) = et_i(ji,jj)
255            zcmo(ji,jj,26) = et_s(ji,jj)
256            zcmo(ji,jj,28) = fsbri(ji,jj)
257            zcmo(ji,jj,29) = fseqv(ji,jj)
258
259            zcmo(ji,jj,30) = bv_i(ji,jj)
260            zcmo(ji,jj,31) = hicol(ji,jj) * zindb
261            zcmo(ji,jj,32) = strength(ji,jj)
262            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  )
263            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0     ! Surface melt
264            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0     ! Bottom melt
265            zcmo(ji,jj,36) = divu_i(ji,jj)
266            zcmo(ji,jj,37) = shear_i(ji,jj)
267            zcmo(ji,jj,38) = diag_res_pr(ji,jj) * 86400.0     ! Bottom melt
268            zcmo(ji,jj,39) = vt_i(ji,jj)  ! ice volume
269            zcmo(ji,jj,40) = vt_s(ji,jj)  ! snow volume
270
271            zcmo(ji,jj,41) = fsalt_rpo(ji,jj)
272            zcmo(ji,jj,42) = fsalt_res(ji,jj)
273
274            zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * 86400.0     ! transport of ice volume
275
276        END DO
277      END DO
278
279      !
280      ! ecriture d'un fichier netcdf
281      !
282      niter = niter + 1
283      DO jf = 1 , noumef
284         !
285         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf)
286         !
287         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. )
288         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. )
289         ENDIF
290         !
291         IF( ln_nicep ) THEN
292            WRITE(numout,*)
293            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
294            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
295         ENDIF
296         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
297         !
298      END DO
299
300      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
301         IF( lwp) WRITE(numout,*) ' Closing the icemod file '
302         CALL histclo( nice )
303      ENDIF
304
305       CALL iom_put ('iceconc', zcmo(:,:,1) )          ! field1: ice concentration
306       CALL iom_put ('icethic_cea', zcmo(:,:,2) )      ! field2: ice thickness (i.e. icethi(:,:))
307       CALL iom_put ('snowthic_cea', zcmo(:,:,3))      ! field3: snow thickness
308       CALL iom_put ('icebopr', zcmo(:,:,4) )   ! field4: daily bottom thermo ice production
309       CALL iom_put ('icedypr', zcmo(:,:,5) )   ! field5: daily dynamic ice production
310       CALL iom_put ('ioceflxb', zcmo(:,:,6) )         ! field6: Oceanic flux at the ice base
311       CALL iom_put ('uice_ipa', zcmo(:,:,7) )         ! field7: ice velocity u component
312       CALL iom_put ('vice_ipa', zcmo(:,:,8) )         ! field8: ice velocity v component
313       CALL iom_put ('isst', zcmo(:,:,9) )             ! field 9: sea surface temperature
314       CALL iom_put ('isss', zcmo(:,:,10) )            ! field 10: sea surface salinity
315       CALL iom_put ('qt_oc', zcmo(:,:,11) )           ! field 11: total flux at ocean surface
316       CALL iom_put ('qsr_oc', zcmo(:,:,12) )          ! field 12: solar flux at ocean surface
317       CALL iom_put ('qns_oc', zcmo(:,:,13) )          ! field 13: non-solar flux at ocean surface
318       !CALL iom_put ('hfbri', fhbri )                  ! field 14: heat flux due to brine release
319       CALL iom_put ('qsr_io', zcmo(:,:,17) )          ! field 17: solar flux at ice/ocean surface
320       CALL iom_put ('qns_io', zcmo(:,:,18) )          ! field 18: non-solar flux at ice/ocean surface
321       !CALL iom_put ('snowpre', zcmo(:,:,19) * 86400) ! field 19 :snow precip         
322       CALL iom_put ('micesalt', zcmo(:,:,20) )        ! field 20 :mean ice salinity
323       CALL iom_put ('miceage', zcmo(:,:,21) / 365)    ! field 21: mean ice age
324       CALL iom_put ('icelapr',zcmo(:,:,22) )   ! field 22: daily lateral thermo ice prod.
325       CALL iom_put ('icesipr',zcmo(:,:,23) )   ! field 23: daily snowice ice prod.
326       CALL iom_put ('micet', zcmo(:,:,24) )           ! field 24: mean ice temperature
327       CALL iom_put ('icehc', zcmo(:,:,25) )           ! field 25: ice total heat content
328       CALL iom_put ('isnowhc', zcmo(:,:,26) )         ! field 26: snow total heat content
329       CALL iom_put ('icest', zcmo(:,:,27) )           ! field 27: ice surface temperature
330       CALL iom_put ('fsbri', zcmo(:,:,28) * 86400 )           ! field 28: brine salt flux
331       CALL iom_put ('fseqv', zcmo(:,:,29) * 86400 )           ! field 29: equivalent FW salt flux
332       CALL iom_put ('ibrinv', zcmo(:,:,30) *100 )     ! field 30: brine volume
333       CALL iom_put ('icecolf', zcmo(:,:,31) )         ! field 31: frazil ice collection thickness
334       CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 )  ! field 32: ice strength
335       CALL iom_put ('icevel', zcmo(:,:,33) )          ! field 33: ice velocity
336       CALL iom_put ('isume', zcmo(:,:,34) )    ! field 34: surface melt
337       CALL iom_put ('ibome', zcmo(:,:,35) )     ! field 35: bottom melt
338       CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8)    ! field 36: divergence
339       CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 )  ! field 37: shear
340       CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate
341       CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume
342       CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume
343       CALL iom_put ('fsrpo', zcmo(:,:,41) * 86400 )           ! field 41: salt flux from ridging rafting
344       CALL iom_put ('fsres', zcmo(:,:,42) * 86400 )           ! field 42: salt flux from limupdate (resultant)
345       CALL iom_put ('icetrp', zcmo(:,:,43) )    ! field 43: ice volume transport
346
347      !-----------------------------
348      ! Thickness distribution file
349      !-----------------------------
350      IF( add_diag_swi == 1 ) THEN
351
352         DO jl = 1, jpl 
353            CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. )
354            CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. )
355            CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. )
356            CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. )
357            CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. )
358         END DO
359
360         ! Compute ice age
361         DO jl = 1, jpl 
362            DO jj = 1, jpj
363               DO ji = 1, jpi
364                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
365                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda
366               END DO
367            END DO
368         END DO
369
370         ! Compute brine volume
371         zei(:,:,:) = 0._wp
372         DO jl = 1, jpl 
373            DO jk = 1, nlay_i
374               DO jj = 1, jpj
375                  DO ji = 1, jpi
376                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
377                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
378                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
379                        zinda / nlay_i
380                  END DO
381               END DO
382            END DO
383         END DO
384
385         DO jl = 1, jpl 
386            CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. )
387         END DO
388
389         CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area
390         CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness
391         CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth
392         CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity
393         CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age
394         CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume
395
396         !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
397         !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
398         !     not yet implemented
399
400         IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
401            IF(lwp) WRITE(numout,*) ' Closing the icemod file '
402            CALL histclo( nicea ) 
403         ENDIF
404         !
405      ENDIF
406
407      CALL wrk_dealloc( jpi, jpj, zfield )
408      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
409      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
410
411      IF( nn_timing == 1 )  CALL timing_stop('limwri')
412     
413   END SUBROUTINE lim_wri
414#endif
415
416   SUBROUTINE lim_wri_init
417      !!-------------------------------------------------------------------
418      !!                    ***   ROUTINE lim_wri_init  ***
419      !!               
420      !! ** Purpose :   ???
421      !!
422      !! ** Method  : Read the namicewri namelist and check the parameter
423      !!       values called at the first timestep (nit000)
424      !!
425      !! ** input   :   Namelist namicewri
426      !!-------------------------------------------------------------------
427      INTEGER ::   nf      ! ???
428
429      TYPE FIELD 
430         CHARACTER(len = 35) :: ztitle 
431         CHARACTER(len = 8 ) :: zname         
432         CHARACTER(len = 8 ) :: zunit
433         INTEGER             :: znc   
434         REAL                :: zcmulti 
435         REAL                :: zcadd       
436      END TYPE FIELD
437
438      TYPE(FIELD) ::  &
439         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
440         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
441         field_13, field_14, field_15, field_16, field_17, field_18,   &
442         field_19, field_20, field_21, field_22, field_23, field_24,   &
443         field_25, field_26, field_27, field_28, field_29, field_30,   &
444         field_31, field_32, field_33, field_34, field_35, field_36,   &
445         field_37, field_38, field_39, field_40, field_41, field_42, field_43
446
447      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
448      !
449      NAMELIST/namiceout/ noumef, &
450         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
451         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
452         field_13, field_14, field_15, field_16, field_17, field_18,   &
453         field_19, field_20, field_21, field_22, field_23, field_24,   &
454         field_25, field_26, field_27, field_28, field_29, field_30,   &
455         field_31, field_32, field_33, field_34, field_35, field_36,   &
456         field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi
457      !!-------------------------------------------------------------------
458
459      REWIND( numnam_ice )                ! Read Namelist namicewri
460      READ  ( numnam_ice  , namiceout )
461
462      zfield(1)  = field_1
463      zfield(2)  = field_2
464      zfield(3)  = field_3
465      zfield(4)  = field_4
466      zfield(5)  = field_5
467      zfield(6)  = field_6
468      zfield(7)  = field_7
469      zfield(8)  = field_8
470      zfield(9)  = field_9
471      zfield(10) = field_10
472      zfield(11) = field_11
473      zfield(12) = field_12
474      zfield(13) = field_13
475      zfield(14) = field_14
476      zfield(15) = field_15
477      zfield(16) = field_16
478      zfield(17) = field_17
479      zfield(18) = field_18
480      zfield(19) = field_19
481      zfield(20) = field_20
482      zfield(21) = field_21
483      zfield(22) = field_22
484      zfield(23) = field_23
485      zfield(24) = field_24
486      zfield(25) = field_25
487      zfield(26) = field_26
488      zfield(27) = field_27
489      zfield(28) = field_28
490      zfield(29) = field_29
491      zfield(30) = field_30
492      zfield(31) = field_31
493      zfield(32) = field_32
494      zfield(33) = field_33
495      zfield(34) = field_34
496      zfield(35) = field_35
497      zfield(36) = field_36
498      zfield(37) = field_37
499      zfield(38) = field_38
500      zfield(39) = field_39
501      zfield(40) = field_40
502      zfield(41) = field_41
503      zfield(42) = field_42
504      zfield(43) = field_43
505
506      DO nf = 1, noumef
507         titn  (nf) = zfield(nf)%ztitle
508         nam   (nf) = zfield(nf)%zname
509         uni   (nf) = zfield(nf)%zunit
510         nc    (nf) = zfield(nf)%znc
511         cmulti(nf) = zfield(nf)%zcmulti
512         cadd  (nf) = zfield(nf)%zcadd
513      END DO
514
515      IF(lwp) THEN                        ! control print
516         WRITE(numout,*)
517         WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
518         WRITE(numout,*) '~~~~~~~~~~~~'
519         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
520         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
521            &            '    multiplicative constant       additive constant '
522         DO nf = 1 , noumef         
523            WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   &
524               &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf)
525         END DO
526         WRITE(numout,*) ' add_diag_swi ', add_diag_swi
527      ENDIF
528      !
529   END SUBROUTINE lim_wri_init
530 
531   SUBROUTINE lim_wri_state( kt, kid, kh_i )
532      !!---------------------------------------------------------------------
533      !!                 ***  ROUTINE lim_wri_state  ***
534      !!       
535      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
536      !!      the instantaneous ice state and forcing fields for ice model
537      !!        Used to find errors in the initial state or save the last
538      !!      ocean state in case of abnormal end of a simulation
539      !!
540      !! History :
541      !!   4.1  !  2013-06  (C. Rousset)
542      !!----------------------------------------------------------------------
543      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
544      INTEGER, INTENT( in ) ::   kid , kh_i       
545      !!----------------------------------------------------------------------
546      !CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz )
547
548      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
549      CALL histdef( kid, "iiceconc", "Ice concentration"       , "%"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
550      CALL histdef( kid, "iicetemp", "Ice temperature"         , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
551      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
552      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
553      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 )
554      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 ) 
555      CALL histdef( kid, "iicesflx", "Solar flux over ocean"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
556      CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
557      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
558      CALL histdef( kid, "iicesali", "Ice salinity"            , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
559      CALL histdef( kid, "iicevolu", "Ice volume"              , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
560      CALL histdef( kid, "iicedive", "Ice divergence"          , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
561
562      !CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
563      !CALL histdef( kid, "iice_hid", "Ice thickness by cat"    , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
564      !CALL histdef( kid, "iice_hsd", "Snow thickness by cat"   , "m"      , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
565      !CALL histdef( kid, "iice_std", "Ice salinity by cat"     , "PSU"    , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
566
567      CALL histend( kid, snc4set )   ! end of the file definition
568
569      CALL histwrite( kid, "iicethic", kt, icethi        , jpi*jpj, (/1/) )   
570      CALL histwrite( kid, "iiceconc", kt, at_i          , jpi*jpj, (/1/) )
571      CALL histwrite( kid, "iicetemp", kt, tm_i - rtt    , jpi*jpj, (/1/) )
572      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
573      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
574      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
575      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
576      CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) )
577      CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) )
578      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
579      CALL histwrite( kid, "iicesali", kt, smt_i          , jpi*jpj, (/1/) )
580      CALL histwrite( kid, "iicevolu", kt, vt_i           , jpi*jpj, (/1/) )
581      CALL histwrite( kid, "iicedive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
582
583      !CALL histwrite( kid, "iice_itd", kt, a_i  , jpi*jpj*jpl, (/1/)  )   ! area
584      !CALL histwrite( kid, "iice_hid", kt, ht_i , jpi*jpj*jpl, (/1/)  )   ! thickness
585      !CALL histwrite( kid, "iice_hsd", kt, ht_s , jpi*jpj*jpl, (/1/)  )   ! snow depth
586      !CALL histwrite( kid, "iice_std", kt, sm_i , jpi*jpj*jpl, (/1/)  )   ! salinity
587
588    END SUBROUTINE lim_wri_state
589
590#else
591   !!----------------------------------------------------------------------
592   !!   Default option :         Empty module          NO LIM sea-ice model
593   !!----------------------------------------------------------------------
594CONTAINS
595   SUBROUTINE lim_wri          ! Empty routine
596   END SUBROUTINE lim_wri
597#endif
598
599   !!======================================================================
600END MODULE limwri
Note: See TracBrowser for help on using the repository browser.