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_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

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

Last change on this file since 4147 was 4147, checked in by cetlod, 10 years ago

merge in dev_LOCEAN_2013, the 1st development branch dev_r3853_CNRS9_Confsetting, from its starting point ( r3853 ) on the trunk: see ticket #1169
  • Property svn:keywords set to Id
File size: 20.4 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   !!----------------------------------------------------------------------
13   USE ioipsl
14   USE dianam          ! build name of file (routine)
15   USE phycst
16   USE dom_oce
17   USE sbc_oce         ! Surface boundary condition: ocean fields
18   USE sbc_ice         ! Surface boundary condition: ice fields
19   USE dom_ice
20   USE ice
21   USE limvar
22   USE in_out_manager
23   USE lbclnk
24   USE lib_mpp         ! MPP library
25   USE wrk_nemo        ! work arrays
26   USE par_ice
27   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC lim_wri        ! routine called by lim_step.F90
33
34   INTEGER, PARAMETER ::   jpnoumax = 40   !: maximum number of variable for ice output
35   
36   INTEGER  ::   noumef             ! number of fields
37   INTEGER  ::   noumefa            ! number of additional fields
38   INTEGER  ::   add_diag_swi       ! additional diagnostics
39   INTEGER  ::   nz                                         ! dimension for the itd field
40
41   REAL(wp) , DIMENSION(jpnoumax) ::   cmulti         ! multiplicative constant
42   REAL(wp) , DIMENSION(jpnoumax) ::   cadd           ! additive constant
43   REAL(wp) , DIMENSION(jpnoumax) ::   cmultia        ! multiplicative constant
44   REAL(wp) , DIMENSION(jpnoumax) ::   cadda          ! additive constant
45   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn, titna   ! title of the field
46   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam , nama    ! name of the field
47   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni , unia    ! unit of the field
48   INTEGER            , DIMENSION(jpnoumax) ::   nc  , nca     ! switch for saving field ( = 1 ) or not ( = 0 )
49
50   REAL(wp)  ::   epsi16 = 1e-16_wp
51   REAL(wp)  ::   zzero  = 0._wp
52   REAL(wp)  ::   zone   = 1._wp     
53   !!----------------------------------------------------------------------
54   !! NEMO/LIM3 3.4 , UCL - NEMO Consortium (2011)
55   !! $Id$
56   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
57   !!----------------------------------------------------------------------
58CONTAINS
59
60#if defined key_dimgout
61# include "limwri_dimg.h90"
62#else
63
64   SUBROUTINE lim_wri( kindic )
65      !!-------------------------------------------------------------------
66      !!  This routine computes the average of some variables and write it
67      !!  on the ouput files.
68      !!  ATTENTION cette routine n'est valable que si le pas de temps est
69      !!  egale a une fraction entiere de 1 jours.
70      !!  Diff 1-D 3-D : suppress common also included in etat
71      !!                 suppress cmoymo 11-18
72      !!  modif : 03/06/98
73      !!-------------------------------------------------------------------
74      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
75      !
76      INTEGER ::  ji, jj, jk, jl, jf, ipl ! dummy loop indices
77      INTEGER ::  ierr
78      REAL(wp),DIMENSION(1) ::   zdept
79      REAL(wp) ::  zsto, zjulian, zout, zindh, zinda, zindb
80      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zcmo, zcmoa
81      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zfield
82      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zmaskitd, zoi, zei
83
84      CHARACTER(len = 40) ::   clhstnam, clop, clhstnama
85
86      INTEGER , SAVE ::   nice, nhorid, ndim, niter, ndepid
87      INTEGER , SAVE ::   nicea, nhorida, ndimitd
88      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndex51
89      INTEGER , ALLOCATABLE, DIMENSION(:), SAVE ::   ndexitd
90      !!-------------------------------------------------------------------
91
92      CALL wrk_alloc( jpi, jpj, zfield )
93      CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
94      CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
95
96      ipl = jpl
97
98      IF( numit == nstart ) THEN
99
100         ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr )
101         IF( lk_mpp    )   CALL mpp_sum ( ierr )
102         IF( ierr /= 0 ) THEN
103            CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' )   ;   RETURN
104         ENDIF
105
106         CALL lim_wri_init 
107
108         IF(lwp) WRITE(numout,*) ' lim_wri, first time step '
109         IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi
110
111         !--------------------
112         !  1) Initialization
113         !--------------------
114
115         !-------------
116         ! Normal file
117         !-------------
118
119         zsto     = rdt_ice
120         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
121         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
122         ENDIF
123         zout     = nwrite * rdt_ice / nn_fsbc
124         niter    = ( nit000 - 1 ) / nn_fsbc
125         zdept(1) = 0.
126
127         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
128         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
129         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
130         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice,   &
131            &           nhorid, nice, domain_id=nidom, snc4chunks=snc4set )
132         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
133         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
134
135         DO jf = 1 , noumef
136            IF(lwp) WRITE(numout,*) 'jf', jf
137            IF ( nc(jf) == 1 ) THEN
138               CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
139                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
140               IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout'
141               IF(lwp) WRITE(numout,*)  nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout 
142            ENDIF
143         END DO
144
145         CALL histend(nice, snc4set)
146
147         !-----------------
148         ! ITD file output
149         !-----------------
150         zsto     = rdt_ice
151         clop     = "ave(x)"
152         zout     = nwrite * rdt_ice / nn_fsbc
153         zdept(1) = 0.
154
155         CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
156         CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit,         &
157            1, jpi, 1, jpj,            & ! zoom
158            niter, zjulian, rdt_ice,   & ! time
159            nhorida,                   & ! ? linked with horizontal ...
160            nicea , domain_id=nidom, snc4chunks=snc4set)                  ! file
161         CALL histvert( nicea, "icethi", "L levels",               &
162            "m", ipl , hi_mean , nz )
163         DO jl = 1, jpl
164            zmaskitd(:,:,jl) = tmask(:,:,1)
165         END DO
166         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
167         CALL wheneq( jpi*jpj*jpl, zmaskitd, 1, 1., ndexitd, ndimitd  ) 
168         CALL histdef( nicea, "iice_itd", "Ice area in categories"         , "-"    ,   & 
169            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
170         CALL histdef( nicea, "iice_hid", "Ice thickness in categories"    , "m"    ,   & 
171            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
172         CALL histdef( nicea, "iice_hsd", "Snow depth in in categories"    , "m"    ,   & 
173            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
174         CALL histdef( nicea, "iice_std", "Ice salinity distribution"      , "ppt"  ,   & 
175            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
176         CALL histdef( nicea, "iice_otd", "Ice age distribution"               , "days",   & 
177            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
178         CALL histdef( nicea, "iice_etd", "Brine volume distr. "               , "%"    ,   & 
179            jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
180         CALL histend(nicea, snc4set)
181      ENDIF
182
183      !     !-----------------------------------------------------------------------!
184      !     !--2. Computation of instantaneous values                               !
185      !     !-----------------------------------------------------------------------!
186
187      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
188      IF( ln_nicep ) THEN
189         WRITE(numout,*)
190         WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
191         WRITE(numout,*) '~~~~~~~ '
192         WRITE(numout,*) ' kindic = ', kindic
193      ENDIF
194      !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
195
196      !-- calculs des valeurs instantanees
197      zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
198      zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
199
200      DO jl = 1, jpl
201         DO jj = 1, jpj
202            DO ji = 1, jpi
203               zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
204               zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
205               zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl) 
206               zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl) 
207               zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)*a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)*zinda
208            END DO
209         END DO
210      END DO
211
212      CALL lim_var_bv
213
214      DO jj = 2 , jpjm1
215         DO ji = 2 , jpim1
216            zindh  = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
217            zinda  = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
218            zindb  = zindh * zinda
219
220            zcmo(ji,jj,1)  = at_i(ji,jj)
221            zcmo(ji,jj,2)  = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda
222            zcmo(ji,jj,3)  = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi16 ) * zinda
223            zcmo(ji,jj,4)  = diag_bot_gr(ji,jj) * 86400.0 * zinda    ! Bottom thermodynamic ice production
224            zcmo(ji,jj,5)  = diag_dyn_gr(ji,jj) * 86400.0 * zinda    ! Dynamic ice production (rid/raft)
225            zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * 86400.0 * zinda    ! Lateral thermodynamic ice production
226            zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * 86400.0 * zinda    ! Snow ice production ice production
227            zcmo(ji,jj,24) = tm_i(ji,jj) - rtt
228
229            zcmo(ji,jj,6)  = fbif  (ji,jj)
230            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
231            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
232            zcmo(ji,jj,9)  = sst_m(ji,jj)
233            zcmo(ji,jj,10) = sss_m(ji,jj)
234
235            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
236            zcmo(ji,jj,12) = qsr(ji,jj)
237            zcmo(ji,jj,13) = qns(ji,jj)
238            zcmo(ji,jj,14) = fhbri(ji,jj)
239            zcmo(ji,jj,15) = utau_ice(ji,jj)
240            zcmo(ji,jj,16) = vtau_ice(ji,jj)
241            zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj)
242            zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj)
243            zcmo(ji,jj,19) = sprecip(ji,jj)
244            zcmo(ji,jj,20) = smt_i(ji,jj)
245            zcmo(ji,jj,21) = ot_i(ji,jj)
246            zcmo(ji,jj,25) = et_i(ji,jj)
247            zcmo(ji,jj,26) = et_s(ji,jj)
248            zcmo(ji,jj,28) = sfx_bri(ji,jj)
249            zcmo(ji,jj,29) = sfx_thd(ji,jj)
250
251            zcmo(ji,jj,30) = bv_i(ji,jj)
252            zcmo(ji,jj,31) = hicol(ji,jj)
253            zcmo(ji,jj,32) = strength(ji,jj)
254            zcmo(ji,jj,33) = SQRT(  zcmo(ji,jj,7)*zcmo(ji,jj,7) + zcmo(ji,jj,8)*zcmo(ji,jj,8)  )
255            zcmo(ji,jj,34) = diag_sur_me(ji,jj) * 86400.0 * zinda    ! Surface melt
256            zcmo(ji,jj,35) = diag_bot_me(ji,jj) * 86400.0 * zinda    ! Bottom melt
257            zcmo(ji,jj,36) = divu_i(ji,jj)
258            zcmo(ji,jj,37) = shear_i(ji,jj)
259         END DO
260      END DO
261
262      !
263      ! ecriture d'un fichier netcdf
264      !
265      niter = niter + 1
266      DO jf = 1 , noumef
267         !
268         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf)
269         !
270         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN   ;   CALL lbc_lnk( zfield, 'T', -1. )
271         ELSE                                                            ;   CALL lbc_lnk( zfield, 'T',  1. )
272         ENDIF
273         !
274         IF( ln_nicep ) THEN
275            WRITE(numout,*)
276            WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
277            WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
278         ENDIF
279         IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
280         !
281      END DO
282
283      IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
284         IF( lwp) WRITE(numout,*) ' Closing the icemod file '
285         CALL histclo( nice )
286      ENDIF
287
288      !-----------------------------
289      ! Thickness distribution file
290      !-----------------------------
291      IF( add_diag_swi == 1 ) THEN
292
293         DO jl = 1, jpl 
294            CALL lbc_lnk( a_i(:,:,jl)  , 'T' ,  1. )
295            CALL lbc_lnk( sm_i(:,:,jl) , 'T' ,  1. )
296            CALL lbc_lnk( oa_i(:,:,jl) , 'T' ,  1. )
297            CALL lbc_lnk( ht_i(:,:,jl) , 'T' ,  1. )
298            CALL lbc_lnk( ht_s(:,:,jl) , 'T' ,  1. )
299         END DO
300
301         ! Compute ice age
302         DO jl = 1, jpl 
303            DO jj = 1, jpj
304               DO ji = 1, jpi
305                  zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
306                  zoi(ji,jj,jl) = oa_i(ji,jj,jl)  / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * zinda
307               END DO
308            END DO
309         END DO
310
311         ! Compute brine volume
312         zei(:,:,:) = 0._wp
313         DO jl = 1, jpl 
314            DO jk = 1, nlay_i
315               DO jj = 1, jpj
316                  DO ji = 1, jpi
317                     zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
318                     zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
319                        ( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * &
320                        zinda / nlay_i
321                  END DO
322               END DO
323            END DO
324         END DO
325
326         DO jl = 1, jpl 
327            CALL lbc_lnk( zei(:,:,jl) , 'T' ,  1. )
328         END DO
329
330         CALL histwrite( nicea, "iice_itd", niter, a_i  , ndimitd , ndexitd  )   ! area
331         CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd  )   ! thickness
332         CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd  )   ! snow depth
333         CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd  )   ! salinity
334         CALL histwrite( nicea, "iice_otd", niter, zoi  , ndimitd , ndexitd  )   ! age
335         CALL histwrite( nicea, "iice_etd", niter, zei  , ndimitd , ndexitd  )   ! brine volume
336
337         !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
338         !     IF( kindic < 0 )   CALL lim_wri_state( 'output.abort' )
339         !     not yet implemented
340
341         IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
342            IF(lwp) WRITE(numout,*) ' Closing the icemod file '
343            CALL histclo( nicea ) 
344         ENDIF
345         !
346      ENDIF
347
348      CALL wrk_dealloc( jpi, jpj, zfield )
349      CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
350      CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
351     
352   END SUBROUTINE lim_wri
353#endif
354
355   SUBROUTINE lim_wri_init
356      !!-------------------------------------------------------------------
357      !!                    ***   ROUTINE lim_wri_init  ***
358      !!               
359      !! ** Purpose :   ???
360      !!
361      !! ** Method  : Read the namicewri namelist and check the parameter
362      !!       values called at the first timestep (nit000)
363      !!
364      !! ** input   :   Namelist namicewri
365      !!-------------------------------------------------------------------
366      INTEGER ::   nf      ! ???
367      INTEGER ::   ios     ! Local integer output status for namelist read
368
369      TYPE FIELD 
370         CHARACTER(len = 35) :: ztitle 
371         CHARACTER(len = 8 ) :: zname         
372         CHARACTER(len = 8 ) :: zunit
373         INTEGER             :: znc   
374         REAL                :: zcmulti 
375         REAL                :: zcadd       
376      END TYPE FIELD
377
378      TYPE(FIELD) ::  &
379         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
380         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
381         field_13, field_14, field_15, field_16, field_17, field_18,   &
382         field_19, field_20, field_21, field_22, field_23, field_24,   &
383         field_25, field_26, field_27, field_28, field_29, field_30,   &
384         field_31, field_32, field_33, field_34, field_35, field_36,   &
385         field_37
386
387      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
388      !
389      NAMELIST/namiceout/ noumef, &
390         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
391         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
392         field_13, field_14, field_15, field_16, field_17, field_18,   &
393         field_19, field_20, field_21, field_22, field_23, field_24,   &
394         field_25, field_26, field_27, field_28, field_29, field_30,   &
395         field_31, field_32, field_33, field_34, field_35, field_36,   &
396         field_37, add_diag_swi
397      !!-------------------------------------------------------------------
398      REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs
399      READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
400901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
401
402      REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs
403      READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
404902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
405      WRITE ( numoni, namiceout )
406
407      zfield(1)  = field_1
408      zfield(2)  = field_2
409      zfield(3)  = field_3
410      zfield(4)  = field_4
411      zfield(5)  = field_5
412      zfield(6)  = field_6
413      zfield(7)  = field_7
414      zfield(8)  = field_8
415      zfield(9)  = field_9
416      zfield(10) = field_10
417      zfield(11) = field_11
418      zfield(12) = field_12
419      zfield(13) = field_13
420      zfield(14) = field_14
421      zfield(15) = field_15
422      zfield(16) = field_16
423      zfield(17) = field_17
424      zfield(18) = field_18
425      zfield(19) = field_19
426      zfield(20) = field_20
427      zfield(21) = field_21
428      zfield(22) = field_22
429      zfield(23) = field_23
430      zfield(24) = field_24
431      zfield(25) = field_25
432      zfield(26) = field_26
433      zfield(27) = field_27
434      zfield(28) = field_28
435      zfield(29) = field_29
436      zfield(30) = field_30
437      zfield(31) = field_31
438      zfield(32) = field_32
439      zfield(33) = field_33
440      zfield(34) = field_34
441      zfield(35) = field_35
442      zfield(36) = field_36
443      zfield(37) = field_37
444
445      DO nf = 1, noumef
446         titn  (nf) = zfield(nf)%ztitle
447         nam   (nf) = zfield(nf)%zname
448         uni   (nf) = zfield(nf)%zunit
449         nc    (nf) = zfield(nf)%znc
450         cmulti(nf) = zfield(nf)%zcmulti
451         cadd  (nf) = zfield(nf)%zcadd
452      END DO
453
454      IF(lwp) THEN                        ! control print
455         WRITE(numout,*)
456         WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
457         WRITE(numout,*) '~~~~~~~~~~~~'
458         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
459         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
460            &            '    multiplicative constant       additive constant '
461         DO nf = 1 , noumef         
462            WRITE(numout,*) '   ', titn(nf), '   '    , nam   (nf), '      '  , uni (nf),   &
463               &            '  ' , nc  (nf),'        ', cmulti(nf), '        ', cadd(nf)
464         END DO
465         WRITE(numout,*) ' add_diag_swi ', add_diag_swi
466      ENDIF
467      !
468   END SUBROUTINE lim_wri_init
469
470#else
471   !!----------------------------------------------------------------------
472   !!   Default option :         Empty module          NO LIM sea-ice model
473   !!----------------------------------------------------------------------
474CONTAINS
475   SUBROUTINE lim_wri          ! Empty routine
476   END SUBROUTINE lim_wri
477#endif
478
479   !!======================================================================
480END MODULE limwri
Note: See TracBrowser for help on using the repository browser.