Context Navigation

trcdta.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.

Property svn:keywords set to Id

File size: 12.4 KB

Line
1	MODULE trcdta
2	!!======================================================================
3	!! * MODULE trcdta *
4	!! TOP : reads passive tracer data
5	!!=====================================================================
6	!! History : 1.0 ! 2002-04 (O. Aumont) original code
7	!! - ! 2004-03 (C. Ethe) module
8	!! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90
9	!! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation
10	!! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models
11	!! 3.6 ! 2015-03 (T. Lovato) revisit code I/O
12	!!----------------------------------------------------------------------
13	#if defined key_top
14	!!----------------------------------------------------------------------
15	!! 'key_top' TOP model
16	!!----------------------------------------------------------------------
17	!! trc_dta : read and time interpolated passive tracer data
18	!!----------------------------------------------------------------------
19	USE par_trc ! passive tracers parameters
20	USE oce_trc ! shared variables between ocean and passive tracers
21	USE trc ! passive tracers common variables
22	!
23	USE iom ! I/O manager
24	USE lib_mpp ! MPP library
25	USE fldread ! read input fields
26
27	IMPLICIT NONE
28	PRIVATE
29
30	PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90
31	PUBLIC trc_dta_ini ! called in trcini.F90
32
33	INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data
34	INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data
35	INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
36	REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values
37	!$AGRIF_DO_NOT_TREAT
38	TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read)
39	!$AGRIF_END_DO_NOT_TREAT
40
41	!! Substitutions
42	#include "do_loop_substitute.h90"
43	!!----------------------------------------------------------------------
44	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
45	!! $Id$
46	!! Software governed by the CeCILL license (see ./LICENSE)
47	!!----------------------------------------------------------------------
48	CONTAINS
49
50	SUBROUTINE trc_dta_ini(ntrc)
51	!!----------------------------------------------------------------------
52	!! * ROUTINE trc_dta_ini *
53	!!
54	!! ** Purpose : initialisation of passive tracer input data
55	!!
56	!! ** Method : - Read namtsd namelist
57	!! - allocates passive tracer data structure
58	!!----------------------------------------------------------------------
59	INTEGER,INTENT(in) :: ntrc ! number of tracers
60	!
61	INTEGER :: jl, jn ! dummy loop indices
62	INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers
63	REAL(wp) :: zfact
64	CHARACTER(len=100) :: clndta, clntrc
65	!
66	CHARACTER(len=100) :: cn_dir
67	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
68	TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
69	REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trfac ! multiplicative factor for tracer values
70	!!
71	NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac
72	!!----------------------------------------------------------------------
73	!
74	IF( lwp ) THEN
75	WRITE(numout,*)
76	WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)'
77	WRITE(numout,*) '~~~~~~~~~~~ '
78	ENDIF
79	!
80	! Initialisation
81	ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0
82	! Compute the number of tracers to be initialised with data
83	ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
84	IF( ierr0 > 0 ) THEN
85	CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' ) ; RETURN
86	ENDIF
87	nb_trcdta = 0
88	n_trc_index(:) = 0
89	DO jn = 1, ntrc
90	IF( ln_trc_ini(jn) ) THEN
91	nb_trcdta = nb_trcdta + 1
92	n_trc_index(jn) = nb_trcdta
93	ENDIF
94	END DO
95	!
96	ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking
97	IF(lwp) THEN
98	WRITE(numout,*)
99	WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
100	ENDIF
101	!
102	READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
103	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
104	READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
105	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
106	IF(lwm) WRITE ( numont, namtrc_dta )
107
108	IF( lwp ) THEN
109	DO jn = 1, ntrc
110	IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true
111	clndta = TRIM( sn_trcdta(jn)%clvar )
112	clntrc = TRIM( ctrcnm (jn) )
113	if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
114	zfact = rn_trfac(jn)
115	IF( clndta /= clntrc ) THEN
116	CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation ', &
117	& 'Input name of data file : '//TRIM(clndta)// &
118	& ' differs from that of tracer : '//TRIM(clntrc)//' ')
119	ENDIF
120	WRITE(numout,*)
121	WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', &
122	& jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
123	ENDIF
124	END DO
125	ENDIF
126	!
127	IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero
128	ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
129	IF( ierr1 > 0 ) THEN
130	CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN
131	ENDIF
132	!
133	DO jn = 1, ntrc
134	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
135	jl = n_trc_index(jn)
136	slf_i(jl) = sn_trcdta(jn)
137	rf_trfac(jl) = rn_trfac(jn)
138	ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
139	IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
140	IF( ierr2 + ierr3 > 0 ) THEN
141	CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' ) ; RETURN
142	ENDIF
143	ENDIF
144	!
145	ENDDO
146	! ! fill sf_trcdta with slf_i and control print
147	CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
148	!
149	ENDIF
150	!
151	DEALLOCATE( slf_i ) ! deallocate local field structure
152	!
153	END SUBROUTINE trc_dta_ini
154
155
156	SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta)
157	!!----------------------------------------------------------------------
158	!! * ROUTINE trc_dta *
159	!!
160	!! ** Purpose : provides passive tracer data at kt
161	!!
162	!! ** Method : - call fldread routine
163	!! - s- or mixed z-s coordinate: vertical interpolation on model mesh
164	!! - ln_trcdmp=F: deallocates the data structure as they are not used
165	!!
166	!! ** Action : sf_trcdta passive tracer data on meld mesh and interpolated at time-step kt
167	!!----------------------------------------------------------------------
168	INTEGER , INTENT(in ) :: kt ! ocean time-step
169	INTEGER , INTENT(in ) :: Kmm ! time level index
170	TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read
171	REAL(wp) , INTENT(in ) :: ptrcfac ! multiplication factor
172	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ptrcdta ! 3D data array
173	!
174	INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices
175	REAL(wp):: zl, zi
176	REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace
177	CHARACTER(len=100) :: clndta
178	!!----------------------------------------------------------------------
179	!
180	IF( ln_timing ) CALL timing_start('trc_dta')
181	!
182	IF( kt == nit000 .AND. lwp) THEN
183	WRITE(numout,*)
184	WRITE(numout,*) 'trc_dta : passive tracers data for IC'
185	WRITE(numout,*) '~~~~~~~ '
186	ENDIF
187	!
188	IF( nb_trcdta > 0 ) THEN
189	!
190	! read data at kt time step
191	CALL fld_read( kt, 1, sf_trcdta )
192	ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
193	!
194	IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
195	!
196	IF( kt == nit000 .AND. lwp )THEN
197	WRITE(numout,*)
198	WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
199	ENDIF
200	DO_2D_11_11
201	DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points
202	zl = gdept(ji,jj,jk,Kmm)
203	IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data
204	ztp(jk) = ptrcdta(ji,jj,1)
205	ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data
206	ztp(jk) = ptrcdta(ji,jj,jpkm1)
207	ELSE ! inbetween : vertical interpolation between jkk & jkk+1
208	DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1)
209	IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
210	zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
211	ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
212	ENDIF
213	END DO
214	ENDIF
215	END DO
216	DO jk = 1, jpkm1
217	ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord
218	END DO
219	ptrcdta(ji,jj,jpk) = 0._wp
220	END_2D
221	!
222	ELSE !== z- or zps- coordinate ==!
223	! zps-coordinate (partial steps) interpolation at the last ocean level
224	! IF( ln_zps ) THEN
225	! DO jj = 1, jpj
226	! DO ji = 1, jpi
227	! ik = mbkt(ji,jj)
228	! IF( ik > 1 ) THEN
229	! zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
230	! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
231	! ENDIF
232	! ik = mikt(ji,jj)
233	! IF( ik > 1 ) THEN
234	! zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
235	! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
236	! ENDIF
237	! END DO
238	! END DO
239	! ENDIF
240	!
241	ENDIF
242	!
243	! Scale by multiplicative factor
244	ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
245	!
246	ENDIF
247	!
248	IF( ln_timing ) CALL timing_stop('trc_dta')
249	!
250	END SUBROUTINE trc_dta
251
252	#else
253	!!----------------------------------------------------------------------
254	!! Dummy module NO 3D passive tracer data
255	!!----------------------------------------------------------------------
256	CONTAINS
257	SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) ! Empty routine
258	WRITE(,) 'trc_dta: You should not have seen this print! error?', kt
259	END SUBROUTINE trc_dta
260	#endif
261
262	!!======================================================================
263	END MODULE trcdta

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/trcdta.F90 @ 12340

Download in other formats: