Context Navigation

limwri_2.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

Property svn:keywords set to Id

File size: 17.6 KB

Rev	Line
[821]	1	MODULE limwri_2
[3]	2	!!======================================================================
[821]	3	!! * MODULE limwri_2 *
[3]	4	!! Ice diagnostics : write ice output files
	5	!!======================================================================
[1482]	6	!! history : 2.0 ! 2003-08 (C. Ethe) original code
	7	!! 2.0 ! 2004-10 (C. Ethe ) 1D configuration
	8	!! - ! 2009-06 (B. Lemaire ) iom_put + lim_wri_state_2
[508]	9	!!-------------------------------------------------------------------
[821]	10	#if defined key_lim2
[3]	11	!!----------------------------------------------------------------------
[888]	12	!! 'key_lim2' LIM 2.0 sea-ice model
[3]	13	!!----------------------------------------------------------------------
[508]	14	!!----------------------------------------------------------------------
[3625]	15	!! lim_wri_2 : write of the diagnostics variables in ouput file
	16	!! lim_wri_init_2 : initialization and namelist read
[1482]	17	!! lim_wri_state_2 : write for initial state or/and abandon:
	18	!! > output.init.nc (if ninist = 1 in namelist)
	19	!! > output.abort.nc
[3]	20	!!----------------------------------------------------------------------
[717]	21	USE phycst
[3]	22	USE dom_oce
[888]	23	USE sbc_oce
	24	USE sbc_ice
[821]	25	USE dom_ice_2
	26	USE ice_2
[888]	27
[3625]	28	USE dianam ! build name of file (routine)
[717]	29	USE lbclnk
[888]	30	USE in_out_manager
[3625]	31	USE lib_mpp ! MPP library
	32	USE wrk_nemo ! work arrays
[1359]	33	USE iom
[888]	34	USE ioipsl
[3625]	35	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
[3]	36
	37	IMPLICIT NONE
	38	PRIVATE
	39
[1482]	40	#if ! defined key_iomput
	41	PUBLIC lim_wri_2 ! called by sbc_ice_lim_2
	42	#endif
	43	PUBLIC lim_wri_state_2 ! called by dia_wri_state
[2715]	44	PUBLIC lim_wri_alloc_2 ! called by nemogcm.F90
[3]	45
[508]	46	INTEGER, PARAMETER :: jpnoumax = 40 ! maximum number of variable for ice output
	47	INTEGER :: noumef ! number of fields
	48	REAL(wp) , DIMENSION(jpnoumax) :: cmulti , & ! multiplicative constant
	49	& cadd ! additive constant
	50	CHARACTER(len = 35), DIMENSION(jpnoumax) :: titn ! title of the field
	51	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: nam ! name of the field
	52	CHARACTER(len = 8 ), DIMENSION(jpnoumax) :: uni ! unit of the field
	53	INTEGER , DIMENSION(jpnoumax) :: nc ! switch for saving field ( = 1 ) or not ( = 0 )
[3]	54
[508]	55	INTEGER :: nice, nhorid, ndim, niter, ndepid ! ????
[2715]	56	INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) :: ndex51 ! ????
[508]	57
[2715]	58	REAL(wp) :: epsi16 = 1.e-16_wp ! constant values
	59	REAL(wp) :: zzero = 0._wp ! - -
	60	REAL(wp) :: zone = 1._wp ! - -
[3]	61
[2715]	62	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: zcmo ! Workspace array for netcdf writer.
	63
	64
[888]	65	!! * Substitutions
	66	# include "vectopt_loop_substitute.h90"
