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.

diamlr.F90 in NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DIA/diamlr.F90 @ 12680

Last change on this file since 12680 was 12680, checked in by techene, 4 years ago
dynatfQCO.F90, stepLF.F90 : fixed (remove pe3. from dyn_atf_qco input arguments), all : remove e3. tables and include gurvan's feedbacks
File size: 23.6 KB

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

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

Download in other formats: