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

Last change on this file was 14239, checked in by smasson, 3 years ago

trunk: replace key_iomput by key_xios

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