[508]	67	!!----------------------------------------------------------------------
[2528]	68	!! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
[1156]	69	!! $Id$
[2528]	70	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[508]	71	!!----------------------------------------------------------------------
[3]	72	CONTAINS
[508]	73
[2715]	74	INTEGER FUNCTION lim_wri_alloc_2()
	75	!!-------------------------------------------------------------------
	76	!! * ROUTINE lim_wri_alloc_2 *
	77	!!-------------------------------------------------------------------
	78	ALLOCATE( ndex51(jpij), zcmo(jpi,jpj,jpnoumax), STAT=lim_wri_alloc_2)
	79	!
	80	IF( lk_mpp ) CALL mpp_sum ( lim_wri_alloc_2 )
	81	IF( lim_wri_alloc_2 /= 0 ) CALL ctl_warn('lim_wri_alloc_2: failed to allocate array ndex51')
	82	!
	83	END FUNCTION lim_wri_alloc_2
	84
	85
[1482]	86	#if ! defined key_iomput
[821]	87	SUBROUTINE lim_wri_2( kt )
[3]	88	!!-------------------------------------------------------------------
[821]	89	!! * ROUTINE lim_wri_2 *
[508]	90	!!
	91	!! ** Purpose : write the sea-ice output file in NetCDF
	92	!!
	93	!! ** Method : computes the average of some variables and write
	94	!! it in the NetCDF ouput files
	95	!! CAUTION: the sea-ice time-step must be an integer fraction
	96	!! of a day
[3]	97	!!-------------------------------------------------------------------
[508]	98	INTEGER, INTENT(in) :: kt ! number of iteration
[888]	99	!!
[508]	100	INTEGER :: ji, jj, jf ! dummy loop indices
[3764]	101	CHARACTER(len = 80) :: clhstnam, clop
[1310]	102	REAL(wp) :: zsto, zjulian, zout, & ! temporary scalars
[508]	103	& zindh, zinda, zindb, ztmu
	104	REAL(wp), DIMENSION(1) :: zdept
[3294]	105	REAL(wp), POINTER, DIMENSION(:,:) :: zfield
[3]	106	!!-------------------------------------------------------------------
[2715]	107
[3294]	108	CALL wrk_alloc( jpi, jpj, zfield )
[1482]	109	!--------------------!
[888]	110	IF( kt == nit000 ) THEN ! Initialisation !
[508]	111	! !--------------------!
[2715]	112
[821]	113	CALL lim_wri_init_2
[508]	114
[3]	115	zsto = rdt_ice
[1312]	116	IF( ln_mskland ) THEN ; clop = "ave(only(x))" ! put 1.e+20 on land (very expensive!!)
	117	ELSE ; clop = "ave(x)" ! no use of the mask value (require less cpu time)
	118	ENDIF
[888]	119	zout = nwrite * rdt_ice / nn_fsbc
[1339]	120	niter = ( nit000 - 1 ) / nn_fsbc
[3]	121	zdept(1) = 0.
	122
[1310]	123	CALL ymds2ju ( nyear, nmonth, nday, rdt, zjulian )
	124	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
[3]	125	CALL dia_nam ( clhstnam, nwrite, 'icemod' )
[508]	126	CALL histbeg ( clhstnam, jpi, glamt, jpj, gphit, &
[2528]	127	& 1, jpi, 1, jpj, niter, zjulian, rdt_ice, nhorid, nice , domain_id=nidom, snc4chunks=snc4set)
[1334]	128	CALL histvert( nice, "deptht", "Vertical T levels", "m", 1, zdept, ndepid, "down")
[3]	129	CALL wheneq ( jpij , tmask(:,:,1), 1, 1., ndex51, ndim)
	130
[88]	131	DO jf = 1, noumef
[888]	132	IF( nc(jf) == 1 ) CALL histdef( nice, nam(jf), titn(jf), uni(jf), jpi, jpj &
	133	& , nhorid, 1, 1, 1, -99, 32, clop, zsto, zout )
[3]	134	END DO
[2528]	135	CALL histend( nice, snc4set )
[888]	136	!
[3]	137	ENDIF
[508]	138	! !--------------------!
	139	! ! Cumulate at kt !
	140	! !--------------------!
