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_2.h90 in trunk/NEMO/LIM_SRC_2 – NEMO

Context Navigation

source: trunk/NEMO/LIM_SRC_2/limwri_dimg_2.h90 @ 1156

Last change on this file since 1156 was 1156, checked in by rblod, 16 years ago
Update Id and licence information, see ticket #210
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 7.9 KB

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

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

Download in other formats:

Original Format