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/trunk/src/OCE/DIA – NEMO

source: NEMO/trunk/src/OCE/DIA/diamlr.F90 @ 12377

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

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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