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

Rev	Line
[11910]	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
[11922]	9	USE par_oce , ONLY : wp, jpi, jpj
[11950]	10	USE phycst , ONLY : rpi
[11910]	11	USE in_out_manager , ONLY : lwp, numout, ln_timing
[11942]	12	USE iom , ONLY : iom_put, iom_use, iom_update_file_name
[11922]	13	USE dom_oce , ONLY : adatrj
[11910]	14	USE timing , ONLY : timing_start, timing_stop
[11921]	15	USE xios
[12122]	16	USE tide_mod
[11910]	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
[12340]	25	!! * Substitutions
	26	# include "do_loop_substitute.h90"
[11910]	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
[11942]	62	TYPE(xios_fieldgroup) :: slxhdl_fldgrp
	63	TYPE(xios_filegroup) :: slxhdl_filgrp
[11971]	64	TYPE(xios_field), ALLOCATABLE, DIMENSION(:) :: slxhdl_regs, slxhdl_flds
[11942]	65	TYPE(xios_field) :: slxhdl_fld
	66	TYPE(xios_file) :: slxhdl_fil
[11971]	67	LOGICAL :: llxatt_enabled, llxatt_comment
	68	CHARACTER(LEN=256) :: clxatt_expr, clxatt_comment
[11961]	69	CHARACTER(LEN=32) :: clxatt_name1, clxatt_name2
	70	CHARACTER(LEN=32) :: clxatt_gridref, clxatt_fieldref
[11942]	71	INTEGER, PARAMETER :: jpscanmax = 999
	72	INTEGER :: ireg, ifld
	73	CHARACTER(LEN=3) :: cl3i
	74	CHARACTER(LEN=6) :: cl6a
[12010]	75	CHARACTER(LEN=7) :: cl7a
[11942]	76	CHARACTER(LEN=1) :: clgt
	77	CHARACTER(LEN=2) :: clgd
[11950]	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
[12122]	83	CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = ' n/a '
	84	TYPE(tide_harmonic), DIMENSION(:), POINTER :: stideconst
[11921]	85
[11910]	86	IF(lwp) THEN
	87	WRITE(numout, *)
	88	WRITE(numout, *) 'dia_mlr_iom_init : IOM context setup for multiple-linear-regression'
[11911]	89	WRITE(numout, *) '~~~~~~~~~~~~~~~~'
[11910]	90	END IF
	91
[11925]	92	! Get handles to multiple-linear-regression analysis configuration (field
	93	! group 'diamrl_fields' and file group 'diamlr_files'); if no suitable
[11921]	94	! configuration is found, disable diamlr
[11925]	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
[11942]	97	CALL xios_get_handle("diamlr_fields", slxhdl_fldgrp)
	98	CALL xios_get_handle("diamlr_files", slxhdl_filgrp)
[11921]	99	ELSE
	100	IF (lwp) THEN
[12229]	101	WRITE(numout, *) "diamlr: configuration not found or incomplete (field group 'diamlr_fields'"
[11925]	102	WRITE(numout, *) " and/or file group 'diamlr_files' and/or field 'diamlr_time' missing);"
[11921]	103	WRITE(numout, *) " disabling output for multiple-linear-regression analysis."
	104	END IF
	105	lk_diamlr = .FALSE.
	106	END IF
	107
[11942]	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, &
[11971]	128	& description="Intermediate output for multiple-linear-regression analysis - "//cl6a )
[11942]	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
[11950]	134	! a 3-digit integer); also carry out placeholder substitution of tidal
	135	! parameters in regressor expressions
	136	!
[11942]	137	ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) )
	138	ireg = 0
	139	ifld = 0
[11950]	140	!
[12122]	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
[11950]	156
[11942]	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
[11950]	162
[11942]	163	CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) )
[11950]	164	! Retrieve pre-configured value of "enabled" attribute and
	165	! regressor expression
[11961]	166	CALL xios_get_attr ( slxhdl_regs(ireg+1), enabled=llxatt_enabled, expr=clxatt_expr )
[11950]	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
[11961]	170	IF ( llxatt_enabled ) THEN
[11950]	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
[12122]	175	! tidal-forcing implementation (if enabled)
[11950]	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)
[12122]	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__"
[11961]	183	DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[12122]	184	WRITE (clfloat, '(e25.18)') stideconst(jn)%omega
[11961]	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 ) ))
[11950]	188	END DO
[12122]	189	clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_phase__"
[11961]	190	DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[11950]	191	WRITE (clfloat, '(e25.18)') ztide_phase
[11961]	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 ) ))
[11950]	195	END DO
[12122]	196	clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_amplitude__"
[11961]	197	DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[12122]	198	WRITE (clfloat, '(e25.18)') stideconst(jn)%f
[11961]	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 ) ))
[11950]	202	END DO
	203	END DO
	204
[11971]	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
[11950]	214
[11971]	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
[11950]	222	ireg = ireg + 1 ! Accept regressor in list of active regressors
	223
	224	END IF
[11942]	225	END IF
	226
	227	! Look for field
	228	IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN
[11950]	229
[11942]	230	CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) )
	231	! Retrieve pre-configured value of "enabled" attribute
[11961]	232	CALL xios_get_attr ( slxhdl_flds(ifld+1), enabled=llxatt_enabled )
[11942]	233	! If enabled, keep handle in list of fields selected for analysis
[11961]	234	IF ( llxatt_enabled ) THEN
[11950]	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
[11942]	244	END IF
	245
	246	END DO
[11950]	247
	248	! Output number of active regressors and fields selected for analysis
[11942]	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
[11972]	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" )
[12097]	256	!$AGRIF_DO_NOT_TREAT
[11972]	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" )
[12097]	261	!$AGRIF_END_DO_NOT_TREAT
[11972]	262	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_minimum" )
[12097]	263	!$AGRIF_DO_NOT_TREAT
[11972]	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" )
[12097]	268	!$AGRIF_END_DO_NOT_TREAT
[11972]	269	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_maximum" )
[12097]	270	!$AGRIF_DO_NOT_TREAT
[11972]	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" )
[12097]	275	!$AGRIF_END_DO_NOT_TREAT
[11972]	276
[11942]	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.
[11971]	287	CALL xios_get_attr ( slxhdl_regs( jm ), name=clxatt_name1, expr=clxatt_expr, &
	288	& enabled=llxatt_enabled, comment=clxatt_comment )
[12010]	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", &
[11961]	291	& field_ref="diamlr_time", enabled=llxatt_enabled )
[12010]	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)
[11942]	313	CALL xios_set_attr ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar", &
[12010]	314	& field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
[11942]	315
[11971]	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
[11961]	325	CALL xios_get_attr ( slxhdl_regs(jm), name=clxatt_name1 )
[11942]	326	DO jn = 1, jm
	327	! Field for product between regressors
[11971]	328	CALL xios_get_attr ( slxhdl_regs(jn), name=clxatt_name2 )
[11961]	329	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
[11942]	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
[11971]	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")
[11942]	343	! Add regressor-product field to output file
[11961]	344	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
[11942]	345	END DO
	346
[11972]	347	! iv) set up definitions for the output of scalar products with
[11942]	348	! fields selected for analysis
	349	DO jn = 1, ifld
[12012]	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 )
[11942]	353	clgt="T"
[11961]	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"
[11942]	357	clgd="2D"
[12010]	358	cl7a=""
	359	IF ( INDEX( clxatt_gridref, "_3D" ) > 0 ) THEN
	360	clgd="3D"
	361	ELSE
	362	cl7a="diamlr_"
	363	END IF
[11961]	364	CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
[11942]	365	! Set appropriate name attribute to avoid the possibility of
	366	! using an inappropriate inherited name attribute as the variable
[11971]	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 ), &
[12010]	372	& grid_ref=cl7a//"grid_"//clgt//"_"//clgd, &
	373	& field_ref=TRIM( clxatt_name1 )//"_grid_"//clgt//"_"//clgd, &
[11971]	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" )
[11942]	379	CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil )
[11961]	380	CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
[11942]	381	END DO
	382
	383	END DO
	384
[11950]	385	! Release list of active regressors and fields selected for analysis
	386	DEALLOCATE( slxhdl_regs, slxhdl_flds )
	387
[11942]	388	END IF
	389
[11910]	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
[11950]	400	REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d
[11922]	401
[11910]	402	IF( ln_timing ) CALL timing_start('dia_mlr')
	403
[11922]	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)
[11910]	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: