Context Navigation

icectl.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

Property svn:keywords set to Id

File size: 39.3 KB

Line
1	MODULE icectl
2	!!======================================================================
3	!! * MODULE icectl *
4	!! sea-ice : controls and prints
5	!!======================================================================
6	!! History : 3.5 ! 2015-01 (M. Vancoppenolle) Original code
7	!! 3.7 ! 2016-10 (C. Rousset) Add routine ice_prt3D
8	!! 4.0 ! 2018 (many people) SI3 [aka Sea Ice cube]
9	!!----------------------------------------------------------------------
10	#if defined key_si3
11	!!----------------------------------------------------------------------
12	!! 'key_si3' SI3 sea-ice model
13	!!----------------------------------------------------------------------
14	!! ice_cons_hsm : conservation tests on heat, salt and mass during a time step (global)
15	!! ice_cons_final : conservation tests on heat, salt and mass at end of time step (global)
16	!! ice_cons2D : conservation tests on heat, salt and mass at each gridcell
17	!! ice_ctl : control prints in case of crash
18	!! ice_prt : control prints at a given grid point
19	!! ice_prt3D : control prints of ice arrays
20	!!----------------------------------------------------------------------
21	USE phycst ! physical constants
22	USE oce ! ocean dynamics and tracers
23	USE dom_oce ! ocean space and time domain
24	USE ice ! sea-ice: variables
25	USE ice1D ! sea-ice: thermodynamics variables
26	USE sbc_oce ! Surface boundary condition: ocean fields
27	USE sbc_ice ! Surface boundary condition: ice fields
28	!
29	USE in_out_manager ! I/O manager
30	USE iom ! I/O manager library
31	USE lib_mpp ! MPP library
32	USE lib_fortran ! fortran utilities (glob_sum + no signed zero)
33	USE timing ! Timing
34	USE prtctl ! Print control
35
36	IMPLICIT NONE
37	PRIVATE
38
39	PUBLIC ice_cons_hsm
40	PUBLIC ice_cons_final
41	PUBLIC ice_cons2D
42	PUBLIC ice_ctl
43	PUBLIC ice_prt
44	PUBLIC ice_prt3D
45
46	! thresold rates for conservation
47	! these values are changed by the namelist parameter rn_icechk, so that threshold = zchk * rn_icechk
48	REAL(wp), PARAMETER :: zchk_m = 2.5e-7 ! kg/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost
49	REAL(wp), PARAMETER :: zchk_s = 2.5e-6 ! g/m2/s <=> 1e-6 m of ice per hour spuriously gained/lost (considering s=10g/kg)
50	REAL(wp), PARAMETER :: zchk_t = 7.5e-2 ! W/m2 <=> 1e-6 m of ice per hour spuriously gained/lost (considering Lf=3e5J/kg)
51
52	!! * Substitutions
53	# include "vectopt_loop_substitute.h90"
54	# include "do_loop_substitute.h90"
55	!!----------------------------------------------------------------------
56	!! NEMO/ICE 4.0 , NEMO Consortium (2018)
57	!! $Id$
58	!! Software governed by the CeCILL license (see ./LICENSE)
59	!!----------------------------------------------------------------------
60	CONTAINS
61
62	SUBROUTINE ice_cons_hsm( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft )
63	!!-------------------------------------------------------------------
64	!! * ROUTINE ice_cons_hsm *
65	!!
66	!! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
67	!! + test if ice concentration and volume are > 0
68	!!
69	!! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true
70	!! It prints in ocean.output if there is a violation of conservation at each time-step
71	!! The thresholds (zchk_m, zchk_s, zchk_t) determine violations
72	!! For salt and heat thresholds, ice is considered to have a salinity of 10
73	!! and a heat content of 3e5 J/kg (=latent heat of fusion)
74	!!-------------------------------------------------------------------
75	INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end
76	CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
77	REAL(wp) , INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
78	!!
79	REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat, &
80	& zdiag_vmin, zdiag_amin, zdiag_amax, zdiag_eimin, zdiag_esmin, zdiag_smin
81	REAL(wp) :: zvtrp, zetrp
82	REAL(wp) :: zarea
83	!!-------------------------------------------------------------------
84	!
85	IF( icount == 0 ) THEN
86
87	pdiag_v = glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t )
88	pdiag_s = glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t )
89	pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t )
90
91	! mass flux
92	pdiag_fv = glob_sum( 'icectl', &
93	& ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
94	& wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t )
95	! salt flux
96	pdiag_fs = glob_sum( 'icectl', &
97	& ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + &
98	& sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t )
99	! heat flux
100	pdiag_ft = glob_sum( 'icectl', &
101	& ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
102	& - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )
103
104	ELSEIF( icount == 1 ) THEN
105
106	! -- mass diag -- !
107	zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos, dim=3 ) * e1e2t ) - pdiag_v ) * r1_rdtice &
108	& + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + &
109	& wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + &
110	& wfx_ice_sub + wfx_spr ) * e1e2t ) &
111	& - pdiag_fv
112	!
113	! -- salt diag -- !
114	zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_rdtice &
115	& + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + &
116	& sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) &
117	& - pdiag_fs
118	!
119	! -- heat diag -- !
120	zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t &
121	& ) * r1_rdtice &
122	& + glob_sum( 'icectl', ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
123	& - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) &
124	& - pdiag_ft
125
126	! -- min/max diag -- !
127	zdiag_amax = glob_max( 'icectl', SUM( a_i, dim=3 ) )
128	zdiag_vmin = glob_min( 'icectl', v_i )
129	zdiag_amin = glob_min( 'icectl', a_i )
130	zdiag_smin = glob_min( 'icectl', sv_i )
131	zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) )
132	zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) )
133
134	! -- advection scheme is conservative? -- !
135	zvtrp = glob_sum( 'icectl', ( diag_trp_vi * rhoi + diag_trp_vs * rhos ) * e1e2t ) ! must be close to 0 (only for Prather)
136	zetrp = glob_sum( 'icectl', ( diag_trp_ei + diag_trp_es ) * e1e2t ) ! must be close to 0 (only for Prather)
137
138	! ice area (+epsi10 to set a threshold > 0 when there is no ice)
139	zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t )
140
141	IF( lwp ) THEN
142	! check conservation issues
143	IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) &
144	& WRITE(numout,) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass rdt_ice
145	IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) &
146	& WRITE(numout,) cd_routine,' : violation salt cons. [g] = ',zdiag_salt rdt_ice
147	IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) &
148	& WRITE(numout,) cd_routine,' : violation heat cons. [J] = ',zdiag_heat rdt_ice
149	! check negative values
150	IF( zdiag_vmin < 0. ) WRITE(numout,*) cd_routine,' : violation v_i < 0 = ',zdiag_vmin
151	IF( zdiag_amin < 0. ) WRITE(numout,*) cd_routine,' : violation a_i < 0 = ',zdiag_amin
152	IF( zdiag_smin < 0. ) WRITE(numout,*) cd_routine,' : violation s_i < 0 = ',zdiag_smin
153	IF( zdiag_eimin < 0. ) WRITE(numout,*) cd_routine,' : violation e_i < 0 = ',zdiag_eimin
154	IF( zdiag_esmin < 0. ) WRITE(numout,*) cd_routine,' : violation e_s < 0 = ',zdiag_esmin
155	! check maximum ice concentration
156	IF( zdiag_amax > MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) &
157	& WRITE(numout,*) cd_routine,' : violation a_i > amax = ',zdiag_amax
158	! check if advection scheme is conservative
159	! only check for Prather because Ultimate-Macho uses corrective fluxes (wfx etc)
160	! so the formulation for conservation is different (and not coded)
161	! it does not mean UM is not conservative (it is checked with above prints) => update (09/2019): same for Prather now
162	!IF( ln_adv_Pra .AND. ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) &
163	! & WRITE(numout,) cd_routine,' : violation adv scheme [kg] = ',zvtrp rdt_ice
164	ENDIF
165	!
166	ENDIF
167
168	END SUBROUTINE ice_cons_hsm
169
170	SUBROUTINE ice_cons_final( cd_routine )
171	!!-------------------------------------------------------------------
172	!! * ROUTINE ice_cons_final *
173	!!
174	!! ** Purpose : Test the conservation of heat, salt and mass at the end of each ice time-step
175	!!
176	!! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true
177	!! It prints in ocean.output if there is a violation of conservation at each time-step
178	!! The thresholds (zchk_m, zchk_s, zchk_t) determine the violations
179	!! For salt and heat thresholds, ice is considered to have a salinity of 10
180	!! and a heat content of 3e5 J/kg (=latent heat of fusion)
181	!!-------------------------------------------------------------------
182	CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
183	REAL(wp) :: zdiag_mass, zdiag_salt, zdiag_heat
184	REAL(wp) :: zarea
185	!!-------------------------------------------------------------------
186
187	! water flux
188	! -- mass diag -- !
189	zdiag_mass = glob_sum( 'icectl', ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t )
190
191	! -- salt diag -- !
192	zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice ) * e1e2t )
193
194	! -- heat diag -- !
195	! clem: not the good formulation
196	!!zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat + hfx_thd + hfx_dyn + hfx_res + hfx_sub + hfx_spr &
197	!! & ) * e1e2t )
198
199	! ice area (+epsi10 to set a threshold > 0 when there is no ice)
200	zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t )
201
202	IF( lwp ) THEN
203	IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) &
204	& WRITE(numout,) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass rdt_ice
205	IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) &
206	& WRITE(numout,) cd_routine,' : violation salt cons. [g] = ',zdiag_salt rdt_ice
207	!!IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) WRITE(numout,) cd_routine,' : violation heat cons. [J] = ',zdiag_heat rdt_ice
208	ENDIF
209	!
210	END SUBROUTINE ice_cons_final
211
212	SUBROUTINE ice_cons2D( icount, cd_routine, pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft )
213	!!-------------------------------------------------------------------
214	!! * ROUTINE ice_cons2D *
215	!!
216	!! ** Purpose : Test the conservation of heat, salt and mass for each ice routine
217	!! + test if ice concentration and volume are > 0
218	!!
219	!! ** Method : This is an online diagnostics which can be activated with ln_icediachk=true
220	!! It stops the code if there is a violation of conservation at any gridcell
221	!!-------------------------------------------------------------------
222	INTEGER , INTENT(in) :: icount ! called at: =0 the begining of the routine, =1 the end
223	CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
224	REAL(wp) , DIMENSION(jpi,jpj), INTENT(inout) :: pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft
225	!!
226	REAL(wp), DIMENSION(jpi,jpj) :: zdiag_mass, zdiag_salt, zdiag_heat, &
227	& zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin !!, zdiag_amax
228	INTEGER :: jl, jk
229	LOGICAL :: ll_stop_m = .FALSE.
230	LOGICAL :: ll_stop_s = .FALSE.
231	LOGICAL :: ll_stop_t = .FALSE.
232	CHARACTER(len=120) :: clnam ! filename for the output
233	!!-------------------------------------------------------------------
234	!
235	IF( icount == 0 ) THEN
236
237	pdiag_v = SUM( v_i * rhoi + v_s * rhos, dim=3 )
238	pdiag_s = SUM( sv_i * rhoi , dim=3 )
239	pdiag_t = SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 )
240
241	! mass flux
242	pdiag_fv = wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
243	& wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr
244	! salt flux
245	pdiag_fs = sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam
246	! heat flux
247	pdiag_ft = hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
248	& - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr
249
250	ELSEIF( icount == 1 ) THEN
251
252	! -- mass diag -- !
253	zdiag_mass = ( SUM( v_i * rhoi + v_s * rhos, dim=3 ) - pdiag_v ) * r1_rdtice &
254	& + ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + &
255	& wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) &
256	& - pdiag_fv
257	IF( MAXVAL( ABS(zdiag_mass) ) > zchk_m * rn_icechk_cel ) ll_stop_m = .TRUE.
258	!
259	! -- salt diag -- !
260	zdiag_salt = ( SUM( sv_i * rhoi , dim=3 ) - pdiag_s ) * r1_rdtice &
261	& + ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) &
262	& - pdiag_fs
263	IF( MAXVAL( ABS(zdiag_salt) ) > zchk_s * rn_icechk_cel ) ll_stop_s = .TRUE.
264	!
265	! -- heat diag -- !
266	zdiag_heat = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) - pdiag_t ) * r1_rdtice &
267	& + ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &
268	& - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) &
269	& - pdiag_ft
270	IF( MAXVAL( ABS(zdiag_heat) ) > zchk_t * rn_icechk_cel ) ll_stop_t = .TRUE.
271	!
272	! -- other diags -- !
273	! a_i < 0
274	zdiag_amin(:,:) = 0._wp
275	DO jl = 1, jpl
276	WHERE( a_i(:,:,jl) < 0._wp ) zdiag_amin(:,:) = 1._wp
277	ENDDO
278	! v_i < 0
279	zdiag_vmin(:,:) = 0._wp
280	DO jl = 1, jpl
281	WHERE( v_i(:,:,jl) < 0._wp ) zdiag_vmin(:,:) = 1._wp
282	ENDDO
283	! s_i < 0
284	zdiag_smin(:,:) = 0._wp
285	DO jl = 1, jpl
286	WHERE( s_i(:,:,jl) < 0._wp ) zdiag_smin(:,:) = 1._wp
287	ENDDO
288	! e_i < 0
289	zdiag_emin(:,:) = 0._wp
290	DO jl = 1, jpl
291	DO jk = 1, nlay_i
292	WHERE( e_i(:,:,jk,jl) < 0._wp ) zdiag_emin(:,:) = 1._wp
293	ENDDO
294	ENDDO
295	! a_i > amax
296	!WHERE( SUM( a_i, dim=3 ) > ( MAX( rn_amax_n, rn_amax_s ) + epsi10 ) ; zdiag_amax(:,:) = 1._wp
297	!ELSEWHERE ; zdiag_amax(:,:) = 0._wp
298	!END WHERE
299
300	IF( ll_stop_m .OR. ll_stop_s .OR. ll_stop_t ) THEN
301	clnam = 'diag_ice_conservation_'//cd_routine
302	CALL ice_cons_wri( clnam, zdiag_mass, zdiag_salt, zdiag_heat, zdiag_amin, zdiag_vmin, zdiag_smin, zdiag_emin )
303	ENDIF
304
305	IF( ll_stop_m ) CALL ctl_stop( 'STOP', cd_routine//': ice mass conservation issue' )
306	IF( ll_stop_s ) CALL ctl_stop( 'STOP', cd_routine//': ice salt conservation issue' )
307	IF( ll_stop_t ) CALL ctl_stop( 'STOP', cd_routine//': ice heat conservation issue' )
308
309	ENDIF
310
311	END SUBROUTINE ice_cons2D
312
313	SUBROUTINE ice_cons_wri( cdfile_name, pdiag_mass, pdiag_salt, pdiag_heat, pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin )
314	!!---------------------------------------------------------------------
315	!! * ROUTINE ice_cons_wri *
316	!!
317	!! ** Purpose : create a NetCDF file named cdfile_name which contains
318	!! the instantaneous fields when conservation issue occurs
319	!!
320	!! ** Method : NetCDF files using ioipsl
321	!!----------------------------------------------------------------------
322	CHARACTER(len=*), INTENT( in ) :: cdfile_name ! name of the file created
323	REAL(wp), DIMENSION(:,:), INTENT( in ) :: pdiag_mass, pdiag_salt, pdiag_heat, &
324	& pdiag_amin, pdiag_vmin, pdiag_smin, pdiag_emin !!, pdiag_amax
325	!!
326	INTEGER :: inum
327	!!----------------------------------------------------------------------
328	!
329	IF(lwp) WRITE(numout,*)
330	IF(lwp) WRITE(numout,*) 'ice_cons_wri : single instantaneous ice state'
331	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ named :', cdfile_name, '...nc'
332	IF(lwp) WRITE(numout,*)
333
334	CALL iom_open( TRIM(cdfile_name), inum, ldwrt = .TRUE., kdlev = jpl )
335
336	CALL iom_rstput( 0, 0, inum, 'cons_mass', pdiag_mass(:,:) , ktype = jp_r8 ) ! ice mass spurious lost/gain
337	CALL iom_rstput( 0, 0, inum, 'cons_salt', pdiag_salt(:,:) , ktype = jp_r8 ) ! ice salt spurious lost/gain
338	CALL iom_rstput( 0, 0, inum, 'cons_heat', pdiag_heat(:,:) , ktype = jp_r8 ) ! ice heat spurious lost/gain
339	! other diags
340	CALL iom_rstput( 0, 0, inum, 'aneg_count', pdiag_amin(:,:) , ktype = jp_r8 ) !
341	CALL iom_rstput( 0, 0, inum, 'vneg_count', pdiag_vmin(:,:) , ktype = jp_r8 ) !
342	CALL iom_rstput( 0, 0, inum, 'sneg_count', pdiag_smin(:,:) , ktype = jp_r8 ) !
343	CALL iom_rstput( 0, 0, inum, 'eneg_count', pdiag_emin(:,:) , ktype = jp_r8 ) !
344
345	CALL iom_close( inum )
346
347	END SUBROUTINE ice_cons_wri
348
349	SUBROUTINE ice_ctl( kt )
350	!!-------------------------------------------------------------------
351	!! * ROUTINE ice_ctl *
352	!!
353	!! ** Purpose : Alerts in case of model crash
354	!!-------------------------------------------------------------------
355	INTEGER, INTENT(in) :: kt ! ocean time step
356	INTEGER :: ji, jj, jk, jl ! dummy loop indices
357	INTEGER :: inb_altests ! number of alert tests (max 20)
358	INTEGER :: ialert_id ! number of the current alert
359	REAL(wp) :: ztmelts ! ice layer melting point
360	CHARACTER (len=30), DIMENSION(20) :: cl_alname ! name of alert
361	INTEGER , DIMENSION(20) :: inb_alp ! number of alerts positive
362	!!-------------------------------------------------------------------
363
364	inb_altests = 10
365	inb_alp(:) = 0
366
367	! Alert if incompatible volume and concentration
368	ialert_id = 2 ! reference number of this alert
369	cl_alname(ialert_id) = ' Incompat vol and con ' ! name of the alert
370	DO jl = 1, jpl
371	DO_2D_11_11
372	IF( v_i(ji,jj,jl) /= 0._wp .AND. a_i(ji,jj,jl) == 0._wp ) THEN
373	WRITE(numout,*) ' ALERTE 2 : Incompatible volume and concentration '
374	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
375	ENDIF
376	END_2D
377	END DO
378
379	! Alerte if very thick ice
380	ialert_id = 3 ! reference number of this alert
381	cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert
382	jl = jpl
383	DO_2D_11_11
384	IF( h_i(ji,jj,jl) > 50._wp ) THEN
385	WRITE(numout,*) ' ALERTE 3 : Very thick ice'
386	!CALL ice_prt( kt, ji, jj, 2, ' ALERTE 3 : Very thick ice ' )
387	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
388	ENDIF
389	END_2D
390
391	! Alert if very fast ice
392	ialert_id = 4 ! reference number of this alert
393	cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert
394	DO_2D_11_11
395	IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. .AND. &
396	& at_i(ji,jj) > 0._wp ) THEN
397	WRITE(numout,*) ' ALERTE 4 : Very fast ice'
398	!CALL ice_prt( kt, ji, jj, 1, ' ALERTE 4 : Very fast ice ' )
399	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
400	ENDIF
401	END_2D
402
403	! Alert on salt flux
404	ialert_id = 5 ! reference number of this alert
405	cl_alname(ialert_id) = ' High salt flux ' ! name of the alert
406	DO_2D_11_11
407	IF( ABS( sfx (ji,jj) ) > 1.0e-2 ) THEN ! = 1 psu/day for 1m ocean depth
408	WRITE(numout,*) ' ALERTE 5 : High salt flux'
409	!CALL ice_prt( kt, ji, jj, 3, ' ALERTE 5 : High salt flux ' )
410	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
411	ENDIF
412	END_2D
413
414	! Alert if there is ice on continents
415	ialert_id = 6 ! reference number of this alert
416	cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert
417	DO_2D_11_11
418	IF( tmask(ji,jj,1) <= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN
419	WRITE(numout,*) ' ALERTE 6 : Ice on continents'
420	!CALL ice_prt( kt, ji, jj, 1, ' ALERTE 6 : Ice on continents ' )
421	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
422	ENDIF
423	END_2D
424
425	!
426	! ! Alert if very fresh ice
427	ialert_id = 7 ! reference number of this alert
428	cl_alname(ialert_id) = ' Very fresh ice ' ! name of the alert
429	DO jl = 1, jpl
430	DO_2D_11_11
431	IF( s_i(ji,jj,jl) < 0.1 .AND. a_i(ji,jj,jl) > 0._wp ) THEN
432	WRITE(numout,*) ' ALERTE 7 : Very fresh ice'
433	! CALL ice_prt(kt,ji,jj,1, ' ALERTE 7 : Very fresh ice ' )
434	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
435	ENDIF
436	END_2D
437	END DO
438	!
439	! Alert if qns very big
440	ialert_id = 8 ! reference number of this alert
441	cl_alname(ialert_id) = ' fnsolar very big ' ! name of the alert
442	DO_2D_11_11
443	IF( ABS( qns(ji,jj) ) > 1500._wp .AND. at_i(ji,jj) > 0._wp ) THEN
444	!
445	WRITE(numout,*) ' ALERTE 8 : Very high non-solar heat flux'
446	!CALL ice_prt( kt, ji, jj, 2, ' ')
447	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
448	!
449	ENDIF
450	END_2D
451	!+++++
452
453	! ! Alert if too old ice
454	ialert_id = 9 ! reference number of this alert
455	cl_alname(ialert_id) = ' Very old ice ' ! name of the alert
456	DO jl = 1, jpl
457	DO_2D_11_11
458	IF ( ( ( ABS( o_i(ji,jj,jl) ) > rdt_ice ) .OR. &
459	( ABS( o_i(ji,jj,jl) ) < 0._wp) ) .AND. &
460	( a_i(ji,jj,jl) > 0._wp ) ) THEN
461	WRITE(numout,*) ' ALERTE 9 : Wrong ice age'
462	!CALL ice_prt( kt, ji, jj, 1, ' ALERTE 9 : Wrong ice age ')
463	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
464	ENDIF
465	END_2D
466	END DO
467
468	! Alert if very warm ice
469	ialert_id = 10 ! reference number of this alert
470	cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert
471	inb_alp(ialert_id) = 0
472	DO jl = 1, jpl
473	DO_3D_11_11( 1, nlay_i )
474	ztmelts = -rTmlt * sz_i(ji,jj,jk,jl) + rt0
475	IF( t_i(ji,jj,jk,jl) > ztmelts .AND. v_i(ji,jj,jl) > 1.e-10 &
476	& .AND. a_i(ji,jj,jl) > 0._wp ) THEN
477	WRITE(numout,*) ' ALERTE 10 : Very warm ice'
478	inb_alp(ialert_id) = inb_alp(ialert_id) + 1
479	ENDIF
480	END_3D
481	END DO
482
483	! sum of the alerts on all processors
484	IF( lk_mpp ) THEN
485	DO ialert_id = 1, inb_altests
486	CALL mpp_sum('icectl', inb_alp(ialert_id))
487	END DO
488	ENDIF
489
490	! print alerts
491	IF( lwp ) THEN
492	ialert_id = 1 ! reference number of this alert
493	cl_alname(ialert_id) = ' NO alerte 1 ' ! name of the alert
494	WRITE(numout,*) ' time step ',kt
495	WRITE(numout,*) ' All alerts at the end of ice model '
496	DO ialert_id = 1, inb_altests
497	WRITE(numout,*) ialert_id, cl_alname(ialert_id)//' : ', inb_alp(ialert_id), ' times ! '
498	END DO
499	ENDIF
500	!
501	END SUBROUTINE ice_ctl
502
503	SUBROUTINE ice_prt( kt, ki, kj, kn, cd1 )
504	!!-------------------------------------------------------------------
505	!! * ROUTINE ice_prt *
506	!!
507	!! ** Purpose : Writes global ice state on the (i,j) point
508	!! in ocean.ouput
509	!! 3 possibilities exist
510	!! n = 1/-1 -> simple ice state
511	!! n = 2 -> exhaustive state
512	!! n = 3 -> ice/ocean salt fluxes
513	!!
514	!! ** input : point coordinates (i,j)
515	!! n : number of the option
516	!!-------------------------------------------------------------------
517	INTEGER , INTENT(in) :: kt ! ocean time step
518	INTEGER , INTENT(in) :: ki, kj, kn ! ocean gridpoint indices
519	CHARACTER(len=*), INTENT(in) :: cd1 !
520	!!
521	INTEGER :: jl, ji, jj
522	!!-------------------------------------------------------------------
523
524	DO ji = mi0(ki), mi1(ki)
525	DO jj = mj0(kj), mj1(kj)
526
527	WRITE(numout,*) ' time step ',kt,' ',cd1 ! print title
528
529	!----------------
530	! Simple state
531	!----------------
532
533	IF ( kn == 1 .OR. kn == -1 ) THEN
534	WRITE(numout,*) ' ice_prt - Point : ',ji,jj
535	WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
536	WRITE(numout,*) ' Simple state '
537	WRITE(numout,*) ' masks s,u,v : ', tmask(ji,jj,1), umask(ji,jj,1), vmask(ji,jj,1)
538	WRITE(numout,*) ' lat - long : ', gphit(ji,jj), glamt(ji,jj)
539	WRITE(numout,*) ' - Ice drift '
540	WRITE(numout,*) ' ~~~~~~~~~~~ '
541	WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
542	WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
543	WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
544	WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
545	WRITE(numout,*) ' strength : ', strength(ji,jj)
546	WRITE(numout,*)
547	WRITE(numout,*) ' - Cell values '
548	WRITE(numout,*) ' ~~~~~~~~~~~ '
549	WRITE(numout,*) ' at_i : ', at_i(ji,jj)
550	WRITE(numout,*) ' ato_i : ', ato_i(ji,jj)
551	WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
552	WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
553	DO jl = 1, jpl
554	WRITE(numout,*) ' - Category (', jl,')'
555	WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl)
556	WRITE(numout,*) ' h_i : ', h_i(ji,jj,jl)
557	WRITE(numout,*) ' h_s : ', h_s(ji,jj,jl)
558	WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl)
559	WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl)
560	WRITE(numout,*) ' e_s : ', e_s(ji,jj,1:nlay_s,jl)
561	WRITE(numout,*) ' e_i : ', e_i(ji,jj,1:nlay_i,jl)
562	WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl)
563	WRITE(numout,*) ' t_snow : ', t_s(ji,jj,1:nlay_s,jl)
564	WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
565	WRITE(numout,*) ' s_i : ', s_i(ji,jj,jl)
566	WRITE(numout,*) ' sv_i : ', sv_i(ji,jj,jl)
567	WRITE(numout,*)
568	END DO
569	ENDIF
570
571	!--------------------
572	! Exhaustive state
573	!--------------------
574
575	IF ( kn .EQ. 2 ) THEN
576	WRITE(numout,*) ' ice_prt - Point : ',ji,jj
577	WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
578	WRITE(numout,*) ' Exhaustive state '
579	WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
580	WRITE(numout,*)
581	WRITE(numout,*) ' - Cell values '
582	WRITE(numout,*) ' ~~~~~~~~~~~ '
583	WRITE(numout,*) ' at_i : ', at_i(ji,jj)
584	WRITE(numout,*) ' vt_i : ', vt_i(ji,jj)
585	WRITE(numout,*) ' vt_s : ', vt_s(ji,jj)
586	WRITE(numout,*) ' u_ice(i-1,j) : ', u_ice(ji-1,jj)
587	WRITE(numout,*) ' u_ice(i ,j) : ', u_ice(ji,jj)
588	WRITE(numout,*) ' v_ice(i ,j-1): ', v_ice(ji,jj-1)
589	WRITE(numout,*) ' v_ice(i ,j) : ', v_ice(ji,jj)
590	WRITE(numout,*) ' strength : ', strength(ji,jj)
591	WRITE(numout,*) ' u_ice_b : ', u_ice_b(ji,jj) , ' v_ice_b : ', v_ice_b(ji,jj)
592	WRITE(numout,*)
593
594	DO jl = 1, jpl
595	WRITE(numout,*) ' - Category (',jl,')'
596	WRITE(numout,*) ' ~~~~~~~~ '
597	WRITE(numout,*) ' h_i : ', h_i(ji,jj,jl) , ' h_s : ', h_s(ji,jj,jl)
598	WRITE(numout,*) ' t_i : ', t_i(ji,jj,1:nlay_i,jl)
599	WRITE(numout,*) ' t_su : ', t_su(ji,jj,jl) , ' t_s : ', t_s(ji,jj,1:nlay_s,jl)
600	WRITE(numout,*) ' s_i : ', s_i(ji,jj,jl) , ' o_i : ', o_i(ji,jj,jl)
601	WRITE(numout,*) ' a_i : ', a_i(ji,jj,jl) , ' a_i_b : ', a_i_b(ji,jj,jl)
602	WRITE(numout,*) ' v_i : ', v_i(ji,jj,jl) , ' v_i_b : ', v_i_b(ji,jj,jl)
603	WRITE(numout,*) ' v_s : ', v_s(ji,jj,jl) , ' v_s_b : ', v_s_b(ji,jj,jl)
604	WRITE(numout,*) ' e_i1 : ', e_i(ji,jj,1,jl) , ' ei1 : ', e_i_b(ji,jj,1,jl)
605	WRITE(numout,*) ' e_i2 : ', e_i(ji,jj,2,jl) , ' ei2_b : ', e_i_b(ji,jj,2,jl)
606	WRITE(numout,*) ' e_snow : ', e_s(ji,jj,1,jl) , ' e_snow_b : ', e_s_b(ji,jj,1,jl)
607	WRITE(numout,*) ' sv_i : ', sv_i(ji,jj,jl) , ' sv_i_b : ', sv_i_b(ji,jj,jl)
608	WRITE(numout,*) ' oa_i : ', oa_i(ji,jj,jl) , ' oa_i_b : ', oa_i_b(ji,jj,jl)
609	END DO !jl
610
611	WRITE(numout,*)
612	WRITE(numout,*) ' - Heat / FW fluxes '
613	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
614	WRITE(numout,) ' - Heat fluxes in and out the ice **'
615	WRITE(numout,) ' qsr_ini : ', (1._wp-at_i_b(ji,jj)) qsr(ji,jj) + SUM( a_i_b(ji,jj,:) * qsr_ice(ji,jj,:) )
616	WRITE(numout,) ' qns_ini : ', (1._wp-at_i_b(ji,jj)) qns(ji,jj) + SUM( a_i_b(ji,jj,:) * qns_ice(ji,jj,:) )
617	WRITE(numout,*)
618	WRITE(numout,*)
619	WRITE(numout,*) ' sst : ', sst_m(ji,jj)
620	WRITE(numout,*) ' sss : ', sss_m(ji,jj)
621	WRITE(numout,*)
622	WRITE(numout,*) ' - Stresses '
623	WRITE(numout,*) ' ~~~~~~~~ '
624	WRITE(numout,*) ' utau_ice : ', utau_ice(ji,jj)
625	WRITE(numout,*) ' vtau_ice : ', vtau_ice(ji,jj)
626	WRITE(numout,*) ' utau : ', utau (ji,jj)
627	WRITE(numout,*) ' vtau : ', vtau (ji,jj)
628	ENDIF
629
630	!---------------------
631	! Salt / heat fluxes
632	!---------------------
633
634	IF ( kn .EQ. 3 ) THEN
635	WRITE(numout,*) ' ice_prt - Point : ',ji,jj
636	WRITE(numout,*) ' ~~~~~~~~~~~~~~ '
637	WRITE(numout,*) ' - Salt / Heat Fluxes '
638	WRITE(numout,*) ' ~~~~~~~~~~~~~~~~ '
639	WRITE(numout,*) ' lat - long ', gphit(ji,jj), glamt(ji,jj)
640	WRITE(numout,*)
641	WRITE(numout,) ' - Heat fluxes at bottom interface **'
642	WRITE(numout,*) ' qsr : ', qsr(ji,jj)
643	WRITE(numout,*) ' qns : ', qns(ji,jj)
644	WRITE(numout,*)
645	WRITE(numout,*) ' hfx_mass : ', hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_snw(ji,jj) + hfx_res(ji,jj)
646	WRITE(numout,*) ' qt_atm_oi : ', qt_atm_oi(ji,jj)
647	WRITE(numout,*) ' qt_oce_ai : ', qt_oce_ai(ji,jj)
648	WRITE(numout,*) ' dhc : ', diag_heat(ji,jj)
649	WRITE(numout,*)
650	WRITE(numout,*) ' hfx_dyn : ', hfx_dyn(ji,jj)
651	WRITE(numout,*) ' hfx_thd : ', hfx_thd(ji,jj)
652	WRITE(numout,*) ' hfx_res : ', hfx_res(ji,jj)
653	WRITE(numout,*) ' qsb_ice_bot : ', qsb_ice_bot(ji,jj)
654	WRITE(numout,) ' qlead : ', qlead(ji,jj) r1_rdtice
655	WRITE(numout,*)
656	WRITE(numout,) ' - Salt fluxes at bottom interface **'
657	WRITE(numout,*) ' emp : ', emp (ji,jj)
658	WRITE(numout,*) ' sfx : ', sfx (ji,jj)
659	WRITE(numout,*) ' sfx_res : ', sfx_res(ji,jj)
660	WRITE(numout,*) ' sfx_bri : ', sfx_bri(ji,jj)
661	WRITE(numout,*) ' sfx_dyn : ', sfx_dyn(ji,jj)
662	WRITE(numout,*)
663	WRITE(numout,*) ' - Momentum fluxes '
664	WRITE(numout,*) ' utau : ', utau(ji,jj)
665	WRITE(numout,*) ' vtau : ', vtau(ji,jj)
666	ENDIF
667	WRITE(numout,*) ' '
668	!
669	END DO
670	END DO
671	!
672	END SUBROUTINE ice_prt
673
674	SUBROUTINE ice_prt3D( cd_routine )
675	!!-------------------------------------------------------------------
676	!! * ROUTINE ice_prt3D *
677	!!
678	!! ** Purpose : CTL prints of ice arrays in case sn_cfctl%prtctl is activated
679	!!
680	!!-------------------------------------------------------------------
681	CHARACTER(len=*), INTENT(in) :: cd_routine ! name of the routine
682	INTEGER :: jk, jl ! dummy loop indices
683
684	CALL prt_ctl_info(' ========== ')
685	CALL prt_ctl_info( cd_routine )
686	CALL prt_ctl_info(' ========== ')
687	CALL prt_ctl_info(' - Cell values : ')
688	CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
689	CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' cell area :')
690	CALL prt_ctl(tab2d_1=at_i , clinfo1=' at_i :')
691	CALL prt_ctl(tab2d_1=ato_i , clinfo1=' ato_i :')
692	CALL prt_ctl(tab2d_1=vt_i , clinfo1=' vt_i :')
693	CALL prt_ctl(tab2d_1=vt_s , clinfo1=' vt_s :')
694	CALL prt_ctl(tab2d_1=divu_i , clinfo1=' divu_i :')
695	CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :')
696	CALL prt_ctl(tab2d_1=stress1_i , clinfo1=' stress1_i :')
697	CALL prt_ctl(tab2d_1=stress2_i , clinfo1=' stress2_i :')
698	CALL prt_ctl(tab2d_1=stress12_i , clinfo1=' stress12_i :')
699	CALL prt_ctl(tab2d_1=strength , clinfo1=' strength :')
700	CALL prt_ctl(tab2d_1=delta_i , clinfo1=' delta_i :')
701	CALL prt_ctl(tab2d_1=u_ice , clinfo1=' u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :')
702
703	DO jl = 1, jpl
704	CALL prt_ctl_info(' ')
705	CALL prt_ctl_info(' - Category : ', ivar1=jl)
706	CALL prt_ctl_info(' ~~~~~~~~~~')
707	CALL prt_ctl(tab2d_1=h_i (:,:,jl) , clinfo1= ' h_i : ')
708	CALL prt_ctl(tab2d_1=h_s (:,:,jl) , clinfo1= ' h_s : ')
709	CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' t_su : ')
710	CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' t_snow : ')
711	CALL prt_ctl(tab2d_1=s_i (:,:,jl) , clinfo1= ' s_i : ')
712	CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' o_i : ')
713	CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' a_i : ')
714	CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' v_i : ')
715	CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' v_s : ')
716	CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' e_i1 : ')
717	CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' e_snow : ')
718	CALL prt_ctl(tab2d_1=sv_i (:,:,jl) , clinfo1= ' sv_i : ')
719	CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' oa_i : ')
720
721	DO jk = 1, nlay_i
722	CALL prt_ctl_info(' - Layer : ', ivar1=jk)
723	CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i : ')
724	END DO
725	END DO
726
727	CALL prt_ctl_info(' ')
728	CALL prt_ctl_info(' - Heat / FW fluxes : ')
729	CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ')
730	CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' sst : ', tab2d_2=sss_m , clinfo2= ' sss : ')
731	CALL prt_ctl(tab2d_1=qsr , clinfo1= ' qsr : ', tab2d_2=qns , clinfo2= ' qns : ')
732	CALL prt_ctl(tab2d_1=emp , clinfo1= ' emp : ', tab2d_2=sfx , clinfo2= ' sfx : ')
733
734	CALL prt_ctl_info(' ')
735	CALL prt_ctl_info(' - Stresses : ')
736	CALL prt_ctl_info(' ~~~~~~~~~~ ')
737	CALL prt_ctl(tab2d_1=utau , clinfo1= ' utau : ', tab2d_2=vtau , clinfo2= ' vtau : ')
738	CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ')
739
740	END SUBROUTINE ice_prt3D
741
742	#else
743	!!----------------------------------------------------------------------
744	!! Default option Empty Module No SI3 sea-ice model
745	!!----------------------------------------------------------------------
746	#endif
747
748	!!======================================================================
749	END MODULE icectl

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

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

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/ICE/icectl.F90 @ 12340

Download in other formats: