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.
icewri.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icewri.F90 @ 8534

Last change on this file since 8534 was 8534, checked in by clem, 7 years ago

changes in style - part6 - pure cosmetics

File size: 31.3 KB
Line 
1MODULE icewri
2   !!======================================================================
3   !!                     ***  MODULE  icewri  ***
4   !!   sea-ice : output ice variables
5   !!======================================================================
6#if defined key_lim3
7   !!----------------------------------------------------------------------
8   !!   'key_lim3'                                       ESIM sea-ice model
9   !!----------------------------------------------------------------------
10   !!   ice_wri       : write of the diagnostics variables in ouput file
11   !!   ice_wri_state : write for initial state or/and abandon
12   !!----------------------------------------------------------------------
13   USE dianam         ! build name of file (routine)
14   USE phycst         ! physical constant
15   USE dom_oce        ! domain: ocean
16   USE sbc_oce        ! surf. boundary cond.: ocean
17   USE sbc_ice        ! Surface boundary condition: ice fields
18   USE ice            ! sea-ice: variables
19   USE icevar         ! sea-ice: operations
20   !
21   USE ioipsl         !
22   USE in_out_manager ! I/O manager
23   USE iom            ! I/O manager library
24   USE lib_mpp        ! MPP library
25   USE lib_fortran    ! fortran utilities (glob_sum + no signed zero)
26   USE lbclnk         ! lateral boundary conditions (or mpp links)
27   USE timing         ! Timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC ice_wri        ! called by ice_stp
33   PUBLIC ice_wri_state  ! called by dia_wri_state
34
35   !!----------------------------------------------------------------------
36   !! NEMO/ICE 4.0 , NEMO Consortium (2017)
37   !! $Id: icewri.F90 8409 2017-08-07 15:29:21Z clem $
38   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
39   !!----------------------------------------------------------------------
40CONTAINS
41
42   SUBROUTINE ice_wri( kindic )
43      !!-------------------------------------------------------------------
44      !!  This routine computes the average of some variables and write it
45      !!  on the ouput files.
46      !!  ATTENTION cette routine n'est valable que si le pas de temps est
47      !!  egale a une fraction entiere de 1 jours.
48      !!  Diff 1-D 3-D : suppress common also included in etat
49      !!                 suppress cmoymo 11-18
50      !!  modif : 03/06/98
51      !!-------------------------------------------------------------------
52      INTEGER, INTENT(in) ::   kindic   ! if kindic < 0 there has been an error somewhere
53      !
54      INTEGER  ::  ji, jj, jk, jl  ! dummy loop indices
55      REAL(wp) ::  z2da, z2db, ztmp, zrho1, zrho2, zmiss_val
56      REAL(wp), DIMENSION(jpi,jpj)     ::  z2d, zswi, zmiss !  2D workspace
57      REAL(wp), DIMENSION(jpi,jpj)     ::  zfb              ! ice freeboard
58      REAL(wp), DIMENSION(jpi,jpj)     ::  zamask, zamask15 ! 15% concentration mask
59      REAL(wp), DIMENSION(jpi,jpj,jpl) ::  zswi2, zmiss2
60      !
61      ! Global ice diagnostics (SIMIP)
62      REAL(wp) ::  zdiag_area_nh, zdiag_extt_nh, zdiag_volu_nh   ! area, extent, volume
63      REAL(wp) ::  zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh 
64      !!-------------------------------------------------------------------
65
66      IF( nn_timing == 1 )   CALL timing_start('icewri')
67
68      !----------------------------------------
69      ! Brine volume, switches, missing values
70      !----------------------------------------
71
72      CALL ice_var_bv      ! brine volume
73
74      ! tresholds for outputs
75      DO jj = 1, jpj
76         DO ji = 1, jpi
77            zswi(ji,jj)      = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice
78            zamask(ji,jj)    = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05   ) ) ! 1 if 5% ice, 0 if less - required to mask thickness and snow depth
79            zamask15(ji,jj)  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15   ) ) ! 1 if 15% ice, 0 if less
80         END DO
81      END DO
82      DO jl = 1, jpl
83         DO jj = 1, jpj
84            DO ji = 1, jpi
85               zswi2(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) )
86            END DO
87         END DO
88      END DO
89
90      zmiss_val     = 1.e20_wp
91      zmiss (:,:)   = zmiss_val * ( 1._wp - zswi (:,:) )
92      zmiss2(:,:,:) = zmiss_val * ( 1._wp - zswi2(:,:,:) )
93
94      !----------------------------------------
95      ! Standard outputs
96      !----------------------------------------
97      ! fluxes
98      IF( iom_use('qsr_oce') )   CALL iom_put( "qsr_oce" , qsr_oce(:,:) * ( 1._wp - at_i_b(:,:) ) )                      !     solar flux at ocean surface
99      IF( iom_use('qns_oce') )   CALL iom_put( "qns_oce" , qns_oce(:,:) * ( 1._wp - at_i_b(:,:) ) + qemp_oce(:,:) )      ! non-solar flux at ocean surface
100      IF( iom_use('qsr_ice') )   CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux at ice surface
101      IF( iom_use('qns_ice') )   CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) ) ! non-solar flux at ice surface
102      IF( iom_use('qtr_ice') )   CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )                 !     solar flux transmitted thru ice
103      IF( iom_use('qt_oce' ) )   CALL iom_put( "qt_oce"  , ( qsr_oce(:,:) + qns_oce(:,:) ) * ( 1._wp - at_i_b(:,:) ) + qemp_oce(:,:) )
104      IF( iom_use('qt_ice' ) )   CALL iom_put( "qt_ice"  , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) )   &
105         &                                                      * a_i_b(:,:,:), dim=3 ) + qemp_ice(:,:) )
106!!gm I don't understand the variable below.... why not multiplied by a_i_b or (1-a_i_b) ???
107      IF( iom_use('qemp_oce') )  CALL iom_put( "qemp_oce" , qemp_oce(:,:) ) 
108      IF( iom_use('qemp_ice') )  CALL iom_put( "qemp_ice" , qemp_ice(:,:) ) 
109      IF( iom_use('emp_oce' ) )  CALL iom_put( "emp_oce"  , emp_oce (:,:) )   ! emp over ocean (taking into account the snow blown away from the ice)
110      IF( iom_use('emp_ice' ) )  CALL iom_put( "emp_ice"  , emp_ice (:,:) )   ! emp over ice   (taking into account the snow blown away from the ice)
111
112      ! velocity
113      IF( iom_use('uice_ipa') )  CALL iom_put( "uice_ipa" , u_ice         )   ! ice velocity u component
114      IF( iom_use('vice_ipa') )  CALL iom_put( "vice_ipa" , v_ice         )   ! ice velocity v component
115
116      IF( iom_use('icevel') .OR. iom_use('icevel_mv') ) THEN
117         DO jj = 2 , jpjm1
118            DO ji = 2 , jpim1
119               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) )
120               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) )
121               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db )
122           END DO
123         END DO
124         CALL lbc_lnk( z2d, 'T', 1. )
125         IF( iom_use('icevel'   ) )   CALL iom_put( "icevel"       , z2d        )                          ! ice velocity module
126         IF( iom_use('icevel_mv') )   CALL iom_put( "icevel_mv"    , z2d(:,:) * zswi(:,:) + zmiss(:,:) )   ! ice velocity module (missing value)
127      ENDIF
128
129      IF( iom_use('tau_icebfr') )     CALL iom_put( "tau_icebfr"  , tau_icebfr             )  ! ice friction with ocean bottom (landfast ice) 
130      !
131      IF( iom_use('miceage')  )       CALL iom_put( "miceage"     , om_i * zswi * zamask15 )  ! mean ice age
132      IF( iom_use('micet')    )       CALL iom_put( "micet"       , ( tm_i  - rt0 ) * zswi )  ! ice mean    temperature
133      IF( iom_use('icest')    )       CALL iom_put( "icest"       , ( tm_su - rt0 ) * zswi )  ! ice surface temperature
134      IF( iom_use('icecolf')  )       CALL iom_put( "icecolf"     , hicol                  )  ! frazil ice collection thickness
135      !
136      CALL iom_put( "isst"        , sst_m               )        ! sea surface temperature
137      CALL iom_put( "isss"        , sss_m               )        ! sea surface salinity
138      CALL iom_put( "iceconc"     , at_i  * zswi        )        ! ice concentration
139      CALL iom_put( "icevolu"     , vt_i  * zswi        )        ! ice volume = mean ice thickness over the cell
140      CALL iom_put( "icethick"    , htm_i * zswi        )        ! ice thickness
141      CALL iom_put( "icehc"       , et_i  * zswi        )        ! ice total heat content
142      CALL iom_put( "isnowhc"     , et_s  * zswi        )        ! snow total heat content
143      CALL iom_put( "ibrinv"      , bvm_i * zswi * 100. )        ! brine volume
144      CALL iom_put( "snowpre"     , sprecip * 86400.    )        ! snow precipitation [m/day]
145      CALL iom_put( "micesalt"    , smt_i   * zswi      )        ! mean ice salinity
146      CALL iom_put( "snowvol"     , vt_s    * zswi      )        ! snow volume
147     
148      CALL iom_put( "sfxbog"      , sfx_bog * rday      )        ! salt flux from bottom growth
149      CALL iom_put( "sfxbom"      , sfx_bom * rday      )        ! salt flux from bottom melting
150      CALL iom_put( "sfxsum"      , sfx_sum * rday      )        ! salt flux from surface melting
151      CALL iom_put( "sfxlam"      , sfx_lam * rday      )        ! salt flux from lateral melting
152      CALL iom_put( "sfxsni"      , sfx_sni * rday      )        ! salt flux from snow ice formation
153      CALL iom_put( "sfxopw"      , sfx_opw * rday      )        ! salt flux from open water formation
154      CALL iom_put( "sfxdyn"      , sfx_dyn * rday      )        ! salt flux from ridging rafting
155      CALL iom_put( "sfxres"      , sfx_res * rday      )        ! salt flux from corrections (resultant)
156      CALL iom_put( "sfxbri"      , sfx_bri * rday      )        ! salt flux from brines
157      CALL iom_put( "sfxsub"      , sfx_sub * rday      )        ! salt flux from sublimation
158      CALL iom_put( "sfx"         , sfx     * rday      )        ! total salt flux
159
160      ztmp = rday / rhoic
161      CALL iom_put( "vfxres"     , wfx_res * ztmp       )        ! daily prod./melting due to corrections
162      CALL iom_put( "vfxopw"     , wfx_opw * ztmp       )        ! daily lateral thermodynamic ice production
163      CALL iom_put( "vfxsni"     , wfx_sni * ztmp       )        ! daily snowice ice production
164      CALL iom_put( "vfxbog"     , wfx_bog * ztmp       )        ! daily bottom thermodynamic ice production
165      CALL iom_put( "vfxdyn"     , wfx_dyn * ztmp       )        ! daily dynamic ice production (rid/raft)
166      CALL iom_put( "vfxsum"     , wfx_sum * ztmp       )        ! surface melt
167      CALL iom_put( "vfxbom"     , wfx_bom * ztmp       )        ! bottom melt
168      CALL iom_put( "vfxlam"     , wfx_lam * ztmp       )        ! lateral melt
169      CALL iom_put( "vfxice"     , wfx_ice * ztmp       )        ! total ice growth/melt
170
171      IF ( ln_pnd ) &
172         CALL iom_put( "vfxpnd"  , wfx_pnd * ztmp       )        ! melt pond water flux
173
174      IF ( iom_use( "vfxthin" ) ) THEN   ! ice production for open water + thin ice (<20cm) => comparable to observations 
175         WHERE( htm_i(:,:) < 0.2 .AND. htm_i(:,:) > 0. ) ; z2d = wfx_bog
176         ELSEWHERE                                       ; z2d = 0._wp
177         END WHERE
178         CALL iom_put( "vfxthin", ( wfx_opw + z2d ) * ztmp )
179      ENDIF
180
181      ztmp = rday * r1_rhosn
182      CALL iom_put( "vfxspr"     , wfx_spr * ztmp       )        ! precip (snow)
183      CALL iom_put( "vfxsnw"     , wfx_snw * ztmp       )        ! total snw growth/melt
184      CALL iom_put( "vfxsub"     , wfx_sub * ztmp       )        ! sublimation (snow/ice)
185      CALL iom_put( "vfxsub_err" , wfx_err_sub * ztmp   )        ! "excess" of sublimation sent to ocean     
186 
187      CALL iom_put ('hfxthd'     , hfx_thd(:,:)         )   
188      CALL iom_put ('hfxdyn'     , hfx_dyn(:,:)         )   
189      CALL iom_put ('hfxres'     , hfx_res(:,:)         )   
190      CALL iom_put ('hfxout'     , hfx_out(:,:)         )   
191      CALL iom_put ('hfxin'      , hfx_in(:,:)          )   
192      CALL iom_put ('hfxsnw'     , hfx_snw(:,:)         )   
193      CALL iom_put ('hfxsub'     , hfx_sub(:,:)         )   
194      CALL iom_put ('hfxerr'     , hfx_err_dif(:,:)     )   
195      CALL iom_put ('hfxerr_rem' , hfx_err_rem(:,:)     )   
196     
197      CALL iom_put ('hfxsum'     , hfx_sum(:,:)         )   
198      CALL iom_put ('hfxbom'     , hfx_bom(:,:)         )   
199      CALL iom_put ('hfxbog'     , hfx_bog(:,:)         )   
200      CALL iom_put ('hfxdif'     , hfx_dif(:,:)         )   
201      CALL iom_put ('hfxopw'     , hfx_opw(:,:)         )   
202      CALL iom_put ('hfxtur'     , fhtur(:,:) * at_i_b(:,:) ) ! turbulent heat flux at ice base
203      CALL iom_put ('hfxdhc'     , diag_heat(:,:)       )   ! Heat content variation in snow and ice
204      CALL iom_put ('hfxspr'     , hfx_spr(:,:)         )   ! Heat content of snow precip
205
206!!gm ====>>>>>  THIS should be moved where at_ip, vt_ip are computed fro the last time in the time-step  (limmpd)
207      ! MV MP 2016
208      IF ( ln_pnd ) THEN
209         CALL iom_put( "iceamp"  , at_ip  * zswi        )   ! melt pond total fraction
210         CALL iom_put( "icevmp"  , vt_ip  * zswi        )   ! melt pond total volume per unit area
211      ENDIF
212      ! END MV MP 2016
213!!gm  <<<<<<======= end
214
215      !----------------------------------
216      ! Output category-dependent fields
217      !----------------------------------
218      IF ( iom_use('iceconc_cat' ) )  CALL iom_put( "iceconc_cat"      , a_i   * zswi2   )        ! area for categories
219      IF ( iom_use('icethic_cat' ) )  CALL iom_put( "icethic_cat"      , ht_i  * zswi2   )        ! thickness for categories
220      IF ( iom_use('snowthic_cat') )  CALL iom_put( "snowthic_cat"     , ht_s  * zswi2   )        ! snow depth for categories
221      IF ( iom_use('salinity_cat') )  CALL iom_put( "salinity_cat"     , sm_i  * zswi2   )        ! salinity for categories
222      IF ( iom_use('icetemp_cat' ) )  CALL iom_put( "icetemp_cat", ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zswi2 )    ! ice temperature
223      IF ( iom_use('snwtemp_cat' ) )  CALL iom_put( "snwtemp_cat", ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zswi2 )    ! snow temperature
224      IF ( iom_use('iceage_cat'  ) )  CALL iom_put( "iceage_cat" , o_i * zswi2 )                   ! ice age
225      IF ( iom_use('brinevol_cat') )  CALL iom_put( "brinevol_cat", bv_i * 100. * zswi2 )          ! brine volume
226
227      ! MV MP 2016
228      IF ( ln_pnd ) THEN
229         IF ( iom_use('iceamp_cat') )  CALL iom_put( "iceamp_cat"     , a_ip       * zswi2   )       ! melt pond frac for categories
230         IF ( iom_use('icevmp_cat') )  CALL iom_put( "icevmp_cat"     , v_ip       * zswi2   )       ! melt pond frac for categories
231         IF ( iom_use('icehmp_cat') )  CALL iom_put( "icehmp_cat"     , h_ip       * zswi2   )       ! melt pond frac for categories
232         IF ( iom_use('iceafp_cat') )  CALL iom_put( "iceafp_cat"     , a_ip_frac  * zswi2   )       ! melt pond frac for categories
233      ENDIF
234      ! END MV MP 2016
235
236      !--------------------------------
237      ! Add-ons for SIMIP
238      !--------------------------------
239      zrho1 = ( rau0 - rhoic ) * r1_rau0; zrho2 = rhosn * r1_rau0
240
241      IF ( iom_use( "icepres"  ) ) CALL iom_put( "icepres"     , zswi(:,:)                     )                                ! Ice presence (1 or 0)
242      IF ( iom_use( "icemass"  ) ) CALL iom_put( "icemass"     , rhoic * vt_i(:,:) * zswi(:,:) )                                ! Ice mass per cell area
243      IF ( iom_use( "icethic"  ) ) CALL iom_put( "icethic"     , htm_i(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Ice thickness
244      IF ( iom_use( "snomass"  ) ) CALL iom_put( "snomass"     , rhosn * vt_s(:,:)         * zswi(:,:) + zmiss(:,:) )           ! Snow mass per cell area
245      IF ( iom_use( "snothic"  ) ) CALL iom_put( "snothic"     , htm_s(:,:) * zamask(:,:)  + ( 1. - zamask(:,:) ) * zmiss_val )     ! Snow thickness       
246
247      IF ( iom_use( "iceconc_cat_mv"  ) )  CALL iom_put( "iceconc_cat_mv" , a_i(:,:,:)  * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Area for categories
248      IF ( iom_use( "icethic_cat_mv"  ) )  CALL iom_put( "icethic_cat_mv" , ht_i(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Thickness for categories
249      IF ( iom_use( "snowthic_cat_mv" ) )  CALL iom_put( "snowthic_cat_mv", ht_s(:,:,:) * zswi2(:,:,:) + zmiss2(:,:,:) )        ! Snow depth for categories
250
251      IF ( iom_use( "icestK"   ) ) CALL iom_put( "icestK"      , tm_su(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice surface temperature
252      IF ( iom_use( "icesntK"  ) ) CALL iom_put( "icesntK"     , tm_si(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Snow-ice interface temperature
253      IF ( iom_use( "icebotK"  ) ) CALL iom_put( "icebotK"     , t_bo(:,:)                 * zswi(:,:) + zmiss(:,:) )           ! Ice bottom temperature
254      IF ( iom_use( "iceage"   ) ) CALL iom_put( "iceage"      , om_i(:,:) * zamask15(:,:) + ( 1. - zamask15(:,:) ) * zmiss_val )   ! Ice age
255      IF ( iom_use( "icesmass" ) ) CALL iom_put( "icesmass"    , SUM( smv_i, DIM = 3 ) * rhoic * 1.0e-3 * zswi(:,:) )           ! Mass of salt in sea ice per cell area
256      IF ( iom_use( "icesal"   ) ) CALL iom_put( "icesal"      , smt_i(:,:)                * zswi(:,:) + zmiss(:,:) )           ! Ice salinity
257
258      IF ( iom_use( "icefb"    ) ) THEN
259         zfb(:,:) = ( zrho1 * htm_i(:,:) - zrho2 * htm_s(:,:) )                                         
260         WHERE( zfb < 0._wp ) ;   zfb = 0._wp ;   END WHERE
261                                   CALL iom_put( "icefb"       , zfb(:,:)                  * zswi(:,:) + zmiss(:,:) )           ! Ice freeboard
262      ENDIF
263
264      IF ( iom_use( "isnhcneg" ) ) CALL iom_put( "isnhcneg"    , - et_s(:,:)               * zswi(:,:) + zmiss(:,:) )           ! Snow total heat content
265
266      IF ( iom_use( "dmithd"   ) ) CALL iom_put( "dmithd"      , - wfx_bog - wfx_bom - wfx_sum   &                       ! Sea-ice mass change from thermodynamics
267              &                                                   - wfx_sni - wfx_opw - wfx_res )
268      IF ( iom_use( "dmidyn"   ) ) CALL iom_put( "dmidyn"      , - wfx_dyn(:,:) + rhoic * diag_trp_vi(:,:) )             ! Sea-ice mass change from dynamics(kg/m2/s)
269      IF ( iom_use( "dmiopw"   ) ) CALL iom_put( "dmiopw"      , - wfx_opw                  )                            ! Sea-ice mass change through growth in open water
270      IF ( iom_use( "dmibog"   ) ) CALL iom_put( "dmibog"      , - wfx_bog                  )                            ! Sea-ice mass change through basal growth
271      IF ( iom_use( "dmisni"   ) ) CALL iom_put( "dmisni"      , - wfx_sni                  )                            ! Sea-ice mass change through snow-to-ice conversion
272      IF ( iom_use( "dmisum"   ) ) CALL iom_put( "dmisum"      , - wfx_sum                  )                            ! Sea-ice mass change through surface melting
273      IF ( iom_use( "dmibom"   ) ) CALL iom_put( "dmibom"      , - wfx_bom                  )                            ! Sea-ice mass change through bottom melting
274
275      IF ( iom_use( "dmtsub"   ) ) CALL iom_put( "dmtsub"      , - wfx_sub                  )                            ! Sea-ice mass change through evaporation and sublimation
276      IF ( iom_use( "dmssub"   ) ) CALL iom_put( "dmssub"      , - wfx_snw_sub              )                            ! Snow mass change through sublimation
277      IF ( iom_use( "dmisub"   ) ) CALL iom_put( "dmisub"      , - wfx_ice_sub              )                            ! Sea-ice mass change through sublimation
278
279      IF ( iom_use( "dmsspr"   ) ) CALL iom_put( "dmsspr"      , - wfx_spr                  )                            ! Snow mass change through snow fall
280      IF ( iom_use( "dmsssi"   ) ) CALL iom_put( "dmsssi"      ,   wfx_sni*rhosn*r1_rhoic   )                            ! Snow mass change through snow-to-ice conversion
281
282      IF ( iom_use( "dmsmel"   ) ) CALL iom_put( "dmsmel"      , - wfx_snw_sum              )                            ! Snow mass change through melt
283      IF ( iom_use( "dmsdyn"   ) ) CALL iom_put( "dmsdyn"      , - wfx_snw_dyn(:,:) + rhosn * diag_trp_vs(:,:) )         ! Snow mass change through dynamics(kg/m2/s)
284
285      IF ( iom_use( "hfxsenso" ) ) CALL iom_put( "hfxsenso"    ,   -fhtur(:,:)              * zswi(:,:) + zmiss(:,:) )   ! Sensible oceanic heat flux
286      IF ( iom_use( "hfxconbo" ) ) CALL iom_put( "hfxconbo"    ,   diag_fc_bo               * zswi(:,:) + zmiss(:,:) )   ! Bottom conduction flux
287      IF ( iom_use( "hfxconsu" ) ) CALL iom_put( "hfxconsu"    ,   diag_fc_su               * zswi(:,:) + zmiss(:,:) )   ! Surface conduction flux
288
289      IF ( iom_use( "wfxtot"   ) ) CALL iom_put( "wfxtot"      ,   wfx_ice(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Total freshwater flux from sea ice
290      IF ( iom_use( "wfxsum"   ) ) CALL iom_put( "wfxsum"      ,   wfx_sum(:,:)             * zswi(:,:) + zmiss(:,:) )   ! Freshwater flux from sea-ice surface
291      IF ( iom_use( "sfx_mv"   ) ) CALL iom_put( "sfx_mv"      ,   sfx(:,:) * 0.001         * zswi(:,:) + zmiss(:,:) )   ! Total salt flux
292
293      IF ( iom_use( "uice_mv"  ) ) CALL iom_put( "uice_mv"     ,   u_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity u component
294      IF ( iom_use( "vice_mv"  ) ) CALL iom_put( "vice_mv"     ,   v_ice(:,:)               * zswi(:,:) + zmiss(:,:) )   ! ice velocity v component
295     
296      IF ( iom_use( "utau_ice" ) ) CALL iom_put( "utau_ice"     ,  utau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (x)
297      IF ( iom_use( "vtau_ice" ) ) CALL iom_put( "vtau_ice"     ,  vtau_ice(:,:)            * zswi(:,:) + zmiss(:,:) )   ! Wind stress term in force balance (y)
298
299      !--------------------------------
300      ! Global ice diagnostics (SIMIP)
301      !--------------------------------
302      !
303      IF ( iom_use( "NH_icearea" ) .OR. iom_use( "NH_icevolu" ) .OR. iom_use( "NH_iceextt" ) )   THEN   ! NH diagnostics
304         !
305         WHERE( ff_t > 0._wp )   ;   zswi(:,:) = 1.0e-12
306         ELSEWHERE               ;   zswi(:,:) = 0.
307         END WHERE
308         zdiag_area_nh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) )
309         zdiag_volu_nh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
310         !
311         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zswi(:,:) = 1.0e-12
312         ELSEWHERE                                 ; zswi(:,:) = 0.
313         END WHERE
314         zdiag_extt_nh = glob_sum( zswi(:,:) * e1e2t(:,:) )
315         !
316         IF ( iom_use( "NH_icearea" ) )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh  )
317         IF ( iom_use( "NH_icevolu" ) )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh  )
318         IF ( iom_use( "NH_iceextt" ) )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh  )
319         !
320      ENDIF
321      !
322      IF ( iom_use( "SH_icearea" ) .OR. iom_use( "SH_icevolu" ) .OR. iom_use( "SH_iceextt" ) )   THEN   ! SH diagnostics
323         !
324         WHERE( ff_t < 0._wp ); zswi(:,:) = 1.0e-12; 
325         ELSEWHERE            ; zswi(:,:) = 0.
326         END WHERE
327         zdiag_area_sh = glob_sum( at_i(:,:) * zswi(:,:) * e1e2t(:,:) ) 
328         zdiag_volu_sh = glob_sum( vt_i(:,:) * zswi(:,:) * e1e2t(:,:) )
329         !
330         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zswi(:,:) = 1.0e-12
331         ELSEWHERE                              ; zswi(:,:) = 0.
332         END WHERE
333         zdiag_extt_sh = glob_sum( zswi(:,:) * e1e2t(:,:) )
334         !
335         IF ( iom_use( "SH_icearea" ) ) CALL iom_put( "SH_icearea", zdiag_area_sh )
336         IF ( iom_use( "SH_icevolu" ) ) CALL iom_put( "SH_icevolu", zdiag_volu_sh )
337         IF ( iom_use( "SH_iceextt" ) ) CALL iom_put( "SH_iceextt", zdiag_extt_sh )
338         !
339      ENDIF 
340      !
341!!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
342!!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' )
343!!CR      !     not yet implemented
344!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl....
345      !
346      IF( nn_timing == 1 )  CALL timing_stop('icewri')
347      !
348   END SUBROUTINE ice_wri
349
350 
351   SUBROUTINE ice_wri_state( kt, kid, kh_i )
352      !!---------------------------------------------------------------------
353      !!                 ***  ROUTINE ice_wri_state  ***
354      !!       
355      !! ** Purpose :   create a NetCDF file named cdfile_name which contains
356      !!      the instantaneous ice state and forcing fields for ice model
357      !!        Used to find errors in the initial state or save the last
358      !!      ocean state in case of abnormal end of a simulation
359      !!
360      !! History :   4.0  !  2013-06  (C. Rousset)
361      !!----------------------------------------------------------------------
362      INTEGER, INTENT( in )   ::   kt               ! ocean time-step index)
363      INTEGER, INTENT( in )   ::   kid , kh_i
364      INTEGER                 ::   nz_i, jl
365      REAL(wp), DIMENSION(jpl) :: jcat
366      !!----------------------------------------------------------------------
367      !
368      DO jl = 1, jpl
369         jcat(jl) = REAL(jl)
370      END DO
371     
372      CALL histvert( kid, "ncatice", "Ice Categories","", jpl, jcat, nz_i, "up")
373
374      CALL histdef( kid, "sithic", "Ice thickness"           , "m"      ,   &
375      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
376      CALL histdef( kid, "siconc", "Ice concentration"       , "%"      ,   &
377      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
378      CALL histdef( kid, "sitemp", "Ice temperature"         , "C"      ,   &
379      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
380      CALL histdef( kid, "sivelu", "i-Ice speed "            , "m/s"    ,   &
381      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
382      CALL histdef( kid, "sivelv", "j-Ice speed "            , "m/s"    ,   &
383      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
384      CALL histdef( kid, "sistru", "i-Wind stress over ice " , "Pa"     ,   &
385      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
386      CALL histdef( kid, "sistrv", "j-Wind stress over ice " , "Pa"     ,   &
387      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
388      CALL histdef( kid, "sisflx", "Solar flux over ocean"     , "w/m2" ,   &
389      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
390      CALL histdef( kid, "sinflx", "Non-solar flux over ocean" , "w/m2" ,   &
391      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
392      CALL histdef( kid, "isnowpre", "Snow precipitation"      , "kg/m2/s",   &
393      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
394      CALL histdef( kid, "sisali", "Ice salinity"            , "PSU"    ,   &
395      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
396      CALL histdef( kid, "sivolu", "Ice volume"              , "m"      ,   &
397      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
398      CALL histdef( kid, "sidive", "Ice divergence"          , "10-8s-1",   &
399      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt ) 
400
401      ! MV MP 2016
402      IF ( ln_pnd ) THEN
403         CALL histdef( kid, "si_amp", "Melt pond fraction"      , "%"      ,   &
404      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
405         CALL histdef( kid, "si_vmp", "Melt pond volume"        ,  "m"     ,   &
406      &         jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
407      ENDIF
408      ! END MV MP 2016
409
410      CALL histdef( kid, "vfxbog", "Ice bottom production"   , "m/s"    ,   &
411      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
412      CALL histdef( kid, "vfxdyn", "Ice dynamic production"  , "m/s"    ,   &
413      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
414      CALL histdef( kid, "vfxopw", "Ice open water prod"     , "m/s"    ,   &
415      &       jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
416      CALL histdef( kid, "vfxsni", "Snow ice production "    , "m/s"    ,   &
417      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
418      CALL histdef( kid, "vfxres", "Ice prod from corrections" , "m/s"  ,   &
419      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
420      CALL histdef( kid, "vfxbom", "Ice bottom melt"         , "m/s"    ,   &
421      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
422      CALL histdef( kid, "vfxsum", "Ice surface melt"        , "m/s"    ,   &
423      &      jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
424
425      CALL histdef( kid, "sithicat", "Ice thickness"         , "m"      ,   &
426      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
427      CALL histdef( kid, "siconcat", "Ice concentration"     , "%"      ,   &
428      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
429      CALL histdef( kid, "sisalcat", "Ice salinity"           , ""      ,   &
430      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
431      CALL histdef( kid, "sitemcat", "Ice temperature"       , "C"      ,   &
432      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
433      CALL histdef( kid, "snthicat", "Snw thickness"         , "m"      ,   &
434      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
435      CALL histdef( kid, "sntemcat", "Snw temperature"       , "C"      ,   &
436      &      jpi, jpj, kh_i, jpl, 1, jpl, nz_i, 32, "inst(x)", rdt, rdt )
437
438      CALL histend( kid, snc4set )   ! end of the file definition
439
440      CALL histwrite( kid, "sithic", kt, htm_i         , jpi*jpj, (/1/) )   
441      CALL histwrite( kid, "siconc", kt, at_i          , jpi*jpj, (/1/) )
442      CALL histwrite( kid, "sitemp", kt, tm_i - rt0    , jpi*jpj, (/1/) )
443      CALL histwrite( kid, "sivelu", kt, u_ice          , jpi*jpj, (/1/) )
444      CALL histwrite( kid, "sivelv", kt, v_ice          , jpi*jpj, (/1/) )
445      CALL histwrite( kid, "sistru", kt, utau_ice       , jpi*jpj, (/1/) )
446      CALL histwrite( kid, "sistrv", kt, vtau_ice       , jpi*jpj, (/1/) )
447      CALL histwrite( kid, "sisflx", kt, qsr , jpi*jpj, (/1/) )
448      CALL histwrite( kid, "sinflx", kt, qns , jpi*jpj, (/1/) )
449      CALL histwrite( kid, "isnowpre", kt, sprecip        , jpi*jpj, (/1/) )
450      CALL histwrite( kid, "sisali", kt, smt_i          , jpi*jpj, (/1/) )
451      CALL histwrite( kid, "sivolu", kt, vt_i           , jpi*jpj, (/1/) )
452      CALL histwrite( kid, "sidive", kt, divu_i*1.0e8   , jpi*jpj, (/1/) )
453
454      ! MV MP 2016
455      IF ( ln_pnd ) THEN
456         CALL histwrite( kid, "si_amp", kt, at_ip         , jpi*jpj, (/1/) )
457         CALL histwrite( kid, "si_vmp", kt, vt_ip         , jpi*jpj, (/1/) )
458      ENDIF
459      ! END MV MP 2016
460
461      CALL histwrite( kid, "vfxbog", kt, wfx_bog        , jpi*jpj, (/1/) )
462      CALL histwrite( kid, "vfxdyn", kt, wfx_dyn        , jpi*jpj, (/1/) )
463      CALL histwrite( kid, "vfxopw", kt, wfx_opw        , jpi*jpj, (/1/) )
464      CALL histwrite( kid, "vfxsni", kt, wfx_sni        , jpi*jpj, (/1/) )
465      CALL histwrite( kid, "vfxres", kt, wfx_res        , jpi*jpj, (/1/) )
466      CALL histwrite( kid, "vfxbom", kt, wfx_bom        , jpi*jpj, (/1/) )
467      CALL histwrite( kid, "vfxsum", kt, wfx_sum        , jpi*jpj, (/1/) )
468      IF ( ln_pnd ) &
469         CALL histwrite( kid, "vfxpnd", kt, wfx_pnd     , jpi*jpj, (/1/) )
470
471      CALL histwrite( kid, "sithicat", kt, ht_i        , jpi*jpj*jpl, (/1/) )   
472      CALL histwrite( kid, "siconcat", kt, a_i         , jpi*jpj*jpl, (/1/) )   
473      CALL histwrite( kid, "sisalcat", kt, sm_i        , jpi*jpj*jpl, (/1/) )   
474      CALL histwrite( kid, "sitemcat", kt, tm_i - rt0  , jpi*jpj*jpl, (/1/) )   
475      CALL histwrite( kid, "snthicat", kt, ht_s        , jpi*jpj*jpl, (/1/) )   
476      CALL histwrite( kid, "sntemcat", kt, tm_su - rt0 , jpi*jpj*jpl, (/1/) )   
477
478      ! Close the file
479      ! -----------------
480!!gm I don't understand why the file is not closed !
481      !CALL histclo( kid )
482      !
483    END SUBROUTINE ice_wri_state
484
485#else
486   !!----------------------------------------------------------------------
487   !!   Default option :         Empty module         NO ESIM sea-ice model
488   !!----------------------------------------------------------------------
489#endif
490
491   !!======================================================================
492END MODULE icewri
Note: See TracBrowser for help on using the repository browser.