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

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta

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