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

Context Navigation

source: branches/2013/dev_LOCEAN_2013/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90 @ 4161

Last change on this file since 4161 was 4161, checked in by cetlod, 10 years ago
dev_LOCEAN_2013 : merge in the 3rd dev branch dev_r4028_CNRS_LIM3, see ticket #1169
Property svn:keywords set to `Id`
File size: 29.6 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
[4161]	12	!! lim_wri_state : write for initial state or/and abandon
[825]	13	!!----------------------------------------------------------------------
	14	USE ioipsl
[888]	15	USE dianam ! build name of file (routine)
[825]	16	USE phycst
	17	USE dom_oce
[888]	18	USE sbc_oce ! Surface boundary condition: ocean fields
	19	USE sbc_ice ! Surface boundary condition: ice fields
[825]	20	USE dom_ice
	21	USE ice
[2715]	22	USE limvar
	23	USE in_out_manager
[825]	24	USE lbclnk
[2715]	25	USE lib_mpp ! MPP library
[3294]	26	USE wrk_nemo ! work arrays
[825]	27	USE par_ice
[4161]	28	USE iom
	29	USE timing ! Timing
	30	USE lib_fortran ! Fortran utilities
[825]	31
	32	IMPLICIT NONE
	33	PRIVATE
	34
	35	PUBLIC lim_wri ! routine called by lim_step.F90
[4161]	36	PUBLIC lim_wri_state ! called by dia_wri_state
[825]	37
[4161]	38	INTEGER, PARAMETER :: jpnoumax = 43 !: maximum number of variable for ice output
[2715]	39
	40	INTEGER :: noumef ! number of fields
	41	INTEGER :: noumefa ! number of additional fields
	42	INTEGER :: add_diag_swi ! additional diagnostics
	43	INTEGER :: nz ! dimension for the itd field
[825]	44
[2715]	45	REAL(wp) , DIMENSION(jpnoumax) :: cmulti ! multiplicative constant
	46	REAL(wp) , DIMENSION(jpnoumax) :: cadd ! additive constant
	47	REAL(wp) , DIMENSION(jpnoumax) :: cmultia ! multiplicative constant
	48	REAL(wp) , DIMENSION(jpnoumax) :: cadda ! additive constant
	49	CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn, titna ! title of the field
	50	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam , nama ! name of the field
	51	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni , unia ! unit of the field
	52	INTEGER , DIMENSION(jpnoumax) :: nc , nca ! switch for saving field ( = 1 ) or not ( = 0 )
[825]	53
[4161]	54	REAL(wp) :: epsi06 = 1e-6_wp
[2715]	55	REAL(wp) :: zzero = 0._wp
[3294]	56	REAL(wp) :: zone = 1._wp
[2528]	57	!!----------------------------------------------------------------------
[4161]	58	!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
[2528]	59	!! $Id$
[2715]	60	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[2528]	61	!!----------------------------------------------------------------------
	62	CONTAINS
[825]	63
	64	#if defined key_dimgout
	65	# include "limwri_dimg.h90"
	66	#else
	67
	68	SUBROUTINE lim_wri( kindic )
	69	!!-------------------------------------------------------------------
	70	!! This routine computes the average of some variables and write it
	71	!! on the ouput files.
	72	!! ATTENTION cette routine n'est valable que si le pas de temps est
	73	!! egale a une fraction entiere de 1 jours.
	74	!! Diff 1-D 3-D : suppress common also included in etat
	75	!! suppress cmoymo 11-18
	76	!! modif : 03/06/98
	77	!!-------------------------------------------------------------------
[2715]	78	INTEGER, INTENT(in) :: kindic ! if kindic < 0 there has been an error somewhere
	79	!
	80	INTEGER :: ji, jj, jk, jl, jf, ipl ! dummy loop indices
	81	INTEGER :: ierr
[825]	82	REAL(wp),DIMENSION(1) :: zdept
[4161]	83	REAL(wp) :: zsto, zjulian, zout, zindh, zinda, zindb, zindc
[3294]	84	REAL(wp), POINTER, DIMENSION(:,:,:) :: zcmo, zcmoa
	85	REAL(wp), POINTER, DIMENSION(:,: ) :: zfield
[2715]	86	REAL(wp), POINTER, DIMENSION(:,:,:) :: zmaskitd, zoi, zei
[921]	87
[4161]	88	CHARACTER(len = 60) :: clhstnam, clop, clhstnama
[921]	89
[2715]	90	INTEGER , SAVE :: nice, nhorid, ndim, niter, ndepid
	91	INTEGER , SAVE :: nicea, nhorida, ndimitd
	92	INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndex51
	93	INTEGER , ALLOCATABLE, DIMENSION(:), SAVE :: ndexitd
	94	!!-------------------------------------------------------------------
[825]	95
[4161]	96	IF( nn_timing == 1 ) CALL timing_start('limwri')
	97
[3294]	98	CALL wrk_alloc( jpi, jpj, zfield )
	99	CALL wrk_alloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
	100	CALL wrk_alloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
[2777]	101
[2715]	102	ipl = jpl
[825]	103
[2715]	104	IF( numit == nstart ) THEN
[921]	105
[3294]	106	ALLOCATE( ndex51(jpij), ndexitd(jpij*jpl), STAT=ierr )
[2777]	107	IF( lk_mpp ) CALL mpp_sum ( ierr )
[2715]	108	IF( ierr /= 0 ) THEN
	109	CALL ctl_stop( 'lim_wri : unable to allocate standard arrays' ) ; RETURN
	110	ENDIF
[825]	111
	112	CALL lim_wri_init
[921]	113
[1112]	114	IF(lwp) WRITE(numout,*) ' lim_wri, first time step '
	115	IF(lwp) WRITE(numout,*) ' add_diag_swi ', add_diag_swi
[825]	116
	117	!--------------------
	118	! 1) Initialization
	119	!--------------------
	120
	121	!-------------
	122	! Normal file
	123	!-------------
[1339]	124	niter = ( nit000 - 1 ) / nn_fsbc
[1310]	125	CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
	126	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
[4161]	127	!clem
	128	! zsto = rdt_ice
	129	! IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!)
	130	! ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time)
	131	! ENDIF
	132	! zout = nwrite * rdt_ice / nn_fsbc
	133	! zdept(1) = 0.
	134	!
	135	! CALL dia_nam ( clhstnam, nwrite, 'icemod_old' )
	136	! CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, 1, jpi, 1, jpj, niter, zjulian, rdt_ice, &
	137	! & nhorid, nice, domain_id=nidom, snc4chunks=snc4set )
	138	! CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
	139	! CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
	140	!
	141	! DO jf = 1 , noumef
	142	! IF(lwp) WRITE(numout,*) 'jf', jf
	143	! IF ( nc(jf) == 1 ) THEN
	144	! CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
	145	! , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
	146	! IF(lwp) WRITE(numout,*) 'nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout'
	147	! IF(lwp) WRITE(numout,*) nice, nam(jf), titn(jf), uni(jf), nhorid, clop, zsto, zout
	148	! ENDIF
	149	! END DO
	150	!
	151	! CALL histend(nice, snc4set)
	152	!clem
	153	!
[825]	154	!-----------------
	155	! ITD file output
	156	!-----------------
	157	zsto = rdt_ice
	158	clop = "ave(x)"
[888]	159	zout = nwrite * rdt_ice / nn_fsbc
[825]	160	zdept(1) = 0.
	161
[3853]	162	CALL dia_nam ( clhstnama, nwrite, 'icemoa' )
[825]	163	CALL histbeg ( clhstnama, jpi, glamt, jpj, gphit, &
[1339]	164	1, jpi, 1, jpj, & ! zoom
	165	niter, zjulian, rdt_ice, & ! time
	166	nhorida, & ! ? linked with horizontal ...
[2528]	167	nicea , domain_id=nidom, snc4chunks=snc4set) ! file
[4161]	168	CALL histvert( nicea, "icethi", "L levels","m", ipl , hi_mean , nz )
[825]	169	DO jl = 1, jpl
	170	zmaskitd(:,:,jl) = tmask(:,:,1)
	171	END DO
	172	CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
	173	CALL wheneq( jpijpjjpl, zmaskitd, 1, 1., ndexitd, ndimitd )
	174	CALL histdef( nicea, "iice_itd", "Ice area in categories" , "-" , &
[921]	175	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[825]	176	CALL histdef( nicea, "iice_hid", "Ice thickness in categories" , "m" , &
[921]	177	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[825]	178	CALL histdef( nicea, "iice_hsd", "Snow depth in in categories" , "m" , &
[921]	179	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[825]	180	CALL histdef( nicea, "iice_std", "Ice salinity distribution" , "ppt" , &
[921]	181	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[825]	182	CALL histdef( nicea, "iice_otd", "Ice age distribution" , "days", &
[921]	183	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[825]	184	CALL histdef( nicea, "iice_etd", "Brine volume distr. " , "%" , &
[921]	185	jpi, jpj, nhorida, jpl, 1, jpl, nz, 15, clop, zsto, zout )
[2528]	186	CALL histend(nicea, snc4set)
[825]	187	ENDIF
	188
[921]	189	! !-----------------------------------------------------------------------!
	190	! !--2. Computation of instantaneous values !
	191	! !-----------------------------------------------------------------------!
	192
	193	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[1055]	194	IF( ln_nicep ) THEN
[825]	195	WRITE(numout,*)
	196	WRITE(numout,*) 'lim_wri : write ice outputs in NetCDF files at time : ', nyear, nmonth, nday, numit
	197	WRITE(numout,*) '~~~~~~~ '
	198	WRITE(numout,*) ' kindic = ', kindic
	199	ENDIF
[921]	200	!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
[825]	201
	202	!-- calculs des valeurs instantanees
[2715]	203	zcmo ( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
	204	zcmoa( 1:jpi, 1:jpj, 1:jpnoumax ) = 0._wp
[825]	205
[4161]	206	! Ice surface temperature and some fluxes
[825]	207	DO jl = 1, jpl
	208	DO jj = 1, jpj
	209	DO ji = 1, jpi
[4161]	210	zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
[825]	211	zcmo(ji,jj,17) = zcmo(ji,jj,17) + a_i(ji,jj,jl)*qsr_ice (ji,jj,jl)
[888]	212	zcmo(ji,jj,18) = zcmo(ji,jj,18) + a_i(ji,jj,jl)*qns_ice(ji,jj,jl)
[4161]	213	zcmo(ji,jj,27) = zcmo(ji,jj,27) + zinda(t_su(ji,jj,jl)-rtt)a_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)
	214	zcmo(ji,jj,21) = zcmo(ji,jj,21) + zinda*oa_i(ji,jj,jl)/MAX(at_i(ji,jj),epsi06)
[825]	215	END DO
	216	END DO
	217	END DO
	218
[4161]	219	! Mean sea ice temperature
	220	CALL lim_var_icetm
	221
	222	! Brine volume
[825]	223	CALL lim_var_bv
[921]	224
[825]	225	DO jj = 2 , jpjm1
	226	DO ji = 2 , jpim1
[4161]	227	zinda = MAX( zzero , SIGN( zone , at_i(ji,jj) - epsi06 ) )
	228	zindb = MAX( zzero , SIGN( zone , at_i(ji,jj) ) )
[825]	229
	230	zcmo(ji,jj,1) = at_i(ji,jj)
[4161]	231	zcmo(ji,jj,2) = vt_i(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
	232	zcmo(ji,jj,3) = vt_s(ji,jj) / MAX( at_i(ji,jj), epsi06 ) * zinda
	233	zcmo(ji,jj,4) = diag_bot_gr(ji,jj) * rday ! Bottom thermodynamic ice production
	234	zcmo(ji,jj,5) = diag_dyn_gr(ji,jj) * rday ! Dynamic ice production (rid/raft)
	235	zcmo(ji,jj,22) = diag_lat_gr(ji,jj) * rday ! Lateral thermodynamic ice production
	236	zcmo(ji,jj,23) = diag_sni_gr(ji,jj) * rday ! Snow ice production ice production
	237	zcmo(ji,jj,24) = (tm_i(ji,jj) - rtt) * zinda
[825]	238
[4161]	239	zcmo(ji,jj,6) = fbif(ji,jj)*at_i(ji,jj)
	240	zcmo(ji,jj,7) = ( u_ice(ji,jj) * tmu(ji,jj) + u_ice(ji-1,jj) * tmu(ji-1,jj) ) * 0.5_wp
	241	zcmo(ji,jj,8) = ( v_ice(ji,jj) * tmv(ji,jj) + v_ice(ji,jj-1) * tmv(ji,jj-1) ) * 0.5_wp
[888]	242	zcmo(ji,jj,9) = sst_m(ji,jj)
	243	zcmo(ji,jj,10) = sss_m(ji,jj)
[825]	244
[888]	245	zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
	246	zcmo(ji,jj,12) = qsr(ji,jj)
	247	zcmo(ji,jj,13) = qns(ji,jj)
[825]	248	zcmo(ji,jj,14) = fhbri(ji,jj)
[1469]	249	zcmo(ji,jj,15) = utau_ice(ji,jj)
	250	zcmo(ji,jj,16) = vtau_ice(ji,jj)
[2715]	251	zcmo(ji,jj,17) = zcmo(ji,jj,17) + ( 1._wp - at_i(ji,jj) ) * qsr(ji,jj)
	252	zcmo(ji,jj,18) = zcmo(ji,jj,18) + ( 1._wp - at_i(ji,jj) ) * qns(ji,jj)
[825]	253	zcmo(ji,jj,19) = sprecip(ji,jj)
	254	zcmo(ji,jj,20) = smt_i(ji,jj)
	255	zcmo(ji,jj,25) = et_i(ji,jj)
	256	zcmo(ji,jj,26) = et_s(ji,jj)
[3625]	257	zcmo(ji,jj,28) = sfx_bri(ji,jj)
	258	zcmo(ji,jj,29) = sfx_thd(ji,jj)
[921]	259
[825]	260	zcmo(ji,jj,30) = bv_i(ji,jj)
[4161]	261	zcmo(ji,jj,31) = hicol(ji,jj) * zindb
[825]	262	zcmo(ji,jj,32) = strength(ji,jj)
[2715]	263	zcmo(ji,jj,33) = SQRT( zcmo(ji,jj,7)zcmo(ji,jj,7) + zcmo(ji,jj,8)zcmo(ji,jj,8) )
[4161]	264	zcmo(ji,jj,34) = diag_sur_me(ji,jj) * rday ! Surface melt
	265	zcmo(ji,jj,35) = diag_bot_me(ji,jj) * rday ! Bottom melt
[825]	266	zcmo(ji,jj,36) = divu_i(ji,jj)
	267	zcmo(ji,jj,37) = shear_i(ji,jj)
[4161]	268	zcmo(ji,jj,38) = diag_res_pr(ji,jj) * rday ! Bottom melt
	269	zcmo(ji,jj,39) = vt_i(ji,jj) ! ice volume
	270	zcmo(ji,jj,40) = vt_s(ji,jj) ! snow volume
	271
	272	zcmo(ji,jj,41) = sfx_mec(ji,jj)
	273	zcmo(ji,jj,42) = sfx_res(ji,jj)
	274
	275	zcmo(ji,jj,43) = diag_trp_vi(ji,jj) * rday ! transport of ice volume
	276
	277	END DO
[825]	278	END DO
	279
	280	!
	281	! ecriture d'un fichier netcdf
	282	!
	283	niter = niter + 1
[4161]	284	!clem
	285	! DO jf = 1 , noumef
	286	! !
	287	! zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf)
	288	! !
	289	! IF( jf == 7 .OR. jf == 8 .OR. jf == 15 .OR. jf == 16 ) THEN ; CALL lbc_lnk( zfield, 'T', -1. )
	290	! ELSE ; CALL lbc_lnk( zfield, 'T', 1. )
	291	! ENDIF
	292	! !
	293	! IF( ln_nicep ) THEN
	294	! WRITE(numout,*)
	295	! WRITE(numout,*) 'nc(jf), nice, nam(jf), niter, ndim'
	296	! WRITE(numout,*) nc(jf), nice, nam(jf), niter, ndim
	297	! ENDIF
	298	! IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
	299	! !
	300	! END DO
	301	!
	302	! IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
	303	! IF( lwp) WRITE(numout,*) ' Closing the icemod file '
	304	! CALL histclo( nice )
	305	! ENDIF
	306	!clem
	307	!
	308	CALL iom_put ('iceconc', zcmo(:,:,1) ) ! field1: ice concentration
	309	CALL iom_put ('icethic_cea', zcmo(:,:,2) ) ! field2: ice thickness (i.e. icethi(:,:))
	310	CALL iom_put ('snowthic_cea', zcmo(:,:,3)) ! field3: snow thickness
	311	CALL iom_put ('icebopr', zcmo(:,:,4) ) ! field4: daily bottom thermo ice production
	312	CALL iom_put ('icedypr', zcmo(:,:,5) ) ! field5: daily dynamic ice production
	313	CALL iom_put ('ioceflxb', zcmo(:,:,6) ) ! field6: Oceanic flux at the ice base
	314	CALL iom_put ('uice_ipa', zcmo(:,:,7) ) ! field7: ice velocity u component
	315	CALL iom_put ('vice_ipa', zcmo(:,:,8) ) ! field8: ice velocity v component
	316	CALL iom_put ('isst', zcmo(:,:,9) ) ! field 9: sea surface temperature
	317	CALL iom_put ('isss', zcmo(:,:,10) ) ! field 10: sea surface salinity
	318	CALL iom_put ('qt_oce', zcmo(:,:,11) ) ! field 11: total flux at ocean surface
	319	CALL iom_put ('qsr_oce', zcmo(:,:,12) ) ! field 12: solar flux at ocean surface
	320	CALL iom_put ('qns_oce', zcmo(:,:,13) ) ! field 13: non-solar flux at ocean surface
	321	!CALL iom_put ('hfbri', fhbri ) ! field 14: heat flux due to brine release
	322	CALL iom_put( 'utau_ice', zcmo(:,:,15) ) ! Wind stress over ice along i-axis at I-point
	323	CALL iom_put( 'vtau_ice', zcmo(:,:,16) ) ! Wind stress over ice along j-axis at I-point
	324	CALL iom_put ('qsr_io', zcmo(:,:,17) ) ! field 17: solar flux at ice/ocean surface
	325	CALL iom_put ('qns_io', zcmo(:,:,18) ) ! field 18: non-solar flux at ice/ocean surface
	326	!CALL iom_put ('snowpre', zcmo(:,:,19) * rday ! field 19 :snow precip
	327	CALL iom_put ('micesalt', zcmo(:,:,20) ) ! field 20 :mean ice salinity
	328	CALL iom_put ('miceage', zcmo(:,:,21) / 365) ! field 21: mean ice age
	329	CALL iom_put ('icelapr',zcmo(:,:,22) ) ! field 22: daily lateral thermo ice prod.
	330	CALL iom_put ('icesipr',zcmo(:,:,23) ) ! field 23: daily snowice ice prod.
	331	CALL iom_put ('micet', zcmo(:,:,24) ) ! field 24: mean ice temperature
	332	CALL iom_put ('icehc', zcmo(:,:,25) ) ! field 25: ice total heat content
	333	CALL iom_put ('isnowhc', zcmo(:,:,26) ) ! field 26: snow total heat content
	334	CALL iom_put ('icest', zcmo(:,:,27) ) ! field 27: ice surface temperature
	335	CALL iom_put ('sfxbri', zcmo(:,:,28) * rday ) ! field 28: brine salt flux
	336	CALL iom_put ('sfxthd', zcmo(:,:,29) * rday ) ! field 29: equivalent FW salt flux
	337	CALL iom_put ('ibrinv', zcmo(:,:,30) *100 ) ! field 30: brine volume
	338	CALL iom_put ('icecolf', zcmo(:,:,31) ) ! field 31: frazil ice collection thickness
	339	CALL iom_put ('icestr', zcmo(:,:,32) * 0.001 ) ! field 32: ice strength
	340	CALL iom_put ('icevel', zcmo(:,:,33) ) ! field 33: ice velocity
	341	CALL iom_put ('isume', zcmo(:,:,34) ) ! field 34: surface melt
	342	CALL iom_put ('ibome', zcmo(:,:,35) ) ! field 35: bottom melt
	343	CALL iom_put ('idive', zcmo(:,:,36) * 1.0e8) ! field 36: divergence
	344	CALL iom_put ('ishear', zcmo(:,:,37) * 1.0e8 ) ! field 37: shear
	345	CALL iom_put ('icerepr', zcmo(:,:,38) ) ! field 38: daily prod./melting due to limupdate
	346	CALL iom_put ('icevolu', zcmo(:,:,39) ) ! field 39: ice volume
	347	CALL iom_put ('snowvol', zcmo(:,:,40) ) ! field 40: snow volume
	348	CALL iom_put ('sfxmec', zcmo(:,:,41) * rday ) ! field 41: salt flux from ridging rafting
	349	CALL iom_put ('sfxres', zcmo(:,:,42) * rday ) ! field 42: salt flux from limupdate (resultant)
	350	CALL iom_put ('icetrp', zcmo(:,:,43) ) ! field 43: ice volume transport
[825]	351
	352	!-----------------------------
	353	! Thickness distribution file
	354	!-----------------------------
[2715]	355	IF( add_diag_swi == 1 ) THEN
[825]	356
[921]	357	DO jl = 1, jpl
	358	CALL lbc_lnk( a_i(:,:,jl) , 'T' , 1. )
	359	CALL lbc_lnk( sm_i(:,:,jl) , 'T' , 1. )
	360	CALL lbc_lnk( oa_i(:,:,jl) , 'T' , 1. )
	361	CALL lbc_lnk( ht_i(:,:,jl) , 'T' , 1. )
	362	CALL lbc_lnk( ht_s(:,:,jl) , 'T' , 1. )
[825]	363	END DO
	364
[921]	365	! Compute ice age
	366	DO jl = 1, jpl
[825]	367	DO jj = 1, jpj
	368	DO ji = 1, jpi
[4161]	369	zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
	370	zoi(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi06 ) * zinda
[825]	371	END DO
	372	END DO
	373	END DO
	374
[921]	375	! Compute brine volume
[2715]	376	zei(:,:,:) = 0._wp
[921]	377	DO jl = 1, jpl
	378	DO jk = 1, nlay_i
	379	DO jj = 1, jpj
	380	DO ji = 1, jpi
[4161]	381	zinda = MAX( zzero , SIGN( zone , a_i(ji,jj,jl) - epsi06 ) )
[921]	382	zei(ji,jj,jl) = zei(ji,jj,jl) + 100.0* &
[4161]	383	( - tmut * s_i(ji,jj,jk,jl) / MIN( ( t_i(ji,jj,jk,jl) - rtt ), - epsi06 ) ) * &
[921]	384	zinda / nlay_i
	385	END DO
	386	END DO
	387	END DO
	388	END DO
[825]	389
[921]	390	DO jl = 1, jpl
	391	CALL lbc_lnk( zei(:,:,jl) , 'T' , 1. )
	392	END DO
[825]	393
[921]	394	CALL histwrite( nicea, "iice_itd", niter, a_i , ndimitd , ndexitd ) ! area
	395	CALL histwrite( nicea, "iice_hid", niter, ht_i , ndimitd , ndexitd ) ! thickness
	396	CALL histwrite( nicea, "iice_hsd", niter, ht_s , ndimitd , ndexitd ) ! snow depth
	397	CALL histwrite( nicea, "iice_std", niter, sm_i , ndimitd , ndexitd ) ! salinity
	398	CALL histwrite( nicea, "iice_otd", niter, zoi , ndimitd , ndexitd ) ! age
	399	CALL histwrite( nicea, "iice_etd", niter, zei , ndimitd , ndexitd ) ! brine volume
	400
	401	! ! Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s
	402	! IF( kindic < 0 ) CALL lim_wri_state( 'output.abort' )
	403	! not yet implemented
	404
[2715]	405	IF( ( nn_fsbc * niter ) >= nitend .OR. kindic < 0 ) THEN
[1112]	406	IF(lwp) WRITE(numout,*) ' Closing the icemod file '
[921]	407	CALL histclo( nicea )
	408	ENDIF
[2715]	409	!
[825]	410	ENDIF
	411
[3294]	412	CALL wrk_dealloc( jpi, jpj, zfield )
	413	CALL wrk_dealloc( jpi, jpj, jpnoumax, zcmo, zcmoa )
	414	CALL wrk_dealloc( jpi, jpj, jpl, zmaskitd, zoi, zei )
[4161]	415
	416	IF( nn_timing == 1 ) CALL timing_stop('limwri')
[2777]	417
[825]	418	END SUBROUTINE lim_wri
	419	#endif
	420
	421	SUBROUTINE lim_wri_init
	422	!!-------------------------------------------------------------------
	423	!! * ROUTINE lim_wri_init *
	424	!!
	425	!! ** Purpose : ???
	426	!!
	427	!! ** Method : Read the namicewri namelist and check the parameter
	428	!! values called at the first timestep (nit000)
	429	!!
	430	!! ** input : Namelist namicewri
	431	!!-------------------------------------------------------------------
	432	INTEGER :: nf ! ???
[4147]	433	INTEGER :: ios ! Local integer output status for namelist read
[825]	434
	435	TYPE FIELD
	436	CHARACTER(len = 35) :: ztitle
	437	CHARACTER(len = 8 ) :: zname
	438	CHARACTER(len = 8 ) :: zunit
	439	INTEGER :: znc
	440	REAL :: zcmulti
	441	REAL :: zcadd
	442	END TYPE FIELD
	443
	444	TYPE(FIELD) :: &
	445	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
	446	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
	447	field_13, field_14, field_15, field_16, field_17, field_18, &
	448	field_19, field_20, field_21, field_22, field_23, field_24, &
	449	field_25, field_26, field_27, field_28, field_29, field_30, &
	450	field_31, field_32, field_33, field_34, field_35, field_36, &
[4161]	451	field_37, field_38, field_39, field_40, field_41, field_42, field_43
[825]	452
	453	TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
[2715]	454	!
[825]	455	NAMELIST/namiceout/ noumef, &
	456	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
	457	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
	458	field_13, field_14, field_15, field_16, field_17, field_18, &
	459	field_19, field_20, field_21, field_22, field_23, field_24, &
	460	field_25, field_26, field_27, field_28, field_29, field_30, &
	461	field_31, field_32, field_33, field_34, field_35, field_36, &
[4161]	462	field_37, field_38, field_39, field_40, field_41, field_42, field_43, add_diag_swi
[825]	463	!!-------------------------------------------------------------------
[4147]	464	REWIND( numnam_ice_ref ) ! Namelist namiceout in reference namelist : Ice outputs
	465	READ ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
	466	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
[825]	467
[4147]	468	REWIND( numnam_ice_cfg ) ! Namelist namiceout in configuration namelist : Ice outputs
	469	READ ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
	470	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
	471	WRITE ( numoni, namiceout )
[825]	472
	473	zfield(1) = field_1
	474	zfield(2) = field_2
	475	zfield(3) = field_3
	476	zfield(4) = field_4
	477	zfield(5) = field_5
	478	zfield(6) = field_6
	479	zfield(7) = field_7
	480	zfield(8) = field_8
	481	zfield(9) = field_9
	482	zfield(10) = field_10
	483	zfield(11) = field_11
	484	zfield(12) = field_12
	485	zfield(13) = field_13
	486	zfield(14) = field_14
	487	zfield(15) = field_15
	488	zfield(16) = field_16
	489	zfield(17) = field_17
	490	zfield(18) = field_18
	491	zfield(19) = field_19
	492	zfield(20) = field_20
	493	zfield(21) = field_21
	494	zfield(22) = field_22
	495	zfield(23) = field_23
	496	zfield(24) = field_24
	497	zfield(25) = field_25
	498	zfield(26) = field_26
	499	zfield(27) = field_27
	500	zfield(28) = field_28
	501	zfield(29) = field_29
	502	zfield(30) = field_30
	503	zfield(31) = field_31
	504	zfield(32) = field_32
	505	zfield(33) = field_33
	506	zfield(34) = field_34
	507	zfield(35) = field_35
	508	zfield(36) = field_36
	509	zfield(37) = field_37
[4161]	510	zfield(38) = field_38
	511	zfield(39) = field_39
	512	zfield(40) = field_40
	513	zfield(41) = field_41
	514	zfield(42) = field_42
	515	zfield(43) = field_43
[921]	516
[825]	517	DO nf = 1, noumef
	518	titn (nf) = zfield(nf)%ztitle
	519	nam (nf) = zfield(nf)%zname
	520	uni (nf) = zfield(nf)%zunit
	521	nc (nf) = zfield(nf)%znc
	522	cmulti(nf) = zfield(nf)%zcmulti
	523	cadd (nf) = zfield(nf)%zcadd
	524	END DO
	525
[2715]	526	IF(lwp) THEN ! control print
[825]	527	WRITE(numout,*)
	528	WRITE(numout,*) 'lim_wri_init : Ice parameters for outputs'
	529	WRITE(numout,*) '~~~~~~~~~~~~'
	530	WRITE(numout,*) ' number of fields to be stored noumef = ', noumef
	531	WRITE(numout,*) ' title name unit Saving (1/0) ', &
	532	& ' multiplicative constant additive constant '
	533	DO nf = 1 , noumef
[2715]	534	WRITE(numout,*) ' ', titn(nf), ' ' , nam (nf), ' ' , uni (nf), &
	535	& ' ' , nc (nf),' ', cmulti(nf), ' ', cadd(nf)
[825]	536	END DO
	537	WRITE(numout,*) ' add_diag_swi ', add_diag_swi
	538	ENDIF
[2715]	539	!
[825]	540	END SUBROUTINE lim_wri_init
[4161]	541
	542	SUBROUTINE lim_wri_state( kt, kid, kh_i )
	543	!!---------------------------------------------------------------------
	544	!! * ROUTINE lim_wri_state *
	545	!!
	546	!! ** Purpose : create a NetCDF file named cdfile_name which contains
	547	!! the instantaneous ice state and forcing fields for ice model
	548	!! Used to find errors in the initial state or save the last
	549	!! ocean state in case of abnormal end of a simulation
	550	!!
	551	!! History :
	552	!! 4.1 ! 2013-06 (C. Rousset)
	553	!!----------------------------------------------------------------------
	554	INTEGER, INTENT( in ) :: kt ! ocean time-step index)
	555	INTEGER, INTENT( in ) :: kid , kh_i
	556	!!----------------------------------------------------------------------
	557	!CALL histvert( kid, "icethi", "L levels","m", jpl , hi_mean , nz )
[825]	558
[4161]	559	CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	560	CALL histdef( kid, "iiceconc", "Ice concentration" , "%" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	561	CALL histdef( kid, "iicetemp", "Ice temperature" , "C" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	562	CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	563	CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	564	CALL histdef( kid, "iicestru", "i-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	565	CALL histdef( kid, "iicestrv", "j-Wind stress over ice (I-pt)", "Pa", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	566	CALL histdef( kid, "iicesflx", "Solar flux over ocean" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	567	CALL histdef( kid, "iicenflx", "Non-solar flux over ocean" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	568	CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	569	CALL histdef( kid, "iicesali", "Ice salinity" , "PSU" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	570	CALL histdef( kid, "iicevolu", "Ice volume" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	571	CALL histdef( kid, "iicedive", "Ice divergence" , "10-8s-1", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	572
	573	!CALL histdef( kid, "iice_itd", "Ice concentration by cat", "%" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
	574	!CALL histdef( kid, "iice_hid", "Ice thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
	575	!CALL histdef( kid, "iice_hsd", "Snow thickness by cat" , "m" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
	576	!CALL histdef( kid, "iice_std", "Ice salinity by cat" , "PSU" , jpi, jpj, kh_i, jpl, 1, jpl, -99, 32, "inst(x)", rdt, rdt )
	577
	578	CALL histend( kid, snc4set ) ! end of the file definition
	579
	580	CALL histwrite( kid, "iicethic", kt, icethi , jpi*jpj, (/1/) )
	581	CALL histwrite( kid, "iiceconc", kt, at_i , jpi*jpj, (/1/) )
	582	CALL histwrite( kid, "iicetemp", kt, tm_i - rtt , jpi*jpj, (/1/) )
	583	CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) )
	584	CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) )
	585	CALL histwrite( kid, "iicestru", kt, utau_ice , jpi*jpj, (/1/) )
	586	CALL histwrite( kid, "iicestrv", kt, vtau_ice , jpi*jpj, (/1/) )
	587	CALL histwrite( kid, "iicesflx", kt, qsr , jpi*jpj, (/1/) )
	588	CALL histwrite( kid, "iicenflx", kt, qns , jpi*jpj, (/1/) )
	589	CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) )
	590	CALL histwrite( kid, "iicesali", kt, smt_i , jpi*jpj, (/1/) )
	591	CALL histwrite( kid, "iicevolu", kt, vt_i , jpi*jpj, (/1/) )
	592	CALL histwrite( kid, "iicedive", kt, divu_i1.0e8 , jpijpj, (/1/) )
	593
	594	!CALL histwrite( kid, "iice_itd", kt, a_i , jpijpjjpl, (/1/) ) ! area
	595	!CALL histwrite( kid, "iice_hid", kt, ht_i , jpijpjjpl, (/1/) ) ! thickness
	596	!CALL histwrite( kid, "iice_hsd", kt, ht_s , jpijpjjpl, (/1/) ) ! snow depth
	597	!CALL histwrite( kid, "iice_std", kt, sm_i , jpijpjjpl, (/1/) ) ! salinity
	598
	599	END SUBROUTINE lim_wri_state
	600
[825]	601	#else
	602	!!----------------------------------------------------------------------
	603	!! Default option : Empty module NO LIM sea-ice model
	604	!!----------------------------------------------------------------------
	605	CONTAINS
	606	SUBROUTINE lim_wri ! Empty routine
	607	END SUBROUTINE lim_wri
	608	#endif
	609
	610	!!======================================================================
	611	END MODULE limwri

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

Download in other formats: