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 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_dimg_2.h90 @ 3200

Last change on this file since 3200 was 3200, checked in by cbricaud, 12 years ago
bugs corections for compilation witk key_dimgout
Property svn:keywords set to `Id`
File size: 8.1 KB

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

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

Download in other formats:

Original Format