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.F90 in branches/dev_002_LIM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/dev_002_LIM/NEMO/LIM_SRC_3/limwri.F90 @ 830

Last change on this file since 830 was 825, checked in by ctlod, 16 years ago
dev_002_LIM : add the LIM 3.0 component, see ticketr: #71
File size: 19.9 KB

Line
1	MODULE limwri
2	!!======================================================================
3	!! * MODULE limwri *
4	!! Ice diagnostics : write ice output files
5	!!======================================================================
6	!!----------------------------------------------------------------------
7	!! LIM 2.0, UCL-LOCEAN-IPSL (2005)
8	!! $Header: /home/opalod/NEMOCVSROOT/NEMO/LIM_SRC/limwri.F90,v 1.4 2005/03/27 18:34:42 opalod Exp $
9	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
10	!!----------------------------------------------------------------------
11	#if defined key_lim3
12	!!----------------------------------------------------------------------
13	!! 'key_lim3' LIM sea-ice model
14	!!----------------------------------------------------------------------
15	!! lim_wri : write of the diagnostics variables in ouput file
16	!! lim_wri_init : initialization and namelist read
17	!!----------------------------------------------------------------------
18	!! * Modules used
19	USE ioipsl
20	USE dianam ! build name of file (routine)
21	USE phycst
22	USE dom_oce
23	USE daymod
24	USE in_out_manager
25	USE ice_oce ! ice variables
26	USE flx_oce
27	USE dom_ice
28	USE ice
29	USE iceini
30	USE lbclnk
31	USE limicepoints
32	USE par_ice
33	USE limvar
34
35	IMPLICIT NONE
36	PRIVATE
37
38	!! * Accessibility
39	PUBLIC lim_wri ! routine called by lim_step.F90
40
41	!! * Module variables
42	INTEGER, PARAMETER :: & !:
43	jpnoumax = 40 !: maximum number of variable for ice output
44	INTEGER :: &
45	noumef , & ! number of fields
46	noumefa , & ! number of additional fields
47	add_diag_swi , & ! additional diagnostics
48	nz ! dimension for the itd field
49
50	REAL(wp) , DIMENSION(jpnoumax) :: &
51	cmulti , & ! multiplicative constant
52	cadd , & ! additive constant
53	cmultia , & ! multiplicative constant
54	cadda ! additive constant
55	CHARACTER(len = 35), DIMENSION(jpnoumax) :: &
56	titn, titna ! title of the field
57	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: &
58	nam, nama ! name of the field
59	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: &
60	uni, unia ! unit of the field
61	INTEGER , DIMENSION(jpnoumax) :: &
62	nc, nca ! switch for saving field ( = 1 ) or not ( = 0 )
63
64	REAL(wp) :: & ! constant values
65	epsi16 = 1e-16 , &
66	zzero = 0.e0 , &
67	zone = 1.e0
68
69	CONTAINS
70	#if defined key_dimgout
71
72	# include "limwri_dimg.h90"
73
74	#else
75
76	SUBROUTINE lim_wri( kindic )
77	!!-------------------------------------------------------------------
78	!! This routine computes the average of some variables and write it
79	!! on the ouput files.
80	!! ATTENTION cette routine n'est valable que si le pas de temps est
81	!! egale a une fraction entiere de 1 jours.
82	!! Diff 1-D 3-D : suppress common also included in etat
83	!! suppress cmoymo 11-18
84	!! modif : 03/06/98
85	!!-------------------------------------------------------------------
86	INTEGER, INTENT(in) :: &
87	kindic ! if kindic < 0 there has been an error somewhere
88
89	!! * Local variables
90	REAL(wp),DIMENSION(1) :: zdept
91
92	REAL(wp) :: &
93	zsto, zsec, zjulian,zout, &
94	zindh,zinda,zindb
95	REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: &
96	zcmo, &
97	zcmoa ! additional fields
98
99	REAL(wp), DIMENSION(jpi,jpj) :: &
100	zfield, zfielda
101
102	REAL(wp), DIMENSION(jpi,jpj,jpl) :: &
103	zmaskitd, zoi, zei
104
105	INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices
106
107	CHARACTER(len = 40) :: &
108	clhstnam, clop, &
109	clhstnama, clopa
110
111	INTEGER , SAVE :: &
112	nice, nhorid, ndim, niter, ndepid
113	INTEGER , SAVE :: &
114	nicea, nhorida, ndima, nitera, ndepida, ndimitd
115	INTEGER , DIMENSION( jpij ) , SAVE :: &
116	ndex51
117	INTEGER , DIMENSION( jpij*jpl ) , SAVE :: &
118	ndexitd
119	!!-------------------------------------------------------------------
120
121	ipl = jpl
122
123	IF ( numit == nstart ) THEN
124
125	CALL lim_wri_init
126
127	WRITE(numout,*) ' lim_wri, first time step '
128	WRITE(numout,*) ' add_diag_swi ', add_diag_swi
129
130	!--------------------
131	! 1) Initialization
132	!--------------------
133
134	!-------------
135	! Normal file
136	!-------------
137
138	zsto = rdt_ice
139	clop = "ave(x)"
140	zout = nwrite * rdt_ice / nfice
141	zsec = 0.
142	niter = 0
143	zdept(1) = 0.
144
145	CALL ymds2ju ( nyear, nmonth, nday, zsec, zjulian )
146	CALL dia_nam ( clhstnam, nwrite, 'icemod' )
147	CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, 0, zjulian, rdt_ice, nhorid, nice )
148	CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid)
149	CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
150
151	DO jf = 1 , noumef
152	WRITE(numout,*) 'jf', jf
153	IF ( nc(jf) == 1 ) THEN
154	CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
155	, nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
156	WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout'
157	WRITE(numout,*) nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout
158	ENDIF
159	END DO
160
161	CALL histend(nice)
162
163	!-----------------
164	! ITD file output
165	!-----------------
166	zsto = rdt_ice
167	clop = "ave(x)"
168	zout = nwrite * rdt_ice / nfice
169	zsec = 0.
170	nitera = 0
171	zdept(1) = 0.
172
173	CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
174	CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, &
175	1, jpi, 1, jpj, & ! zoom
176	0, zjulian, rdt_ice, & ! time
177	nhorida, & ! ? linked with horizontal ...
178	nicea ) ! file
179	CALL histvert( nicea, "icethi", "L levels", &
180	"m", ipl , hi_mean , nz )
181	DO jl = 1, jpl
182	zmaskitd(:,:,jl) = tmask(:,:,1)
183	END DO
184	CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
185	CALL wheneq( jpijpjjpl, zmaskitd, 1, 1., ndexitd, ndimitd )
186	CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , &
187	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
188	CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , &
189	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
190	CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , &
191	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
192	CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , &
193	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
194	CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", &
195	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
196	CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , &
197	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
198	CALL histend(nicea)
199	ENDIF
200
201	! !-----------------------------------------------------------------------!
202	! !--2. Computation of instantaneous values !
203	! !-----------------------------------------------------------------------!
204
205	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
206	IF(lwp) THEN
207	WRITE(numout,*)
208	WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
209	WRITE(numout,*) '~~~~~~~ '
210	WRITE(numout,*) ' kindic = ', kindic
211	ENDIF
212	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
213
214	!-- calculs des valeurs instantanees
215	zcmo( 1:jpi, 1:jpj, 1:jpnoumax ) = 0.0
216	zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0.0
217
218	DO jl = 1, jpl
219	DO jj = 1, jpj
220	DO ji = 1, jpi
221	zindh = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
222	zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
223	zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)
224	zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qnsr_ice(ji,jj,jl)
225	zcmo(ji,jj,27) = zcmo(ji,jj,27) + t_su(ji,jj,jl)a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi16)zinda
226	END DO
227	END DO
228	END DO
229
230	CALL lim_var_bv
231
232	DO jj = 2 , jpjm1
233	DO ji = 2 , jpim1
234	zindh = MAX( zzero , SIGN( zone , vt_i(ji,jj) * at_i(ji,jj) - 0.10 ) )
235	zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - 0.10 ) )
236	zindb = zindh * zinda
237
238	zcmo(ji,jj,1) = at_i(ji,jj)
239	zcmo(ji,jj,2) = vt_i(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda
240	zcmo(ji,jj,3) = vt_s(ji,jj)/MAX(at_i(ji,jj),epsi16)*zinda
241	zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * &
242	86400.0 * zinda !Bottom thermodynamic ice production
243	zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * &
244	86400.0 * zinda !Dynamic ice production (rid/raft)
245	zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * &
246	86400.0 * zinda !Lateral thermodynamic ice production
247	zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * &
248	86400.0 * zinda !Snow ice production ice production
249	zcmo(ji,jj,24) = tm_i(ji,jj) - rtt
250
251	zcmo(ji,jj,6) = fbif (ji,jj)
252	zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) &
253	& + u_ice(ji-1,jj) * tmu(ji-1,jj) ) &
254	& / 2.0
255	zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) &
256	& + v_ice(ji,jj-1) * tmv(ji,jj-1) ) &
257	& / 2.0
258	zcmo(ji,jj,9) = sst_io(ji,jj)
259	zcmo(ji,jj,10) = sss_io(ji,jj)
260
261	zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
262	zcmo(ji,jj,12) = fsolar (ji,jj)
263	zcmo(ji,jj,13) = fnsolar(ji,jj)
264	zcmo(ji,jj,14) = fhbri(ji,jj)
265	zcmo(ji,jj,15) = gtaux(ji,jj)
266	zcmo(ji,jj,16) = gtauy(ji,jj)
267	zcmo(ji,jj,17) = zcmo(ji,jj,17) + (1.0-at_i(ji,jj))*qsr_oce(ji,jj)
268	zcmo(ji,jj,18) = zcmo(ji,jj,18) + (1.0-at_i(ji,jj))*qnsr_oce (ji,jj)
269	zcmo(ji,jj,19) = sprecip(ji,jj)
270	zcmo(ji,jj,20) = smt_i(ji,jj)
271	zcmo(ji,jj,21) = ot_i(ji,jj)
272	zcmo(ji,jj,25) = et_i(ji,jj)
273	zcmo(ji,jj,26) = et_s(ji,jj)
274	zcmo(ji,jj,28) = fsbri(ji,jj)
275	zcmo(ji,jj,29) = fseqv(ji,jj)
276
277	zcmo(ji,jj,30) = bv_i(ji,jj)
278	zcmo(ji,jj,31) = hicol(ji,jj)
279	zcmo(ji,jj,32) = strength(ji,jj)
280	zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)*zcmo(ji,jj,7) + &
281	zcmo(ji,jj,8)*zcmo(ji,jj,8) )
282	zcmo(ji,jj,34) = diag_sur_me(ji,jj) * &
283	86400.0 * zinda ! Surface melt
284	zcmo(ji,jj,35) = diag_bot_me(ji,jj) * &
285	86400.0 * zinda ! Bottom melt
286	zcmo(ji,jj,36) = divu_i(ji,jj)
287	zcmo(ji,jj,37) = shear_i(ji,jj)
288	END DO
289	END DO
290
291	!
292	! ecriture d'un fichier netcdf
293	!
294	niter = niter + 1
295	DO jf = 1 , noumef
296	DO jj = 1 , jpj
297	DO ji = 1 , jpi
298	zfield(ji,jj) = zcmo(ji,jj,jf) * cmulti(jf) + cadd(jf)
299	END DO
300	END DO
301
302	IF ( jf == 7 .OR. jf == 8 .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR. &
303	jf == 16 ) THEN
304	CALL lbc_lnk( zfield, 'T', -1. )
305	ELSE
306	CALL lbc_lnk( zfield, 'T', 1. )
307	ENDIF
308
309	!+++++
310	WRITE(numout,*)
311	WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
312	WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
313	!+++++
314	IF ( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
315
316	END DO
317
318	IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN
319	WRITE(numout,*) ' Closing the icemod file '
320	CALL histclo( nice )
321	ENDIF
322
323	!-----------------------------
324	! Thickness distribution file
325	!-----------------------------
326	IF ( add_diag_swi .EQ. 1 ) THEN
327
328	DO jl = 1, jpl
329	CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. )
330	CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. )
331	CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. )
332	CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. )
333	CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. )
334	END DO
335
336	! Compute ice age
337	DO jl = 1, jpl
338	DO jj = 1, jpj
339	DO ji = 1, jpi
340	zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
341	zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , 1.0e-6 ) * &
342	zinda
343	END DO
344	END DO
345	END DO
346
347	! Compute brine volume
348	zei(:,:,:) = 0.0
349	DO jl = 1, jpl
350	DO jk = 1, nlay_i
351	DO jj = 1, jpj
352	DO ji = 1, jpi
353	zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - 1.0e-6 ) )
354	zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
355	( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), -1.0e-6 ) ) * &
356	zinda / nlay_i
357	END DO
358	END DO
359	END DO
360	END DO
361
362	DO jl = 1, jpl
363	CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. )
364	END DO
365
366	CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area
367	CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness
368	CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth
369	CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity
370	CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age
371	CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume
372
373	! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
374	! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' )
375	! not yet implemented
376
377	IF ( ( nfice * niter + nit000 - 1 ) >= nitend .OR. kindic < 0 ) THEN
378	WRITE(numout,*) ' Closing the icemod file '
379	CALL histclo( nicea )
380	ENDIF
381
382	ENDIF
383
384	END SUBROUTINE lim_wri
385	#endif
386
387	SUBROUTINE lim_wri_init
388	!!-------------------------------------------------------------------
389	!! * ROUTINE lim_wri_init *
390	!!
391	!! ** Purpose : ???
392	!!
393	!! ** Method : Read the namicewri namelist and check the parameter
394	!! values called at the first timestep (nit000)
395	!!
396	!! ** input : Namelist namicewri
397	!!
398	!! history :
399	!! 8.5 ! 03-08 (C. Ethe) original code
400	!!-------------------------------------------------------------------
401	!! * Local declarations
402	INTEGER :: nf ! ???
403
404	TYPE FIELD
405	CHARACTER(len = 35) :: ztitle
406	CHARACTER(len = 8 ) :: zname
407	CHARACTER(len = 8 ) :: zunit
408	INTEGER :: znc
409	REAL :: zcmulti
410	REAL :: zcadd
411	END TYPE FIELD
412
413	TYPE(FIELD) :: &
414	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
415	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
416	field_13, field_14, field_15, field_16, field_17, field_18, &
417	field_19, field_20, field_21, field_22, field_23, field_24, &
418	field_25, field_26, field_27, field_28, field_29, field_30, &
419	field_31, field_32, field_33, field_34, field_35, field_36, &
420	field_37
421
422	TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
423
424	NAMELIST/namiceout/ noumef, &
425	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
426	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
427	field_13, field_14, field_15, field_16, field_17, field_18, &
428	field_19, field_20, field_21, field_22, field_23, field_24, &
429	field_25, field_26, field_27, field_28, field_29, field_30, &
430	field_31, field_32, field_33, field_34, field_35, field_36, &
431	field_37, add_diag_swi
432	!!-------------------------------------------------------------------
433
434	! Read Namelist namicewri
435	REWIND ( numnam_ice )
436	READ ( numnam_ice , namiceout )
437
438	zfield(1) = field_1
439	zfield(2) = field_2
440	zfield(3) = field_3
441	zfield(4) = field_4
442	zfield(5) = field_5
443	zfield(6) = field_6
444	zfield(7) = field_7
445	zfield(8) = field_8
446	zfield(9) = field_9
447	zfield(10) = field_10
448	zfield(11) = field_11
449	zfield(12) = field_12
450	zfield(13) = field_13
451	zfield(14) = field_14
452	zfield(15) = field_15
453	zfield(16) = field_16
454	zfield(17) = field_17
455	zfield(18) = field_18
456	zfield(19) = field_19
457	zfield(20) = field_20
458	zfield(21) = field_21
459	zfield(22) = field_22
460	zfield(23) = field_23
461	zfield(24) = field_24
462	zfield(25) = field_25
463	zfield(26) = field_26
464	zfield(27) = field_27
465	zfield(28) = field_28
466	zfield(29) = field_29
467	zfield(30) = field_30
468	zfield(31) = field_31
469	zfield(32) = field_32
470	zfield(33) = field_33
471	zfield(34) = field_34
472	zfield(35) = field_35
473	zfield(36) = field_36
474	zfield(37) = field_37
475
476	DO nf = 1, noumef
477	titn (nf) = zfield(nf)%ztitle
478	nam (nf) = zfield(nf)%zname
479	uni (nf) = zfield(nf)%zunit
480	nc (nf) = zfield(nf)%znc
481	cmulti(nf) = zfield(nf)%zcmulti
482	cadd (nf) = zfield(nf)%zcadd
483	END DO
484
485	IF(lwp) THEN
486	WRITE(numout,*)
487	WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
488	WRITE(numout,*) '~~~~~~~~~~~~'
489	WRITE(numout,*) ' number of fields to be stored noumef = ', noumef
490	WRITE(numout,*) ' title name unit Saving (1/0) ', &
491	& ' multiplicative constant additive constant '
492	DO nf = 1 , noumef
493	WRITE(numout,*) ' ', titn(nf), ' ', nam(nf),' ', uni(nf),' ', nc(nf),' ', cmulti(nf), &
494	' ', cadd(nf)
495	END DO
496	WRITE(numout,*) ' add_diag_swi ', add_diag_swi
497	ENDIF
498
499	END SUBROUTINE lim_wri_init
500
501	#else
502	!!----------------------------------------------------------------------
503	!! Default option : Empty module NO LIM sea-ice model
504	!!----------------------------------------------------------------------
505	CONTAINS
506	SUBROUTINE lim_wri ! Empty routine
507	END SUBROUTINE lim_wri
508	#endif
509
510	!!======================================================================
511	END MODULE limwri

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

Download in other formats: