Line data Source code
1 : !=======================================================================
2 : !
3 : ! Reads and interpolates forcing data for biogeochemistry
4 : !
5 : ! authors: Nicole Jeffery, LANL
6 : ! Elizabeth C. Hunke, LANL
7 : !
8 : module icedrv_forcing_bgc
9 :
10 : use icedrv_kinds
11 : use icedrv_domain_size, only: nx
12 : use icedrv_calendar, only: secday
13 : use icedrv_constants, only: nu_forcing, nu_diag
14 : use icepack_intfc, only: icepack_max_algae, icepack_max_doc
15 : use icepack_intfc, only: icepack_max_dic
16 : use icepack_intfc, only: icepack_query_tracer_flags
17 : use icepack_intfc, only: icepack_warnings_flush, icepack_warnings_aborted
18 : use icedrv_system, only: icedrv_system_abort
19 :
20 : implicit none
21 : private
22 : public :: get_forcing_bgc, faero_default, fiso_default, init_forcing_bgc
23 :
24 : real (kind=dbl_kind), dimension(365) :: & ! hardwired for now
25 : sil_data, nit_data
26 :
27 : !=======================================================================
28 :
29 : contains
30 :
31 : !=======================================================================
32 :
33 9 : subroutine init_forcing_bgc
34 :
35 : use icedrv_forcing, only: data_dir, bgc_data_type, bgc_data_file
36 :
37 : integer (kind=int_kind) :: &
38 : ntime, &
39 : i
40 :
41 : real (kind=dbl_kind), dimension(365) :: &
42 : sil, &
43 : nit
44 :
45 : character (char_len_long) filename
46 :
47 : character(len=*), parameter :: subname='(init_forcing_bgc)'
48 :
49 9 : if (trim(bgc_data_type) == 'ISPOL' .or. &
50 : trim(bgc_data_type) == 'NICE') then
51 :
52 6 : if (trim(bgc_data_type) == 'ISPOL') &
53 3 : filename = trim(data_dir)//'/ISPOL_2004/'//trim(bgc_data_file)
54 6 : if (trim(bgc_data_type) == 'NICE') &
55 3 : filename = trim(data_dir)//'/NICE_2015/'//trim(bgc_data_file)
56 :
57 6 : write (nu_diag,*) 'Reading ',filename
58 :
59 6 : ntime = 365 ! daily
60 :
61 6 : open (nu_forcing, file=filename, form='formatted')
62 6 : read (nu_forcing,*) sil
63 6 : read (nu_forcing,*) nit
64 6 : close(nu_forcing)
65 :
66 2196 : do i = 1, ntime
67 2190 : sil_data(i) = sil(i)
68 2196 : nit_data(i) = nit(i)
69 : end do
70 :
71 : end if
72 :
73 9 : end subroutine init_forcing_bgc
74 :
75 : !=======================================================================
76 : !
77 : ! Read and interpolate annual climatologies of silicate and nitrate.
78 : ! Restore model quantities to data if desired.
79 : !
80 : ! author: Elizabeth C. Hunke, LANL
81 :
82 60693 : subroutine get_forcing_bgc
83 :
84 : use icedrv_arrays_column, only: ocean_bio_all
85 : use icedrv_calendar, only: yday
86 : use icedrv_flux, only: sil, nit
87 : use icedrv_forcing, only: interp_coeff, bgc_data_type
88 :
89 : integer (kind=int_kind) :: &
90 : i, & ! horizontal indices
91 : ixm,ixx, & ! record numbers for neighboring months
92 : maxrec , & ! maximum record number
93 : recslot , & ! spline slot for current record
94 : recnum , & ! record number
95 : dataloc , & ! = 1 for data located in middle of time interval
96 : ! = 2 for date located at end of time interval
97 : ks ! bgc tracer index (bio_index_o)
98 :
99 : real (kind=dbl_kind) :: &
100 : c1intp, c2intp
101 :
102 : logical (kind=log_kind) :: tr_bgc_Sil, tr_bgc_Nit
103 :
104 : character(len=*), parameter :: subname='(get_forcing_bgc)'
105 :
106 60693 : call icepack_query_tracer_flags(tr_bgc_Sil_out=tr_bgc_Sil, tr_bgc_Nit_out=tr_bgc_Nit)
107 60693 : call icepack_warnings_flush(nu_diag)
108 60693 : if (icepack_warnings_aborted()) call icedrv_system_abort(string=subname, &
109 0 : file=__FILE__,line= __LINE__)
110 :
111 60693 : if (trim(bgc_data_type) == 'ISPOL' .or. &
112 : trim(bgc_data_type) == 'NICE') then
113 :
114 36558 : dataloc = 2 ! data located at end of interval
115 36558 : maxrec = 365 !
116 :
117 : ! current record number
118 36558 : recnum = int(yday)
119 :
120 : ! Compute record numbers for surrounding data (2 on each side)
121 36558 : ixm = mod(recnum+maxrec-2,maxrec) + 1
122 36558 : ixx = mod(recnum-1, maxrec) + 1
123 :
124 36558 : recslot = 2
125 36558 : call interp_coeff (recnum, recslot, secday, dataloc, c1intp, c2intp)
126 :
127 36558 : if (tr_bgc_Sil) then
128 182790 : sil(:) = c1intp * sil_data(ixm) + c2intp * sil_data(ixx)
129 : endif
130 :
131 36558 : if (tr_bgc_Nit) then
132 182790 : nit(:) = c1intp * nit_data(ixm) + c2intp * nit_data(ixx)
133 : endif
134 :
135 182790 : do i = 1, nx
136 146232 : ks = 2*icepack_max_algae + icepack_max_doc + 3 + icepack_max_dic
137 146232 : ocean_bio_all(i,ks) = sil(i) ! Sil
138 146232 : ks = icepack_max_algae + 1
139 146232 : ocean_bio_all(i,ks) = nit(i) ! Nit
140 146232 : ks = 2*icepack_max_algae + icepack_max_doc + 7 + icepack_max_dic
141 182790 : ocean_bio_all(i,ks) = nit(i) ! PON
142 : enddo
143 :
144 : endif
145 :
146 60693 : end subroutine get_forcing_bgc
147 :
148 : !=======================================================================
149 :
150 : ! constant values for atmospheric aerosols
151 : !
152 : ! authors: Elizabeth Hunke, LANL
153 :
154 84816 : subroutine faero_default
155 :
156 : use icedrv_flux, only: faero_atm
157 : character(len=*), parameter :: subname='(faero_default)'
158 :
159 424080 : faero_atm(:,1) = 1.e-12_dbl_kind ! kg/m^2 s
160 424080 : faero_atm(:,2) = 1.e-13_dbl_kind
161 424080 : faero_atm(:,3) = 1.e-14_dbl_kind
162 424080 : faero_atm(:,4) = 1.e-14_dbl_kind
163 424080 : faero_atm(:,5) = 1.e-14_dbl_kind
164 424080 : faero_atm(:,6) = 1.e-14_dbl_kind
165 :
166 84816 : end subroutine faero_default
167 :
168 : !=======================================================================
169 :
170 : ! constant values for atmospheric water isotopes
171 : !
172 : ! authors: Elizabeth Hunke, LANL
173 :
174 15372 : subroutine fiso_default
175 :
176 : use icedrv_flux, only: fiso_atm
177 : character(len=*), parameter :: subname='(fiso_default)'
178 :
179 76860 : fiso_atm(:,1) = 1.e-12_dbl_kind ! kg/m^2 s
180 76860 : fiso_atm(:,2) = 1.e-13_dbl_kind
181 76860 : fiso_atm(:,3) = 1.e-14_dbl_kind
182 :
183 15372 : end subroutine fiso_default
184 :
185 : !=======================================================================
186 :
187 : end module icedrv_forcing_bgc
188 :
189 : !=======================================================================
|
