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_dimg.h90 in trunk/NEMO/LIM_SRC – NEMO

Context Navigation

source: trunk/NEMO/LIM_SRC/limwri_dimg.h90 @ 284

Last change on this file since 284 was 284, checked in by opalod, 19 years ago
nemo_v1_bugfix_001 : CT : to ensure the coherence between ocean & sea-ice fields if making a restart in using DIMG format
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 8.1 KB

Rev	Line
[107]	1	SUBROUTINE lim_wri
[247]	2	!!----------------------------------------------------------------------
	3	!! LIM 2.0, UCL-LOCEAN-IPSL (2005)
	4	!! $Header$
	5	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
	6	!!----------------------------------------------------------------------
[107]	7	!!-------------------------------------------------------------------
	8	!! This routine computes the average of some variables and write it
	9	!! on the ouput files.
	10	!! ATTENTION cette routine n'est valable que si le pas de temps est
	11	!! egale a une fraction entiere de 1 jours.
	12	!! Diff 1-D 3-D : suppress common also included in etat
	13	!! suppress cmoymo 11-18
	14	!! modif : 03/06/98
	15	!!-------------------------------------------------------------------
	16	!! * Local variables
[284]	17	USE diadimg ! use of dia_wri_dimg
[107]	18	REAL(wp),DIMENSION(1) :: zdept
	19
	20	REAL(wp) :: &
	21	zsto, zsec, zjulian,zout, &
	22	zindh,zinda,zindb, &
	23	ztmu
	24	REAL(wp), DIMENSION(jpi,jpj,jpnoumax) :: &
	25	zcmo
	26	REAL(wp), DIMENSION(jpi,jpj) :: &
	27	zfield
	28	INTEGER, SAVE :: nmoyice, & !: counter for averaging
	29	& nwf !: number of fields to write on disk
	30	INTEGER, SAVE,DIMENSION (:), ALLOCATABLE :: nsubindex !: subindex to be saved
	31	! according to namelist
	32
	33	REAL(wp), SAVE, DIMENSION(jpi,jpj,jpnoumax) :: rcmoy
	34	#if ! defined key_diainstant
	35	LOGICAL, PARAMETER :: ll_dia_inst=.false. ! local logical variable
	36	#else
	37	LOGICAL, PARAMETER :: ll_dia_inst=.true.
	38	#endif
	39	INTEGER :: ji, jj, jf, ii ! dummy loop indices and array index
	40	INTEGER :: iyear, iday, imon !
	41
	42	CHARACTER(LEN=80) :: clname, cltext, clmode
	43
	44
	45	INTEGER , SAVE :: &
	46	nice, nhorid, ndim, niter, ndepid
	47	INTEGER , DIMENSION( jpij ) , SAVE :: &
	48	ndex51
	49	!!-------------------------------------------------------------------
	50	IF ( numit == nstart ) THEN
	51
	52	CALL lim_wri_init
	53
	54	nwf = 0
	55	ii = 0
	56
	57	IF (lwp ) THEN
	58	WRITE(numout,*) 'lim_wri : Write ice outputs in dimg'
	59	WRITE(numout,*) '~~~~~~~~'
	60	WRITE(numout,*) ' According to namelist_ice, following fields saved:'
	61	DO jf =1, noumef
	62	IF (nc(jf) == 1 ) THEN
	63	WRITE(numout,* ) ' -',titn(jf), nam(jf), uni(jf)
	64	ENDIF
	65	END DO
	66	ENDIF
	67
	68	DO jf = 1, noumef
	69	IF (nc(jf) == 1 ) nwf = nwf + 1
	70	END DO
	71
	72	ALLOCATE( nsubindex (nwf) )
	73
	74	DO jf = 1, noumef
	75	IF (nc(jf) == 1 ) THEN
	76	ii = ii +1
	77	nsubindex(ii) = jf
	78	END IF
	79	END DO
	80
	81	zsto = rdt_ice
	82	zout = nwrite * rdt_ice / nfice
	83	zsec = 0.
	84	niter = 0
	85	zdept(1) = 0.
	86	nmoyice = 0
	87
	88	ENDIF
	89
	90	#if ! defined key_diainstant
	91	!-- calculs des valeurs instantanees
	92
	93	zcmo(:,:, 1:jpnoumax ) = 0.e0
	94	DO jj = 2 , jpjm1
	95	DO ji = 2 , jpim1
	96	zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
	97	zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
	98	zindb = zindh * zinda
	99	ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
	100	zcmo(ji,jj,1) = hsnif (ji,jj)
	101	zcmo(ji,jj,2) = hicif (ji,jj)
	102	zcmo(ji,jj,3) = hicifp(ji,jj)
	103	zcmo(ji,jj,4) = frld (ji,jj)
	104	zcmo(ji,jj,5) = sist (ji,jj)
	105	zcmo(ji,jj,6) = fbif (ji,jj)
	106	zcmo(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	107	+ u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
	108	/ ztmu
	109
	110	zcmo(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	111	+ v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
	112	/ ztmu
	113	zcmo(ji,jj,9) = sst_io(ji,jj)
	114	zcmo(ji,jj,10) = sss_io(ji,jj)
	115
	116	zcmo(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
	117	zcmo(ji,jj,12) = fsolar (ji,jj)
	118	zcmo(ji,jj,13) = fnsolar(ji,jj)
	119	! See thersf for the coefficient
	120	zcmo(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
	121	zcmo(ji,jj,15) = gtaux(ji,jj)
	122	zcmo(ji,jj,16) = gtauy(ji,jj)
	123	zcmo(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
	124	zcmo(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)
	125	zcmo(ji,jj,19) = sprecip(ji,jj)
	126	END DO
	127	END DO
	128	! Cumulates values between outputs
	129	rcmoy(:,:,:)= rcmoy(:,:,:) + zcmo(:,:,:)
	130	nmoyice = nmoyice + 1
	131	! compute mean value if it is time to write on file
[284]	132	IF ( MOD(numit-nit000+1,nwrite) == 0 ) THEN
[107]	133	rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
	134	#else
[284]	135	IF ( MOD(numit-nit000+1,nwrite) == 0 ) THEN
[107]	136	! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
	137	DO jj = 2 , jpjm1
	138	DO ji = 2 , jpim1
	139	zindh = MAX( zzero , SIGN( zone , hicif(ji,jj) * (1.0 - frld(ji,jj) ) - 0.10 ) )
	140	zinda = MAX( zzero , SIGN( zone , ( 1.0 - frld(ji,jj) ) - 0.10 ) )
	141	zindb = zindh * zinda
	142	ztmu = MAX( 0.5 * zone , ( tmu(ji,jj) + tmu(ji+1,jj) + tmu(ji,jj+1) + tmu(ji+1,jj+1) ) )
	143	rcmoy(ji,jj,1) = hsnif (ji,jj)
	144	rcmoy(ji,jj,2) = hicif (ji,jj)
	145	rcmoy(ji,jj,3) = hicifp(ji,jj)
	146	rcmoy(ji,jj,4) = frld (ji,jj)
	147	rcmoy(ji,jj,5) = sist (ji,jj)
	148	rcmoy(ji,jj,6) = fbif (ji,jj)
	149	rcmoy(ji,jj,7) = zindb * ( u_ice(ji,jj ) * tmu(ji,jj ) + u_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	150	+ u_ice(ji,jj+1) * tmu(ji,jj+1) + u_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
	151	/ ztmu
	152
	153	rcmoy(ji,jj,8) = zindb * ( v_ice(ji,jj ) * tmu(ji,jj ) + v_ice(ji+1,jj ) * tmu(ji+1,jj ) &
	154	+ v_ice(ji,jj+1) * tmu(ji,jj+1) + v_ice(ji+1,jj+1) * tmu(ji+1,jj+1) ) &
	155	/ ztmu
	156	rcmoy(ji,jj,9) = sst_io(ji,jj)
	157	rcmoy(ji,jj,10) = sss_io(ji,jj)
	158
	159	rcmoy(ji,jj,11) = fnsolar(ji,jj) + fsolar(ji,jj)
	160	rcmoy(ji,jj,12) = fsolar (ji,jj)
	161	rcmoy(ji,jj,13) = fnsolar(ji,jj)
	162	! See thersf for the coefficient
	163	rcmoy(ji,jj,14) = - fsalt(ji,jj) * rday * ( sss_io(ji,jj) + epsi16 ) / soce
	164	rcmoy(ji,jj,15) = gtaux(ji,jj)
	165	rcmoy(ji,jj,16) = gtauy(ji,jj)
	166	rcmoy(ji,jj,17) = ( 1.0 - frld(ji,jj) ) * qsr_ice (ji,jj) + frld(ji,jj) * qsr_oce (ji,jj)
	167	rcmoy(ji,jj,18) = ( 1.0 - frld(ji,jj) ) * qnsr_ice(ji,jj) + frld(ji,jj) * qnsr_oce(ji,jj)
	168	rcmoy(ji,jj,19) = sprecip(ji,jj)
	169	END DO
	170	END DO
	171	#endif
	172
	173	!
	174	niter = niter + 1
	175	DO jf = 1 , noumef
	176	zfield(:,:) = (rcmoy(:,:,jf) * cmulti(jf) + cadd(jf)) * tmask(:,:,1)
	177
	178	IF ( jf == 7 .OR. jf == 8 .OR. jf == 11 .OR. jf == 12 .OR. jf == 15 .OR. &
	179	jf == 23 .OR. jf == 24 .OR. jf == 16 ) THEN
	180	CALL lbc_lnk( zfield, 'T', -1. )
	181	ELSE
	182	CALL lbc_lnk( zfield, 'T', 1. )
	183	ENDIF
	184	rcmoy(:,:,jf) = zfield(:,:)
	185	END DO
	186
	187	IF (ll_dia_inst) THEN
	188	clmode='instantaneous'
	189	ELSE
	190	WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
	191	END IF
	192	iyear = ndastp/10000
	193	imon = (ndastp-iyear*10000)/100
	194	iday = ndastp - imon100 - iyear10000
	195	WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
	196	cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
	197	CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
	198	9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
	199
	200	rcmoy(:,:,:) = 0.0
	201	nmoyice = 0
	202	END IF ! MOD(numit, nwrite == 0 ) !
	203
	204	END SUBROUTINE lim_wri

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

Download in other formats:

Original Format