source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_utils366_fabmv1/NEMOGCM/NEMO/TOP_SRC/FABM/inputs_fabm.F90 @ 13241

Last change on this file since 13241 was 13241, checked in by dford, 3 months ago

Update NEMO-FABM coupler for compatability with FABM v1.0.

File size: 10.5 KB
Line 
1MODULE inputs_fabm
2   !!======================================================================
3   !!                         ***  MODULE inputs_fabm  ***
4   !! TOP :   Input module of the FABM tracers
5   !!======================================================================
6
7#if defined key_fabm
8   !!----------------------------------------------------------------------
9   !!   'key_fabm'                                               FABM tracers
10   !!----------------------------------------------------------------------
11   !! initialize_inputs       : initialize input structures
12   !! update_inputs : update 2D input fields
13   !! trc_rnf_fabm : update river data
14   !!----------------------------------------------------------------------
15   USE par_trc
16   USE oce_trc
17   USE trc
18   USE iom
19   USE fldread
20   USE par_fabm
21   USE fabm, only: type_fabm_horizontal_variable_id
22
23   IMPLICIT NONE
24
25#  include "vectopt_loop_substitute.h90"
26
27   PRIVATE
28
29   PUBLIC initialize_inputs
30   PUBLIC link_inputs
31   PUBLIC update_inputs
32   PUBLIC trc_rnf_fabm
33
34#if defined key_trdtrc && defined key_iomput
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) :: tr_inp
36#endif
37
38   TYPE, PUBLIC :: type_input_variable
39      TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf
40      INTEGER                              :: ntimes
41   END TYPE
42
43   TYPE, PUBLIC, EXTENDS(type_input_variable) :: type_input_data
44      TYPE(type_fabm_horizontal_variable_id) :: horizontal_id
45      TYPE(type_input_data), POINTER         :: next => null()
46   END TYPE
47   TYPE (type_input_data), POINTER, PUBLIC :: first_input_data => NULL()
48
49   TYPE, PUBLIC, EXTENDS(type_input_variable):: type_river_data
50      INTEGER   :: jp_pos=0 ! position of linked state variable in trc fields
51      REAL(wp) :: rn_trrnfac=1._wp ! unit conversion factor
52      TYPE(type_river_data), POINTER   :: next => null()
53   END TYPE
54   TYPE (type_river_data), POINTER, PUBLIC :: first_river_data => NULL()
55
56   CONTAINS
57
58     SUBROUTINE initialize_inputs
59        TYPE(FLD_N)        :: sn, sn_empty
60        CHARACTER(LEN=256) :: name
61        REAL(wp) :: rfac
62        NAMELIST /variable/ name,sn
63        NAMELIST /riverdata/ name,sn,rfac
64        LOGICAL :: l_ext
65        INTEGER :: num, ierr, nmlunit
66        TYPE (type_input_data),POINTER :: input_data
67        TYPE (type_river_data),POINTER :: river_data
68        INTEGER :: jn
69        INTEGER , PARAMETER :: nbtimes = 366  !: maximum number of times record in a file
70        REAL(wp), DIMENSION(nbtimes) :: zsteps
71
72        ! Check if fabm_input.nml exists - if not, do nothing and return.
73        INQUIRE( FILE='fabm_input.nml', EXIST=l_ext )
74        IF (.NOT.l_ext) return
75
76        ! Open fabm_input.nml
77        CALL ctl_opn( nmlunit, 'fabm_input.nml', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, num, .FALSE. )
78
79        ! Read any number of "variable" namelists
80        DO
81           ! Initialize namelist variables
82           name = ''
83           sn = sn_empty
84
85           ! Read the namelist
86           READ(nmlunit,nml=variable,err=98,end=99)
87
88           ! Transfer namelist settings to new input_data object
89           ALLOCATE(input_data, STAT=ierr)
90           IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'inputs_fabm:initialize_inputs: unable to allocate input_data object for variable '//TRIM(name) )
91           input_data%horizontal_id = model%get_horizontal_variable_id(name)
92           IF (.NOT.model%is_variable_used(input_data%horizontal_id)) THEN
93              ! This variable was not found among FABM's horizontal variables (at least, those that are read by one or more FABM modules)
94              CALL ctl_stop('STOP', 'inputs_fabm:initialize_inputs: variable "'//TRIM(name)//'" was not found among horizontal FABM variables.')
95           END IF
96           ALLOCATE(input_data%sf(1), STAT=ierr)
97           IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'inputs_fabm:initialize_inputs: unable to allocate sf structure for variable '//TRIM(name) )
98           CALL fld_fill(input_data%sf, (/sn/), '', 'inputs_fabm:initialize_inputs', 'FABM variable '//TRIM(name), 'variable' )
99           ALLOCATE( input_data%sf(1)%fnow(jpi,jpj,1)   )
100           IF( sn%ln_tint ) ALLOCATE( input_data%sf(1)%fdta(jpi,jpj,1,2) )
101
102           ! Get number of record in file (if there is only one, we will read data
103           ! only at the very first time step)
104           CALL fld_clopn( input_data%sf(1) )
105           CALL iom_gettime( input_data%sf(1)%num, zsteps, kntime=input_data%ntimes)
106           CALL iom_close( input_data%sf(1)%num )
107
108           ! Prepend new input variable to list.
109           input_data%next => first_input_data
110           first_input_data => input_data
111        END DO
112
113  98    CALL ctl_stop('STOP', 'inputs_fabm:initialize_inputs: unable to read namelist "riverdata"')
114
115  99    REWIND(nmlunit)
116
117        ! Read any number of "riverdata" namelists
118        DO
119           ! Initialize namelist variables
120           name = ''
121           sn = sn_empty
122           rfac = 1._wp
123
124           ! Read the namelist
125           READ(nmlunit,nml=riverdata,err=198,end=199)
126
127           ! Transfer namelist settings to new river_data object
128           ALLOCATE(river_data, STAT=ierr)
129           IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'inputs_fabm:initialize_inputs: unable to allocate river_data object for variable '//TRIM(name) )
130           ! Check if river data name is in FABM states and
131           ! provide NEMO with position of the respective state variable
132           ! within tracer field
133           DO jn=1,jp_fabm
134             IF (TRIM(name) == TRIM(model%interior_state_variables(jn)%name)) THEN
135               river_data%jp_pos = jp_fabm_m1+jn
136             END IF
137           END DO
138           IF (river_data%jp_pos == 0) THEN
139             ! This variable was not found among FABM's state variables
140             ! passed to NEMO!
141             CALL ctl_stop('STOP', 'inputs_fabm:initialize_inputs: variable "'//TRIM(name)//'" was not found among FABM state variables.')
142           END IF
143
144           ALLOCATE(river_data%sf(1), STAT=ierr)
145           IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'inputs_fabm:initialize_inputs: unable to allocate sf structure for variable '//TRIM(name) )
146           CALL fld_fill(river_data%sf, (/sn/), '', 'inputs_fabm:initialize_inputs', 'FABM variable '//TRIM(name), 'riverdata' )
147           ALLOCATE( river_data%sf(1)%fnow(jpi,jpj,1)   )
148           IF( sn%ln_tint ) ALLOCATE( river_data%sf(1)%fdta(jpi,jpj,1,2) )
149
150           ! Load unit conversion factor:
151           river_data%rn_trrnfac=rfac
152
153           ! Get number of record in file (if there is only one, we will read data
154           ! only at the very first time step)
155           CALL fld_clopn( river_data%sf(1) )
156           CALL iom_gettime( river_data%sf(1)%num, zsteps, kntime=river_data%ntimes)
157           CALL iom_close( river_data%sf(1)%num )
158
159           ! Prepend new input variable to list.
160           river_data%next => first_river_data
161           first_river_data => river_data
162        END DO
163
164  198   CALL ctl_stop('STOP', 'inputs_fabm:initialize_inputs: unable to read namelist "riverdata"')
165
166  199   RETURN
167
168     END SUBROUTINE initialize_inputs
169
170     SUBROUTINE link_inputs
171      TYPE (type_input_data),POINTER :: input_data
172
173      input_data => first_input_data
174      DO WHILE (ASSOCIATED(input_data))
175         ! Provide FABM with pointer to field that will receive prescribed data.
176         ! NB source=data_source_user guarantees that the prescribed data takes priority over any data FABM may already have for that variable.
177         CALL model%link_horizontal_data(input_data%horizontal_id,input_data%sf(1)%fnow(:,:,1),source=data_source_user)
178         input_data => input_data%next
179      END DO
180
181   END SUBROUTINE link_inputs
182
183   SUBROUTINE update_inputs( kt , l_write)
184      INTEGER, INTENT(IN) :: kt
185      LOGICAL, INTENT(IN), OPTIONAL :: l_write
186      TYPE (type_input_data),POINTER :: input_data
187      TYPE (type_river_data),POINTER :: river_data
188
189      input_data => first_input_data
190      DO WHILE (ASSOCIATED(input_data))
191         IF( kt == nit000 .OR. ( kt /= nit000 .AND. input_data%ntimes > 1 ) ) CALL fld_read( kt, 1, input_data%sf )
192#if defined key_trdtrc && defined key_iomput
193         IF ( .NOT.PRESENT(l_write).OR.l_write ) CALL iom_put( 'INP_'//TRIM(input_data%sf(1)%clvar), input_data%sf(1)%fnow(:,:,1)*tmask(:,:,1) )
194#endif
195         input_data => input_data%next
196      END DO
197
198      river_data => first_river_data
199      DO WHILE (ASSOCIATED(river_data))
200         IF( kt == nit000 .OR. ( kt /= nit000 .AND. river_data%ntimes > 1 ) ) CALL fld_read( kt, 1, river_data%sf )
201         river_data => river_data%next
202      END DO
203
204   END SUBROUTINE update_inputs
205
206   SUBROUTINE trc_rnf_fabm( kt )
207      !!----------------------------------------------------------------------
208      !!                  ***  ROUTINE trc_rnf_fabm  ***
209      !!
210      !! ** Purpose :   Add river loadings of biogeochemistry to states
211      !!
212      !! ** Action  :   tra (sms) updated with loadings at time-step kt
213      !!
214      !! This routines assumes river loadings to be given in
215      !! state variable units * m3 / sec
216      !!--------------------------------------------------------------------
217
218      INTEGER, INTENT(in) ::   kt          ! ocean time step
219      REAL(wp) :: zcoef
220      INTEGER :: ji,jj,jk
221      !
222      TYPE (type_river_data),POINTER :: river_data
223
224      river_data => first_river_data
225      DO WHILE (ASSOCIATED(river_data))
226#if defined key_trdtrc && defined key_iomput
227        tr_inp = 0.0_wp
228#endif
229        IF( kt == nit000 .OR. ( kt /= nit000 ) ) THEN
230            DO jj = 2, jpjm1
231              DO ji = fs_2, fs_jpim1
232                ! convert units and divide by surface area
233                ! loading / cell volume * vertical fraction of riverload
234                ! dtrc / dt (river) = riverload / e1e2t / e3t * e3t * h_rnf
235                !                    = riverload / e1e2t / h_rnf
236                zcoef = river_data%rn_trrnfac / e1e2t(ji,jj) / h_rnf(ji,jj)
237                DO jk = 1,nk_rnf(ji,jj)
238                  ! Add river loadings
239                  tra(ji,jj,jk,river_data%jp_pos) = tra(ji,jj,jk,river_data%jp_pos) + river_data%sf(1)%fnow(ji,jj,1)*zcoef
240#if defined key_trdtrc && defined key_iomput
241                  tr_inp(ji,jj,jk) = river_data%sf(1)%fnow(ji,jj,1)*zcoef
242#endif
243                END DO
244              END DO
245            END DO
246#if defined key_trdtrc && defined key_iomput
247            CALL iom_put( 'INP_'//TRIM(river_data%sf(1)%clvar), tr_inp(:,:,:) )
248#endif
249        END IF
250        river_data => river_data%next
251      END DO
252
253   END SUBROUTINE trc_rnf_fabm
254#endif
255   !!======================================================================
256END MODULE inputs_fabm
Note: See TracBrowser for help on using the repository browser.