Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

icbtrj.F90

Last change on this file was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 14.7 KB

Line
1	MODULE icbtrj
2
3	!!======================================================================
4	!! * MODULE icbtrj *
5	!! Ocean physics: trajectory I/O routines
6	!!======================================================================
7	!! History : 3.3.1 ! 2010-01 (Martin&Adcroft) Original code
8	!! - ! 2011-03 (Madec) Part conversion to NEMO form
9	!! - ! Removal of mapping from another grid
10	!! - ! 2011-05 (Alderson) New module to handle trajectory output
11	!!----------------------------------------------------------------------
12	!!----------------------------------------------------------------------
13	!! icb_trj_init :
14	!!----------------------------------------------------------------------
15	USE par_oce ! NEMO parameters
16	USE dom_oce ! NEMO ocean domain
17	USE phycst ! NEMO physical constants
18	USE lib_mpp ! NEMO MPI library, lk_mpp in particular
19	USE in_out_manager ! NEMO IO, numout in particular
20	USE ioipsl, ONLY : ju2ymds ! for calendar
21	USE netcdf
22	!
23	USE icb_oce ! define iceberg arrays
24	USE icbutl ! iceberg utility routines
25
26	IMPLICIT NONE
27	PRIVATE
28
29	PUBLIC icb_trj_init ! routine called in icbini.F90 module
30	PUBLIC icb_trj_write ! routine called in icbstp.F90 module
31	PUBLIC icb_trj_sync ! routine called in icbstp.F90 module
32	PUBLIC icb_trj_end ! routine called in icbstp.F90 module
33
34	INTEGER :: num_traj
35	INTEGER :: n_dim, m_dim
36	INTEGER :: ntrajid
37	INTEGER :: numberid, nstepid, nscaling_id
38	INTEGER :: nlonid, nlatid, nxid, nyid, nuvelid, nvvelid, nmassid
39	INTEGER :: nuoid, nvoid, nuaid, nvaid, nuiid, nviid
40	INTEGER :: nsshxid, nsshyid, nsstid, ncntid, nthkid
41	INTEGER :: nthicknessid, nwidthid, nlengthid
42	INTEGER :: nyearid, ndayid
43	INTEGER :: nmass_of_bits_id, nheat_density_id
44
45	!!----------------------------------------------------------------------
46	!! NEMO/OPA 3.3 , NEMO Consortium (2011)
47	!! $Id$
48	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
49	!!----------------------------------------------------------------------
50	CONTAINS
51
52	!!-------------------------------------------------------------------------
53
54	SUBROUTINE icb_trj_init( ktend )
55	!!----------------------------------------------------------------------
56	!! * ROUTINE icb_trj_init *
57	!!
58	!! ** Purpose : initialise iceberg trajectory output files
59	!!----------------------------------------------------------------------
60	INTEGER, INTENT( in ) :: ktend
61	!
62	INTEGER :: iret
63	INTEGER :: iyear, imonth, iday
64	REAL(wp) :: zfjulday, zsec
65	CHARACTER(len=80) :: cl_filename
66	TYPE(iceberg), POINTER :: this
67	TYPE(point) , POINTER :: pt
68	CHARACTER(LEN=20) :: cldate_ini, cldate_end
69	!!----------------------------------------------------------------------
70
71	! compute initial time step date
72	CALL ju2ymds( fjulday, iyear, imonth, iday, zsec )
73	WRITE(cldate_ini, '(i4.4,2i2.2)') iyear, imonth, iday
74
75	! compute end time step date
76	zfjulday = fjulday + rdttra(1) / rday * REAL( nitend - nit000 + 1 , wp)
77	IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error
78	CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec )
79	WRITE(cldate_end, '(i4.4,2i2.2)') iyear, imonth, iday
80
81	! define trajectory output name
82	IF( lk_mpp ) THEN ; WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A,"_",I4.4,".nc")') TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end)), narea-1
83	ELSE ; WRITE(cl_filename,'("trajectory_icebergs_",A,"-",A ,".nc")') TRIM(ADJUSTL(cldate_ini)), TRIM(ADJUSTL(cldate_end))
84	ENDIF
85	IF ( lwp .AND. nprint > 2) WRITE(numout,'(2a)') 'icebergs, icb_trj_init: creating ',TRIM(cl_filename)
86
87	iret = NF90_CREATE(TRIM(cl_filename), NF90_CLOBBER, ntrajid)
88	IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_create failed')
89
90	! Dimensions
91	iret = NF90_DEF_DIM(ntrajid, 'n', NF90_UNLIMITED, n_dim)
92	IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim n failed')
93	iret = NF90_DEF_DIM(ntrajid, 'k', nkounts, m_dim)
94	IF (iret .NE. NF90_NOERR) CALL ctl_stop('icebergs, icb_trj_init: nf_def_dim k failed')
95
96	! Variables
97	iret = NF90_DEF_VAR(ntrajid, 'iceberg_number', NF90_INT, (/m_dim,n_dim/), numberid)
98	iret = NF90_DEF_VAR(ntrajid, 'timestep', NF90_INT, n_dim, nstepid)
99	iret = NF90_DEF_VAR(ntrajid, 'mass_scaling', NF90_DOUBLE, n_dim, nscaling_id)
100	iret = NF90_DEF_VAR(ntrajid, 'lon', NF90_DOUBLE, n_dim, nlonid)
101	iret = NF90_DEF_VAR(ntrajid, 'lat', NF90_DOUBLE, n_dim, nlatid)
102	iret = NF90_DEF_VAR(ntrajid, 'xi', NF90_DOUBLE, n_dim, nxid)
103	iret = NF90_DEF_VAR(ntrajid, 'yj', NF90_DOUBLE, n_dim, nyid)
104	iret = NF90_DEF_VAR(ntrajid, 'uvel', NF90_DOUBLE, n_dim, nuvelid)
105	iret = NF90_DEF_VAR(ntrajid, 'vvel', NF90_DOUBLE, n_dim, nvvelid)
106	iret = NF90_DEF_VAR(ntrajid, 'uto', NF90_DOUBLE, n_dim, nuoid)
107	iret = NF90_DEF_VAR(ntrajid, 'vto', NF90_DOUBLE, n_dim, nvoid)
108	iret = NF90_DEF_VAR(ntrajid, 'uta', NF90_DOUBLE, n_dim, nuaid)
109	iret = NF90_DEF_VAR(ntrajid, 'vta', NF90_DOUBLE, n_dim, nvaid)
110	iret = NF90_DEF_VAR(ntrajid, 'uti', NF90_DOUBLE, n_dim, nuiid)
111	iret = NF90_DEF_VAR(ntrajid, 'vti', NF90_DOUBLE, n_dim, nviid)
112	iret = NF90_DEF_VAR(ntrajid, 'ssh_x', NF90_DOUBLE, n_dim, nsshyid)
113	iret = NF90_DEF_VAR(ntrajid, 'ssh_y', NF90_DOUBLE, n_dim, nsshxid)
114	iret = NF90_DEF_VAR(ntrajid, 'sst', NF90_DOUBLE, n_dim, nsstid)
115	iret = NF90_DEF_VAR(ntrajid, 'icnt', NF90_DOUBLE, n_dim, ncntid)
116	iret = NF90_DEF_VAR(ntrajid, 'ithk', NF90_DOUBLE, n_dim, nthkid)
117	iret = NF90_DEF_VAR(ntrajid, 'mass', NF90_DOUBLE, n_dim, nmassid)
118	iret = NF90_DEF_VAR(ntrajid, 'thickness', NF90_DOUBLE, n_dim, nthicknessid)
119	iret = NF90_DEF_VAR(ntrajid, 'width', NF90_DOUBLE, n_dim, nwidthid)
120	iret = NF90_DEF_VAR(ntrajid, 'length', NF90_DOUBLE, n_dim, nlengthid)
121	iret = NF90_DEF_VAR(ntrajid, 'year', NF90_INT, n_dim, nyearid)
122	iret = NF90_DEF_VAR(ntrajid, 'day', NF90_DOUBLE, n_dim, ndayid)
123	iret = NF90_DEF_VAR(ntrajid, 'mass_of_bits', NF90_DOUBLE, n_dim, nmass_of_bits_id)
124	iret = NF90_DEF_VAR(ntrajid, 'heat_density', NF90_DOUBLE, n_dim, nheat_density_id)
125
126	! Attributes
127	iret = NF90_PUT_ATT(ntrajid, numberid, 'long_name', 'iceberg number on this processor')
128	iret = NF90_PUT_ATT(ntrajid, numberid, 'units', 'count')
129	iret = NF90_PUT_ATT(ntrajid, nstepid, 'long_name', 'timestep number kt')
130	iret = NF90_PUT_ATT(ntrajid, nstepid, 'units', 'count')
131	iret = NF90_PUT_ATT(ntrajid, nlonid, 'long_name', 'longitude')
132	iret = NF90_PUT_ATT(ntrajid, nlonid, 'units', 'degrees_E')
133	iret = NF90_PUT_ATT(ntrajid, nlatid, 'long_name', 'latitude')
134	iret = NF90_PUT_ATT(ntrajid, nlatid, 'units', 'degrees_N')
135	iret = NF90_PUT_ATT(ntrajid, nxid, 'long_name', 'x grid box position')
136	iret = NF90_PUT_ATT(ntrajid, nxid, 'units', 'fractional')
137	iret = NF90_PUT_ATT(ntrajid, nyid, 'long_name', 'y grid box position')
138	iret = NF90_PUT_ATT(ntrajid, nyid, 'units', 'fractional')
139	iret = NF90_PUT_ATT(ntrajid, nuvelid, 'long_name', 'zonal velocity')
140	iret = NF90_PUT_ATT(ntrajid, nuvelid, 'units', 'm/s')
141	iret = NF90_PUT_ATT(ntrajid, nvvelid, 'long_name', 'meridional velocity')
142	iret = NF90_PUT_ATT(ntrajid, nvvelid, 'units', 'm/s')
143	iret = NF90_PUT_ATT(ntrajid, nuoid, 'long_name', 'ocean u component')
144	iret = NF90_PUT_ATT(ntrajid, nuoid, 'units', 'm/s')
145	iret = NF90_PUT_ATT(ntrajid, nvoid, 'long_name', 'ocean v component')
146	iret = NF90_PUT_ATT(ntrajid, nvoid, 'units', 'm/s')
147	iret = NF90_PUT_ATT(ntrajid, nuaid, 'long_name', 'atmosphere u component')
148	iret = NF90_PUT_ATT(ntrajid, nuaid, 'units', 'm/s')
149	iret = NF90_PUT_ATT(ntrajid, nvaid, 'long_name', 'atmosphere v component')
150	iret = NF90_PUT_ATT(ntrajid, nvaid, 'units', 'm/s')
151	iret = NF90_PUT_ATT(ntrajid, nuiid, 'long_name', 'sea ice u component')
152	iret = NF90_PUT_ATT(ntrajid, nuiid, 'units', 'm/s')
153	iret = NF90_PUT_ATT(ntrajid, nviid, 'long_name', 'sea ice v component')
154	iret = NF90_PUT_ATT(ntrajid, nviid, 'units', 'm/s')
155	iret = NF90_PUT_ATT(ntrajid, nsshxid, 'long_name', 'sea surface height gradient from x points')
156	iret = NF90_PUT_ATT(ntrajid, nsshxid, 'units', 'm/m')
157	iret = NF90_PUT_ATT(ntrajid, nsshyid, 'long_name', 'sea surface height gradient from y points')
158	iret = NF90_PUT_ATT(ntrajid, nsshyid, 'units', 'm/m')
159	iret = NF90_PUT_ATT(ntrajid, nsstid, 'long_name', 'sea surface temperature')
160	iret = NF90_PUT_ATT(ntrajid, nsstid, 'units', 'degC')
161	iret = NF90_PUT_ATT(ntrajid, ncntid, 'long_name', 'sea ice concentration')
162	iret = NF90_PUT_ATT(ntrajid, ncntid, 'units', 'degC')
163	iret = NF90_PUT_ATT(ntrajid, nthkid, 'long_name', 'sea ice thickness')
164	iret = NF90_PUT_ATT(ntrajid, nthkid, 'units', 'm')
165	iret = NF90_PUT_ATT(ntrajid, nmassid, 'long_name', 'mass')
166	iret = NF90_PUT_ATT(ntrajid, nmassid, 'units', 'kg')
167	iret = NF90_PUT_ATT(ntrajid, nthicknessid, 'long_name', 'thickness')
168	iret = NF90_PUT_ATT(ntrajid, nthicknessid, 'units', 'm')
169	iret = NF90_PUT_ATT(ntrajid, nwidthid, 'long_name', 'width')
170	iret = NF90_PUT_ATT(ntrajid, nwidthid, 'units', 'm')
171	iret = NF90_PUT_ATT(ntrajid, nlengthid, 'long_name', 'length')
172	iret = NF90_PUT_ATT(ntrajid, nlengthid, 'units', 'm')
173	iret = NF90_PUT_ATT(ntrajid, nyearid, 'long_name', 'calendar year')
174	iret = NF90_PUT_ATT(ntrajid, nyearid, 'units', 'years')
175	iret = NF90_PUT_ATT(ntrajid, ndayid, 'long_name', 'day of year')
176	iret = NF90_PUT_ATT(ntrajid, ndayid, 'units', 'days')
177	iret = NF90_PUT_ATT(ntrajid, nscaling_id, 'long_name', 'scaling factor for mass of berg')
178	iret = NF90_PUT_ATT(ntrajid, nscaling_id, 'units', 'none')
179	iret = NF90_PUT_ATT(ntrajid, nmass_of_bits_id, 'long_name', 'mass of bergy bits')
180	iret = NF90_PUT_ATT(ntrajid, nmass_of_bits_id, 'units', 'kg')
181	iret = NF90_PUT_ATT(ntrajid, nheat_density_id, 'long_name', 'heat density')
182	iret = NF90_PUT_ATT(ntrajid, nheat_density_id, 'units', 'J/kg')
183
184	! End define mode
185	iret = NF90_ENDDEF(ntrajid)
186	!
187	END SUBROUTINE icb_trj_init
188
189
190	SUBROUTINE icb_trj_write( kt )
191	!!----------------------------------------------------------------------
192	!! * ROUTINE icb_trj_write *
193	!!
194	!! ** Purpose : write out iceberg trajectories
195	!!
196	!! ** Method : - for the moment write out each snapshot of positions later
197	!! can rewrite so that it is buffered and written out more efficiently
198	!!----------------------------------------------------------------------
199	INTEGER, INTENT( in ) :: kt
200	!
201	INTEGER :: iret, jn
202	CHARACTER(len=80) :: cl_filename
203	TYPE(iceberg), POINTER :: this
204	TYPE(point) , POINTER :: pt
205	!!----------------------------------------------------------------------
206
207	! Write variables
208	! sga - just write out the current point of the trajectory
209
210	this => first_berg
211	jn = num_traj
212	DO WHILE (ASSOCIATED(this))
213	pt => this%current_point
214	jn=jn+1
215
216	iret = NF90_PUT_VAR(ntrajid, numberid, this%number, (/1,jn/), (/nkounts,1/) )
217	iret = NF90_PUT_VAR(ntrajid, nstepid, kt, (/ jn /) )
218	iret = NF90_PUT_VAR(ntrajid, nscaling_id, this%mass_scaling, (/ jn /) )
219
220	iret = NF90_PUT_VAR(ntrajid, nlonid, pt%lon, (/ jn /) )
221	iret = NF90_PUT_VAR(ntrajid, nlatid, pt%lat, (/ jn /) )
222	iret = NF90_PUT_VAR(ntrajid, nxid, pt%xi, (/ jn /) )
223	iret = NF90_PUT_VAR(ntrajid, nyid, pt%yj, (/ jn /) )
224	iret = NF90_PUT_VAR(ntrajid, nuvelid, pt%uvel, (/ jn /) )
225	iret = NF90_PUT_VAR(ntrajid, nvvelid, pt%vvel, (/ jn /) )
226	iret = NF90_PUT_VAR(ntrajid, nuoid, pt%uo, (/ jn /) )
227	iret = NF90_PUT_VAR(ntrajid, nvoid, pt%vo, (/ jn /) )
228	iret = NF90_PUT_VAR(ntrajid, nuaid, pt%ua, (/ jn /) )
229	iret = NF90_PUT_VAR(ntrajid, nvaid, pt%va, (/ jn /) )
230	iret = NF90_PUT_VAR(ntrajid, nuiid, pt%ui, (/ jn /) )
231	iret = NF90_PUT_VAR(ntrajid, nviid, pt%vi, (/ jn /) )
232	iret = NF90_PUT_VAR(ntrajid, nsshxid, pt%ssh_x, (/ jn /) )
233	iret = NF90_PUT_VAR(ntrajid, nsshyid, pt%ssh_y, (/ jn /) )
234	iret = NF90_PUT_VAR(ntrajid, nsstid, pt%sst, (/ jn /) )
235	iret = NF90_PUT_VAR(ntrajid, ncntid, pt%cn, (/ jn /) )
236	iret = NF90_PUT_VAR(ntrajid, nthkid, pt%hi, (/ jn /) )
237	iret = NF90_PUT_VAR(ntrajid, nmassid, pt%mass, (/ jn /) )
238	iret = NF90_PUT_VAR(ntrajid, nthicknessid, pt%thickness, (/ jn /) )
239	iret = NF90_PUT_VAR(ntrajid, nwidthid, pt%width, (/ jn /) )
240	iret = NF90_PUT_VAR(ntrajid, nlengthid, pt%length, (/ jn /) )
241	iret = NF90_PUT_VAR(ntrajid, nyearid, pt%year, (/ jn /) )
242	iret = NF90_PUT_VAR(ntrajid, ndayid, pt%day, (/ jn /) )
243	iret = NF90_PUT_VAR(ntrajid, nmass_of_bits_id, pt%mass_of_bits, (/ jn /) )
244	iret = NF90_PUT_VAR(ntrajid, nheat_density_id, pt%heat_density, (/ jn /) )
245
246	this=>this%next
247	END DO
248	IF( lwp .AND. nprint > 0 ) WRITE(numout,*) 'trajectory write to frame ', jn
249	num_traj = jn
250	!
251	END SUBROUTINE icb_trj_write
252
253	!!-------------------------------------------------------------------------
254
255	SUBROUTINE icb_trj_sync()
256	!!----------------------------------------------------------------------
257	!! * ROUTINE icb_trj_sync *
258	!!
259	!! ** Purpose :
260	!!----------------------------------------------------------------------
261	INTEGER :: iret
262	!!----------------------------------------------------------------------
263	! flush to file
264	iret = NF90_SYNC(ntrajid)
265	IF(iret /= NF90_NOERR) CALL ctl_stop( 'icebergs, icb_trj_sync: nf_sync failed' )
266	!
267	END SUBROUTINE icb_trj_sync
268
269
270	SUBROUTINE icb_trj_end()
271	! Local variables
272	INTEGER :: iret
273	!!----------------------------------------------------------------------
274	! Finish up
275	iret = NF90_CLOSE(ntrajid)
276	IF (iret /= NF90_NOERR) CALL ctl_stop( 'icebergs, icb_trj_end: nf_close failed' )
277	!
278	END SUBROUTINE icb_trj_end
279
280	!!-------------------------------------------------------------------------
281
282	END MODULE icbtrj

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/ICB/icbtrj.F90

Download in other formats: