source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_utils305/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90 @ 11977

Last change on this file since 11977 was 11545, checked in by dford, 15 months ago

Specify an index for the xEPS diagnostic from FABM, for use by the observation operator. See https://code.metoffice.gov.uk/trac/utils/ticket/247.

File size: 23.9 KB
Line 
1MODULE trcini_fabm
2   !!======================================================================
3   !!                         ***  MODULE trcini_fabm  ***
4   !! TOP :   initialisation of the FABM tracers
5   !!======================================================================
6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code
7   !!----------------------------------------------------------------------
8#if defined key_fabm
9   !!----------------------------------------------------------------------
10   !!   'key_fabm'                                               FABM tracers
11   !!----------------------------------------------------------------------
12   !! trc_ini_fabm   : FABM model initialisation
13   !!----------------------------------------------------------------------
14   USE par_trc         ! TOP parameters
15   USE oce_trc
16   USE trc
17   USE par_fabm
18   USE trcsms_fabm
19   USE fabm_config,ONLY: fabm_create_model_from_yaml_file
20   USE fabm,ONLY: type_external_variable, fabm_initialize_library
21   USE inputs_fabm,ONLY: initialize_inputs,link_inputs, &
22     type_input_variable,type_input_data,type_river_data, &
23     first_input_data,first_river_data
24#if defined key_git_version
25   USE fabm_version,ONLY: fabm_commit_id=>git_commit_id, &
26                          fabm_branch_name=>git_branch_name
27   USE fabm_types,ONLY: type_version,first_module_version
28#endif
29
30
31   IMPLICIT NONE
32   PRIVATE
33
34#if defined key_git_version
35!#include "gitversion.h90"
36   CHARACTER(len=*),parameter :: git_commit_id = _NEMO_COMMIT_ID_
37   CHARACTER(len=*),parameter :: git_branch_name = _NEMO_BRANCH_
38#endif
39
40   PUBLIC   trc_ini_fabm   ! called by trcini.F90 module
41   PUBLIC   nemo_fabm_init
42
43   !!----------------------------------------------------------------------
44   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
45   !! $Id$
46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
47   !!----------------------------------------------------------------------
48CONTAINS
49
50   SUBROUTINE nemo_fabm_init()
51      INTEGER :: jn
52      INTEGER, PARAMETER :: xml_unit = 1979
53      TYPE (type_input_data),POINTER :: input_data
54      TYPE (type_river_data),POINTER :: river_data
55      CLASS (type_input_variable),POINTER :: input_pointer
56
57      ! Allow FABM to parse fabm.yaml. This ensures numbers of variables are known.
58      call fabm_create_model_from_yaml_file(model)
59
60      jp_fabm = size(model%state_variables)
61      jp_fabm_bottom = size(model%bottom_state_variables)
62      jp_fabm_surface = size(model%surface_state_variables)
63      jp_fabm0 = jptra + 1
64      jp_fabm1 = jptra + jp_fabm
65      jp_fabm_m1=jptra
66      jptra = jptra + jp_fabm
67      jp_fabm_2d = size(model%horizontal_diagnostic_variables)
68      jp_fabm_3d = size(model%diagnostic_variables)
69      jpdia2d = jpdia2d + jp_fabm_2d
70      jpdia3d = jpdia3d + jp_fabm_3d
71      jpdiabio = jpdiabio + jp_fabm
72
73      !Initialize input data structures.
74      call initialize_inputs
75
76      ! Get indexes for select state variables
77      jp_fabm_chl1 = fabm_state_index( 'P1_Chl' )
78      jp_fabm_chl2 = fabm_state_index( 'P2_Chl' )
79      jp_fabm_chl3 = fabm_state_index( 'P3_Chl' )
80      jp_fabm_chl4 = fabm_state_index( 'P4_Chl' )
81      jp_fabm_p1c  = fabm_state_index( 'P1_c' )
82      jp_fabm_p1n  = fabm_state_index( 'P1_n' )
83      jp_fabm_p1p  = fabm_state_index( 'P1_p' )
84      jp_fabm_p1s  = fabm_state_index( 'P1_s' )
85      jp_fabm_p2c  = fabm_state_index( 'P2_c' )
86      jp_fabm_p2n  = fabm_state_index( 'P2_n' )
87      jp_fabm_p2p  = fabm_state_index( 'P2_p' )
88      jp_fabm_p3c  = fabm_state_index( 'P3_c' )
89      jp_fabm_p3n  = fabm_state_index( 'P3_n' )
90      jp_fabm_p3p  = fabm_state_index( 'P3_p' )
91      jp_fabm_p4c  = fabm_state_index( 'P4_c' )
92      jp_fabm_p4n  = fabm_state_index( 'P4_n' )
93      jp_fabm_p4p  = fabm_state_index( 'P4_p' )
94      jp_fabm_z4c  = fabm_state_index( 'Z4_c' )
95      jp_fabm_z5c  = fabm_state_index( 'Z5_c' )
96      jp_fabm_z5n  = fabm_state_index( 'Z5_n' )
97      jp_fabm_z5p  = fabm_state_index( 'Z5_p' )
98      jp_fabm_z6c  = fabm_state_index( 'Z6_c' )
99      jp_fabm_z6n  = fabm_state_index( 'Z6_n' )
100      jp_fabm_z6p  = fabm_state_index( 'Z6_p' )
101      jp_fabm_n1p  = fabm_state_index( 'N1_p' )
102      jp_fabm_n3n  = fabm_state_index( 'N3_n' )
103      jp_fabm_n4n  = fabm_state_index( 'N4_n' )
104      jp_fabm_n5s  = fabm_state_index( 'N5_s' )
105      jp_fabm_o2o  = fabm_state_index( 'O2_o' )
106      jp_fabm_o3c  = fabm_state_index( 'O3_c' )
107      jp_fabm_o3ba = fabm_state_index( 'O3_bioalk' )
108      jp_fabm_r4n  = fabm_state_index( 'R4_n' )
109      jp_fabm_r4c  = fabm_state_index( 'R4_c' )
110      jp_fabm_r4p  = fabm_state_index( 'R4_p' )
111      jp_fabm_r6n  = fabm_state_index( 'R6_n' )
112      jp_fabm_r6c  = fabm_state_index( 'R6_c' )
113      jp_fabm_r6p  = fabm_state_index( 'R6_p' )
114      jp_fabm_r6s  = fabm_state_index( 'R6_s' )
115      jp_fabm_r8n  = fabm_state_index( 'R8_n' )
116      jp_fabm_r8c  = fabm_state_index( 'R8_c' )
117      jp_fabm_r8p  = fabm_state_index( 'R8_p' )
118      jp_fabm_r8s  = fabm_state_index( 'R8_s' )
119
120      ! Get indexes for select diagnostic variables
121      jp_fabm_o3ta  = fabm_diag_index( 'O3_TA' )
122      jp_fabm_o3ph  = fabm_diag_index( 'O3_pH' )
123      jp_fabm_o3pc  = fabm_diag_index( 'O3_pCO2' )
124      jp_fabm_xeps  = fabm_diag_index( 'light_xEPS' )
125      jp_fabm_pgrow = fabm_diag_index( 'p_grow_sum_result' )
126      jp_fabm_ploss = fabm_diag_index( 'p_loss_sum_result' )
127     
128      MLD_MAX(:,:)   = 0.0
129      PGROW_AVG(:,:) = 0.0
130      PLOSS_AVG(:,:) = 0.0
131      PHYT_AVG(:,:)  = 0.0
132
133      IF (lwp) THEN
134         ! write field_def_fabm.xml on lead process
135         OPEN(UNIT=xml_unit,FILE='field_def_fabm.xml',ACTION='WRITE',STATUS='REPLACE')
136
137         WRITE (xml_unit,1000) '<field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" >'
138
139         WRITE (xml_unit,1000) ' <field_group id="ptrc_T" grid_ref="grid_T_3D">'
140         DO jn=1,jp_fabm
141            CALL write_variable_xml(xml_unit,model%state_variables(jn))
142#if defined key_trdtrc
143            CALL write_trends_xml(xml_unit,model%state_variables(jn))
144#endif
145            CALL write_25hourm_xml(xml_unit,model%state_variables(jn))
146            CALL write_tmb_xml(xml_unit,model%state_variables(jn))
147         END DO
148         WRITE (xml_unit,1000) ' </field_group>'
149
150         WRITE (xml_unit,1000) ' <field_group id="sf_T" grid_ref="grid_T_2D">'
151         DO jn=1,jp_fabm_surface
152            CALL write_variable_xml(xml_unit,model%surface_state_variables(jn))
153            CALL write_25hourm_xml(xml_unit,model%surface_state_variables(jn))
154         END DO
155         DO jn=1,jp_fabm_bottom
156            CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn))
157            CALL write_25hourm_xml(xml_unit,model%bottom_state_variables(jn))
158         END DO
159         WRITE (xml_unit,1000) ' </field_group>'
160
161         WRITE (xml_unit,1000) ' <field_group id="diad_T" grid_ref="grid_T_2D">'
162         DO jn=1,size(model%diagnostic_variables)
163            CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3)
164            CALL write_25hourm_xml(xml_unit,model%diagnostic_variables(jn),3)
165            CALL write_tmb_xml(xml_unit,model%diagnostic_variables(jn))
166         END DO
167         DO jn=1,size(model%horizontal_diagnostic_variables)
168            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn))
169            CALL write_25hourm_xml(xml_unit,model%horizontal_diagnostic_variables(jn))
170         END DO
171         WRITE (xml_unit,1000) ' </field_group>'
172
173         WRITE (xml_unit,1000) ' <field_group id="fabm_scalar" grid_ref="grid_0">'
174         DO jn=1,size(model%conserved_quantities)
175            CALL write_variable_xml(xml_unit,model%conserved_quantities(jn))
176         END DO
177         WRITE (xml_unit,1000) ' </field_group>'
178
179         WRITE (xml_unit,1000) ' <field_group id="fabm_input" grid_ref="grid_T_2D">'
180         input_data => first_input_data
181         DO WHILE (ASSOCIATED(input_data))
182           input_pointer => input_data
183           CALL write_input_xml(xml_unit,input_pointer)
184            input_data => input_data%next
185         END DO
186         river_data => first_river_data
187         DO WHILE (ASSOCIATED(river_data))
188           input_pointer => river_data
189           CALL write_input_xml(xml_unit,input_pointer,3)
190            river_data => river_data%next
191         END DO
192         WRITE (xml_unit,1000) ' </field_group>'
193
194         WRITE (xml_unit,1000) '</field_definition>'
195
196         CLOSE(xml_unit)
197      END IF
198      IF( lk_mpp )   CALL mppsync !Ensure field_def_fabm is ready.
199
2001000 FORMAT (A)
201
202   END SUBROUTINE nemo_fabm_init
203
204   SUBROUTINE write_variable_xml(xml_unit,variable,flag_grid_ref)
205      INTEGER,INTENT(IN) :: xml_unit
206      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
207      CLASS (type_external_variable),INTENT(IN) :: variable
208
209      CHARACTER(LEN=20) :: missing_value,string_dimensions
210      INTEGER :: number_dimensions
211
212      ! Check variable dimension for grid_ref specificaiton.
213      ! Default is to not specify the grid_ref in the field definition.
214      IF (present(flag_grid_ref)) THEN
215          number_dimensions=flag_grid_ref
216      ELSE
217          number_dimensions=-1 !default, don't specify grid_ref
218      ENDIF
219
220      WRITE (missing_value,'(E9.3)') variable%missing_value
221      WRITE (string_dimensions,'(I1)') number_dimensions
222      SELECT CASE (number_dimensions)
223      CASE (3)
224         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
225      CASE (2)
226         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>'
227      CASE (0)
228         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="1point"/>'
229      CASE (-1)
230         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'" long_name="'//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" />'
231      CASE default
232         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise output of variable '//TRIM(variable%name)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional variables not supported!!!'
233      END SELECT
234
235   END SUBROUTINE write_variable_xml
236
237   SUBROUTINE write_25hourm_xml(xml_unit,variable,flag_grid_ref)
238      INTEGER,INTENT(IN) :: xml_unit
239      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
240      CLASS (type_external_variable),INTENT(IN) :: variable
241
242      CHARACTER(LEN=20) :: missing_value,string_dimensions
243      INTEGER :: number_dimensions
244
245      ! Check variable dimension for grid_ref specificaiton.
246      ! Default is to not specify the grid_ref in the field definition.
247      IF (present(flag_grid_ref)) THEN
248          number_dimensions=flag_grid_ref
249      ELSE
250          number_dimensions=-1 !default, don't specify grid_ref
251      ENDIF
252
253      WRITE (missing_value,'(E9.3)') 1.e+20
254      WRITE (string_dimensions,'(I1)') number_dimensions
255      SELECT CASE (number_dimensions)
256      CASE (3)
257         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
258      CASE (2)
259         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>'
260      CASE (0)
261         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="1point"/>'
262      CASE (-1)
263         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'25h'//'" long_name="'//TRIM(variable%long_name)//' 25-hour mean'//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" />'
264      CASE default
265         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise output of variable '//TRIM(variable%name)//'25h'//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional variables not supported!!!'
266      END SELECT
267
268   END SUBROUTINE write_25hourm_xml
269
270   SUBROUTINE write_tmb_xml(xml_unit,variable)
271      INTEGER,INTENT(IN) :: xml_unit
272      CLASS (type_external_variable),INTENT(IN) :: variable
273
274      CHARACTER(LEN=20) :: missing_value
275
276      WRITE (missing_value,'(E9.3)') 1.e+20
277      WRITE (xml_unit,'(A)') '  <field id="top_'//TRIM(variable%name)//'" long_name="Top-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>'
278      WRITE (xml_unit,'(A)') '  <field id="mid_'//TRIM(variable%name)//'" long_name="Middle-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>'
279      WRITE (xml_unit,'(A)') '  <field id="bot_'//TRIM(variable%name)//'" long_name="Bottom-level '//TRIM(variable%long_name)//'" unit="'//TRIM(variable%units)//'" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_2D"/>'
280
281   END SUBROUTINE write_tmb_xml
282
283   SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref)
284      INTEGER,INTENT(IN) :: xml_unit
285      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
286      CLASS (type_external_variable),INTENT(IN) :: variable
287
288      INTEGER :: number_dimensions,i
289      CHARACTER(LEN=20) :: missing_value,string_dimensions
290#if defined key_tracer_budget
291      CHARACTER(LEN=3),DIMENSION(10),PARAMETER :: trd_tags = (/ &
292        'LDF','BBL','FOR','ZDF','DMP','SMS','ATF', &
293        'RDB','RDN','VMV' /)
294      CHARACTER(LEN=3),DIMENSION(3),PARAMETER :: trd_e3t_tags = (/ &
295        'XAD','YAD','ZAD' /)
296#else
297      CHARACTER(LEN=3),DIMENSION(13),PARAMETER :: trd_tags = (/ &
298        'XAD','YAD','ZAD','LDF','BBL','FOR','ZDF','DMP','SMS','ATF', &
299        'RDB','RDN','VMV' /)
300#endif
301
302      ! Check variable dimension for grid_ref specificaiton.
303      ! Default is to not specify the grid_ref in the field definition.
304      IF (present(flag_grid_ref)) THEN
305          number_dimensions=flag_grid_ref
306      ELSE
307          number_dimensions=-1 !default, don't specify grid_ref
308      ENDIF
309
310      WRITE (missing_value,'(E9.3)') -2.E20
311      WRITE (string_dimensions,'(I1)') number_dimensions
312      SELECT CASE (number_dimensions)
313      CASE (3)
314        DO i=1,size(trd_tags)
315         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'// &
316            &                   TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//            &
317            &                   TRIM(variable%units)//'/s" default_value="'//                                   &
318            &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
319        END DO
320#if defined key_tracer_budget
321        DO i=1,size(trd_e3t_tags)
322         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_e3t_tags(i))//'_'//TRIM(variable%name)//                     &
323            &                   '_e3t" long_name="'//TRIM(variable%long_name)//' cell depth integrated '//             &
324            &                   TRIM(trd_e3t_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'// &
325            &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
326        END DO
327        WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// &
328           &                   ' cell depth integrated" unit="'//TRIM(variable%units)//'/s" default_value="'//       &
329           &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
330#endif
331      CASE (-1)
332        DO i=1,size(trd_tags)
333         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//   &
334            &                   TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//              &
335            &                   TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />'
336        END DO
337#if defined key_tracer_budget
338        DO i=1,size(trd_e3t_tags)
339         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_e3t_tags(i))//'_'//TRIM(variable%name)//                     &
340            &                   '_e3t" long_name="'//TRIM(variable%long_name)//' cell depth integrated '//             &
341            &                   TRIM(trd_e3t_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'// &
342            &                   TRIM(ADJUSTL(missing_value))//'" />'
343        END DO
344        WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// &
345           &                   ' cell depth integrated" unit="'//TRIM(variable%units)//'/s" default_value="'//       &
346           &                   TRIM(ADJUSTL(missing_value))//'" />'
347#endif
348      CASE default
349         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)// &
350            &                    ': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!'
351      END SELECT
352
353   END SUBROUTINE write_trends_xml
354
355   SUBROUTINE write_input_xml(xml_unit,variable,flag_grid_ref)
356      INTEGER,INTENT(IN) :: xml_unit
357      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
358      CLASS(type_input_variable),POINTER,INTENT(IN) :: variable
359
360      INTEGER :: number_dimensions,i
361      CHARACTER(LEN=20) :: missing_value,string_dimensions
362
363      ! Check variable dimension for grid_ref specificaiton.
364      ! Default is to not specify the grid_ref in the field definition.
365      IF (present(flag_grid_ref)) THEN
366          number_dimensions=flag_grid_ref
367      ELSE
368          number_dimensions=-1 !default, don't specify grid_ref
369      ENDIF
370
371      WRITE (missing_value,'(E9.3)') -2.E20
372      WRITE (string_dimensions,'(I1)') number_dimensions
373      SELECT CASE (number_dimensions)
374      CASE (3)
375        WRITE (xml_unit,'(A)') '  <field id="'//'INP_'//TRIM(variable%sf(1)%clvar)//'" long_name="'//TRIM(variable%sf(1)%clvar)//' input" unit="" default_value="'//TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
376      CASE (-1)
377        WRITE (xml_unit,'(A)') '  <field id="'//'INP_'//TRIM(variable%sf(1)%clvar)//'" long_name="'//TRIM(variable%sf(1)%clvar)//' input" unit="" default_value="'//TRIM(ADJUSTL(missing_value))//'" />'
378      CASE default
379         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise input diagnostic of variable '//TRIM(variable%sf(1)%clvar)//': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional diagnostic not supported!!!'
380      END SELECT
381
382   END SUBROUTINE write_input_xml
383
384   SUBROUTINE trc_ini_fabm
385      !!----------------------------------------------------------------------
386      !!                     ***  trc_ini_fabm  ***
387      !!
388      !! ** Purpose :   initialization for FABM model
389      !!
390      !! ** Method  : - Read the namcfc namelist and check the parameter values
391      !!----------------------------------------------------------------------
392#if defined key_git_version
393      TYPE (type_version),POINTER :: version
394#endif
395      INTEGER :: jn
396
397      !                       ! Allocate FABM arrays
398      IF( trc_sms_fabm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_fabm: unable to allocate FABM arrays' )
399
400      IF(lwp) WRITE(numout,*)
401      IF(lwp) WRITE(numout,*) ' trc_ini_fabm: initialisation of FABM model'
402      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
403#if defined key_git_version
404      IF(lwp) WRITE(numout,*) ' NEMO version:   ',git_commit_id,' (',git_branch_name,' branch)'
405      IF(lwp) WRITE(numout,*) ' FABM version:   ',fabm_commit_id,' (',fabm_branch_name,' branch)'
406#endif
407
408      call fabm_initialize_library()
409#if defined key_git_version
410      version => first_module_version
411
412      do while (associated(version))
413         IF(lwp) WRITE(numout,*)  ' '//trim(version%module_name)//' version:   ',trim(version%version_string)
414         version => version%next
415      end do
416#endif
417
418      ! Log mapping of FABM states:
419      IF (lwp) THEN
420         IF (jp_fabm.gt.0) WRITE(numout,*) " FABM tracers:"
421         DO jn=1,jp_fabm
422            WRITE(numout,*) "   State",jn,":",trim(model%state_variables(jn)%name), &
423               " (",trim(model%state_variables(jn)%long_name), &
424               ") [",trim(model%state_variables(jn)%units),"]"
425         ENDDO
426         IF (jp_fabm_surface.gt.0) WRITE(numout,*) "FABM seasurface states:"
427         DO jn=1,jp_fabm_surface
428            WRITE(numout,*) "   State",jn,":",trim(model%surface_state_variables(jn)%name), &
429               " (",trim(model%surface_state_variables(jn)%long_name), &
430               ") [",trim(model%surface_state_variables(jn)%units),"]"
431         ENDDO
432         IF (jp_fabm_bottom.gt.0) WRITE(numout,*) "FABM seafloor states:"
433         DO jn=1,jp_fabm_bottom
434            WRITE(numout,*) "   State",jn,":",trim(model%bottom_state_variables(jn)%name), &
435               " (",trim(model%bottom_state_variables(jn)%long_name), &
436               ") [",trim(model%bottom_state_variables(jn)%units),"]"
437         ENDDO
438      ENDIF
439
440   END SUBROUTINE trc_ini_fabm
441
442   INTEGER FUNCTION fabm_state_index( state_name )
443      !!----------------------------------------------------------------------
444      !!                     ***  fabm_state_index  *** 
445      !!
446      !! ** Purpose :   return index of a given FABM state variable
447      !!
448      !! ** Method  : - loop through state variables until found
449      !!----------------------------------------------------------------------
450     
451      IMPLICIT NONE
452     
453      CHARACTER(LEN=256), INTENT(IN) :: state_name
454     
455      INTEGER                        :: jn
456
457      !!----------------------------------------------------------------------
458     
459      fabm_state_index = -1
460      DO jn=1,jp_fabm
461         IF (TRIM(model%state_variables(jn)%name) == TRIM(state_name)) THEN
462            fabm_state_index = jn
463            EXIT
464         ENDIF
465      END DO
466      IF (fabm_state_index == -1) THEN
467         CALL ctl_warn( 'Could not find '//TRIM(state_name)//' state variable' )
468      ELSE
469         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(state_name)//' is: ', fabm_state_index
470      ENDIF
471   
472   END FUNCTION fabm_state_index
473
474   INTEGER FUNCTION fabm_diag_index( diag_name )
475      !!----------------------------------------------------------------------
476      !!                     ***  fabm_state_index  *** 
477      !!
478      !! ** Purpose :   return index of a given FABM diagnostic variable
479      !!
480      !! ** Method  : - loop through diagnostic variables until found
481      !!----------------------------------------------------------------------
482     
483      IMPLICIT NONE
484     
485      CHARACTER(LEN=256), INTENT(IN) :: diag_name
486     
487      INTEGER                        :: jn
488
489      !!----------------------------------------------------------------------
490     
491      fabm_diag_index = -1
492      DO jn = 1, SIZE(model%diagnostic_variables)
493         IF (TRIM(model%diagnostic_variables(jn)%name) == TRIM(diag_name)) THEN
494            fabm_diag_index = jn
495            EXIT
496         ENDIF
497      END DO
498      IF (fabm_diag_index == -1) THEN
499         CALL ctl_warn( 'Could not find '//TRIM(diag_name)//' diagnostic' )
500      ELSE
501         IF (lwp) WRITE(numout,*) 'Index for '//TRIM(diag_name)//' is: ', fabm_diag_index
502      ENDIF
503   
504   END FUNCTION fabm_diag_index
505
506#else
507   !!----------------------------------------------------------------------
508   !!   Dummy module                                        No FABM model
509   !!----------------------------------------------------------------------
510CONTAINS
511   SUBROUTINE nemo_fabm_init
512   END SUBROUTINE nemo_fabm_init
513
514   SUBROUTINE trc_ini_fabm            ! Empty routine
515   END SUBROUTINE trc_ini_fabm
516#endif
517
518   !!======================================================================
519END MODULE trcini_fabm
Note: See TracBrowser for help on using the repository browser.