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

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 13354

Last change on this file since 13354 was 6486, checked in by davestorkey, 8 years ago

Remove SVN keywords from UKMO/dev_r5518_GO6_package branch.

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