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

Context Navigation

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

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

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

Download in other formats: