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

Context Navigation

source: trunk/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90 @ 2855

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

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

Download in other formats:

Original Format