Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

icedia.F90

Last change on this file was 15048, checked in by clem, 3 years ago
reduce drastically the number of global communications when using diagnostic outputs. New functions are created: glob_sum_vec and glob_sum_full_vec, which gave a vector as an output. This vector is composed of different summed arrays (such as temperature, salinity etc). Global diagnostics are identical as before. See examples in icedia and diahsb.
Property svn:keywords set to `Id`
File size: 15.3 KB

Line
1	MODULE icedia
2	!!======================================================================
3	!! * MODULE icedia *
4	!! Sea-Ice: global budgets
5	!!======================================================================
6	!! History : 3.4 ! 2012-10 (C. Rousset) original code
7	!! 4.0 ! 2018 (many people) SI3 [aka Sea Ice cube]
8	!!----------------------------------------------------------------------
9	#if defined key_si3
10	!!----------------------------------------------------------------------
11	!! 'key_si3' SI3 sea-ice model
12	!!----------------------------------------------------------------------
13	!! ice_dia : diagnostic of the sea-ice global heat content, salt content and volume conservation
14	!! ice_dia_init : initialization of budget calculation
15	!! ice_dia_rst : read/write budgets restart
16	!!----------------------------------------------------------------------
17	USE dom_oce ! ocean domain
18	USE phycst ! physical constant
19	USE daymod ! model calendar
20	USE sbc_oce , ONLY : sfx, nn_fsbc ! surface boundary condition: ocean fields
21	USE ice ! sea-ice: variables
22	USE icerst ! sea-ice: restart
23	!
24	USE in_out_manager ! I/O manager
25	USE iom ! I/O manager library
26	USE lib_mpp ! MPP library
27	USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
28	USE timing ! Timing
29
30	IMPLICIT NONE
31	PRIVATE
32
33	PUBLIC ice_dia ! called by icestp.F90
34	PUBLIC ice_dia_init ! called in icestp.F90
35
36	REAL(wp), SAVE :: z1_e1e2 ! inverse of the ocean area
37	REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents
38	REAL(wp) :: frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot ! global forcing trends
39
40	!!----------------------------------------------------------------------
41	!! NEMO/ICE 4.0 , NEMO Consortium (2018)
42	!! $Id$
43	!! Software governed by the CeCILL license (see ./LICENSE)
44	!!----------------------------------------------------------------------
45	CONTAINS
46
47	INTEGER FUNCTION ice_dia_alloc()
48	!!---------------------------------------------------------------------!
49	!! * ROUTINE ice_dia_alloc *
50	!!---------------------------------------------------------------------!
51	ALLOCATE( vol_loc_ini(jpi,jpj), sal_loc_ini(jpi,jpj), tem_loc_ini(jpi,jpj), STAT=ice_dia_alloc )
52
53	CALL mpp_sum ( 'icedia', ice_dia_alloc )
54	IF( ice_dia_alloc /= 0 ) CALL ctl_stop( 'STOP', 'ice_dia_alloc: failed to allocate arrays' )
55	!
56	END FUNCTION ice_dia_alloc
57
58	SUBROUTINE ice_dia( kt )
59	!!---------------------------------------------------------------------------
60	!! * ROUTINE ice_dia *
61	!!
62	!! ** Purpose: Compute the sea-ice global heat content, salt content
63	!! and volume conservation
64	!!---------------------------------------------------------------------------
65	INTEGER, INTENT(in) :: kt ! ocean time step
66	!!
67	REAL(wp), DIMENSION(jpi,jpj,16) :: ztmp
68	REAL(wp), DIMENSION(16) :: zbg
69	!!---------------------------------------------------------------------------
70	IF( ln_timing ) CALL timing_start('ice_dia')
71
72	IF( kt == nit000 .AND. lwp ) THEN
73	WRITE(numout,*)
74	WRITE(numout,*)'icedia: output ice diagnostics (integrated over the domain)'
75	WRITE(numout,*)'~~~~~~'
76	ENDIF
77
78	IF( kt == nit000 ) THEN
79	z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) )
80	ENDIF
81
82	ztmp(:,:,:) = 0._wp ! should be better coded
83
84	! ---------------------------!
85	! 1 - Trends due to forcing !
86	! ---------------------------!
87	! they must be kept outside an IF(iom_use) because of the call to dia_rst below
88	ztmp(:,:,1) = - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ! freshwater flux ice/snow-ocean
89	ztmp(:,:,2) = - ( wfx_sub(:,:) + wfx_spr(:,:) ) * e1e2t(:,:) ! freshwater flux ice/snow-atm
90	ztmp(:,:,3) = - sfx (:,:) * e1e2t(:,:) ! salt fluxes ice/snow-ocean
91	ztmp(:,:,4) = qt_atm_oi(:,:) * e1e2t(:,:) ! heat on top of ice-ocean
92	ztmp(:,:,5) = qt_oce_ai(:,:) * e1e2t(:,:) ! heat on top of ocean (and below ice)
93
94	! ----------------------- !
95	! 2 - Contents !
96	! ----------------------- !
97	IF( iom_use('ibgvol_tot' ) ) ztmp(:,:,6 ) = vt_i (:,:) * e1e2t(:,:) ! ice volume
98	IF( iom_use('sbgvol_tot' ) ) ztmp(:,:,7 ) = vt_s (:,:) * e1e2t(:,:) ! snow volume
99	IF( iom_use('ibgarea_tot') ) ztmp(:,:,8 ) = at_i (:,:) * e1e2t(:,:) ! area
100	IF( iom_use('ibgsalt_tot') ) ztmp(:,:,9 ) = st_i (:,:) * e1e2t(:,:) ! salt content
101	IF( iom_use('ibgheat_tot') ) ztmp(:,:,10) = et_i (:,:) * e1e2t(:,:) ! heat content
102	IF( iom_use('sbgheat_tot') ) ztmp(:,:,11) = et_s (:,:) * e1e2t(:,:) ! heat content
103	IF( iom_use('ipbgvol_tot') ) ztmp(:,:,12) = vt_ip(:,:) * e1e2t(:,:) ! ice pond volume
104	IF( iom_use('ilbgvol_tot') ) ztmp(:,:,13) = vt_il(:,:) * e1e2t(:,:) ! ice pond lid volume
105
106	! ---------------------------------- !
107	! 3 - Content variations and drifts !
108	! ---------------------------------- !
109	IF( iom_use('ibgvolume') ) ztmp(:,:,14) = ( rhoivt_i(:,:) + rhosvt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ! freshwater trend
110	IF( iom_use('ibgsaltco') ) ztmp(:,:,15) = ( rhoist_i(:,:) - sal_loc_ini(:,:) ) e1e2t(:,:) ! salt content trend
111	IF( iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) &
112	& ztmp(:,:,16) = ( et_i(:,:) + et_s(:,:) - tem_loc_ini(:,:) ) * e1e2t(:,:) ! heat content trend
113
114	! global sum
115	zbg(1:16) = glob_sum_vec( 'icedia', ztmp(:,:,1:16) )
116
117	! change units for trends
118	zbg(1) = zbg(1) * r1_rho0 * 1.e-9 * rDt_ice ! freshwater flux ice/snow-ocean (km3)
119	zbg(2) = zbg(2) * r1_rho0 * 1.e-9 * rDt_ice ! freshwater flux ice/snow-atm (km3)
120	zbg(3) = zbg(3) * r1_rho0 * 1.e-9 * rDt_ice ! salt fluxes ice/snow-ocean (km3*pss)
121	zbg(4) = zbg(4) * 1.e-20 * rDt_ice ! heat on top of ice-ocean (1.e20 J)
122	zbg(5) = zbg(5) * 1.e-20 * rDt_ice ! heat on top of ocean (and below ice) (1.e20 J)
123	! cumulative sum
124	frc_voltop = frc_voltop + zbg(1)
125	frc_volbot = frc_volbot + zbg(2)
126	frc_sal = frc_sal + zbg(3)
127	frc_temtop = frc_temtop + zbg(4)
128	frc_tembot = frc_tembot + zbg(5)
129
130	! change units for contents
131	zbg(6) = zbg(6) * 1.e-9 ! ice volume (km3)
132	zbg(7) = zbg(7) * 1.e-9 ! snw volume (km3)
133	zbg(8) = zbg(8) * 1.e-6 ! ice area (km2)
134	zbg(9) = zbg(9) * 1.e-9 ! salt content (km3*pss)
135	zbg(10) = zbg(10) * 1.e-20 ! ice heat content (1.e20 J)
136	zbg(11) = zbg(11) * 1.e-20 ! snw heat content (1.e20 J)
137	zbg(12) = zbg(12) * 1.e-9 ! pnd volume (km3)
138	zbg(13) = zbg(13) * 1.e-9 ! pnd lid volume (km3)
139
140	! change units for trends
141	zbg(14) = zbg(14) * r1_rho0 * 1.e-9 ! freshwater trend (km3)
142	zbg(15) = zbg(15) * r1_rho0 * 1.e-9 ! salt content trend (km3*pss)
143	zbg(16) = zbg(16) * 1.e-20 ! heat content trend (1.e20 J)
144	! difference
145	zbg(14) = zbg(14) - ( frc_voltop + frc_volbot )
146	zbg(15) = zbg(15) - frc_sal
147	zbg(16) = zbg(16) - ( frc_tembot - frc_temtop )
148
149	! outputs
150	CALL iom_put( 'ibgfrcvoltop' , frc_voltop ) ! vol forcing ice/snw-atm (km3 equivalent ocean water)
151	CALL iom_put( 'ibgfrcvolbot' , frc_volbot ) ! vol forcing ice/snw-ocean (km3 equivalent ocean water)
152	CALL iom_put( 'ibgfrcsal' , frc_sal ) ! sal forcing (psu*km3 equivalent ocean water)
153	CALL iom_put( 'ibgfrctemtop' , frc_temtop ) ! heat on top of ice/snw/ocean (1.e20 J)
154	CALL iom_put( 'ibgfrctembot' , frc_tembot ) ! heat on top of ocean(below ice) (1.e20 J)
155	CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ice/snw/ocean (W/m2)
156	CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice) (W/m2)
157
158	CALL iom_put( 'ibgvol_tot' , zbg(6) )
159	CALL iom_put( 'sbgvol_tot' , zbg(7) )
160	CALL iom_put( 'ibgarea_tot' , zbg(8) )
161	CALL iom_put( 'ibgsalt_tot' , zbg(9) )
162	CALL iom_put( 'ibgheat_tot' , zbg(10) )
163	CALL iom_put( 'sbgheat_tot' , zbg(11) )
164	CALL iom_put( 'ipbgvol_tot' , zbg(12) )
165	CALL iom_put( 'ilbgvol_tot' , zbg(13) )
166
167	CALL iom_put( 'ibgvolume' , zbg(14) ) ! ice/snow volume drift (km3 equivalent ocean water)
168	CALL iom_put( 'ibgsaltco' , zbg(15) ) ! ice salt content drift (psu*km3 equivalent ocean water)
169	CALL iom_put( 'ibgheatco' , zbg(16) ) ! ice/snow heat content drift (1.e20 J)
170	!
171	! restarts
172	IF( lrst_ice ) CALL ice_dia_rst( 'WRITE', kt_ice )
173	!
174	IF( ln_timing ) CALL timing_stop('ice_dia')
175	!
176	END SUBROUTINE ice_dia
177
178
179	SUBROUTINE ice_dia_init
180	!!---------------------------------------------------------------------------
181	!! * ROUTINE ice_dia_init *
182	!!
183	!! ** Purpose: Initialization for the heat salt volume budgets
184	!!
185	!! ** Method : Compute initial heat content, salt content and volume
186	!!
187	!! ** Action : - Compute initial heat content, salt content and volume
188	!! - Initialize forcing trends
189	!! - Compute coefficients for conversion
190	!!---------------------------------------------------------------------------
191	INTEGER :: ios, ierror ! local integer
192	!!
193	NAMELIST/namdia/ ln_icediachk, rn_icechk_cel, rn_icechk_glo, ln_icediahsb, ln_icectl, iiceprt, jiceprt
194	!!----------------------------------------------------------------------
195	!
196	READ ( numnam_ice_ref, namdia, IOSTAT = ios, ERR = 901)
197	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdia in reference namelist' )
198	READ ( numnam_ice_cfg, namdia, IOSTAT = ios, ERR = 902 )
199	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdia in configuration namelist' )
200	IF(lwm) WRITE ( numoni, namdia )
201	!
202	IF(lwp) THEN ! control print
203	WRITE(numout,*)
204	WRITE(numout,*) 'ice_dia_init: ice diagnostics'
205	WRITE(numout,*) ' ~~~~~~~~~~~'
206	WRITE(numout,*) ' Namelist namdia:'
207	WRITE(numout,*) ' Diagnose online heat/mass/salt conservation ln_icediachk = ', ln_icediachk
208	WRITE(numout,*) ' threshold for conservation (gridcell) rn_icechk_cel = ', rn_icechk_cel
209	WRITE(numout,*) ' threshold for conservation (global) rn_icechk_glo = ', rn_icechk_glo
210	WRITE(numout,*) ' Output heat/mass/salt budget ln_icediahsb = ', ln_icediahsb
211	WRITE(numout,*) ' control prints for a given grid point ln_icectl = ', ln_icectl
212	WRITE(numout,*) ' chosen grid point position (iiceprt,jiceprt) = (', iiceprt,',', jiceprt,')'
213	ENDIF
214	!
215	IF( ln_icediahsb ) THEN
216	IF( ice_dia_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'ice_dia_init : unable to allocate arrays' ) ! allocate tke arrays
217	CALL ice_dia_rst( 'READ' ) ! read or initialize all required files
218	ENDIF
219	!
220	END SUBROUTINE ice_dia_init
221
222
223	SUBROUTINE ice_dia_rst( cdrw, kt )
224	!!---------------------------------------------------------------------
225	!! * ROUTINE icedia_rst *
226	!!
227	!! ** Purpose : Read or write DIA file in restart file
228	!!
229	!! ** Method : use of IOM library
230	!!----------------------------------------------------------------------
231	CHARACTER(len=*) , INTENT(in) :: cdrw ! "READ"/"WRITE" flag
232	INTEGER, OPTIONAL, INTENT(in) :: kt ! ice time-step
233	!
234	INTEGER :: iter ! local integer
235	REAL(wp) :: ziter ! local scalar
236	!!----------------------------------------------------------------------
237	!
238	IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise
239	IF( ln_rstart ) THEN !* Read the restart file
240	!
241	CALL iom_get( numrir, 'kt_ice' , ziter )
242	IF(lwp) WRITE(numout,*)
243	IF(lwp) WRITE(numout,*) 'ice_dia_rst read at time step = ', ziter
244	IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
245	CALL iom_get( numrir, 'frc_voltop' , frc_voltop )
246	CALL iom_get( numrir, 'frc_volbot' , frc_volbot )
247	CALL iom_get( numrir, 'frc_temtop' , frc_temtop )
248	CALL iom_get( numrir, 'frc_tembot' , frc_tembot )
249	CALL iom_get( numrir, 'frc_sal' , frc_sal )
250	CALL iom_get( numrir, jpdom_auto, 'vol_loc_ini', vol_loc_ini )
251	CALL iom_get( numrir, jpdom_auto, 'tem_loc_ini', tem_loc_ini )
252	CALL iom_get( numrir, jpdom_auto, 'sal_loc_ini', sal_loc_ini )
253	ELSE
254	IF(lwp) WRITE(numout,*)
255	IF(lwp) WRITE(numout,*) ' ice_dia at initial state '
256	IF(lwp) WRITE(numout,*) '~~~~~~~'
257	! set trends to 0
258	frc_voltop = 0._wp
259	frc_volbot = 0._wp
260	frc_temtop = 0._wp
261	frc_tembot = 0._wp
262	frc_sal = 0._wp
263	! record initial ice volume, salt and temp
264	vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:) ! ice/snow volume (kg/m2)
265	tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:) ! ice/snow heat content (J)
266	sal_loc_ini(:,:) = rhoi * st_i(:,:) ! ice salt content (pss*kg/m2)
267	ENDIF
268	!
269	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file
270	! ! -------------------
271	iter = kt + nn_fsbc - 1 ! ice restarts are written at kt == nitrst - nn_fsbc + 1
272	!
273	IF( iter == nitrst ) THEN
274	IF(lwp) WRITE(numout,*)
275	IF(lwp) WRITE(numout,*) 'ice_dia_rst write at time step = ', kt
276	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
277	ENDIF
278	!
279	! Write in numriw (if iter == nitrst)
280	! ------------------
281	CALL iom_rstput( iter, nitrst, numriw, 'frc_voltop' , frc_voltop )
282	CALL iom_rstput( iter, nitrst, numriw, 'frc_volbot' , frc_volbot )
283	CALL iom_rstput( iter, nitrst, numriw, 'frc_temtop' , frc_temtop )
284	CALL iom_rstput( iter, nitrst, numriw, 'frc_tembot' , frc_tembot )
285	CALL iom_rstput( iter, nitrst, numriw, 'frc_sal' , frc_sal )
286	CALL iom_rstput( iter, nitrst, numriw, 'vol_loc_ini', vol_loc_ini )
287	CALL iom_rstput( iter, nitrst, numriw, 'tem_loc_ini', tem_loc_ini )
288	CALL iom_rstput( iter, nitrst, numriw, 'sal_loc_ini', sal_loc_ini )
289	!
290	ENDIF
291	!
292	END SUBROUTINE ice_dia_rst
293
294	#else
295	!!----------------------------------------------------------------------
296	!! Default option : Empty module NO SI3 sea-ice model
297	!!----------------------------------------------------------------------
298	#endif
299
300	!!======================================================================
301	END MODULE icedia

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/trunk/src/ICE/icedia.F90

Download in other formats: