Context Navigation

p4zbc.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

File size: 16.4 KB

Line
1	MODULE p4zbc
2	!!======================================================================
3	!! * MODULE p4sbc *
4	!! TOP : PISCES surface boundary conditions of external inputs of nutrients
5	!!======================================================================
6	!! History : 3.5 ! 2012-07 (O. Aumont, C. Ethe) Original code
7	!!----------------------------------------------------------------------
8	!! p4z_bc : Read and interpolate time-varying nutrients fluxes
9	!! p4z_bc_init : Initialization of p4z_bc
10	!!----------------------------------------------------------------------
11	USE oce_trc ! shared variables between ocean and passive tracers
12	USE trc ! passive tracers common variables
13	USE sms_pisces ! PISCES Source Minus Sink variables
14	USE iom ! I/O manager
15	USE fldread ! time interpolation
16	USE trcbc
17
18	IMPLICIT NONE
19	PRIVATE
20
21	PUBLIC p4z_bc
22	PUBLIC p4z_bc_init
23
24	LOGICAL , PUBLIC :: ln_ironsed !: boolean for Fe input from sediments
25	LOGICAL , PUBLIC :: ln_hydrofe !: boolean for Fe input from hydrothermal vents
26	REAL(wp), PUBLIC :: sedfeinput !: Coastal release of Iron
27	REAL(wp), PUBLIC :: icefeinput !: Iron concentration in sea ice
28	REAL(wp), PUBLIC :: wdust !: Sinking speed of the dust
29	REAL(wp), PUBLIC :: mfrac !: Mineral Content of the dust
30	REAL(wp) :: hratio !: Fe:3He ratio assumed for vent iron supply
31	REAL(wp) :: distcoast !: Distance off the coast for Iron from sediments
32	REAL(wp), PUBLIC :: lgw_rath !: Weak ligand ratio from hydro sources
33
34	LOGICAL , PUBLIC :: ll_bc
35	LOGICAL , PUBLIC :: ll_dust !: boolean for dust input from the atmosphere
36	LOGICAL , PUBLIC :: ll_river !: boolean for river input of nutrients
37	LOGICAL , PUBLIC :: ll_ndepo !: boolean for atmospheric deposition of N
38	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust
39	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ironsed ! structure of input iron from sediment
40	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_hydrofe ! structure of input iron from sediment
41
42	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust fields
43	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ironsed !: Coastal supply of iron
44	REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hydrofe !: Hydrothermal vent supply of iron
45
46	REAL(wp), PUBLIC :: sedsilfrac, sedcalfrac
47
48	!! * Substitutions
49	# include "vectopt_loop_substitute.h90"
50	# include "do_loop_substitute.h90"
51	!!----------------------------------------------------------------------
52	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
53	!! $Id: p4zbc.F90 10869 2019-04-15 10:34:03Z cetlod $
54	!! Software governed by the CeCILL license (see ./LICENSE)
55	!!----------------------------------------------------------------------
56	CONTAINS
57
58	SUBROUTINE p4z_bc( kt, Kbb, Kmm, Krhs )
59	!!----------------------------------------------------------------------
60	!! * routine p4z_bc *
61	!!
62	!! ** purpose : read and interpolate the external sources of nutrients
63	!!
64	!! ** method : read the files and interpolate the appropriate variables
65	!!
66	!! ** input : external netcdf files
67	!!
68	!!----------------------------------------------------------------------
69	INTEGER, INTENT(in) :: kt ! ocean time step
70	INTEGER, INTENT(in) :: Kbb, Kmm, Krhs ! time level index
71	!
72	INTEGER :: ji, jj, jk, jl
73	REAL(wp) :: zcoef, zyyss
74	REAL(wp) :: zdep, ztrfer, zwdust, zwflux, zrivdin
75	!
76	CHARACTER (len=25) :: charout
77	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zirondep
78	REAL(wp), ALLOCATABLE, DIMENSION(:,: ) :: zironice, zndep
79	!!---------------------------------------------------------------------
80	!
81	IF( ln_timing ) CALL timing_start('p4z_bc')
82	!
83	IF( ll_dust ) THEN
84	ALLOCATE( zirondep(jpi,jpj,jpk) )
85	!
86	CALL fld_read( kt, 1, sf_dust )
87	dust(:,:) = MAX( rtrn, sf_dust(1)%fnow(:,:,1) )
88	!
89	jl = n_trc_indsbc(jpfer)
90	zirondep(:,:,1) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
91	! ! Iron solubilization of particles in the water column
92	! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j
93	zwdust = 0.03 / ( wdust / rday ) / ( 270. * rday )
94	DO jk = 2, jpkm1
95	zirondep(:,:,jk) = ( mfrac * dust(:,:) * zwdust / mMass_Fe ) * rfact * EXP( -gdept(:,:,jk,Kmm) / 540. )
96	tr(:,:,jk,jpfer,Krhs) = tr(:,:,jk,jpfer,Krhs) + zirondep(:,:,jk)
97	tr(:,:,jk,jppo4,Krhs) = tr(:,:,jk,jppo4,Krhs) + zirondep(:,:,jk) * 0.023
98	ENDDO
99	!
100	IF( lk_iomput ) THEN
101	CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! surface downward dust depo of iron
102	CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface
103	ENDIF
104	DEALLOCATE( zirondep )
105	ENDIF
106
107	! N/P and Si releases due to coastal rivers
108	! Compute river at nit000 or only if there is more than 1 time record in river file
109	! -----------------------------------------
110	! Add the external input of nutrients from river
111	! ----------------------------------------------------------
112	IF( ll_river ) THEN
113	jl = n_trc_indcbc(jpno3)
114	DO_2D_11_11
115	DO jk = 1, nk_rnf(ji,jj)
116	zcoef = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_cbc_time ) * tmask(ji,jj,1)
117	zrivdin = rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zcoef
118	tr(ji,jj,jk,jptal,Krhs) = tr(ji,jj,jk,jptal,Krhs) - rno3 * zrivdin * rfact
119	ENDDO
120	END_2D
121	ENDIF
122
123	! Add the external input of nutrients from nitrogen deposition
124	! ----------------------------------------------------------
125	IF( ll_ndepo ) THEN
126	ALLOCATE( zndep(jpi,jpj) )
127	IF( ln_trc_sbc(jpno3) ) THEN
128	jl = n_trc_indsbc(jpno3)
129	zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
130	tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
131	ENDIF
132	IF( ln_trc_sbc(jpnh4) ) THEN
133	jl = n_trc_indsbc(jpnh4)
134	zndep(:,:) = rf_trsfac(jl) * sf_trcsbc(jl)%fnow(:,:,1) / e3t(:,:,1,Kmm) / rn_sbc_time
135	tr(:,:,1,jptal,Krhs) = tr(:,:,1,jptal,Krhs) - rno3 * zndep(:,:) * rfact
136	ENDIF
137	DEALLOCATE( zndep )
138	ENDIF
139	!
140	! Iron input/uptake due to sea ice : Crude parameterization based on
141	! Lancelot et al.
142	! ----------------------------------------------------
143	IF( ln_ironice ) THEN
144	!
145	ALLOCATE( zironice(jpi,jpj) )
146	!
147	DO_2D_11_11
148	zdep = rfact / e3t(ji,jj,1,Kmm)
149	zwflux = fmmflx(ji,jj) / 1000._wp
150	zironice(ji,jj) = MAX( -0.99 * tr(ji,jj,1,jpfer,Kbb), -zwflux * icefeinput * zdep )
151	END_2D
152	!
153	tr(:,:,1,jpfer,Krhs) = tr(:,:,1,jpfer,Krhs) + zironice(:,:)
154	!
155	IF( lk_iomput ) CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfactr * e3t(:,:,1,Kmm) * tmask(:,:,1) ) ! iron flux from ice
156	!
157	DEALLOCATE( zironice )
158	!
159	ENDIF
160
161	! Add the external input of iron from sediment mobilization
162	! ------------------------------------------------------
163	IF( ln_ironsed .AND. .NOT.lk_sed ) THEN
164	tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + ironsed(:,:,:) * rfact
165	!
166	IF( lk_iomput ) CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) )
167	ENDIF
168
169	! Add the external input of iron from hydrothermal vents
170	! ------------------------------------------------------
171	IF( ln_hydrofe ) THEN
172	CALL fld_read( kt, 1, sf_hydrofe )
173	DO jk = 1, jpk
174	hydrofe(:,:,jk) = ( MAX( rtrn, sf_hydrofe(1)%fnow(:,:,jk) ) * hratio ) &
175	& / ( e1e2t(:,:) * e3t(:,:,jk,Kmm) * ryyss + rtrn ) / 1000._wp &
176	& * tmask(:,:,jk)
177	ENDDO
178	tr(:,:,:,jpfer,Krhs) = tr(:,:,:,jpfer,Krhs) + hydrofe(:,:,:) * rfact
179	IF( ln_ligand ) tr(:,:,:,jplgw,Krhs) = tr(:,:,:,jplgw,Krhs) + ( hydrofe(:,:,:) * lgw_rath ) * rfact
180	!
181	IF( lk_iomput ) CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
182	ENDIF
183	IF( ln_timing ) CALL timing_stop('p4z_bc')
184	!
185	END SUBROUTINE p4z_bc
186
187
188	SUBROUTINE p4z_bc_init( Kmm )
189	!!----------------------------------------------------------------------
190	!! * routine p4z_bc_init *
191	!!
192	!! ** purpose : initialization of the external sources of nutrients
193	!!
194	!! ** method : read the files and compute the budget
195	!! called at the first timestep (nittrc000)
196	!!
197	!! ** input : external netcdf files
198	!!
199	!!----------------------------------------------------------------------
200	INTEGER, INTENT( in ) :: Kmm ! time level index
201	INTEGER :: ji, jj, jk, jm
202	INTEGER :: ii0, ii1, ij0, ij1
203	INTEGER :: numiron
204	INTEGER :: ierr, ierr1, ierr2, ierr3
205	INTEGER :: ios ! Local integer output status for namelist read
206	INTEGER :: ik50 ! last level where depth less than 50 m
207	REAL(wp) :: zexpide, zdenitide, zmaskt, zsurfc, zsurfp,ze3t, ze3t2, zcslp
208	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zriver, zcmask
209	!
210	CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files
211	TYPE(FLD_N) :: sn_dust, sn_ironsed, sn_hydrofe ! informations about the fields to be read
212	!!
213	NAMELIST/nampisbc/cn_dir, sn_dust, sn_ironsed, sn_hydrofe, &
214	& ln_ironsed, ln_ironice, ln_hydrofe, &
215	& sedfeinput, distcoast, icefeinput, wdust, mfrac, &
216	& hratio, lgw_rath
217	!!----------------------------------------------------------------------
218	!
219	IF(lwp) THEN
220	WRITE(numout,*)
221	WRITE(numout,*) 'p4z_bc_init : initialization of the external sources of nutrients '
222	WRITE(numout,*) '~~~~~~~~~~~~ '
223	ENDIF
224	! !* set file information
225	READ ( numnatp_ref, nampisbc, IOSTAT = ios, ERR = 901)
226	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbc in reference namelist' )
227	READ ( numnatp_cfg, nampisbc, IOSTAT = ios, ERR = 902 )
228	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nampisbc in configuration namelist' )
229	IF(lwm) WRITE ( numonp, nampisbc )
230
231
232	IF(lwp) THEN
233	WRITE(numout,*) ' Namelist : nampissbc '
234	WRITE(numout,*) ' Fe input from sediments ln_ironsed = ', ln_ironsed
235	WRITE(numout,*) ' Fe input from seaice ln_ironice = ', ln_ironice
236	WRITE(numout,*) ' fe input from hydrothermal vents ln_hydrofe = ', ln_hydrofe
237	IF( ln_ironsed ) THEN
238	WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput
239	WRITE(numout,*) ' distance off the coast distcoast = ', distcoast
240	ENDIF
241	IF( ln_ligand ) THEN
242	WRITE(numout,*) ' Weak ligand ratio from sed hydro sources lgw_rath = ', lgw_rath
243	ENDIF
244	IF( ln_ironice ) THEN
245	WRITE(numout,*) ' Iron concentration in sea ice icefeinput = ', icefeinput
246	ENDIF
247	IF( ln_trc_sbc(jpfer) ) THEN
248	WRITE(numout,*) ' Mineral Fe content of the dust mfrac = ', mfrac
249	WRITE(numout,*) ' sinking speed of the dust wdust = ', wdust
250	ENDIF
251	IF( ln_hydrofe ) THEN
252	WRITE(numout,*) ' Fe to 3He ratio assumed for vent iron supply hratio = ', hratio
253	ENDIF
254	END IF
255
256	ll_bc = ( ln_trcbc .AND. lltrcbc ) .OR. ln_hydrofe .OR. ln_ironsed .OR. ln_ironice
257	ll_dust = ln_trc_sbc(jpfer)
258	ll_ndepo = ln_trc_sbc(jpno3) .OR. ln_trc_sbc(jpnh4)
259	ll_river = ln_trc_cbc(jpno3)
260
261	! dust input from the atmosphere
262	! ------------------------------
263	IF( ll_dust ) THEN
264	!
265	IF(lwp) WRITE(numout,*) ' initialize dust input from atmosphere '
266	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
267	!
268	ALLOCATE( dust(jpi,jpj) )
269	!
270	ALLOCATE( sf_dust(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
271	IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_dust structure' )
272	!
273	CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Atmospheric dust deposition', 'nampissed' )
274	ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1) )
275	IF( sn_dust%ln_tint ) ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) )
276	!
277	END IF
278
279	! coastal and island masks
280	! ------------------------
281	IF( ln_ironsed ) THEN
282	!
283	IF(lwp) WRITE(numout,*)
284	IF(lwp) WRITE(numout,*) ' ==>>> ln_ironsed=T , computation of an island mask to enhance coastal supply of iron'
285	!
286	ALLOCATE( ironsed(jpi,jpj,jpk) ) ! allocation
287	!
288	CALL iom_open ( TRIM( sn_ironsed%clname ), numiron )
289	ALLOCATE( zcmask(jpi,jpj,jpk) )
290	CALL iom_get ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 )
291	CALL iom_close( numiron )
292	!
293	ik50 = 5 ! last level where depth less than 50 m
294	DO jk = jpkm1, 1, -1
295	IF( gdept_1d(jk) > 50. ) ik50 = jk - 1
296	END DO
297	IF(lwp) WRITE(numout,*)
298	IF(lwp) WRITE(numout,*) ' Level corresponding to 50m depth ', ik50,' ', gdept_1d(ik50+1)
299	DO_3D_00_00( 1, ik50 )
300	ze3t = e3t_0(ji,jj,jk)
301	zsurfc = e1u(ji,jj) * ( 1. - umask(ji ,jj ,jk) ) &
302	+ e1u(ji,jj) * ( 1. - umask(ji-1,jj ,jk) ) &
303	+ e2v(ji,jj) * ( 1. - vmask(ji ,jj ,jk) ) &
304	+ e2v(ji,jj) * ( 1. - vmask(ji ,jj-1,jk) )
305	zsurfp = zsurfc * ze3t / e1e2t(ji,jj)
306	! estimation of the coastal slope : 5 km off the coast
307	ze3t2 = ze3t * ze3t
308	zcslp = SQRT( ( distcoast*distcoast + ze3t2 ) / ze3t2 )
309	!
310	zcmask(ji,jj,jk) = zcmask(ji,jj,jk) + zcslp * zsurfp
311	END_3D
312	!
313	CALL lbc_lnk( 'p4zbc', zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged)
314	!
315	DO_3D_11_11( 1, jpk )
316	zexpide = MIN( 8.,( gdept(ji,jj,jk,Kmm) / 500. )**(-1.5) )
317	zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2
318	zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 )
319	END_3D
320	! Coastal supply of iron
321	! -------------------------
322	ironsed(:,:,jpk) = 0._wp
323	DO jk = 1, jpkm1
324	ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( e3t_0(:,:,jk) * rday )
325	END DO
326	DEALLOCATE( zcmask)
327	ENDIF
328	!
329	! Iron from Hydrothermal vents
330	! ------------------------
331	IF( ln_hydrofe ) THEN
332	!
333	IF(lwp) WRITE(numout,*)
334	IF(lwp) WRITE(numout,*) ' ==>>> ln_hydrofe=T , Input of iron from hydrothermal vents'
335	!
336	ALLOCATE( hydrofe(jpi,jpj,jpk) ) ! allocation
337	!
338	ALLOCATE( sf_hydrofe(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst
339	IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_hydro structure' )
340	!
341	CALL fld_fill( sf_hydrofe, (/ sn_hydrofe /), cn_dir, 'p4z_sed_init', 'Input of iron from hydrothermal vents', 'nampisbc' )
342	ALLOCATE( sf_hydrofe(1)%fnow(jpi,jpj,jpk) )
343	IF( sn_hydrofe%ln_tint ) ALLOCATE( sf_hydrofe(1)%fdta(jpi,jpj,jpk,2) )
344	!
345	ENDIF
346	!
347	END SUBROUTINE p4z_bc_init
348
349	!!======================================================================
350	END MODULE p4zbc

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zbc.F90 @ 12340

Download in other formats: