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_2.F90 in branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

source: branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 3764

Last change on this file since 3764 was 3764, checked in by smasson, 11 years ago

dev_MERGE_2012: report bugfixes done in the trunk from r3555 to r3763 into dev_MERGE_2012
  • Property svn:keywords set to Id
File size: 17.6 KB
Line 
1MODULE limwri_2
2   !!======================================================================
3   !!                     ***  MODULE  limwri_2  ***
4   !!         Ice diagnostics :  write ice output files
5   !!======================================================================
6   !! history :  2.0  ! 2003-08  (C. Ethe)      original code
7   !!            2.0  ! 2004-10  (C. Ethe )     1D configuration
8   !!             -   ! 2009-06  (B. Lemaire )  iom_put + lim_wri_state_2
9   !!-------------------------------------------------------------------
10#if defined key_lim2
11   !!----------------------------------------------------------------------
12   !!   'key_lim2'                                    LIM 2.0 sea-ice model
13   !!----------------------------------------------------------------------
14   !!----------------------------------------------------------------------
15   !!   lim_wri_2       : write of the diagnostics variables in ouput file
16   !!   lim_wri_init_2  : initialization and namelist read
17   !!   lim_wri_state_2 : write for initial state or/and abandon:
18   !!                     > output.init.nc (if ninist = 1 in namelist)
19   !!                     > output.abort.nc
20   !!----------------------------------------------------------------------
21   USE phycst
22   USE dom_oce
23   USE sbc_oce
24   USE sbc_ice
25   USE dom_ice_2
26   USE ice_2
27
28   USE dianam           ! build name of file (routine)
29   USE lbclnk
30   USE in_out_manager
31   USE lib_mpp          ! MPP library
32   USE wrk_nemo         ! work arrays
33   USE iom
34   USE ioipsl
35   USE lib_fortran      ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
36
37   IMPLICIT NONE
38   PRIVATE
39
40#if ! defined key_iomput
41   PUBLIC   lim_wri_2         ! called by sbc_ice_lim_2
42#endif
43   PUBLIC   lim_wri_state_2   ! called by dia_wri_state
44   PUBLIC   lim_wri_alloc_2   ! called by nemogcm.F90
45
46   INTEGER, PARAMETER                       ::   jpnoumax = 40   ! maximum number of variable for ice output
47   INTEGER                                  ::   noumef          ! number of fields
48   REAL(wp)           , DIMENSION(jpnoumax) ::   cmulti ,     &  ! multiplicative constant
49      &                                          cadd            ! additive constant
50   CHARACTER(len = 35), DIMENSION(jpnoumax) ::   titn            ! title of the field
51   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   nam             ! name of the field
52   CHARACTER(len = 8 ), DIMENSION(jpnoumax) ::   uni             ! unit of the field
53   INTEGER            , DIMENSION(jpnoumax) ::   nc              ! switch for saving field ( = 1 ) or not ( = 0 )
54
55   INTEGER ::   nice, nhorid, ndim, niter, ndepid       ! ????
56   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ????
57
58   REAL(wp) ::   epsi16 = 1.e-16_wp   ! constant values
59   REAL(wp) ::   zzero  = 0._wp       !     -      -
60   REAL(wp) ::   zone   = 1._wp       !     -      -
61
62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer.
63
64
65   !! * Substitutions
66#   include "vectopt_loop_substitute.h90"
67   !!----------------------------------------------------------------------
68   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
69   !! $Id$
70   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
71   !!----------------------------------------------------------------------
72CONTAINS
73
74   INTEGER FUNCTION lim_wri_alloc_2()
75      !!-------------------------------------------------------------------
76      !!                  ***   ROUTINE lim_wri_alloc_2  ***
77      !!-------------------------------------------------------------------
78      ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2)
79      !
80      IF( lk_mpp               )   CALL mpp_sum ( lim_wri_alloc_2 )
81      IF( lim_wri_alloc_2 /= 0 )   CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51')
82      !
83   END FUNCTION lim_wri_alloc_2
84
85
86#if ! defined key_iomput
87# if defined key_dimgout
88   !!----------------------------------------------------------------------
89   !!   'key_dimgout'                                    Direct Access file
90   !!----------------------------------------------------------------------
91# include "limwri_dimg_2.h90"
92# else
93   SUBROUTINE lim_wri_2( kt )
94      !!-------------------------------------------------------------------
95      !!                    ***   ROUTINE lim_wri_2  ***
96      !!               
97      !! ** Purpose :   write the sea-ice output file in NetCDF
98      !!
99      !! ** Method  :   computes the average of some variables and write
100      !!      it in the NetCDF ouput files
101      !!      CAUTION: the sea-ice time-step must be an integer fraction
102      !!      of a day
103      !!-------------------------------------------------------------------
104      INTEGER, INTENT(in) ::   kt     ! number of iteration
105      !!
106      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
107      CHARACTER(len = 80)  ::   clhstnam, clop
108      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars
109         &          zindh, zinda, zindb, ztmu
110      REAL(wp), DIMENSION(1)                ::   zdept
111      REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
112      !!-------------------------------------------------------------------
113
114      CALL wrk_alloc( jpi, jpj, zfield )
115                                                 !--------------------!
116      IF( kt == nit000 ) THEN                    !   Initialisation   !
117         !                                       !--------------------!
118
119         CALL lim_wri_init_2 
120                           
121         zsto     = rdt_ice
122         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
123         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
124         ENDIF
125         zout     = nwrite * rdt_ice / nn_fsbc
126         niter    = ( nit000 - 1 ) / nn_fsbc
127         zdept(1) = 0.
128         
129         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
130         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
131         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
132         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
133            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set)
134         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
135         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
136         
137         DO jf = 1, noumef
138            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
139               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
140         END DO
141         CALL histend( nice, snc4set )
142         !
143      ENDIF
144      !                                          !--------------------!
145      !                                          !   Cumulate at kt   !
146      !                                          !--------------------!
147
148      !-- Store instantaneous values in zcmo
149     
150      zcmo(:,:, 1:jpnoumax ) = 0.e0 
151      DO jj = 2 , jpjm1
152         DO ji = 1 , jpim1   ! NO vector opt.
153            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
154            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
155            zindb  = zindh * zinda
156            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
157            zcmo(ji,jj,1)  = hsnif (ji,jj)
158            zcmo(ji,jj,2)  = hicif (ji,jj)
159            zcmo(ji,jj,3)  = hicifp(ji,jj)
160            zcmo(ji,jj,4)  = frld  (ji,jj)
161            zcmo(ji,jj,5)  = sist  (ji,jj)
162            zcmo(ji,jj,6)  = fbif  (ji,jj)
163           IF (lk_lim2_vp) THEN
164            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
165                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
166                                  / ztmu 
167
168            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
169                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
170                                  / ztmu
171           ELSE
172
173            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj)                       &
174             &                        + u_ice(ji-1,jj) * tmu(ji-1,jj) )                   &
175             &                    / 2.0
176            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)                       &
177             &                        + v_ice(ji,jj-1) * tmv(ji,jj-1) )                   &
178             &                    / 2.0
179
180           ENDIF
181            zcmo(ji,jj,9)  = sst_m(ji,jj)
182            zcmo(ji,jj,10) = sss_m(ji,jj)
183            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
184            zcmo(ji,jj,12) = qsr(ji,jj)
185            zcmo(ji,jj,13) = qns(ji,jj)
186            ! See thersf for the coefficient
187            zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
188            zcmo(ji,jj,15) = utau_ice(ji,jj)
189            zcmo(ji,jj,16) = vtau_ice(ji,jj)
190            zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
191            zcmo(ji,jj,18) = qns_ice(ji,jj,1)
192            zcmo(ji,jj,19) = sprecip(ji,jj)
193         END DO
194      END DO
195      !
196      ! Write the netcdf file
197      !
198      niter = niter + 1
199      DO jf = 1 , noumef
200         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1)
201         SELECT CASE ( jf )
202         CASE ( 7, 8, 15, 16, 20, 21 )  ! velocity or stress fields (vectors)
203            CALL lbc_lnk( zfield, 'T', -1. )
204         CASE DEFAULT                   ! scalar fields
205            CALL lbc_lnk( zfield, 'T',  1. )
206         END SELECT
207
208         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
209
210      END DO
211
212      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice ) 
213
214      CALL wrk_dealloc( jpi, jpj, zfield )
215      !
216   END SUBROUTINE lim_wri_2
217     
218#endif     
219
220   SUBROUTINE lim_wri_init_2
221      !!-------------------------------------------------------------------
222      !!                    ***   ROUTINE lim_wri_init_2  ***
223      !!               
224      !! ** Purpose :   intialisation of LIM sea-ice output
225      !!
226      !! ** Method  : Read the namicewri namelist and check the parameter
227      !!       values called at the first timestep (nit000)
228      !!
229      !! ** input   :   Namelist namicewri
230      !!-------------------------------------------------------------------
231      INTEGER ::   nf      ! ???
232      TYPE FIELD 
233         CHARACTER(len = 35) :: ztitle 
234         CHARACTER(len = 8 ) :: zname         
235         CHARACTER(len = 8 ) :: zunit
236         INTEGER             :: znc   
237         REAL                :: zcmulti 
238         REAL                :: zcadd       
239      END TYPE FIELD
240      TYPE(FIELD) ::  &
241         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
242         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
243         field_13, field_14, field_15, field_16, field_17, field_18,   &
244         field_19
245      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
246
247      NAMELIST/namiceout/ noumef, &
248         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
249         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
250         field_13, field_14, field_15, field_16, field_17, field_18,   &
251         field_19
252      !!-------------------------------------------------------------------
253      !
254      IF( lim_wri_alloc_2() /= 0 ) THEN      ! allocate lim_wri arrrays
255         CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' )   ;   RETURN
256      ENDIF
257
258      REWIND ( numnam_ice )                ! Read Namelist namicewri
259      READ   ( numnam_ice  , namiceout )
260     
261      zfield( 1) = field_1
262      zfield( 2) = field_2
263      zfield( 3) = field_3
264      zfield( 4) = field_4
265      zfield( 5) = field_5
266      zfield( 6) = field_6
267      zfield( 7) = field_7
268      zfield( 8) = field_8
269      zfield( 9) = field_9
270      zfield(10) = field_10
271      zfield(11) = field_11
272      zfield(12) = field_12
273      zfield(13) = field_13
274      zfield(14) = field_14
275      zfield(15) = field_15
276      zfield(16) = field_16
277      zfield(17) = field_17
278      zfield(18) = field_18
279      zfield(19) = field_19
280     
281      DO nf = 1, noumef
282         titn  (nf) = zfield(nf)%ztitle
283         nam   (nf) = zfield(nf)%zname
284         uni   (nf) = zfield(nf)%zunit
285         nc    (nf) = zfield(nf)%znc
286         cmulti(nf) = zfield(nf)%zcmulti
287         cadd  (nf) = zfield(nf)%zcadd
288      END DO
289
290      IF(lwp) THEN
291         WRITE(numout,*)
292         WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
293         WRITE(numout,*) '~~~~~~~~~~~~~~'
294         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
295         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
296            &            '    multiplicative constant       additive constant '
297         DO nf = 1 , noumef         
298            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
299               &       '        ', cadd(nf)
300         END DO
301      ENDIF
302      !   
303   END SUBROUTINE lim_wri_init_2
304
305#endif
306
307   SUBROUTINE lim_wri_state_2( kt, kid, kh_i )
308      !!---------------------------------------------------------------------
309      !!                 ***  ROUTINE lim_wri_state_2  ***
310      !!       
311      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
312      !!      the instantaneous ice state and forcing fields for ice model
313      !!        Used to find errors in the initial state or save the last
314      !!      ocean state in case of abnormal end of a simulation
315      !!
316      !! History :
317      !!   2.0  !  2009-06  (B. Lemaire)
318      !!----------------------------------------------------------------------
319      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
320      INTEGER, INTENT( in ) ::   kid , kh_i       
321      !!----------------------------------------------------------------------
322
323      CALL histdef( kid, "isnowthi", "Snow thickness"          , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
324      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
325      CALL histdef( kid, "iiceprod", "Ice produced"            , "m/kt"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
326      CALL histdef( kid, "ileadfra", "Ice concentration"       , "-"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
327      CALL histdef( kid, "iicetemp", "Ice temperature"         , "K"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
328      CALL histdef( kid, "ioceflxb", "flux at ice base"        , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
329      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
330      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
331      CALL histdef( kid, "isstempe", "Sea surface temperature" , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
332      CALL histdef( kid, "isssalin", "Sea surface salinity"    , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
333      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 )
334      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 ) 
335      CALL histdef( kid, "iicesflx", "Solar flux over ice"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
336      CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
337      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
338
339      CALL histend( kid, snc4set )   ! end of the file definition
340
341      CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )   
342      CALL histwrite( kid, "iicethic", kt, hicif          , jpi*jpj, (/1/) )   
343      CALL histwrite( kid, "iiceprod", kt, hicifp         , jpi*jpj, (/1/) )   
344      CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) )
345      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) )
346      CALL histwrite( kid, "ioceflxb", kt, fbif           , jpi*jpj, (/1/) )
347      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
348      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
349      CALL histwrite( kid, "isstempe", kt, sst_m          , jpi*jpj, (/1/) )
350      CALL histwrite( kid, "isssalin", kt, sss_m          , jpi*jpj, (/1/) )
351      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
352      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
353      CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) )
354      CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) )
355      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
356
357    END SUBROUTINE lim_wri_state_2
358
359#else
360   !!----------------------------------------------------------------------
361   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
362   !!----------------------------------------------------------------------
363CONTAINS
364   SUBROUTINE lim_wri_2          ! Empty routine
365   END SUBROUTINE lim_wri_2
366#endif
367
368   !!======================================================================
369END MODULE limwri_2
Note: See TracBrowser for help on using the repository browser.