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

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

Minor changes to compile and run at the Met Office.

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