source: NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/DIA/diamlr.F90 @ 11942

Last change on this file since 11942 was 11942, checked in by smueller, 11 months ago

Integration of a version of the IOM context setup for multiple-linear-regression analysis that results in the output of a full set of intermediate data for a configured regression analysis (see ticket #2175)

File size: 12.4 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 in_out_manager , ONLY :   lwp, numout, ln_timing
11   USE iom            , ONLY :   iom_put, iom_use, iom_update_file_name
12   USE dom_oce        , ONLY :   adatrj
13   USE timing         , ONLY :   timing_start, timing_stop
14   USE xios
15
16   IMPLICIT NONE
17   PRIVATE
18
19   LOGICAL, PUBLIC ::   lk_diamlr = .FALSE.
20
21   PUBLIC ::   dia_mlr_init, dia_mlr_iom_init, dia_mlr
22
23   !!----------------------------------------------------------------------
24   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
25   !! $Id$
26   !! Software governed by the CeCILL license (see ./LICENSE)
27   !!----------------------------------------------------------------------
28CONTAINS
29   
30   SUBROUTINE dia_mlr_init
31      !!----------------------------------------------------------------------
32      !!                 ***  ROUTINE dia_mlr_init  ***
33      !!
34      !! ** Purpose : initialisation of IOM context management for
35      !!              multiple-linear-regression analysis
36      !!
37      !!----------------------------------------------------------------------
38
39      lk_diamlr = .TRUE.
40
41      IF(lwp) THEN
42         WRITE(numout, *)
43         WRITE(numout, *) 'dia_mlr_init : initialisation of IOM context management for'
44         WRITE(numout, *) '~~~~~~~~~~~~   multiple-linear-regression analysis'
45      END IF
46
47   END SUBROUTINE dia_mlr_init
48
49   SUBROUTINE dia_mlr_iom_init
50      !!----------------------------------------------------------------------
51      !!               ***  ROUTINE dia_mlr_iom_init  ***
52      !!
53      !! ** Purpose : IOM context setup for multiple-linear-regression
54      !!              analysis
55      !!
56      !!----------------------------------------------------------------------
57
58      TYPE(xios_fieldgroup)                       ::   slxhdl_fldgrp
59      TYPE(xios_filegroup)                        ::   slxhdl_filgrp
60      TYPE(xios_field), ALLOCATABLE, DIMENSION(:) ::   slxhdl_regs, slxhdl_flds
61      TYPE(xios_field)                            ::   slxhdl_fld
62      TYPE(xios_file)                             ::   slxhdl_fil
63      LOGICAL                                     ::   slxatt_enabled
64      CHARACTER(LEN=256)                          ::   slxatt_expr
65      CHARACTER(LEN=32)                           ::   slxatt_name1,   slxatt_name2
66      CHARACTER(LEN=32)                           ::   slxatt_gridref, slxatt_fieldref
67      INTEGER, PARAMETER                          ::   jpscanmax = 999
68      INTEGER                                     ::   ireg, ifld
69      CHARACTER(LEN=3)                            ::   cl3i
70      CHARACTER(LEN=6)                            ::   cl6a
71      CHARACTER(LEN=1)                            ::   clgt
72      CHARACTER(LEN=2)                            ::   clgd
73      INTEGER                                     ::   jm, jn
74
75      IF(lwp) THEN
76         WRITE(numout, *)
77         WRITE(numout, *) 'dia_mlr_iom_init : IOM context setup for multiple-linear-regression'
78         WRITE(numout, *) '~~~~~~~~~~~~~~~~'
79      END IF
80
81      ! Get handles to multiple-linear-regression analysis configuration (field
82      ! group 'diamrl_fields' and file group 'diamlr_files'); if no suitable
83      ! configuration is found, disable diamlr
84      IF ( lk_diamlr .AND. xios_is_valid_fieldgroup( "diamlr_fields" ) .AND. xios_is_valid_field( "diamlr_time" ) .AND.   &
85         & xios_is_valid_filegroup( "diamlr_files" ) ) THEN
86         CALL xios_get_handle("diamlr_fields", slxhdl_fldgrp)
87         CALL xios_get_handle("diamlr_files",  slxhdl_filgrp)
88      ELSE
89         IF (lwp) THEN
90            WRITE(numout, *) "diamlr: configuration not found or icomplete (field group 'diamlr_fields'"
91            WRITE(numout, *) "        and/or file group 'diamlr_files' and/or field 'diamlr_time' missing);"
92            WRITE(numout, *) "        disabling output for multiple-linear-regression analysis."
93         END IF
94         lk_diamlr = .FALSE.
95      END IF
96
97      ! Set up IOM context for multiple-linear-regression analysis
98      IF ( lk_diamlr ) THEN
99
100         ! Set up output files for grid types scalar, grid_T, grid_U, grid_V,
101         ! and grid_W
102         DO jm = 1, 5
103            SELECT CASE( jm )
104            CASE( 1 )
105               cl6a = 'scalar'
106            CASE( 2 )
107               cl6a = 'grid_T'
108            CASE( 3 )
109               cl6a = 'grid_U'
110            CASE( 4 )
111               cl6a = 'grid_V'
112            CASE( 5 )
113               cl6a = 'grid_W'
114            END SELECT
115            CALL xios_add_child      ( slxhdl_filgrp, slxhdl_fil, "diamlr_file_"//cl6a )
116            CALL xios_set_attr       ( slxhdl_fil, name_suffix="_diamlr_"//cl6a,   &
117               &                       description="Intermediary output for multiple-linear-regression analysis - "//cl6a )
118            CALL iom_update_file_name( "diamlr_file_"//cl6a )
119         END DO
120
121         ! Compile lists of active regressors and of fields selected for
122         ! analysis (fields "diamlr_r<nnn>" and "diamlr_f<nnn>", where <nnn> is
123         ! a 3-digit integer)
124         ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) )
125         ireg = 0
126         ifld = 0
127         DO jm = 1, jpscanmax
128            WRITE (cl3i, '(i3.3)') jm
129
130            ! Look for regressor
131            IF ( xios_is_valid_field( "diamlr_r"//cl3i ) ) THEN
132               CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) )
133               ! Set name attribute (and overwrite possible pre-configured name)
134               ! with field id to enable id string retrieval from stored handle
135               ! below
136               CALL xios_set_attr  ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i )
137               ! Retrieve pre-configured value of "enabled" attribute
138               CALL xios_get_attr  ( slxhdl_regs(ireg+1), enabled=slxatt_enabled )
139               ! If enabled, keep handle in list of activ regressors
140               IF ( slxatt_enabled ) ireg = ireg + 1
141            END IF
142
143            ! Look for field
144            IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN
145               CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) )
146               ! Set name attribute (and overwrite possible pre-configured name)
147               ! with field id to enable id string retrieval from stored handle
148               ! below
149               CALL xios_set_attr  ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i )
150               ! Retrieve pre-configured value of "enabled" attribute
151               CALL xios_get_attr  ( slxhdl_flds(ifld+1), enabled=slxatt_enabled )
152               ! If enabled, keep handle in list of fields selected for analysis
153               IF ( slxatt_enabled ) ifld = ifld + 1
154            END IF
155
156         END DO
157         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ireg, ' active regressors found'
158         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ifld, ' fields selected for analysis'
159
160         ! For each active regressor:
161         DO jm = 1, ireg
162
163            !   i) set up 2-dimensional and 3-dimensional versions of the
164            !      regressors; explicitely set "enabled" attribute; note, while
165            !      the scalar versions of regressors are part of the
166            !      configuration, the respective 2-dimensional versions take
167            !      over the defining expression, while the scalar and
168            !      3-dimensional versions are simply obtained via grid
169            !      transformations from the 2-dimensional version.
170            CALL xios_get_attr  ( slxhdl_regs( jm ), name=slxatt_name1, expr=slxatt_expr, enabled=slxatt_enabled )
171            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"_2D" )
172            CALL xios_set_attr  ( slxhdl_fld, expr=TRIM( slxatt_expr ), grid_ref="diamlr_grid_2D",     &
173               &                  field_ref="diamlr_time", enabled=slxatt_enabled )
174            CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"_3D")
175            CALL xios_set_attr  ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_3D",            &
176               &                  field_ref=TRIM( slxatt_name1 )//"_2D", enabled=slxatt_enabled)
177            CALL xios_set_attr  ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar",   &
178               &                  field_ref=TRIM( slxatt_name1 )//"_2D", enabled=slxatt_enabled)
179
180            !  ii) set up definitions for the output of scalar products with
181            !      itself and with other active regressors
182            CALL xios_get_attr  ( slxhdl_regs(jm), name=slxatt_name1 )
183            CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil)
184            DO jn = 1, jm
185               ! Field for product between regressors
186               CALL xios_get_attr  ( slxhdl_regs(jn), name=slxatt_name2, enabled=slxatt_enabled )
187               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ) )
188               ! Set appropriate name attribute to avoid the possibility of
189               ! using an inappropriate inherited name attribute as the variable
190               ! name in the output file
191               CALL xios_set_attr  ( slxhdl_fld, name=TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ),      &
192                  &                  grid_ref="diamlr_grid_scalar", expr="this * "//TRIM( slxatt_name2 ),   &
193                  &                  field_ref=TRIM( slxatt_name1 ), enabled=slxatt_enabled, operation="accumulate")
194               ! Add regressor-product field to output file
195               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ) )
196            END DO
197
198            ! iii) set up definitions for the output of scalar products with
199            !      fields selected for analysis
200            DO jn = 1, ifld
201               CALL xios_get_attr( slxhdl_flds(jn), name=slxatt_name2, grid_ref=slxatt_gridref, field_ref=slxatt_fieldref )
202               clgt="T"
203               IF ( INDEX( slxatt_gridref, "_U_" ) > 0 ) clgt="U"
204               IF ( INDEX( slxatt_gridref, "_V_" ) > 0 ) clgt="V"
205               IF ( INDEX( slxatt_gridref, "_W_" ) > 0 ) clgt="W"
206               clgd="2D"
207               IF ( INDEX( slxatt_gridref, "_3D" ) > 0 ) clgd="3D"
208               CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ) )
209               ! Set appropriate name attribute to avoid the possibility of
210               ! using an inappropriate inherited name attribute as the variable
211               ! name in the output file
212               CALL xios_set_attr  ( slxhdl_fld, name=TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ),         &
213                  &                  expr="this * "//TRIM( slxatt_fieldref ), grid_ref="diamlr_grid_"//clgd,   &
214                  &                  field_ref=TRIM( slxatt_name1 )//"_"//clgd, enabled=slxatt_enabled, operation="accumulate" )
215               CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil )
216               CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ) )
217            END DO
218
219         END DO
220
221      END IF
222
223      ! Release list of active regressors and fields selected for analysis
224      DEALLOCATE( slxhdl_regs, slxhdl_flds )
225     
226   END SUBROUTINE dia_mlr_iom_init
227
228   SUBROUTINE dia_mlr
229      !!----------------------------------------------------------------------
230      !!                   ***  ROUTINE dia_mlr  ***
231      !!
232      !! ** Purpose : update time used in multiple-linear-regression analysis
233      !!
234      !!----------------------------------------------------------------------
235
236      REAL, DIMENSION(jpi,jpj) ::   zadatrj2d
237
238      IF( ln_timing )   CALL timing_start('dia_mlr')
239
240      ! Update time to the continuous time since the start of the model run
241      ! (value of adatrj converted to time in units of seconds)
242      !
243      ! A 2-dimensional field of constant value is sent, and subsequently used
244      ! directly or transformed to a scalar or a constant 3-dimensional field as
245      ! required.
246      zadatrj2d(:,:) = adatrj*86400.0_wp
247      IF ( iom_use('diamlr_time') ) CALL iom_put('diamlr_time', zadatrj2d)
248     
249      IF( ln_timing )   CALL timing_stop('dia_mlr')
250
251   END SUBROUTINE dia_mlr
252
253END MODULE diamlr
Note: See TracBrowser for help on using the repository browser.