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

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DIA/diamlr.F90 @ 12345

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

Branch dev_r12072_MERGE_OPTION2_2019. Fixed ticket #2372. Changes to enable compilation without key_iomput

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