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

Context Navigation

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 4425

Last change on this file since 4425 was 3853, checked in by flavoni, 11 years ago
back to icemoa name for lim3, see ticket #1071
Property svn:keywords set to `Id`
File size: 19.9 KB

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

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

Download in other formats: