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 trunk/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: trunk/NEMO/LIM_SRC_3/limwri.F90 @ 867

Last change on this file since 867 was 834, checked in by ctlod, 16 years ago
Clean comments and useless lines, see ticket:#72
File size: 19.8 KB

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

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

Download in other formats: