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 trunk/NEMO/LIM_SRC_2 – NEMO

source: trunk/NEMO/LIM_SRC_2/limwri_2.F90 @ 1482

Last change on this file since 1482 was 1482, checked in by smasson, 15 years ago

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