[3]	141
[888]	142	!-- Store instantaneous values in zcmo
[3]	143
[88]	144	zcmo(:,:, 1:jpnoumax ) = 0.e0
[3]	145	DO jj = 2 , jpjm1
[4251]	146	DO ji = 2 , jpim1 ! NO vector opt.
[3]	147	zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
	148	zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
	149	zindb = zindh * zinda
	150	ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
	151	zcmo(ji,jj,1) = hsnif (ji,jj)
	152	zcmo(ji,jj,2) = hicif (ji,jj)
	153	zcmo(ji,jj,3) = hicifp(ji,jj)
	154	zcmo(ji,jj,4) = frld (ji,jj)
	155	zcmo(ji,jj,5) = sist (ji,jj)
	156	zcmo(ji,jj,6) = fbif (ji,jj)
[3764]	157	IF (lk_lim2_vp) THEN
[1470]	158	zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	159	+ u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[3]	160	/ ztmu
	161
[1470]	162	zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	163	+ v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
[3]	164	/ ztmu
[3764]	165	ELSE
	166
	167	zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj) &
	168	& + u_ice(ji-1,jj) * tmu(ji-1,jj) ) &
	169	& / 2.0
	170	zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmv(ji,jj) &
	171	& + v_ice(ji,jj-1) * tmv(ji,jj-1) ) &
	172	& / 2.0
	173
	174	ENDIF
[888]	175	zcmo(ji,jj,9) = sst_m(ji,jj)
	176	zcmo(ji,jj,10) = sss_m(ji,jj)
	177	zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
	178	zcmo(ji,jj,12) = qsr(ji,jj)
	179	zcmo(ji,jj,13) = qns(ji,jj)
[3]	180	! See thersf for the coefficient
[3625]	181	zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce !!gm ???
[1469]	182	zcmo(ji,jj,15) = utau_ice(ji,jj)
	183	zcmo(ji,jj,16) = vtau_ice(ji,jj)
[1463]	184	zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
	185	zcmo(ji,jj,18) = qns_ice(ji,jj,1)
[3]	186	zcmo(ji,jj,19) = sprecip(ji,jj)
	187	END DO
	188	END DO
	189	!
[508]	190	! Write the netcdf file
[3]	191	!
	192	niter = niter + 1
	193	DO jf = 1 , noumef
[3764]	194	zfield(:,:) = zcmo(:,:,jf) * cmulti(jf) + cadd(jf) * tmask(:,:,1)
	195	SELECT CASE ( jf )
	196	CASE ( 7, 8, 15, 16, 20, 21 ) ! velocity or stress fields (vectors)
[3]	197	CALL lbc_lnk( zfield, 'T', -1. )
[3764]	198	CASE DEFAULT ! scalar fields
[3]	199	CALL lbc_lnk( zfield, 'T', 1. )
[3764]	200	END SELECT
	201
[888]	202	IF( nc(jf) == 1 ) CALL histwrite( nice, nam(jf), niter, zfield, ndim, ndex51 )
[3764]	203
[3]	204	END DO
[3764]	205
[1334]	206	IF( ( nn_fsbc * niter ) >= nitend ) CALL histclo( nice )
[1359]	207
[3294]	208	CALL wrk_dealloc( jpi, jpj, zfield )
[2715]	209	!
[821]	210	END SUBROUTINE lim_wri_2
[1482]	211
[821]	212	SUBROUTINE lim_wri_init_2
[3]	213	!!-------------------------------------------------------------------
[821]	214	!! * ROUTINE lim_wri_init_2 *
[3]	215	!!
[508]	216	!! ** Purpose : intialisation of LIM sea-ice output
[3]	217	!!
	218	!! ** Method : Read the namicewri namelist and check the parameter
	219	!! values called at the first timestep (nit000)
	220	!!
	221	!! ** input : Namelist namicewri
	222	!!-------------------------------------------------------------------
	223	INTEGER :: nf ! ???
[4147]	224	INTEGER :: ios ! Local integer output status for namelist read
[3]	225	TYPE FIELD
	226	CHARACTER(len = 35) :: ztitle
	227	CHARACTER(len = 8 ) :: zname
	228	CHARACTER(len = 8 ) :: zunit
	229	INTEGER :: znc
	230	REAL :: zcmulti
	231	REAL :: zcadd
	232	END TYPE FIELD
	233	TYPE(FIELD) :: &
	234	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
	235	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
	236	field_13, field_14, field_15, field_16, field_17, field_18, &
	237	field_19
