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

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

Last change on this file since 12482 was 12482, checked in by techene, 4 years ago

new reference without ztilde, duplicated modules and routines to be modified from zstar MLF to zstar LF

File size: 23.2 KB
RevLine 
[11910]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
[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
[12344]15#if defined key_iomput
[11921]16   USE xios
[12344]17#endif
[12122]18   USE tide_mod
[11910]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
[12340]27   !! * Substitutions
28#  include "do_loop_substitute.h90"
[11910]29   !!----------------------------------------------------------------------
30   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
31   !! $Id$
32   !! Software governed by the CeCILL license (see ./LICENSE)
33   !!----------------------------------------------------------------------
34CONTAINS
[12482]35
[11910]36   SUBROUTINE dia_mlr_init
37      !!----------------------------------------------------------------------
38      !!                 ***  ROUTINE dia_mlr_init  ***
39      !!
[12482]40      !! ** Purpose : initialisation of IOM context management for
[11910]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      !!----------------------------------------------------------------------
[12344]63#if defined key_iomput
[11910]64
[11942]65      TYPE(xios_fieldgroup)                       ::   slxhdl_fldgrp
66      TYPE(xios_filegroup)                        ::   slxhdl_filgrp
[11971]67      TYPE(xios_field), ALLOCATABLE, DIMENSION(:) ::   slxhdl_regs,    slxhdl_flds
[11942]68      TYPE(xios_field)                            ::   slxhdl_fld
69      TYPE(xios_file)                             ::   slxhdl_fil
[11971]70      LOGICAL                                     ::   llxatt_enabled, llxatt_comment
71      CHARACTER(LEN=256)                          ::   clxatt_expr,    clxatt_comment
[11961]72      CHARACTER(LEN=32)                           ::   clxatt_name1,   clxatt_name2
73      CHARACTER(LEN=32)                           ::   clxatt_gridref, clxatt_fieldref
[11942]74      INTEGER, PARAMETER                          ::   jpscanmax = 999
75      INTEGER                                     ::   ireg, ifld
76      CHARACTER(LEN=3)                            ::   cl3i
77      CHARACTER(LEN=6)                            ::   cl6a
[12010]78      CHARACTER(LEN=7)                            ::   cl7a
[11942]79      CHARACTER(LEN=1)                            ::   clgt
80      CHARACTER(LEN=2)                            ::   clgd
[11950]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
[12122]86      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = ' n/a '
87      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst
[11921]88
[11910]89      IF(lwp) THEN
90         WRITE(numout, *)
91         WRITE(numout, *) 'dia_mlr_iom_init : IOM context setup for multiple-linear-regression'
[11911]92         WRITE(numout, *) '~~~~~~~~~~~~~~~~'
[11910]93      END IF
94
[11925]95      ! Get handles to multiple-linear-regression analysis configuration (field
96      ! group 'diamrl_fields' and file group 'diamlr_files'); if no suitable
[11921]97      ! configuration is found, disable diamlr
[11925]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
[11942]100         CALL xios_get_handle("diamlr_fields", slxhdl_fldgrp)
101         CALL xios_get_handle("diamlr_files",  slxhdl_filgrp)
[11921]102      ELSE
103         IF (lwp) THEN
[12229]104            WRITE(numout, *) "diamlr: configuration not found or incomplete (field group 'diamlr_fields'"
[11925]105            WRITE(numout, *) "        and/or file group 'diamlr_files' and/or field 'diamlr_time' missing);"
[11921]106            WRITE(numout, *) "        disabling output for multiple-linear-regression analysis."
107         END IF
108         lk_diamlr = .FALSE.
109      END IF
110
[11942]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,   &
[11971]131               &                       description="Intermediate output for multiple-linear-regression analysis - "//cl6a )
[11942]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
[11950]137         ! a 3-digit integer); also carry out placeholder substitution of tidal
138         ! parameters in regressor expressions
139         !
[11942]140         ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) )
141         ireg = 0
142         ifld = 0
[11950]143         !
[12122]144         IF ( ln_tide ) THEN
145            ! Retrieve information (frequency, phase, nodal correction) about all
146            ! available tidal constituents for placeholder substitution below
[12482]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  ' /)
[12122]154            CALL tide_init_harmonics(ctide_selected, stideconst)
155            itide = size(stideconst)
156         ELSE
157            itide = 0
158         ENDIF
[12482]159
[11942]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
[11950]165
[11942]166               CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) )
[11950]167               ! Retrieve pre-configured value of "enabled" attribute and
168               ! regressor expression
[11961]169               CALL xios_get_attr  ( slxhdl_regs(ireg+1), enabled=llxatt_enabled, expr=clxatt_expr )
[11950]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
[11961]173               IF ( llxatt_enabled ) THEN
[11950]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
[12122]178                  ! tidal-forcing implementation (if enabled)
[11950]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)
[12122]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__"
[11961]186                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[12122]187                        WRITE (clfloat, '(e25.18)') stideconst(jn)%omega
[11961]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 ) ))
[11950]191                     END DO
[12122]192                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_phase__"
[11961]193                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[11950]194                        WRITE (clfloat, '(e25.18)') ztide_phase
[11961]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 ) ))
[11950]198                     END DO
[12122]199                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_amplitude__"
[11961]200                     DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 )
[12122]201                        WRITE (clfloat, '(e25.18)') stideconst(jn)%f
[11961]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 ) ))
[11950]205                     END DO
206                  END DO
207
[11971]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
[11950]217
[11971]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
[11950]225                  ireg = ireg + 1   ! Accept regressor in list of active regressors
226
227               END IF
[11942]228            END IF
229
230            ! Look for field
231            IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN
[11950]232
[11942]233               CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) )
234               ! Retrieve pre-configured value of "enabled" attribute
[11961]235               CALL xios_get_attr  ( slxhdl_flds(ifld+1), enabled=llxatt_enabled )
[11942]236               ! If enabled, keep handle in list of fields selected for analysis
[11961]237               IF ( llxatt_enabled ) THEN
[12482]238
[11950]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
[11942]247            END IF
248
249         END DO
[11950]250
251         ! Output number of active regressors and fields selected for analysis
[11942]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
[11972]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" )
[12097]259!$AGRIF_DO_NOT_TREAT
[11972]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" )
[12097]264!$AGRIF_END_DO_NOT_TREAT
[11972]265         CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_minimum" )
[12097]266!$AGRIF_DO_NOT_TREAT
[11972]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" )
[12097]271!$AGRIF_END_DO_NOT_TREAT
[11972]272         CALL xios_add_child ( slxhdl_fil, slxhdl_fld, "diamlr_time_maximum" )
[12097]273!$AGRIF_DO_NOT_TREAT
[11972]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" )
[12097]278!$AGRIF_END_DO_NOT_TREAT
[11972]279
[11942]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.
[11971]290            CALL xios_get_attr  ( slxhdl_regs( jm ), name=clxatt_name1, expr=clxatt_expr,              &
291               &                  enabled=llxatt_enabled, comment=clxatt_comment )
[12010]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",     &
[11961]294               &                  field_ref="diamlr_time", enabled=llxatt_enabled )
[12010]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)
[11942]316            CALL xios_set_attr  ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar",   &
[12010]317               &                  field_ref=TRIM( clxatt_name1 )//"_grid_T_2D", enabled=llxatt_enabled)
[11942]318
[11971]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" )
[12482]325
[11971]326            ! iii) set up the output of scalar products with itself and with
327            !      other active regressors
[11961]328            CALL xios_get_attr  ( slxhdl_regs(jm), name=clxatt_name1 )
[11942]329            DO jn = 1, jm
330               ! Field for product between regressors
[11971]331               CALL xios_get_attr  ( slxhdl_regs(jn), name=clxatt_name2 )
[11961]332               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
[11942]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
[11971]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")
[11942]346               ! Add regressor-product field to output file
[11961]347               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) )
[11942]348            END DO
349
[11972]350            !  iv) set up definitions for the output of scalar products with
[11942]351            !      fields selected for analysis
352            DO jn = 1, ifld
[12012]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 )
[11942]356               clgt="T"
[11961]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"
[11942]360               clgd="2D"
[12010]361               cl7a=""
362               IF ( INDEX( clxatt_gridref, "_3D" ) > 0 ) THEN
363                  clgd="3D"
364               ELSE
365                  cl7a="diamlr_"
366               END IF
[11961]367               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
[11942]368               ! Set appropriate name attribute to avoid the possibility of
369               ! using an inappropriate inherited name attribute as the variable
[11971]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 ),                            &
[12010]375                  &                  grid_ref=cl7a//"grid_"//clgt//"_"//clgd,                                      &
376                  &                  field_ref=TRIM( clxatt_name1 )//"_grid_"//clgt//"_"//clgd,          &
[11971]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" )
[11942]382               CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil )
[11961]383               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) )
[11942]384            END DO
385
386         END DO
387
[11950]388         ! Release list of active regressors and fields selected for analysis
389         DEALLOCATE( slxhdl_regs, slxhdl_flds )
390
[11942]391      END IF
[12344]392#else
393      IF( .FALSE. ) write(numout,*) 'dia_mlr_iom_init: should not see this'    ! useless statement to avoid compiler warnings
394#endif
[11942]395
[11910]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
[11950]406      REAL(wp), DIMENSION(jpi,jpj) ::   zadatrj2d
[11922]407
[11910]408      IF( ln_timing )   CALL timing_start('dia_mlr')
409
[11922]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)
[12482]418
[11910]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.