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

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago

All wrk_alloc removed

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