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

Context Navigation

source: branches/2012/dev_NOC_2012_rev3555/NEMOGCM/NEMO/LIM_SRC_2/limwri_dimg_2.h90 @ 3625

Last change on this file since 3625 was 3625, checked in by acc, 11 years ago
Branch dev_NOC_2012_r3555. #1006. Step 7. Check in code now merged with dev_r3385_NOCS04_HAMF
Property svn:keywords set to `Id`
File size: 8.2 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	rcmoy(:,:,:) = 0._wp
48	ENDIF
49
50	IF( kt == nit000 ) THEN
51	!
52	CALL lim_wri_init_2
53
54	nwf = 0
55	ii = 0
56
57	IF(lwp ) THEN
58	WRITE(numout,*) 'lim_wri_2 : 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 / nn_fsbc
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 ! NO vector opt.
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_m(ji,jj)
114	zcmo(ji,jj,10) = sss_m(ji,jj)
115
116	zcmo(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
117	zcmo(ji,jj,12) = qsr(ji,jj)
118	zcmo(ji,jj,13) = qns(ji,jj)
119	! See thersf for the coefficient
120	zcmo(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
121	zcmo(ji,jj,15) = utau_ice(ji,jj)
122	zcmo(ji,jj,16) = vtau_ice(ji,jj)
123	zcmo(ji,jj,17) = qsr_ice(ji,jj,1)
124	zcmo(ji,jj,18) = qns_ice(ji,jj,1)
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
132	IF ( MOD(kt+nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
133	rcmoy(:,:,:) = rcmoy(:,:,:) / FLOAT(nmoyice)
134	#else
135	IF ( MOD(kt-nn_fsbc-1-nit000+1,nwrite) == 0 ) THEN
136	! case of instantaneaous output rcmoy(:,:, 1:jpnoumax ) = 0.e0
137	DO jj = 2 , jpjm1
138	DO ji = 2 , jpim1 ! NO vector opt.
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_m(ji,jj)
157	rcmoy(ji,jj,10) = sss_m(ji,jj)
158
159	rcmoy(ji,jj,11) = qns(ji,jj) + qsr(ji,jj)
160	rcmoy(ji,jj,12) = qsr(ji,jj)
161	rcmoy(ji,jj,13) = qns(ji,jj)
162	! See thersf for the coefficient
163	rcmoy(ji,jj,14) = - sfx (ji,jj) * rday * ( sss_m(ji,jj) + epsi16 ) / soce
164	rcmoy(ji,jj,15) = utau_ice(ji,jj)
165	rcmoy(ji,jj,16) = vtau_ice(ji,jj)
166	rcmoy(ji,jj,17) = qsr_ice(ji,jj,1)
167	rcmoy(ji,jj,18) = qns_ice(ji,jj,1)
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 == 15 .OR. jf == 16 ) THEN
179	CALL lbc_lnk( zfield, 'T', -1. )
180	ELSE
181	CALL lbc_lnk( zfield, 'T', 1. )
182	ENDIF
183	rcmoy(:,:,jf) = zfield(:,:)
184	END DO
185
186	IF (ll_dia_inst) THEN
187	clmode='instantaneous'
188	ELSE
189	WRITE(clmode,'(f5.1,a)' ) nwrite*rdt/86400.,' days average'
190	END IF
191	iyear = ndastp/10000
192	imon = (ndastp-iyear*10000)/100
193	iday = ndastp - imon100 - iyear10000
194	WRITE(clname,9000) TRIM(cexper),'ICEMOD',iyear,imon,iday
195	cltext=TRIM(cexper)//' ice modele output'//TRIM(clmode)
196	CALL dia_wri_dimg (clname, cltext, rcmoy, nwf , 'I', nsubindex)
197	9000 FORMAT(a,"_",a,"_y",i4.4,"m",i2.2,"d",i2.2,".dimgproc")
198
199	rcmoy(:,:,:) = 0.0
200	nmoyice = 0
201	END IF ! MOD(kt+nn_fsbc-1-nit000+1, nwrite == 0 ) !
202
203	END SUBROUTINE lim_wri_2

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

Download in other formats:

Original Format