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

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 2633

Last change on this file since 2633 was 2633, checked in by trackstand2, 13 years ago

Renamed wrk_use => wrk_in_use and wrk_release => wrk_not_released
  • Property svn:keywords set to Id
File size: 17.3 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   PUBLIC   lim_wri_alloc_2   ! called by nemogcm.F90
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, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51   ! ????
54
55   REAL(wp) ::   epsi16 = 1.e-16_wp   ! constant values
56   REAL(wp) ::   zzero  = 0._wp       !     -      -
57   REAL(wp) ::   zone   = 1._wp       !     -      -
58
59   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   zcmo      ! Workspace array for netcdf writer.
60
61
62   !! * Substitutions
63#   include "vectopt_loop_substitute.h90"
64   !!----------------------------------------------------------------------
65   !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
66   !! $Id$
67   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   FUNCTION lim_wri_alloc_2()
72      !!-------------------------------------------------------------------
73      !!                  ***   ROUTINE lim_wri_alloc_2  ***
74      !!-------------------------------------------------------------------
75      IMPLICIT none
76      INTEGER :: lim_wri_alloc_2
77      !!-------------------------------------------------------------------
78      !
79      ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2)
80      !
81      IF( lk_mpp               )   CALL mpp_sum ( lim_wri_alloc_2 )
82      IF( lim_wri_alloc_2 /= 0 )   CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51')
83      !
84   END FUNCTION lim_wri_alloc_2
85
86
87#if ! defined key_iomput
88# if defined key_dimgout
89   !!----------------------------------------------------------------------
90   !!   'key_dimgout'                                    Direct Access file
91   !!----------------------------------------------------------------------
92# include "limwri_dimg_2.h90"
93# else
94   SUBROUTINE lim_wri_2( kt )
95      !!-------------------------------------------------------------------
96      !!                    ***   ROUTINE lim_wri_2  ***
97      !!               
98      !! ** Purpose :   write the sea-ice output file in NetCDF
99      !!
100      !! ** Method  :   computes the average of some variables and write
101      !!      it in the NetCDF ouput files
102      !!      CAUTION: the sea-ice time-step must be an integer fraction
103      !!      of a day
104      !!-------------------------------------------------------------------
105      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
106      USE wrk_nemo, ONLY: zfield => wrk_2d_1
107      !!
108      INTEGER, INTENT(in) ::   kt     ! number of iteration
109      !!
110      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
111      CHARACTER(len = 40)  ::   clhstnam, clop
112      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars
113         &          zindh, zinda, zindb, ztmu
114      REAL(wp), DIMENSION(1)                ::   zdept
115      !!-------------------------------------------------------------------
116
117      IF(wrk_in_use(2, 1))THEN
118         CALL ctl_stop('lim_wri_2 : requested workspace array unavailable.')
119         RETURN
120      END IF
121                                                 !--------------------!
122      IF( kt == nit000 ) THEN                    !   Initialisation   !
123         !                                       !--------------------!
124
125         CALL lim_wri_init_2 
126                           
127         zsto     = rdt_ice
128         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
129         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
130         ENDIF
131         zout     = nwrite * rdt_ice / nn_fsbc
132         niter    = ( nit000 - 1 ) / nn_fsbc
133         zdept(1) = 0.
134         
135         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
136         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
137         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
138         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
139            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set)
140         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
141         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
142         
143         DO jf = 1, noumef
144            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
145               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
146         END DO
147         CALL histend( nice, snc4set )
148         !
149      ENDIF
150      !                                          !--------------------!
151      !                                          !   Cumulate at kt   !
152      !                                          !--------------------!
153
154      !-- Store instantaneous values in zcmo
155     
156      zcmo(:,:, 1:jpnoumax ) = 0.e0 
157      DO jj = 2 , jpjm1
158         DO ji = 1 , jpim1   ! NO vector opt.
159            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
160            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
161            zindb  = zindh * zinda
162            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
163            zcmo(ji,jj,1)  = hsnif (ji,jj)
164            zcmo(ji,jj,2)  = hicif (ji,jj)
165            zcmo(ji,jj,3)  = hicifp(ji,jj)
166            zcmo(ji,jj,4)  = frld  (ji,jj)
167            zcmo(ji,jj,5)  = sist  (ji,jj)
168            zcmo(ji,jj,6)  = fbif  (ji,jj)
169            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
170                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
171                                  / ztmu 
172
173            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
174                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
175                                  / ztmu
176            zcmo(ji,jj,9)  = sst_m(ji,jj)
177            zcmo(ji,jj,10) = sss_m(ji,jj)
178            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
179            zcmo(ji,jj,12) = qsr(ji,jj)
180            zcmo(ji,jj,13) = qns(ji,jj)
181            ! See thersf for the coefficient
182            zcmo(ji,jj,14) = - emps(ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
183            zcmo(ji,jj,15) = utau_ice(ji,jj)
184            zcmo(ji,jj,16) = vtau_ice(ji,jj)
185            zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
186            zcmo(ji,jj,18) = qns_ice(ji,jj,1)
187            zcmo(ji,jj,19) = sprecip(ji,jj)
188         END DO
189      END DO
190      !
191      ! Write the netcdf file
192      !
193      niter = niter + 1
194      DO jf = 1 , noumef
195         DO jj = 1 , jpj
196            DO ji = 1 , jpi
197               zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
198            END DO
199         END DO
200         
201         IF( jf == 7  .OR. jf == 8  .OR. jf == 15 .OR. jf == 16 ) THEN
202            CALL lbc_lnk( zfield, 'T', -1. )
203         ELSE
204            CALL lbc_lnk( zfield, 'T',  1. )
205         ENDIF
206         
207         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
208         
209      END DO
210     
211      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice ) 
212
213      IF(wrk_not_released(2, 1))THEN
214         CALL ctl_stop('lim_wri_2 : failed to release workspace array.')
215      END IF
216
217   END SUBROUTINE lim_wri_2
218     
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#endif
307
308   SUBROUTINE lim_wri_state_2( kt, kid, kh_i )
309      !!---------------------------------------------------------------------
310      !!                 ***  ROUTINE lim_wri_state_2  ***
311      !!       
312      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
313      !!      the instantaneous ice state and forcing fields for ice model
314      !!        Used to find errors in the initial state or save the last
315      !!      ocean state in case of abnormal end of a simulation
316      !!
317      !! History :
318      !!   2.0  !  2009-06  (B. Lemaire)
319      !!----------------------------------------------------------------------
320      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
321      INTEGER, INTENT( in ) ::   kid , kh_i       
322      !!----------------------------------------------------------------------
323
324      CALL histdef( kid, "isnowthi", "Snow thickness"          , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
325      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
326      CALL histdef( kid, "iiceprod", "Ice produced"            , "m/kt"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
327      CALL histdef( kid, "ileadfra", "Ice concentration"       , "-"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
328      CALL histdef( kid, "iicetemp", "Ice temperature"         , "K"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
329      CALL histdef( kid, "ioceflxb", "flux at ice base"        , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
330      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
331      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
332      CALL histdef( kid, "isstempe", "Sea surface temperature" , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
333      CALL histdef( kid, "isssalin", "Sea surface salinity"    , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
334      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 )
335      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 ) 
336      CALL histdef( kid, "iicesflx", "Solar flux over ice"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
337      CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
338      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
339
340      CALL histend( kid, snc4set )   ! end of the file definition
341
342      CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )   
343      CALL histwrite( kid, "iicethic", kt, hicif          , jpi*jpj, (/1/) )   
344      CALL histwrite( kid, "iiceprod", kt, hicifp         , jpi*jpj, (/1/) )   
345      CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) )
346      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) )
347      CALL histwrite( kid, "ioceflxb", kt, fbif           , jpi*jpj, (/1/) )
348      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
349      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
350      CALL histwrite( kid, "isstempe", kt, sst_m          , jpi*jpj, (/1/) )
351      CALL histwrite( kid, "isssalin", kt, sss_m          , jpi*jpj, (/1/) )
352      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
353      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
354      CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) )
355      CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) )
356      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
357
358    END SUBROUTINE lim_wri_state_2
359
360#else
361   !!----------------------------------------------------------------------
362   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
363   !!----------------------------------------------------------------------
364CONTAINS
365   SUBROUTINE lim_wri_2          ! Empty routine
366   END SUBROUTINE lim_wri_2
367#endif
368
369   !!======================================================================
370END MODULE limwri_2
Note: See TracBrowser for help on using the repository browser.