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 @ 107

Last change on this file since 107 was 107, checked in by opalod, 20 years ago
CT : UPDATE068 : Add binary output possibilities with the dimg output format
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 7.8 KB

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

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

Download in other formats:

Original Format