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

source: NEMO/branches/UKMO/r8395_coupling_sequence/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 10763

Last change on this file since 10763 was 10763, checked in by jcastill, 5 years ago

Remove svn keywords properly

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   SUBROUTINE lim_wri_2( kt )
88      !!-------------------------------------------------------------------
89      !!                    ***   ROUTINE lim_wri_2  ***
90      !!               
91      !! ** Purpose :   write the sea-ice output file in NetCDF
92      !!
93      !! ** Method  :   computes the average of some variables and write
94      !!      it in the NetCDF ouput files
95      !!      CAUTION: the sea-ice time-step must be an integer fraction
96      !!      of a day
97      !!-------------------------------------------------------------------
98      INTEGER, INTENT(in) ::   kt     ! number of iteration
99      !!
100      INTEGER  ::   ji, jj, jf                      ! dummy loop indices
101      CHARACTER(len = 80)  ::   clhstnam, clop
102      REAL(wp) ::   zsto, zjulian, zout,   &  ! temporary scalars
103         &          zindh, zinda, zindb, ztmu
104      REAL(wp), DIMENSION(1)                ::   zdept
105      REAL(wp), POINTER, DIMENSION(:,:)     ::   zfield
106      !!-------------------------------------------------------------------
107
108      CALL wrk_alloc( jpi, jpj, zfield )
109                                                 !--------------------!
110      IF( kt == nit000 ) THEN                    !   Initialisation   !
111         !                                       !--------------------!
112
113         CALL lim_wri_init_2 
114                           
115         zsto     = rdt_ice
116         IF( ln_mskland )   THEN   ;   clop = "ave(only(x))"   ! put 1.e+20 on land (very expensive!!)
117         ELSE                      ;   clop = "ave(x)"         ! no use of the mask value (require less cpu time)
118         ENDIF
119         zout     = nwrite * rdt_ice / nn_fsbc
120         niter    = ( nit000 - 1 ) / nn_fsbc
121         zdept(1) = 0.
122         
123         CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
124         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment
125         CALL dia_nam ( clhstnam, nwrite, 'icemod' )
126         CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit,    &
127            &           1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set)
128         CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
129         CALL wheneq  ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
130         
131         DO jf = 1, noumef
132            IF( nc(jf) == 1 )   CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj   &
133               &                                  , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
134         END DO
135         CALL histend( nice, snc4set )
136         !
137      ENDIF
138      !                                          !--------------------!
139      !                                          !   Cumulate at kt   !
140      !                                          !--------------------!
141
142      !-- Store instantaneous values in zcmo
143     
144      zcmo(:,:, 1:jpnoumax ) = 0.e0 
145      DO jj = 2 , jpjm1
146         DO ji = 2 , jpim1   ! NO vector opt.
147            zindh  = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
148            zinda  = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
149            zindb  = zindh * zinda
150            ztmu   = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) ) 
151            zcmo(ji,jj,1)  = hsnif (ji,jj)
152            zcmo(ji,jj,2)  = hicif (ji,jj)
153            zcmo(ji,jj,3)  = hicifp(ji,jj)
154            zcmo(ji,jj,4)  = frld  (ji,jj)
155            zcmo(ji,jj,5)  = sist  (ji,jj)
156            zcmo(ji,jj,6)  = fbif  (ji,jj)
157           IF (lk_lim2_vp) THEN
158            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj  ) + u_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
159                                      + u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
160                                  / ztmu 
161
162            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmu(ji,jj  ) + v_ice(ji+1,jj  ) * tmu(ji+1,jj  )   &
163                                      + v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
164                                  / ztmu
165           ELSE
166
167            zcmo(ji,jj,7)  = zindb * (  u_ice(ji,jj  ) * tmu(ji,jj)                       &
168             &                        + u_ice(ji-1,jj) * tmu(ji-1,jj) )                   &
169             &                    / 2.0
170            zcmo(ji,jj,8)  = zindb * (  v_ice(ji,jj  ) * tmv(ji,jj)                       &
171             &                        + v_ice(ji,jj-1) * tmv(ji,jj-1) )                   &
172             &                    / 2.0
173
174           ENDIF
175            zcmo(ji,jj,9)  = sst_m(ji,jj)
176            zcmo(ji,jj,10) = sss_m(ji,jj)
177            zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
178            zcmo(ji,jj,12) = qsr(ji,jj)
179            zcmo(ji,jj,13) = qns(ji,jj)
180            ! See thersf for the coefficient
181            zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce    !!gm ???
182            zcmo(ji,jj,15) = utau_ice(ji,jj)
183            zcmo(ji,jj,16) = vtau_ice(ji,jj)
184            zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
185            zcmo(ji,jj,18) = qns_ice(ji,jj,1)
186            zcmo(ji,jj,19) = sprecip(ji,jj)
187         END DO
188      END DO
189      !
190      ! Write the netcdf file
191      !
192      niter = niter + 1
193      DO jf = 1 , noumef
194         zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1)
195         SELECT CASE ( jf )
196         CASE ( 7, 8, 15, 16, 20, 21 )  ! velocity or stress fields (vectors)
197            CALL lbc_lnk( zfield, 'T', -1. )
198         CASE DEFAULT                   ! scalar fields
199            CALL lbc_lnk( zfield, 'T',  1. )
200         END SELECT
201
202         IF( nc(jf) == 1 )   CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
203
204      END DO
205
206      IF( ( nn_fsbc * niter ) >= nitend )   CALL histclo( nice ) 
207
208      CALL wrk_dealloc( jpi, jpj, zfield )
209      !
210   END SUBROUTINE lim_wri_2
211
212   SUBROUTINE lim_wri_init_2
213      !!-------------------------------------------------------------------
214      !!                    ***   ROUTINE lim_wri_init_2  ***
215      !!               
216      !! ** Purpose :   intialisation of LIM sea-ice output
217      !!
218      !! ** Method  : Read the namicewri namelist and check the parameter
219      !!       values called at the first timestep (nit000)
220      !!
221      !! ** input   :   Namelist namicewri
222      !!-------------------------------------------------------------------
223      INTEGER ::   nf      ! ???
224      INTEGER ::   ios     ! Local integer output status for namelist read
225      TYPE FIELD 
226         CHARACTER(len = 35) :: ztitle 
227         CHARACTER(len = 8 ) :: zname         
228         CHARACTER(len = 8 ) :: zunit
229         INTEGER             :: znc   
230         REAL                :: zcmulti 
231         REAL                :: zcadd       
232      END TYPE FIELD
233      TYPE(FIELD) ::  &
234         field_1 , field_2 , field_3 , field_4 , field_5 , field_6 ,   &
235         field_7 , field_8 , field_9 , field_10, field_11, field_12,   &
236         field_13, field_14, field_15, field_16, field_17, field_18,   &
237         field_19
238      TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
239
240      NAMELIST/namiceout/ noumef, &
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      !!-------------------------------------------------------------------
246      !
247      IF( lim_wri_alloc_2() /= 0 ) THEN      ! allocate lim_wri arrrays
248         CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' )   ;   RETURN
249      ENDIF
250                   
251      REWIND( numnam_ice_ref )              ! Namelist namiceout in reference namelist : Ice outputs
252      READ  ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
253901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
254
255      REWIND( numnam_ice_cfg )              ! Namelist namiceout in configuration namelist : Ice outputs
256      READ  ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
257902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
258      IF(lwm) WRITE ( numoni, namiceout )
259     
260      zfield( 1) = field_1
261      zfield( 2) = field_2
262      zfield( 3) = field_3
263      zfield( 4) = field_4
264      zfield( 5) = field_5
265      zfield( 6) = field_6
266      zfield( 7) = field_7
267      zfield( 8) = field_8
268      zfield( 9) = field_9
269      zfield(10) = field_10
270      zfield(11) = field_11
271      zfield(12) = field_12
272      zfield(13) = field_13
273      zfield(14) = field_14
274      zfield(15) = field_15
275      zfield(16) = field_16
276      zfield(17) = field_17
277      zfield(18) = field_18
278      zfield(19) = field_19
279     
280      DO nf = 1, noumef
281         titn  (nf) = zfield(nf)%ztitle
282         nam   (nf) = zfield(nf)%zname
283         uni   (nf) = zfield(nf)%zunit
284         nc    (nf) = zfield(nf)%znc
285         cmulti(nf) = zfield(nf)%zcmulti
286         cadd  (nf) = zfield(nf)%zcadd
287      END DO
288
289      IF(lwp) THEN
290         WRITE(numout,*)
291         WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
292         WRITE(numout,*) '~~~~~~~~~~~~~~'
293         WRITE(numout,*) '    number of fields to be stored         noumef = ', noumef
294         WRITE(numout,*) '           title                            name     unit      Saving (1/0) ',   &
295            &            '    multiplicative constant       additive constant '
296         DO nf = 1 , noumef         
297            WRITE(numout,*) '   ', titn(nf), '   ', nam(nf),'      ', uni(nf),'  ', nc(nf),'        ', cmulti(nf),   &
298               &       '        ', cadd(nf)
299         END DO
300      ENDIF
301      !   
302   END SUBROUTINE lim_wri_init_2
303
304#endif
305
306   SUBROUTINE lim_wri_state_2( kt, kid, kh_i )
307      !!---------------------------------------------------------------------
308      !!                 ***  ROUTINE lim_wri_state_2  ***
309      !!       
310      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
311      !!      the instantaneous ice state and forcing fields for ice model
312      !!        Used to find errors in the initial state or save the last
313      !!      ocean state in case of abnormal end of a simulation
314      !!
315      !! History :
316      !!   2.0  !  2009-06  (B. Lemaire)
317      !!----------------------------------------------------------------------
318      INTEGER, INTENT( in ) ::   kt               ! ocean time-step index)
319      INTEGER, INTENT( in ) ::   kid , kh_i       
320      !!----------------------------------------------------------------------
321
322      CALL histdef( kid, "isnowthi", "Snow thickness"          , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
323      CALL histdef( kid, "iicethic", "Ice thickness"           , "m"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
324      CALL histdef( kid, "iiceprod", "Ice produced"            , "m/kt"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
325      CALL histdef( kid, "ileadfra", "Ice concentration"       , "-"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
326      CALL histdef( kid, "iicetemp", "Ice temperature"         , "K"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
327      CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
328      CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)"   , "m/s"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
329      CALL histdef( kid, "isstempe", "Sea surface temperature" , "C"      , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
330      CALL histdef( kid, "isssalin", "Sea surface salinity"    , "PSU"    , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
331      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 )
332      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 ) 
333      CALL histdef( kid, "iicesflx", "Solar flux over ice"     , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
334      CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2"   , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
335      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
336
337      CALL histend( kid, snc4set )   ! end of the file definition
338
339      CALL histwrite( kid, "isnowthi", kt, hsnif          , jpi*jpj, (/1/) )   
340      CALL histwrite( kid, "iicethic", kt, hicif          , jpi*jpj, (/1/) )   
341      CALL histwrite( kid, "iiceprod", kt, hicifp         , jpi*jpj, (/1/) )   
342      CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) )
343      CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) )
344      CALL histwrite( kid, "iicevelu", kt, u_ice          , jpi*jpj, (/1/) )
345      CALL histwrite( kid, "iicevelv", kt, v_ice          , jpi*jpj, (/1/) )
346      CALL histwrite( kid, "isstempe", kt, sst_m          , jpi*jpj, (/1/) )
347      CALL histwrite( kid, "isssalin", kt, sss_m          , jpi*jpj, (/1/) )
348      CALL histwrite( kid, "iicestru", kt, utau_ice       , jpi*jpj, (/1/) )
349      CALL histwrite( kid, "iicestrv", kt, vtau_ice       , jpi*jpj, (/1/) )
350      CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) )
351      CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) )
352      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
353
354    END SUBROUTINE lim_wri_state_2
355
356#else
357   !!----------------------------------------------------------------------
358   !!   Default option :         Empty module      NO LIM 2.0 sea-ice model
359   !!----------------------------------------------------------------------
360CONTAINS
361   SUBROUTINE lim_wri_2          ! Empty routine
362   END SUBROUTINE lim_wri_2
363#endif
364
365   !!======================================================================
366END MODULE limwri_2
Note: See TracBrowser for help on using the repository browser.