[88]	238	TYPE(FIELD) , DIMENSION(jpnoumax) :: zfield
[3]	239
	240	NAMELIST/namiceout/ noumef, &
	241	field_1 , field_2 , field_3 , field_4 , field_5 , field_6 , &
	242	field_7 , field_8 , field_9 , field_10, field_11, field_12, &
	243	field_13, field_14, field_15, field_16, field_17, field_18, &
	244	field_19
	245	!!-------------------------------------------------------------------
[2715]	246	!
	247	IF( lim_wri_alloc_2() /= 0 ) THEN ! allocate lim_wri arrrays
	248	CALL ctl_stop( 'STOP', 'lim_wri_init_2 : unable to allocate standard arrays' ) ; RETURN
	249	ENDIF
[4147]	250
	251	REWIND( numnam_ice_ref ) ! Namelist namiceout in reference namelist : Ice outputs
	252	READ ( numnam_ice_ref, namiceout, IOSTAT = ios, ERR = 901)
	253	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in reference namelist', lwp )
[3]	254
[4147]	255	REWIND( numnam_ice_cfg ) ! Namelist namiceout in configuration namelist : Ice outputs
	256	READ ( numnam_ice_cfg, namiceout, IOSTAT = ios, ERR = 902 )
	257	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namiceout in configuration namelist', lwp )
[4624]	258	IF(lwm) WRITE ( numoni, namiceout )
[508]	259
[888]	260	zfield( 1) = field_1
	261	zfield( 2) = field_2
	262	zfield( 3) = field_3
	263	zfield( 4) = field_4
	264	zfield( 5) = field_5
	265	zfield( 6) = field_6
	266	zfield( 7) = field_7
	267	zfield( 8) = field_8
	268	zfield( 9) = field_9
[3]	269	zfield(10) = field_10
	270	zfield(11) = field_11
	271	zfield(12) = field_12
	272	zfield(13) = field_13
	273	zfield(14) = field_14
	274	zfield(15) = field_15
	275	zfield(16) = field_16
	276	zfield(17) = field_17
	277	zfield(18) = field_18
	278	zfield(19) = field_19
	279
	280	DO nf = 1, noumef
	281	titn (nf) = zfield(nf)%ztitle
	282	nam (nf) = zfield(nf)%zname
	283	uni (nf) = zfield(nf)%zunit
	284	nc (nf) = zfield(nf)%znc
	285	cmulti(nf) = zfield(nf)%zcmulti
	286	cadd (nf) = zfield(nf)%zcadd
	287	END DO
	288
	289	IF(lwp) THEN
	290	WRITE(numout,*)
[821]	291	WRITE(numout,*) 'lim_wri_init_2 : Ice parameters for outputs'
	292	WRITE(numout,*) '~~~~~~~~~~~~~~'
[3]	293	WRITE(numout,*) ' number of fields to be stored noumef = ', noumef
	294	WRITE(numout,*) ' title name unit Saving (1/0) ', &
	295	& ' multiplicative constant additive constant '
	296	DO nf = 1 , noumef
	297	WRITE(numout,*) ' ', titn(nf), ' ', nam(nf),' ', uni(nf),' ', nc(nf),' ', cmulti(nf), &
[888]	298	& ' ', cadd(nf)
[3]	299	END DO
	300	ENDIF
[508]	301	!
[821]	302	END SUBROUTINE lim_wri_init_2
[3]	303
[1482]	304	#endif
	305
	306	SUBROUTINE lim_wri_state_2( kt, kid, kh_i )
	307	!!---------------------------------------------------------------------
	308	!! * ROUTINE lim_wri_state_2 *
	309	!!
	310	!! ** Purpose : create a NetCDF file named cdfile_name which contains
	311	!! the instantaneous ice state and forcing fields for ice model
	312	!! Used to find errors in the initial state or save the last
	313	!! ocean state in case of abnormal end of a simulation
	314	!!
	315	!! History :
	316	!! 2.0 ! 2009-06 (B. Lemaire)
	317	!!----------------------------------------------------------------------
	318	INTEGER, INTENT( in ) :: kt ! ocean time-step index)
	319	INTEGER, INTENT( in ) :: kid , kh_i
	320	!!----------------------------------------------------------------------
	321
	322	CALL histdef( kid, "isnowthi", "Snow thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	323	CALL histdef( kid, "iicethic", "Ice thickness" , "m" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	324	CALL histdef( kid, "iiceprod", "Ice produced" , "m/kt" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	325	CALL histdef( kid, "ileadfra", "Ice concentration" , "-" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	326	CALL histdef( kid, "iicetemp", "Ice temperature" , "K" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	327	CALL histdef( kid, "iicevelu", "i-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	328	CALL histdef( kid, "iicevelv", "j-Ice speed (I-point)" , "m/s" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	329	CALL histdef( kid, "isstempe", "Sea surface temperature" , "C" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	330	CALL histdef( kid, "isssalin", "Sea surface salinity" , "PSU" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	331	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 )
	332	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 )
	333	CALL histdef( kid, "iicesflx", "Solar flux over ice" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	334	CALL histdef( kid, "iicenflx", "Non-solar flux over ice" , "w/m2" , jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	335	CALL histdef( kid, "isnowpre", "Snow precipitation" , "kg/m2/s", jpi, jpj, kh_i, 1, 1, 1, -99, 32, "inst(x)", rdt, rdt )
	336
[2528]	337	CALL histend( kid, snc4set ) ! end of the file definition
[1482]	338
	339	CALL histwrite( kid, "isnowthi", kt, hsnif , jpi*jpj, (/1/) )
	340	CALL histwrite( kid, "iicethic", kt, hicif , jpi*jpj, (/1/) )
	341	CALL histwrite( kid, "iiceprod", kt, hicifp , jpi*jpj, (/1/) )
	342	CALL histwrite( kid, "ileadfra", kt, 1. - frld(:,:) , jpi*jpj, (/1/) )
	343	CALL histwrite( kid, "iicetemp", kt, sist(:,:) - rt0, jpi*jpj, (/1/) )
[1818]	344	CALL histwrite( kid, "iicevelu", kt, u_ice , jpi*jpj, (/1/) )
	345	CALL histwrite( kid, "iicevelv", kt, v_ice , jpi*jpj, (/1/) )
[1482]	346	CALL histwrite( kid, "isstempe", kt, sst_m , jpi*jpj, (/1/) )
	347	CALL histwrite( kid, "isssalin", kt, sss_m , jpi*jpj, (/1/) )
	348	CALL histwrite( kid, "iicestru", kt, utau_ice , jpi*jpj, (/1/) )
	349	CALL histwrite( kid, "iicestrv", kt, vtau_ice , jpi*jpj, (/1/) )
	350	CALL histwrite( kid, "iicesflx", kt, qsr_ice(:,:,1) , jpi*jpj, (/1/) )
	351	CALL histwrite( kid, "iicenflx", kt, qns_ice(:,:,1) , jpi*jpj, (/1/) )
	352	CALL histwrite( kid, "isnowpre", kt, sprecip , jpi*jpj, (/1/) )
	353
	354	END SUBROUTINE lim_wri_state_2
	355
[3]	356	#else
	357	!!----------------------------------------------------------------------
[821]	358	!! Default option : Empty module NO LIM 2.0 sea-ice model
[3]	359	!!----------------------------------------------------------------------
	360	CONTAINS
[821]	361	SUBROUTINE lim_wri_2 ! Empty routine
	362	END SUBROUTINE lim_wri_2
[3]	363	#endif
	364
	365	!!======================================================================
[821]	366	END MODULE limwri_2

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

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

Context Navigation

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 6140

Download in other formats: