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_2.F90 in branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2 – NEMO

Context Navigation

source: branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/LIM_SRC_2/limwri_2.F90 @ 3159

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

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

Download in other formats: