Context Navigation

diamlr.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

File size: 23.1 KB

Line
1	MODULE diamlr
2	!!======================================================================
3	!! * MODULE diamlr *
4	!! Management of the IOM context for multiple-linear-regression analysis
5	!!======================================================================
6	!! History : ! 2019 (S. Mueller)
7	!!----------------------------------------------------------------------
8
9	USE par_oce , ONLY : wp, jpi, jpj
10	USE phycst , ONLY : rpi
11	USE in_out_manager , ONLY : lwp, numout, ln_timing
12	USE iom , ONLY : iom_put, iom_use, iom_update_file_name
13	USE dom_oce , ONLY : adatrj
14	USE timing , ONLY : timing_start, timing_stop
15	USE xios
16	USE tide_mod
17
18	IMPLICIT NONE
19	PRIVATE
20
21	LOGICAL, PUBLIC :: lk_diamlr = .FALSE.
22
23	PUBLIC :: dia_mlr_init, dia_mlr_iom_init, dia_mlr
24
25	!! * Substitutions
26	# include "do_loop_substitute.h90"
27	!!----------------------------------------------------------------------
28	!! NEMO/OCE 4.0 , NEMO Consortium (2019)
29	!! $Id$
30	!! Software governed by the CeCILL license (see ./LICENSE)
31	!!----------------------------------------------------------------------
32	CONTAINS
33
34	SUBROUTINE dia_mlr_init
35	!!----------------------------------------------------------------------
36	!! * ROUTINE dia_mlr_init *
37	!!
38	!! ** Purpose : initialisation of IOM context management for
39	!! multiple-linear-regression analysis
40	!!
41	!!----------------------------------------------------------------------
42
43	lk_diamlr = .TRUE.
44
45	IF(lwp) THEN
46	WRITE(numout, *)
47	WRITE(numout, *) 'dia_mlr_init : initialisation of IOM context management for'
48	WRITE(numout, *) '~~~~~~~~~~~~ multiple-linear-regression analysis'
49	END IF
50
51	END SUBROUTINE dia_mlr_init
52
53	SUBROUTINE dia_mlr_iom_init
54	!!----------------------------------------------------------------------
55	!! * ROUTINE dia_mlr_iom_init *
56	!!
57	!! ** Purpose : IOM context setup for multiple-linear-regression
58	!! analysis
59	!!
60	!!----------------------------------------------------------------------
61
62	TYPE(xios_fieldgroup) :: slxhdl_fldgrp
63	TYPE(xios_filegroup) :: slxhdl_filgrp
64	TYPE(xios_field), ALLOCATABLE, DIMENSION(:) :: slxhdl_regs, slxhdl_flds
65	TYPE(xios_field) :: slxhdl_fld
66	TYPE(xios_file) :: slxhdl_fil
67	LOGICAL :: llxatt_enabled, llxatt_comment
68	CHARACTER(LEN=256) :: clxatt_expr, clxatt_comment
69	CHARACTER(LEN=32) :: clxatt_name1, clxatt_name2
70	CHARACTER(LEN=32) :: clxatt_gridref, clxatt_fieldref
71	INTEGER, PARAMETER :: jpscanmax = 999
72	INTEGER :: ireg, ifld
73	CHARACTER(LEN=3) :: cl3i
74	CHARACTER(LEN=6) :: cl6a
75	CHARACTER(LEN=7) :: cl7a
76	CHARACTER(LEN=1) :: clgt
77	CHARACTER(LEN=2) :: clgd
78	CHARACTER(LEN=25) :: clfloat
79	CHARACTER(LEN=32) :: clrepl
80	INTEGER :: jl, jm, jn
81	INTEGER :: itide ! Number of available tidal components
82	REAL(wp) :: ztide_phase ! Tidal-constituent phase at adatrj=0
83	CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = ' n/a '
84	TYPE(tide_harmonic), DIMENSION(:), POINTER :: stideconst
85
86	IF(lwp) THEN
87	WRITE(numout, *)
88	WRITE(numout, *) 'dia_mlr_iom_init : IOM context setup for multiple-linear-regression'
89	WRITE(numout, *) '~~~~~~~~~~~~~~~~'
90	END IF
91
92	! Get handles to multiple-linear-regression analysis configuration (field
93	! group 'diamrl_fields' and file group 'diamlr_files'); if no suitable
94	! configuration is found, disable diamlr
95	IF ( lk_diamlr .AND. xios_is_valid_fieldgroup( "diamlr_fields" ) .AND. xios_is_valid_field( "diamlr_time" ) .AND. &
96	& xios_is_valid_filegroup( "diamlr_files" ) ) THEN
97	CALL xios_get_handle("diamlr_fields", slxhdl_fldgrp)
98	CALL xios_get_handle("diamlr_files", slxhdl_filgrp)
99	ELSE
100	IF (lwp) THEN
101	WRITE(numout, *) "diamlr: configuration not found or incomplete (field group 'diamlr_fields'"
102	WRITE(numout, *) " and/or file group 'diamlr_files' and/or field 'diamlr_time' missing);"
103	WRITE(numout, *) " disabling output for multiple-linear-regression analysis."
104	END IF
105	lk_diamlr = .FALSE.
106	END IF
107
108	! Set up IOM context for multiple-linear-regression analysis
109	IF ( lk_diamlr ) THEN
110
111	! Set up output files for grid types scalar, grid_T, grid_U, grid_V,
112	! and grid_W
113	DO jm = 1, 5
114	SELECT CASE( jm )
115	CASE( 1 )
116	cl6a = 'scalar'
117	CASE( 2 )
118	cl6a = 'grid_T'
119	CASE( 3 )
120	cl6a = 'grid_U'
121	CASE( 4 )
122	cl6a = 'grid_V'
123	CASE( 5 )
124	cl6a = 'grid_W'
125	END SELECT
126	CALL xios_add_child ( slxhdl_filgrp, slxhdl_fil, "diamlr_file_"//cl6a )
127	CALL xios_set_attr ( slxhdl_fil, name_suffix="_diamlr_"//cl6a, &
128	& description="Intermediate output for multiple-linear-regression analysis - "//cl6a )
129	CALL iom_update_file_name( "diamlr_file_"//cl6a )
130	END DO
131
132	! Compile lists of active regressors and of fields selected for
133	! analysis (fields "diamlr_r<nnn>" and "diamlr_f<nnn>", where <nnn> is
134	! a 3-digit integer); also carry out placeholder substitution of tidal
135	! parameters in regressor expressions
136	!
137	ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) )
138	ireg = 0
139	ifld = 0
140	!
141	IF ( ln_tide ) THEN
142	! Retrieve information (frequency, phase, nodal correction) about all
143	! available tidal constituents for placeholder substitution below
144	ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf', &
145	& 'Msqm', 'Sa', 'K1', 'O1', 'P1', &
146	& 'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', &
147	& 'K2', 'nu2', 'mu2', '2N2', 'L2', &
148	& 'T2', 'eps2', 'lam2', 'R2', 'M3', &
149	& 'MKS2', 'MN4', 'MS4', 'M4', 'N4', &
150	& 'S4', 'M6', 'M8' /)
151	CALL tide_init_harmonics(ctide_selected, stideconst)
152	itide = size(stideconst)
153	ELSE
154	itide = 0
155	ENDIF
156
157	DO jm = 1, jpscanmax
158	WRITE (cl3i, '(i3.3)') jm
159
160	! Look for regressor
161	IF ( xios_is_valid_field( "diamlr_r"//cl3i ) ) THEN
162
163	CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) )
164	! Retrieve pre-configured value of "enabled" attribute and
165	! regressor expression
166	CALL xios_get_attr ( slxhdl_regs(ireg+1), enabled=llxatt_enabled, expr=clxatt_expr )
167	! If enabled, keep handle in list of active regressors; also
168	! substitute placeholders for tidal frequencies, phases, and
169	! nodal corrections in regressor expressions
170	IF ( llxatt_enabled ) THEN
171
172	! Substitution of placeholders for tidal-constituent
173	! parameters (amplitudes, angular veloccities, nodal phase
174	! correction) with values that have been obtained from the
175	! tidal-forcing implementation (if enabled)
176	DO jn = 1, itide
177	! Compute phase of tidal constituent (incl. current nodal
178	! correction) at the start of the model run (i.e. for
179	! adatrj=0)
180	ztide_phase = MOD( stideconst(jn)%u + stideconst(jn)%v0 - adatrj * 86400.0_wp * stideconst(jn)%omega, &
181	& 2.0_wp * rpi )
182	clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_omega__"
183	DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
184	WRITE (clfloat, '(e25.18)') stideconst(jn)%omega
185	jl = INDEX( clxatt_expr, TRIM( clrepl ) )
186	clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// &
187	& clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
188	END DO
189	clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_phase__"
190	DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
191	WRITE (clfloat, '(e25.18)') ztide_phase
192	jl = INDEX( clxatt_expr, TRIM( clrepl ) )
193	clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// &
194	& clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
195	END DO
196	clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_amplitude__"
197	DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
198	WRITE (clfloat, '(e25.18)') stideconst(jn)%f
199	jl = INDEX( clxatt_expr, TRIM( clrepl ) )
200	clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// &
201	& clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) ))
202	END DO
203	END DO
204
205	! Set standard value for comment attribute, including possible
206	! existing comment added in parantheses
207	CALL xios_is_defined_attr( slxhdl_regs(ireg+1), comment=llxatt_comment )
208	IF ( llxatt_comment ) THEN
209	CALL xios_get_attr( slxhdl_regs(ireg+1), comment=clxatt_comment )
210	clxatt_comment = "Regressor "//cl3i//" ("//TRIM( clxatt_comment )//") "
211	ELSE
212	clxatt_comment = "Regressor "//cl3i
213	END IF
214
215	! Set name attribute (and overwrite possible pre-configured
216	! name) with field id to enable id string retrieval from
217	! stored handle below, re-set expression with possible
218	! substitutions, and set or re-set comment attribute
219	CALL xios_set_attr ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i, expr=TRIM( clxatt_expr ), &
220	& comment=TRIM( clxatt_comment ) )
221
222	ireg = ireg + 1 ! Accept regressor in list of active regressors
223
224	END IF
225	END IF
226
227	! Look for field
228	IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN
229
230	CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) )
231	! Retrieve pre-configured value of "enabled" attribute
232	CALL xios_get_attr ( slxhdl_flds(ifld+1), enabled=llxatt_enabled )
233	! If enabled, keep handle in list of fields selected for analysis
234	IF ( llxatt_enabled ) THEN
235
236	! Set name attribute (and overwrite possible pre-configured name)
237	! with field id to enable id string retrieval from stored handle
238	! below
239	CALL xios_set_attr ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i )
240
241	ifld = ifld + 1 ! Accept field in list of fields selected for analysis
242
243	END IF
244	END IF
245
246	END DO
247
248	! Output number of active regressors and fields selected for analysis
249	IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ireg, ' active regressors found'
250	IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ifld, ' fields selected for analysis'
251
252	! Set up output of minimum, maximum, and average values of the time
253	! variable available for the computation of regressors (diamlr_time)
254	CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil )
255	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_average" )
256	!$AGRIF_DO_NOT_TREAT
257	CALL xios_set_attr ( slxhdl_fld, standard_name="diamlr_time", &
258	& long_name="Elapsed model time at start of regression interval", &
259	& unit="s", operation="average", field_ref="diamlr_time", &
260	& grid_ref="diamlr_grid_2D_to_scalar" )
261	!$AGRIF_END_DO_NOT_TREAT
262	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_minimum" )
263	!$AGRIF_DO_NOT_TREAT
264	CALL xios_set_attr ( slxhdl_fld, standard_name="diamlr_time", &
265	& long_name="Elapsed model time at start of regression interval", &
266	& unit="s", operation="minimum", field_ref="diamlr_time", &
267	& grid_ref="diamlr_grid_2D_to_scalar" )
268	!$AGRIF_END_DO_NOT_TREAT
269	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_maximum" )
270	!$AGRIF_DO_NOT_TREAT
271	CALL xios_set_attr ( slxhdl_fld, standard_name="diamlr_time", &
272	& long_name="Elapsed model time at start of regression interval", &
273	& unit="s", operation="maximum", field_ref="diamlr_time", &
274	& grid_ref="diamlr_grid_2D_to_scalar" )
275	!$AGRIF_END_DO_NOT_TREAT
276
277	! For each active regressor:
278	DO jm = 1, ireg
279
280	! i) set up 2-dimensional and 3-dimensional versions of the
281	! regressors; explicitely set "enabled" attribute; note, while
282	! the scalar versions of regressors are part of the
283	! configuration, the respective 2-dimensional versions take
284	! over the defining expression, while the scalar and
285	! 3-dimensional versions are simply obtained via grid
286	! transformations from the 2-dimensional version.
287	CALL xios_get_attr ( slxhdl_regs( jm ), name=clxatt_name1, expr=clxatt_expr, &
288	& enabled=llxatt_enabled, comment=clxatt_comment )
289	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_T_2D" )
290	CALL xios_set_attr ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_T_2D", &
291	& field_ref="diamlr_time", enabled=llxatt_enabled )
292	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_U_2D" )
293	CALL xios_set_attr ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_U_2D", &
294	& field_ref="diamlr_time", enabled=llxatt_enabled )
295	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_V_2D" )
296	CALL xios_set_attr ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_V_2D", &
297	& field_ref="diamlr_time", enabled=llxatt_enabled )
298	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_W_2D" )
299	CALL xios_set_attr ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_W_2D", &
300	& field_ref="diamlr_time", enabled=llxatt_enabled )
301	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_T_3D")
302	CALL xios_set_attr ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_T_3D", &
303	& field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
304	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_U_3D")
305	CALL xios_set_attr ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_U_3D", &
306	& field_ref=TRIM( clxatt_name1 )//"_grid_U_2D", enabled=llxatt_enabled)
307	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_V_3D")
308	CALL xios_set_attr ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_V_3D", &
309	& field_ref=TRIM( clxatt_name1 )//"_grid_V_2D", enabled=llxatt_enabled)
310	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_grid_W_3D")
311	CALL xios_set_attr ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_grid_W_3D", &
312	& field_ref=TRIM( clxatt_name1 )//"_grid_W_2D", enabled=llxatt_enabled)
313	CALL xios_set_attr ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar", &
314	& field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
315
316	! ii) set up output of active regressors, including metadata
317	CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil )
318	! Add regressor to output file
319	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 ) )
320	CALL xios_set_attr ( slxhdl_fld, standard_name=TRIM( clxatt_comment ), long_name=TRIM( clxatt_expr ), &
321	& operation="average" )
322
323	! iii) set up the output of scalar products with itself and with
324	! other active regressors
325	CALL xios_get_attr ( slxhdl_regs(jm), name=clxatt_name1 )
326	DO jn = 1, jm
327	! Field for product between regressors
328	CALL xios_get_attr ( slxhdl_regs(jn), name=clxatt_name2 )
329	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
330	! Set appropriate name attribute to avoid the possibility of
331	! using an inappropriate inherited name attribute as the variable
332	! name in the output file
333	CALL xios_set_attr ( slxhdl_fld, &
334	& name=TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ), &
335	& grid_ref="diamlr_grid_scalar", &
336	& expr="this * "//TRIM( clxatt_name2 ), &
337	& field_ref=TRIM( clxatt_name1 ), &
338	& enabled=llxatt_enabled, &
339	& long_name="Scalar product of regressor "//TRIM( clxatt_name1 )// &
340	& " and regressor "//TRIM( clxatt_name2 ), &
341	& standard_name=TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ), &
342	& operation="accumulate")
343	! Add regressor-product field to output file
344	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
345	END DO
346
347	! iv) set up definitions for the output of scalar products with
348	! fields selected for analysis
349	DO jn = 1, ifld
350	CALL xios_get_attr ( slxhdl_flds(jn), name=clxatt_name2, field_ref=clxatt_fieldref )
351	CALL xios_get_handle( TRIM( clxatt_fieldref ), slxhdl_fld )
352	CALL xios_get_attr ( slxhdl_fld, grid_ref=clxatt_gridref )
353	clgt="T"
354	IF ( INDEX( clxatt_gridref, "_U_" ) > 0 ) clgt="U"
355	IF ( INDEX( clxatt_gridref, "_V_" ) > 0 ) clgt="V"
356	IF ( INDEX( clxatt_gridref, "_W_" ) > 0 ) clgt="W"
357	clgd="2D"
358	cl7a=""
359	IF ( INDEX( clxatt_gridref, "_3D" ) > 0 ) THEN
360	clgd="3D"
361	ELSE
362	cl7a="diamlr_"
363	END IF
364	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
365	! Set appropriate name attribute to avoid the possibility of
366	! using an inappropriate inherited name attribute as the variable
367	! name in the output file; use metadata (standard_name and
368	! long_name) to refer to the id of the analysed field
369	CALL xios_set_attr ( slxhdl_fld, &
370	& name=TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ), &
371	& expr="this * "//TRIM( clxatt_fieldref ), &
372	& grid_ref=cl7a//"grid_"//clgt//"_"//clgd, &
373	& field_ref=TRIM( clxatt_name1 )//"_grid_"//clgt//"_"//clgd, &
374	& enabled=llxatt_enabled, &
375	& long_name="Scalar product of "//TRIM( clxatt_fieldref )// &
376	& " and regressor "//TRIM( clxatt_name1 ), &
377	& standard_name=TRIM( clxatt_fieldref )//"."//TRIM( clxatt_name1 ), &
378	& operation="accumulate" )
379	CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil )
380	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
381	END DO
382
383	END DO
384
385	! Release list of active regressors and fields selected for analysis
386	DEALLOCATE( slxhdl_regs, slxhdl_flds )
387
388	END IF
389
390	END SUBROUTINE dia_mlr_iom_init
391
392	SUBROUTINE dia_mlr
393	!!----------------------------------------------------------------------
394	!! * ROUTINE dia_mlr *
395	!!
396	!! ** Purpose : update time used in multiple-linear-regression analysis
397	!!
398	!!----------------------------------------------------------------------
399
400	REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d
401
402	IF( ln_timing ) CALL timing_start('dia_mlr')
403
404	! Update time to the continuous time since the start of the model run
405	! (value of adatrj converted to time in units of seconds)
406	!
407	! A 2-dimensional field of constant value is sent, and subsequently used
408	! directly or transformed to a scalar or a constant 3-dimensional field as
409	! required.
410	zadatrj2d(:,:) = adatrj*86400.0_wp
411	IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d)
412
413	IF( ln_timing ) CALL timing_stop('dia_mlr')
414
415	END SUBROUTINE dia_mlr
416
417	END MODULE diamlr

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

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

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diamlr.F90 @ 12340

Download in other formats: