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 @ 12587

Last change on this file since 12587 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
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
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      !!----------------------------------------------------------------------
[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
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
[11950]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
[11950]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
[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" )
325               
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)
[11910]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.