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.
trcini_fabm.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/FABM – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_FABM/NEMOGCM/NEMO/TOP_SRC/FABM/trcini_fabm.F90 @ 10158

Last change on this file since 10158 was 10158, checked in by dford, 6 years ago

Minor changes to compile and run at the Met Office.
File size: 15.7 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      jpdia2d = jpdia2d + size(model%horizontal_diagnostic_variables)
68      jpdia3d = jpdia3d + size(model%diagnostic_variables)
69      jpdiabio = jpdiabio + jp_fabm
70
71      !Initialize input data structures.
72      call initialize_inputs
73
74      IF (lwp) THEN
75         ! write field_def_fabm.xml on lead process
76         OPEN(UNIT=xml_unit,FILE='field_def_fabm.xml',ACTION='WRITE',STATUS='REPLACE')
77
78         WRITE (xml_unit,1000) '<field_definition level="1" prec="4" operation="average" enabled=".TRUE." default_value="1.e20" >'
79
80         WRITE (xml_unit,1000) ' <field_group id="ptrc_T" grid_ref="grid_T_3D">'
81         DO jn=1,jp_fabm
82            CALL write_variable_xml(xml_unit,model%state_variables(jn))
83#if defined key_trdtrc
84            CALL write_trends_xml(xml_unit,model%state_variables(jn))
85#endif
86         END DO
87         WRITE (xml_unit,1000) ' </field_group>'
88
89         WRITE (xml_unit,1000) ' <field_group id="sf_T" grid_ref="grid_T_2D">'
90         DO jn=1,jp_fabm_surface
91            CALL write_variable_xml(xml_unit,model%surface_state_variables(jn))
92         END DO
93         DO jn=1,jp_fabm_bottom
94            CALL write_variable_xml(xml_unit,model%bottom_state_variables(jn))
95         END DO
96         WRITE (xml_unit,1000) ' </field_group>'
97
98         WRITE (xml_unit,1000) ' <field_group id="diad_T" grid_ref="grid_T_2D">'
99         DO jn=1,size(model%diagnostic_variables)
100            CALL write_variable_xml(xml_unit,model%diagnostic_variables(jn),3)
101         END DO
102         DO jn=1,size(model%horizontal_diagnostic_variables)
103            CALL write_variable_xml(xml_unit,model%horizontal_diagnostic_variables(jn))
104         END DO
105         WRITE (xml_unit,1000) ' </field_group>'
106
107         WRITE (xml_unit,1000) ' <field_group id="fabm_scalar" grid_ref="grid_0">'
108         DO jn=1,size(model%conserved_quantities)
109            CALL write_variable_xml(xml_unit,model%conserved_quantities(jn))
110         END DO
111         WRITE (xml_unit,1000) ' </field_group>'
112
113         WRITE (xml_unit,1000) ' <field_group id="fabm_input" grid_ref="grid_T_2D">'
114         input_data => first_input_data
115         DO WHILE (ASSOCIATED(input_data))
116           input_pointer => input_data
117           CALL write_input_xml(xml_unit,input_pointer)
118            input_data => input_data%next
119         END DO
120         river_data => first_river_data
121         DO WHILE (ASSOCIATED(river_data))
122           input_pointer => river_data
123           CALL write_input_xml(xml_unit,input_pointer,3)
124            river_data => river_data%next
125         END DO
126         WRITE (xml_unit,1000) ' </field_group>'
127
128         WRITE (xml_unit,1000) '</field_definition>'
129
130         CLOSE(xml_unit)
131      END IF
132      IF( lk_mpp )   CALL mppsync !Ensure field_def_fabm is ready.
133
1341000 FORMAT (A)
135
136   END SUBROUTINE nemo_fabm_init
137
138   SUBROUTINE write_variable_xml(xml_unit,variable,flag_grid_ref)
139      INTEGER,INTENT(IN) :: xml_unit
140      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
141      CLASS (type_external_variable),INTENT(IN) :: variable
142
143      CHARACTER(LEN=20) :: missing_value,string_dimensions
144      INTEGER :: number_dimensions
145
146      ! Check variable dimension for grid_ref specificaiton.
147      ! Default is to not specify the grid_ref in the field definition.
148      IF (present(flag_grid_ref)) THEN
149          number_dimensions=flag_grid_ref
150      ELSE
151          number_dimensions=-1 !default, don't specify grid_ref
152      ENDIF
153
154      WRITE (missing_value,'(E9.3)') variable%missing_value
155      WRITE (string_dimensions,'(I1)') number_dimensions
156      SELECT CASE (number_dimensions)
157      CASE (3)
158         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" />'
159      CASE (2)
160         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"/>'
161      CASE (0)
162         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"/>'
163      CASE (-1)
164         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))//'" />'
165      CASE default
166         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!!!'
167      END SELECT
168
169   END SUBROUTINE write_variable_xml
170
171   SUBROUTINE write_trends_xml(xml_unit,variable,flag_grid_ref)
172      INTEGER,INTENT(IN) :: xml_unit
173      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
174      CLASS (type_external_variable),INTENT(IN) :: variable
175
176      INTEGER :: number_dimensions,i
177      CHARACTER(LEN=20) :: missing_value,string_dimensions
178#if defined key_tracer_budget
179      CHARACTER(LEN=3),DIMENSION(10),PARAMETER :: trd_tags = (/ &
180        'LDF','BBL','FOR','ZDF','DMP','SMS','ATF', &
181        'RDB','RDN','VMV' /)
182      CHARACTER(LEN=3),DIMENSION(3),PARAMETER :: trd_e3t_tags = (/ &
183        'XAD','YAD','ZAD' /)
184#else
185      CHARACTER(LEN=3),DIMENSION(13),PARAMETER :: trd_tags = (/ &
186        'XAD','YAD','ZAD','LDF','BBL','FOR','ZDF','DMP','SMS','ATF', &
187        'RDB','RDN','VMV' /)
188#endif
189
190      ! Check variable dimension for grid_ref specificaiton.
191      ! Default is to not specify the grid_ref in the field definition.
192      IF (present(flag_grid_ref)) THEN
193          number_dimensions=flag_grid_ref
194      ELSE
195          number_dimensions=-1 !default, don't specify grid_ref
196      ENDIF
197
198      WRITE (missing_value,'(E9.3)') -2.E20
199      WRITE (string_dimensions,'(I1)') number_dimensions
200      SELECT CASE (number_dimensions)
201      CASE (3)
202        DO i=1,size(trd_tags)
203         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'// &
204            &                   TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//            &
205            &                   TRIM(variable%units)//'/s" default_value="'//                                   &
206            &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
207        END DO
208#if defined key_tracer_budget
209        DO i=1,size(trd_e3t_tags)
210         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_e3t_tags(i))//'_'//TRIM(variable%name)//                     &
211            &                   '_e3t" long_name="'//TRIM(variable%long_name)//' cell depth integrated '//             &
212            &                   TRIM(trd_e3t_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'// &
213            &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
214        END DO
215        WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// &
216           &                   ' cell depth integrated" unit="'//TRIM(variable%units)//'/s" default_value="'//       &
217           &                   TRIM(ADJUSTL(missing_value))//'" grid_ref="grid_T_3D" />'
218#endif
219      CASE (-1)
220        DO i=1,size(trd_tags)
221         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_tags(i))//'_'//TRIM(variable%name)//'" long_name="'//   &
222            &                   TRIM(variable%long_name)//' '//TRIM(trd_tags(i))//' trend" unit="'//              &
223            &                   TRIM(variable%units)//'/s" default_value="'//TRIM(ADJUSTL(missing_value))//'" />'
224        END DO
225#if defined key_tracer_budget
226        DO i=1,size(trd_e3t_tags)
227         WRITE (xml_unit,'(A)') '  <field id="'//TRIM(trd_e3t_tags(i))//'_'//TRIM(variable%name)//                     &
228            &                   '_e3t" long_name="'//TRIM(variable%long_name)//' cell depth integrated '//             &
229            &                   TRIM(trd_e3t_tags(i))//' trend" unit="'//TRIM(variable%units)//'/s" default_value="'// &
230            &                   TRIM(ADJUSTL(missing_value))//'" />'
231        END DO
232        WRITE (xml_unit,'(A)') '  <field id="'//TRIM(variable%name)//'_e3t" long_name="'//TRIM(variable%long_name)// &
233           &                   ' cell depth integrated" unit="'//TRIM(variable%units)//'/s" default_value="'//       &
234           &                   TRIM(ADJUSTL(missing_value))//'" />'
235#endif
236      CASE default
237         IF(lwp) WRITE(numout,*) ' trc_ini_fabm: Failing to initialise trends of variable '//TRIM(variable%name)// &
238            &                    ': Output of '//TRIM(ADJUSTL(string_dimensions))//'-dimensional trends not supported!!!'
239      END SELECT
240
241   END SUBROUTINE write_trends_xml
242
243   SUBROUTINE write_input_xml(xml_unit,variable,flag_grid_ref)
244      INTEGER,INTENT(IN) :: xml_unit
245      INTEGER,INTENT(IN),OPTIONAL :: flag_grid_ref
246      CLASS(type_input_variable),POINTER,INTENT(IN) :: variable
247
248      INTEGER :: number_dimensions,i
249      CHARACTER(LEN=20) :: missing_value,string_dimensions
250
251      ! Check variable dimension for grid_ref specificaiton.
252      ! Default is to not specify the grid_ref in the field definition.
253      IF (present(flag_grid_ref)) THEN
254          number_dimensions=flag_grid_ref
255      ELSE
256          number_dimensions=-1 !default, don't specify grid_ref
257      ENDIF
258
259      WRITE (missing_value,'(E9.3)') -2.E20
260      WRITE (string_dimensions,'(I1)') number_dimensions
261      SELECT CASE (number_dimensions)
262      CASE (3)
263        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" />'
264      CASE (-1)
265        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))//'" />'
266      CASE default
267         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!!!'
268      END SELECT
269
270   END SUBROUTINE write_input_xml
271
272   SUBROUTINE trc_ini_fabm
273      !!----------------------------------------------------------------------
274      !!                     ***  trc_ini_fabm  ***
275      !!
276      !! ** Purpose :   initialization for FABM model
277      !!
278      !! ** Method  : - Read the namcfc namelist and check the parameter values
279      !!----------------------------------------------------------------------
280#if defined key_git_version
281      TYPE (type_version),POINTER :: version
282#endif
283      INTEGER :: jn
284
285      !                       ! Allocate FABM arrays
286      IF( trc_sms_fabm_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_fabm: unable to allocate FABM arrays' )
287
288      IF(lwp) WRITE(numout,*)
289      IF(lwp) WRITE(numout,*) ' trc_ini_fabm: initialisation of FABM model'
290      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
291#if defined key_git_version
292      IF(lwp) WRITE(numout,*) ' NEMO version:   ',git_commit_id,' (',git_branch_name,' branch)'
293      IF(lwp) WRITE(numout,*) ' FABM version:   ',fabm_commit_id,' (',fabm_branch_name,' branch)'
294#endif
295
296      call fabm_initialize_library()
297#if defined key_git_version
298      version => first_module_version
299
300      do while (associated(version))
301         IF(lwp) WRITE(numout,*)  ' '//trim(version%module_name)//' version:   ',trim(version%version_string)
302         version => version%next
303      end do
304#endif
305
306      ! Log mapping of FABM states:
307      IF (lwp) THEN
308         IF (jp_fabm.gt.0) WRITE(numout,*) " FABM tracers:"
309         DO jn=1,jp_fabm
310            WRITE(numout,*) "   State",jn,":",trim(model%state_variables(jn)%name), &
311               " (",trim(model%state_variables(jn)%long_name), &
312               ") [",trim(model%state_variables(jn)%units),"]"
313         ENDDO
314         IF (jp_fabm_surface.gt.0) WRITE(numout,*) "FABM seasurface states:"
315         DO jn=1,jp_fabm_surface
316            WRITE(numout,*) "   State",jn,":",trim(model%surface_state_variables(jn)%name), &
317               " (",trim(model%surface_state_variables(jn)%long_name), &
318               ") [",trim(model%surface_state_variables(jn)%units),"]"
319         ENDDO
320         IF (jp_fabm_bottom.gt.0) WRITE(numout,*) "FABM seafloor states:"
321         DO jn=1,jp_fabm_bottom
322            WRITE(numout,*) "   State",jn,":",trim(model%bottom_state_variables(jn)%name), &
323               " (",trim(model%bottom_state_variables(jn)%long_name), &
324               ") [",trim(model%bottom_state_variables(jn)%units),"]"
325         ENDDO
326      ENDIF
327
328   END SUBROUTINE trc_ini_fabm
329
330#else
331   !!----------------------------------------------------------------------
332   !!   Dummy module                                        No FABM model
333   !!----------------------------------------------------------------------
334CONTAINS
335   SUBROUTINE nemo_fabm_init
336   END SUBROUTINE nemo_fabm_init
337
338   SUBROUTINE trc_ini_fabm            ! Empty routine
339   END SUBROUTINE trc_ini_fabm
340#endif
341
342   !!======================================================================
343END MODULE trcini_fabm
Note: See TracBrowser for help on using the repository browser.