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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

diadct.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

Context Navigation

source: branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis3/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90 @ 11066

Last change on this file since 11066 was 11066, checked in by rrenshaw, 5 years ago
changes to add regional means output and correction for section transports
Property svn:executable set to ``*
File size: 131.8 KB

Line
1	MODULE diadct
2	!!=====================================================================
3	!! * MODULE diadct *
4	!! Ocean diagnostics: Compute the transport trough a sec.
5	!!===============================================================
6	!! History :
7	!!
8	!! original : 02/99 (Y Drillet)
9	!! addition : 10/01 (Y Drillet, R Bourdalle Badie)
10	!! : 10/05 (M Laborie) F90
11	!! addition : 04/07 (G Garric) Ice sections
12	!! bugfix : 04/07 (C Bricaud) test on sec%nb_point
13	!! initialisation of ztransp1,ztransp2,...
14	!! nemo_v_3_4: 09/2011 (C Bricaud)
15	!!
16	!!
17	!!----------------------------------------------------------------------
18	#if defined key_diadct
19	!!----------------------------------------------------------------------
20	!! 'key_diadct' :
21	!!----------------------------------------------------------------------
22	!!----------------------------------------------------------------------
23	!! dia_dct : Compute the transport through a sec.
24	!! dia_dct_init : Read namelist.
25	!! readsec : Read sections description and pathway
26	!! removepoints : Remove points which are common to 2 procs
27	!! transport : Compute transport for each sections
28	!! dia_dct_wri : Write tranports results in ascii files
29	!! interp : Compute temperature/salinity/density at U-point or V-point
30	!!
31	!!----------------------------------------------------------------------
32	!! * Modules used
33	USE oce ! ocean dynamics and tracers
34	USE dom_oce ! ocean space and time domain
35	USE phycst ! physical constants
36	USE in_out_manager ! I/O manager
37	USE iom ! I/0 library
38	USE daymod ! calendar
39	USE dianam ! build name of file
40	USE lib_mpp ! distributed memory computing library
41	#if defined key_lim2
42	USE ice_2
43	#endif
44	#if defined key_lim3
45	USE ice
46	#endif
47	USE domvvl
48	USE timing ! preformance summary
49	USE wrk_nemo ! working arrays
50
51	IMPLICIT NONE
52	PRIVATE
53
54	!! * Routine accessibility
55	PUBLIC dia_dct ! routine called by step.F90
56	PUBLIC dia_dct_init ! routine called by opa.F90
57	PUBLIC diadct_alloc ! routine called by nemo_init in nemogcm.F90
58	PRIVATE readsec
59	PRIVATE removepoints
60	PRIVATE transport
61	PRIVATE dia_dct_wri
62	PRIVATE dia_dct_wri_NOOS
63
64	#include "domzgr_substitute.h90"
65
66	!! * Shared module variables
67	LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .TRUE. !: model-data diagnostics flag
68	LOGICAL, PUBLIC :: ln_dct_calc_noos_25h !: Calcuate noos 25 h means
69	LOGICAL, PUBLIC :: ln_dct_calc_noos_hr !: Calcuate noos hourly means
70	! JT
71	LOGICAL, PUBLIC :: ln_dct_iom_cont !: Use IOM Output?
72	LOGICAL, PUBLIC :: ln_dct_ascii !: Output ascii or binary
73	LOGICAL, PUBLIC :: ln_dct_h !: Output hourly instantaneous or mean values
74	! JT
75
76	!! * Module variables
77	INTEGER :: nn_dct ! Frequency of computation
78	INTEGER :: nn_dctwri ! Frequency of output
79	INTEGER :: nn_secdebug ! Number of the section to debug
80	INTEGER :: nn_dct_h ! Frequency of computation for NOOS hourly files
81	INTEGER :: nn_dctwri_h ! Frequency of output for NOOS hourly files
82
83	INTEGER, PARAMETER :: nb_class_max = 12 ! maximum number of classes, i.e. depth levels or density classes
84	INTEGER, PARAMETER :: nb_sec_max = 100 ! maximum number of sections
85	INTEGER, PARAMETER :: nb_point_max = 375 ! maximum number of points in a single section
86	INTEGER, PARAMETER :: nb_type_class = 14 ! types of calculations, i.e. pos transport, neg transport, heat transport, salt transport
87	INTEGER, PARAMETER :: nb_3d_vars = 5
88	INTEGER, PARAMETER :: nb_2d_vars = 2
89	INTEGER :: nb_sec
90
91	TYPE POINT_SECTION
92	INTEGER :: I,J
93	END TYPE POINT_SECTION
94
95	TYPE COORD_SECTION
96	REAL(wp) :: lon,lat
97	END TYPE COORD_SECTION
98
99	TYPE SECTION
100	CHARACTER(len=60) :: name ! name of the sec
101	LOGICAL :: llstrpond ! true if you want the computation of salt and
102	! heat transports
103	LOGICAL :: ll_ice_section ! ice surface and ice volume computation
104	LOGICAL :: ll_date_line ! = T if the section crosses the date-line
105	TYPE(COORD_SECTION), DIMENSION(2) :: coordSec ! longitude and latitude of the extremities of the sec
106	INTEGER :: nb_class ! number of boundaries for density classes
107	INTEGER, DIMENSION(nb_point_max) :: direction ! vector direction of the point in the section
108	CHARACTER(len=40),DIMENSION(nb_class_max) :: classname ! characteristics of the class
109	REAL(wp), DIMENSION(nb_class_max) :: zsigi ,&! in-situ density classes (99 if you don't want)
110	zsigp ,&! potential density classes (99 if you don't want)
111	zsal ,&! salinity classes (99 if you don't want)
112	ztem ,&! temperature classes(99 if you don't want)
113	zlay ! level classes (99 if you don't want)
114	REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport ! transport output
115	REAL(wp), DIMENSION(nb_type_class,nb_class_max) :: transport_h ! transport output
116	REAL(wp) :: slopeSection ! slope of the section
117	INTEGER :: nb_point ! number of points in the section
118	TYPE(POINT_SECTION),DIMENSION(nb_point_max) :: listPoint ! list of points in the sections
119	END TYPE SECTION
120
121	TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
122
123	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d
124	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d
125	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: transports_3d_h
126	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: transports_2d_h
127	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_hr_output
128
129	!! $Id$
130	CONTAINS
131
132
133	INTEGER FUNCTION diadct_alloc()
134	!!----------------------------------------------------------------------
135	!! * FUNCTION diadct_alloc *
136	!!----------------------------------------------------------------------
137	INTEGER :: ierr(5)
138	!!----------------------------------------------------------------------
139
140	ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk) , STAT=ierr(1) )
141	ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(2) )
142	ALLOCATE(transports_3d_h(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(3) )
143	ALLOCATE(transports_2d_h(nb_2d_vars,nb_sec_max,nb_point_max) , STAT=ierr(4) )
144	ALLOCATE(z_hr_output(nb_sec_max,3,nb_class_max) , STAT=ierr(5) )
145
146	diadct_alloc = MAXVAL( ierr )
147	IF( diadct_alloc /= 0 ) CALL ctl_warn('diadct_alloc: failed to allocate arrays')
148
149	END FUNCTION diadct_alloc
150
151	SUBROUTINE dia_dct_init
152	!!---------------------------------------------------------------------
153	!! * ROUTINE diadct *
154	!!
155	!! ** Purpose: Read the namelist parameters
156	!! Open output files
157	!!
158	!!---------------------------------------------------------------------
159	NAMELIST/namdct/nn_dct,ln_dct_h,nn_dctwri,ln_dct_ascii,nn_secdebug,ln_dct_calc_noos_25h,ln_dct_calc_noos_hr,ln_dct_iom_cont
160	INTEGER :: ios,jsec ! Local integer output status for namelist read
161	CHARACTER(len=3) :: jsec_str ! name of the jsec
162
163	IF( nn_timing == 1 ) CALL timing_start('dia_dct_init')
164
165	REWIND( numnam_ref ) ! Namelist namdct in reference namelist : Diagnostic: transport through sections
166	READ ( numnam_ref, namdct, IOSTAT = ios, ERR = 901)
167	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist', lwp )
168
169	REWIND( numnam_cfg ) ! Namelist namdct in configuration namelist : Diagnostic: transport through sections
170	READ ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 )
171	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp )
172	IF(lwm) WRITE ( numond, namdct )
173
174	IF( ln_NOOS ) THEN
175
176	!Do calculation for daily, 25hourly mean every hour
177	nn_dct=3600./rdt ! hard coded for NOOS transects, to give 25 hour means from hourly instantaneous values
178
179	!write out daily, 25hourly mean every day
180	nn_dctwri=86400./rdt
181
182
183	!nn_dct_h=1 ! hard coded for NOOS transects, to give hourly data
184	! If you want hourly instantaneous values, you only do the calculation every 12 timesteps (if rdt = 300)
185	! and output it every 12 time steps. For this, you set the ln_dct_h to be True, and it calcuates it automatically
186	! if you want hourly mean values, set ln_dct_h to be False, and it will do the calculate every time step.
187	!
188	!SELECT CASE( ln_dct_h )
189	! CASE(.TRUE.)
190	! nn_dct_h=3600./rdt
191	! CASE(.FALSE.)
192	! nn_dct_h=1
193	!END SELECT
194
195	IF ( ln_dct_h ) THEN
196	nn_dct_h=3600./rdt
197	ELSE
198	nn_dct_h=1.
199	ENDIF
200
201	!JT write out hourly calculation every hour
202	nn_dctwri_h=3600./rdt
203	ENDIF
204
205	IF( lwp ) THEN
206	WRITE(numout,*) " "
207	WRITE(numout,*) "diadct_init: compute transports through sections "
208	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
209	IF( ln_NOOS ) THEN
210	WRITE(numout,*) " Calculate NOOS hourly output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_hr
211	WRITE(numout,*) " Calculate NOOS 25 hour mean output: ln_dct_calc_noos_hr = ",ln_dct_calc_noos_25h
212	WRITE(numout,*) " Use IOM Output: ln_dct_iom_cont = ",ln_dct_iom_cont
213	WRITE(numout,*) " Output in ASCII (True) or Binary (False): ln_dct_ascii = ",ln_dct_ascii
214	WRITE(numout,*) " Frequency of hourly computation - instantaneous (TRUE) or hourly mean (FALSE): ln_dct_h = ",ln_dct_h
215
216	WRITE(numout,*) " Frequency of computation hard coded to be every hour: nn_dct = ",nn_dct
217	WRITE(numout,*) " Frequency of write hard coded to average 25 instantaneous hour values: nn_dctwri = ",nn_dctwri
218	WRITE(numout,*) " Frequency of hourly computation (timestep) : nn_dct_h = ",nn_dct_h
219	WRITE(numout,*) " Frequency of hourly computation Not hard coded to be every timestep, or : nn_dct_h = ",nn_dct_h
220	WRITE(numout,*) " Frequency of hourly write hard coded to every hour: nn_dctwri_h = ",nn_dctwri_h
221	ELSE
222	WRITE(numout,*) " Frequency of computation: nn_dct = ",nn_dct
223	WRITE(numout,*) " Frequency of write: nn_dctwri = ",nn_dctwri
224	ENDIF
225
226	IF ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN
227	WRITE(numout,*)" Debug section number: ", nn_secdebug
228	ELSE IF ( nn_secdebug == 0 )THEN ; WRITE(numout,*)" No section to debug"
229	ELSE IF ( nn_secdebug == -1 )THEN ; WRITE(numout,*)" Debug all sections"
230	ELSE ; WRITE(numout,*)" Wrong value for nn_secdebug : ",nn_secdebug
231	ENDIF
232
233	IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0) &
234	& CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' )
235
236	ENDIF
237
238
239	IF ( ln_NOOS ) THEN
240	IF ( ln_dct_calc_noos_25h .or. ln_dct_calc_noos_hr ) CALL readsec
241	ENDIF
242
243	!open output file
244	IF( lwp ) THEN
245	IF( ln_NOOS ) THEN
246	WRITE(numout,*) "diadct_init: Open output files. ASCII? ",ln_dct_ascii
247	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
248	IF ( ln_dct_ascii ) THEN
249	if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
250	if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_h', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
251	ELSE
252	if ( ln_dct_calc_noos_25h ) CALL ctl_opn( numdct_NOOS ,'NOOS_transport_bin' , 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
253	if ( ln_dct_calc_noos_hr ) CALL ctl_opn( numdct_NOOS_h,'NOOS_transport_bin_h', 'REPLACE', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
254	ENDIF
255	ELSE
256	CALL ctl_opn( numdct_vol, 'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
257	CALL ctl_opn( numdct_heat, 'heat_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
258	CALL ctl_opn( numdct_salt, 'salt_transport' , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
259	ENDIF
260	ENDIF
261
262	! Initialise arrays to zero
263	transports_3d(:,:,:,:) =0._wp
264	transports_2d(:,:,:) =0._wp
265	transports_3d_h(:,:,:,:) =0._wp
266	transports_2d_h(:,:,:) =0._wp
267	z_hr_output(:,:,:) =0._wp
268
269	IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init')
270
271	IF (ln_dct_iom_cont) THEN
272	IF( lwp ) THEN
273	WRITE(numout,*) " "
274	WRITE(numout,*) "diadct_init: using xios iom_put for output: field_def.xml and iodef.xml code"
275	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
276	WRITE(numout,*) ""
277	WRITE(numout,*) " field_def.xml"
278	WRITE(numout,*) " ~~~~~~~~~~~~~"
279	WRITE(numout,*) ""
280	WRITE(numout,*) ""
281
282	WRITE(numout,*) ' <field_group id="noos_cross_section" domain_ref="1point" axis_ref="noos" operation="average">'
283
284	DO jsec=1,nb_sec
285	WRITE (jsec_str, "(I3.3)") jsec
286
287	WRITE(numout,*) ' <field id="noos_'//jsec_str//'_trans" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS transport cross-section number: '//jsec_str//' (total, positive, negative)" unit="m^3/s" />'
288	WRITE(numout,*) ' <field id="noos_'//jsec_str//'_heat" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS heat cross-section number: '//jsec_str//' (total, positive, negative)" unit="J/s" />'
289	WRITE(numout,*) ' <field id="noos_'//jsec_str//'_salt" long_name="' // TRIM(secs(jsec)%name) // ' 25h mean NOOS salt cross-section number: '//jsec_str//' (total, positive, negative)" unit="g/s" />'
290
291	ENDDO
292
293	WRITE(numout,*) ' </field_group>'
294
295	WRITE(numout,*) ""
296	WRITE(numout,*) ""
297	WRITE(numout,*) " iodef.xml"
298	WRITE(numout,*) " ~~~~~~~~~"
299	WRITE(numout,*) ""
300	WRITE(numout,*) ""
301
302	WRITE(numout,*) ' <file_group id="1d" output_freq="1d" output_level="10" enabled=".TRUE.">'
303	WRITE(numout,*) ""
304	WRITE(numout,*) ' <file id="noos_cross_section" name="NOOS_transport">'
305	DO jsec=1,nb_sec
306	WRITE (jsec_str, "(I3.3)") jsec
307
308	WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_trans" />'
309	WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_heat" />'
310	WRITE(numout,*) ' <field field_ref="noos_'//jsec_str//'_salt" />'
311
312	ENDDO
313	WRITE(numout,*) ' </file>'
314	WRITE(numout,*) ""
315	WRITE(numout,*) ' </file_group>'
316
317	WRITE(numout,*) ""
318	WRITE(numout,*) ""
319	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
320	WRITE(numout,*) ""
321
322	ENDIF
323	ENDIF
324
325
326	!
327	END SUBROUTINE dia_dct_init
328
329
330	SUBROUTINE dia_dct(kt)
331	!!---------------------------------------------------------------------
332	!! * ROUTINE diadct *
333	!!
334	!! Purpose :: Compute section transports and write it in numdct files
335	!!
336	!! Method :: All arrays initialised to zero in dct_init
337	!! Each nn_dct time step call subroutine 'transports' for
338	!! each section to sum the transports.
339	!! Each nn_dctwri time step:
340	!! Divide the arrays by the number of summations to gain
341	!! an average value
342	!! Call dia_dct_sum to sum relevant grid boxes to obtain
343	!! totals for each class (density, depth, temp or sal)
344	!! Call dia_dct_wri to write the transports into file
345	!! Reinitialise all relevant arrays to zero
346	!!---------------------------------------------------------------------
347	!! * Arguments
348	INTEGER,INTENT(IN) ::kt
349
350	!! * Local variables
351	INTEGER :: jsec, &! loop on sections
352	itotal ! nb_sec_maxnb_type_classnb_class_max
353	LOGICAL :: lldebug =.FALSE. ! debug a section
354
355	INTEGER , DIMENSION(1) :: ish ! tmp array for mpp_sum
356	INTEGER , DIMENSION(3) :: ish2 ! "
357	REAL(wp), POINTER, DIMENSION(:) :: zwork ! "
358	REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! "
359
360	!!---------------------------------------------------------------------
361	IF( nn_timing == 1 ) CALL timing_start('dia_dct')
362
363	IF( lk_mpp )THEN
364	itotal = nb_sec_maxnb_type_classnb_class_max
365	CALL wrk_alloc( itotal , zwork )
366	CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum )
367	ENDIF
368	lldebug=.TRUE.
369	! Initialise arrays
370	zwork(:) = 0.0
371	zsum(:,:,:) = 0.0
372
373	IF( lwp .AND. kt==nit000+nn_dct-1 ) THEN
374	WRITE(numout,*) " "
375	WRITE(numout,*) "diadct: compute transport"
376	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~~~~~"
377	WRITE(numout,*) "nb_sec = ",nb_sec
378	WRITE(numout,*) "nn_dct = ",nn_dct
379	WRITE(numout,*) "ln_NOOS = ",ln_NOOS
380	WRITE(numout,*) "nb_sec = ",nb_sec
381	WRITE(numout,*) "nb_sec_max = ",nb_sec_max
382	WRITE(numout,*) "nb_type_class = ",nb_type_class
383	WRITE(numout,*) "nb_class_max = ",nb_class_max
384	ENDIF
385
386
387	IF ( ln_dct_calc_noos_25h ) THEN
388
389	! Compute transport and write only at nn_dctwri
390	IF ( MOD(kt,nn_dct)==0 .or. & ! compute transport every nn_dct time steps
391	(ln_NOOS .and. kt==nn_it000 ) ) THEN ! also include first time step when calculating NOOS 25 hour averages
392
393
394
395	DO jsec=1,nb_sec
396
397	lldebug=.FALSE.
398	IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp ) lldebug=.TRUE.
399
400	!Compute transport through section
401	CALL transport(secs(jsec),lldebug,jsec)
402
403
404	ENDDO
405
406	IF( MOD(kt,nn_dctwri)==0 )THEN
407
408
409
410	IF( lwp .AND. kt==nit000+nn_dctwri-1 ) WRITE(numout,*)" diadct: average and write at kt = ",kt
411
412
413	! Not 24 values, but 25! divide by ((nn_dctwri/nn_dct) +1)
414	!! divide arrays by nn_dctwri/nn_dct to obtain average
415	transports_3d(:,:,:,:)= transports_3d(:,:,:,:)/((nn_dctwri/nn_dct)+1.)
416	transports_2d(:,:,:) = transports_2d(:,:,:) /((nn_dctwri/nn_dct)+1.)
417
418	! Sum over each class
419	DO jsec=1,nb_sec
420	CALL dia_dct_sum(secs(jsec),jsec)
421	ENDDO
422
423	!Sum on all procs
424	IF( lk_mpp )THEN
425	zsum(:,:,:)=0.0_wp
426	ish(1) = nb_sec_maxnb_type_classnb_class_max
427	ish2 = (/nb_sec_max,nb_type_class,nb_class_max/)
428	DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport(:,:) ; ENDDO
429	zwork(:)= RESHAPE(zsum(:,:,:), ish )
430	CALL mpp_sum(zwork, ish(1))
431	zsum(:,:,:)= RESHAPE(zwork,ish2)
432	DO jsec=1,nb_sec ; secs(jsec)%transport(:,:) = zsum(jsec,:,:) ; ENDDO
433	ENDIF
434
435	!Write the transport
436	DO jsec=1,nb_sec
437
438	IF( lwp .and. .not. ln_NOOS )CALL dia_dct_wri(kt,jsec,secs(jsec))
439	!IF( lwp .and. ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting
440	IF( ln_NOOS )CALL dia_dct_wri_NOOS(kt,jsec,secs(jsec)) ! use NOOS specific formatting
441
442
443	!nullify transports values after writing
444	transports_3d(:,jsec,:,:)=0.0
445	transports_2d(:,jsec,: )=0.0
446	secs(jsec)%transport(:,:)=0.
447
448
449	IF ( ln_NOOS ) CALL transport(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values)
450
451
452
453	ENDDO
454
455	ENDIF
456
457	ENDIF
458
459	ENDIF
460	IF ( ln_dct_calc_noos_hr ) THEN
461	IF ( MOD(kt,nn_dct_h)==0 ) THEN ! compute transport every nn_dct_h time steps
462
463	DO jsec=1,nb_sec
464
465	lldebug=.FALSE.
466	IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct_h-1 .AND. lwp ) lldebug=.TRUE.
467
468	!Compute transport through section
469	CALL transport_h(secs(jsec),lldebug,jsec)
470
471	ENDDO
472
473	IF( MOD(kt,nn_dctwri_h)==0 )THEN
474
475	IF( lwp .AND. kt==nit000+nn_dctwri_h-1 )WRITE(numout,*)" diadct: average and write hourly files at kt = ",kt
476
477	!! divide arrays by nn_dctwri/nn_dct to obtain average
478	!
479	! JT - I think this is wrong. I think it is trying to sum over 25 hours, but only dividing by 24.
480	! I think it might work for daily cycles, but not for monthly cycles,
481	!
482	transports_3d_h(:,:,:,:)=transports_3d_h(:,:,:,:)/(nn_dctwri_h/nn_dct_h)
483	transports_2d_h(:,:,:) =transports_2d_h(:,:,:) /(nn_dctwri_h/nn_dct_h)
484
485	! Sum over each class
486	DO jsec=1,nb_sec
487	CALL dia_dct_sum_h(secs(jsec),jsec)
488	ENDDO
489
490	!Sum on all procs
491	IF( lk_mpp )THEN
492	ish(1) = nb_sec_maxnb_type_classnb_class_max
493	ish2 = (/nb_sec_max,nb_type_class,nb_class_max/)
494	DO jsec=1,nb_sec ; zsum(jsec,:,:) = secs(jsec)%transport_h(:,:) ; ENDDO
495	zwork(:)= RESHAPE(zsum(:,:,:), ish )
496	CALL mpp_sum(zwork, ish(1))
497	zsum(:,:,:)= RESHAPE(zwork,ish2)
498	DO jsec=1,nb_sec ; secs(jsec)%transport_h(:,:) = zsum(jsec,:,:) ; ENDDO
499	ENDIF
500
501	!Write the transport
502	DO jsec=1,nb_sec
503
504	IF( lwp .and. ln_NOOS ) THEN
505	CALL dia_dct_wri_NOOS_h(kt/nn_dctwri_h,jsec,secs(jsec)) ! use NOOS specific formatting
506	endif
507	!nullify transports values after writing
508	transports_3d_h(:,jsec,:,:)=0.0
509	transports_2d_h(:,jsec,:)=0.0
510	secs(jsec)%transport_h(:,:)=0.0
511
512	! for hourly mean or hourly instantaneous, you don't initialise! start with zero!
513	!IF ( ln_NOOS ) CALL transport_h(secs(jsec),lldebug,jsec) ! reinitialise for next 25 hour instantaneous average (overlapping values)
514
515	ENDDO
516
517	ENDIF
518
519	ENDIF
520
521	ENDIF
522
523	IF( lk_mpp )THEN
524	itotal = nb_sec_maxnb_type_classnb_class_max
525	CALL wrk_dealloc( itotal , zwork )
526	CALL wrk_dealloc( nb_sec_max,nb_type_class,nb_class_max , zsum )
527	ENDIF
528
529	IF( nn_timing == 1 ) CALL timing_stop('dia_dct')
530	!
531	END SUBROUTINE dia_dct
532
533	SUBROUTINE readsec
534	!!---------------------------------------------------------------------
535	!! * ROUTINE readsec *
536	!!
537	!! ** Purpose:
538	!! Read a binary file(section_ijglobal.diadct)
539	!! generated by the tools "NEMOGCM/TOOLS/SECTIONS_DIADCT"
540	!!
541	!!
542	!!---------------------------------------------------------------------
543	!! * Local variables
544	INTEGER :: iptglo , iptloc ! Global and local number of points for a section
545	INTEGER :: isec, iiglo, ijglo, iiloc, ijloc,iost,i1 ,i2 ! temporary integer
546	INTEGER :: jsec, jpt ! dummy loop indices
547
548	INTEGER, DIMENSION(2) :: icoord
549	CHARACTER(len=160) :: clname !filename
550	CHARACTER(len=200) :: cltmp
551	CHARACTER(len=200) :: clformat !automatic format
552	TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates
553	!read in the file
554	INTEGER, POINTER, DIMENSION(:) :: directemp !contains listpoints directions
555	!read in the files
556	LOGICAL :: llbon ,&!local logical
557	lldebug !debug the section
558	!!-------------------------------------------------------------------------------------
559	CALL wrk_alloc( nb_point_max, directemp )
560
561	!open input file
562	!---------------
563	!write(numout,*) 'dct low-level pre open: little endian '
564	!OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='LITTLE_ENDIAN')
565
566	write(numout,*) 'dct low-level pre open: big endian :',nproc,narea
567	OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='BIG_ENDIAN')
568
569	!write(numout,*) 'dct low-level pre open: SWAP '
570	!OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='SWAP')
571
572	!write(numout,*) 'dct low-level pre open: NATIVE '
573	!OPEN(UNIT=107,FILE='section_ijglobal.diadct', FORM='UNFORMATTED', ACCESS='SEQUENTIAL', STATUS='OLD',convert='NATIVE')
574
575	READ(107) isec
576	CLOSE(107)
577
578	CALL ctl_opn( numdct_in, 'section_ijglobal.diadct', 'OLD', 'UNFORMATTED', 'SEQUENTIAL', -1, numout, .TRUE. )
579
580	!---------------
581	!Read input file
582	!---------------
583
584	DO jsec=1,nb_sec_max !loop on the nb_sec sections
585
586	IF ( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) ) &
587	& WRITE(numout,*)'debugging for section number: ',jsec
588
589	!initialization
590	!---------------
591	secs(jsec)%name=''
592	secs(jsec)%llstrpond = .FALSE.
593	secs(jsec)%ll_ice_section = .FALSE.
594	secs(jsec)%ll_date_line = .FALSE.
595	secs(jsec)%nb_class = 0
596	secs(jsec)%zsigi = 99._wp
597	secs(jsec)%zsigp = 99._wp
598	secs(jsec)%zsal = 99._wp
599	secs(jsec)%ztem = 99._wp
600	secs(jsec)%zlay = 99._wp
601	secs(jsec)%transport = 0._wp
602	secs(jsec)%transport_h = 0._wp
603	secs(jsec)%nb_point = 0
604
605	!read section's number / name / computing choices / classes / slopeSection / points number
606	!-----------------------------------------------------------------------------------------
607
608	READ(numdct_in,iostat=iost) isec
609	IF (iost .NE. 0 ) then
610	write(numout,*) 'unable to read section_ijglobal.diadct. iost = ',iost
611	EXIT !end of file
612	ENDIF
613
614
615	WRITE(cltmp,'(a,i4.4,a,i4.4)')'diadct: read sections : Problem of section number: isec= ',isec,' and jsec= ',jsec
616
617
618	IF( jsec .NE. isec ) CALL ctl_stop( cltmp )
619
620	READ(numdct_in)secs(jsec)%name
621	READ(numdct_in)secs(jsec)%llstrpond
622	READ(numdct_in)secs(jsec)%ll_ice_section
623	READ(numdct_in)secs(jsec)%ll_date_line
624	READ(numdct_in)secs(jsec)%coordSec
625	READ(numdct_in)secs(jsec)%nb_class
626	READ(numdct_in)secs(jsec)%zsigi
627	READ(numdct_in)secs(jsec)%zsigp
628	READ(numdct_in)secs(jsec)%zsal
629	READ(numdct_in)secs(jsec)%ztem
630	READ(numdct_in)secs(jsec)%zlay
631	READ(numdct_in)secs(jsec)%slopeSection
632	READ(numdct_in)iptglo
633
634	IF ( ln_NOOS ) THEN
635	WRITE(numout,*) 'Section name = ',TRIM(secs(jsec)%name)
636	WRITE(numout,*) 'coordSec = ',secs(jsec)%coordSec
637	WRITE(numout,*) 'iptglo = ',iptglo
638	ENDIF
639
640	!debug
641	!-----
642
643	IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN
644
645	WRITE(clformat,'(a,i2,a)') '(A40,', nb_class_max,'(f8.3,1X))'
646
647	WRITE(numout,*) " Section name : ",TRIM(secs(jsec)%name)
648	WRITE(numout,*) " Compute temperature and salinity transports ? ",secs(jsec)%llstrpond
649	WRITE(numout,*) " Compute ice transport ? ",secs(jsec)%ll_ice_section
650	WRITE(numout,*) " Section crosses date-line ? ",secs(jsec)%ll_date_line
651	WRITE(numout,*) " Slope section : ",secs(jsec)%slopeSection
652	WRITE(numout,*) " Number of points in the section: ",iptglo
653	WRITE(numout,*) " Number of classes ",secs(jsec)%nb_class
654	WRITE(numout,clformat)" Insitu density classes : ",secs(jsec)%zsigi
655	WRITE(numout,clformat)" Potential density classes : ",secs(jsec)%zsigp
656	WRITE(numout,clformat)" Salinity classes : ",secs(jsec)%zsal
657	WRITE(numout,clformat)" Temperature classes : ",secs(jsec)%ztem
658	WRITE(numout,clformat)" Depth classes : ",secs(jsec)%zlay
659	ENDIF
660
661	IF( iptglo .NE. 0 )THEN
662
663	!read points'coordinates and directions
664	!--------------------------------------
665	IF ( ln_NOOS ) THEN
666	WRITE(numout,*) 'Coords and direction read'
667	ENDIF
668
669	coordtemp(:) = POINT_SECTION(0,0) !list of points read
670	directemp(:) = 0 !value of directions of each points
671	DO jpt=1,iptglo
672	READ(numdct_in)i1,i2
673	coordtemp(jpt)%I = i1
674	coordtemp(jpt)%J = i2
675	ENDDO
676	READ(numdct_in)directemp(1:iptglo)
677
678	!debug
679	!-----
680	IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN
681	WRITE(numout,*)" List of points in global domain:"
682	DO jpt=1,iptglo
683	WRITE(numout,*)' # I J ',jpt,coordtemp(jpt),directemp(jpt)
684	ENDDO
685	ENDIF
686
687	!Now each proc selects only points that are in its domain:
688	!--------------------------------------------------------
689	iptloc = 0 !initialize number of points selected
690	DO jpt=1,iptglo !loop on listpoint read in the file
691
692	iiglo=coordtemp(jpt)%I ! global coordinates of the point
693	ijglo=coordtemp(jpt)%J ! "
694
695	IF( iiglo==jpidta .AND. nimpp==1 ) iiglo = 2
696
697	iiloc=iiglo-jpizoom+1-nimpp+1 ! local coordinates of the point
698	ijloc=ijglo-jpjzoom+1-njmpp+1 ! "
699
700	!verify if the point is on the local domain:(1,nlei)*(1,nlej)
701	IF( iiloc .GE. 1 .AND. iiloc .LE. nlei .AND. &
702	ijloc .GE. 1 .AND. ijloc .LE. nlej )THEN
703	iptloc = iptloc + 1 ! count local points
704	secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates
705	secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction
706	ENDIF
707
708	ENDDO
709
710	secs(jsec)%nb_point=iptloc !store number of section's points
711
712	!debug
713	!-----
714	IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN
715	WRITE(numout,*)" List of points selected by the proc:"
716	DO jpt = 1,iptloc
717	iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
718	ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
719	WRITE(numout,*)' # I J : ',iiglo,ijglo
720	ENDDO
721	ENDIF
722
723	IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN
724	DO jpt = 1,iptloc
725	iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
726	ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
727	ENDDO
728	ENDIF
729
730	!remove redundant points between processors
731	!------------------------------------------
732	lldebug = .FALSE. ; IF ( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. lwp ) lldebug = .TRUE.
733	IF( iptloc .NE. 0 )THEN
734	CALL removepoints(secs(jsec),'I','top_list',lldebug)
735	CALL removepoints(secs(jsec),'I','bot_list',lldebug)
736	CALL removepoints(secs(jsec),'J','top_list',lldebug)
737	CALL removepoints(secs(jsec),'J','bot_list',lldebug)
738	ENDIF
739	IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN
740	DO jpt = 1,secs(jsec)%nb_point
741	iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
742	ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
743	ENDDO
744	ENDIF
745
746	!debug
747	!-----
748	IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )THEN
749	WRITE(numout,*)" List of points after removepoints:"
750	iptloc = secs(jsec)%nb_point
751	DO jpt = 1,iptloc
752	iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 + nimpp - 1
753	ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1
754	WRITE(numout,*)' # I J : ',iiglo,ijglo
755	CALL FLUSH(numout)
756	ENDDO
757	ENDIF
758
759	ELSE ! iptglo = 0
760	IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) )&
761	WRITE(numout,*)' No points for this section.'
762	ENDIF
763
764	ENDDO !end of the loop on jsec
765
766	nb_sec = jsec-1 !number of section read in the file
767
768	IF( lwp ) WRITE(numout,*)'diadct: read sections: Finished readsec.'
769
770	CALL wrk_dealloc( nb_point_max, directemp )
771	!
772	END SUBROUTINE readsec
773
774	SUBROUTINE removepoints(sec,cdind,cdextr,ld_debug)
775	!!---------------------------------------------------------------------------
776	!! *** function removepoints
777	!!
778	!! ** Purpose :: Remove points which are common to 2 procs
779	!!
780	!----------------------------------------------------------------------------
781	!! * arguments
782	TYPE(SECTION),INTENT(INOUT) :: sec
783	CHARACTER(len=1),INTENT(IN) :: cdind ! = 'I'/'J'
784	CHARACTER(len=8),INTENT(IN) :: cdextr ! = 'top_list'/'bot_list'
785	LOGICAL,INTENT(IN) :: ld_debug
786
787	!! * Local variables
788	INTEGER :: iextr ,& !extremity of listpoint that we verify
789	iind ,& !coord of listpoint that we verify
790	itest ,& !indice value of the side of the domain
791	!where points could be redundant
792	isgn ,& ! isgn= 1 : scan listpoint from start to end
793	! isgn=-1 : scan listpoint from end to start
794	istart,iend !first and last points selected in listpoint
795	INTEGER :: jpoint !loop on list points
796	INTEGER, POINTER, DIMENSION(:) :: idirec !contains temporary sec%direction
797	INTEGER, POINTER, DIMENSION(:,:) :: icoord !contains temporary sec%listpoint
798	!----------------------------------------------------------------------------
799	CALL wrk_alloc( nb_point_max, idirec )
800	CALL wrk_alloc( 2, nb_point_max, icoord )
801
802	IF( ld_debug )WRITE(numout,*)' -------------------------'
803	IF( ld_debug )WRITE(numout,*)' removepoints in listpoint'
804
805	!iextr=extremity of list_point that we verify
806	IF ( cdextr=='bot_list' )THEN ; iextr=1 ; isgn=1
807	ELSE IF ( cdextr=='top_list' )THEN ; iextr=sec%nb_point ; isgn=-1
808	ELSE ; CALL ctl_stop("removepoints :Wrong value for cdextr")
809	ENDIF
810
811	!which coordinate shall we verify ?
812	IF ( cdind=='I' )THEN ; itest=nlei ; iind=1
813	ELSE IF ( cdind=='J' )THEN ; itest=nlej ; iind=2
814	ELSE ; CALL ctl_stop("removepoints :Wrong value for cdind")
815	ENDIF
816
817	IF( ld_debug )THEN
818	WRITE(numout,*)' case: coord/list extr/domain side'
819	WRITE(numout,*)' ', cdind,' ',cdextr,' ',itest
820	WRITE(numout,*)' Actual number of points: ',sec%nb_point
821	ENDIF
822
823	icoord(1,1:nb_point_max) = sec%listPoint%I
824	icoord(2,1:nb_point_max) = sec%listPoint%J
825	idirec = sec%direction
826	sec%listPoint = POINT_SECTION(0,0)
827	sec%direction = 0
828
829	jpoint=iextr+isgn
830	DO WHILE( jpoint .GE. 1 .AND. jpoint .LE. sec%nb_point )
831	IF( icoord( iind,jpoint-isgn ) == itest .AND. icoord( iind,jpoint ) == itest )THEN ; jpoint=jpoint+isgn
832	ELSE ; EXIT
833	ENDIF
834	ENDDO
835
836	IF( cdextr=='bot_list')THEN ; istart=jpoint-1 ; iend=sec%nb_point
837	ELSE ; istart=1 ; iend=jpoint+1
838	ENDIF
839
840	sec%listPoint(1:1+iend-istart)%I = icoord(1,istart:iend)
841	sec%listPoint(1:1+iend-istart)%J = icoord(2,istart:iend)
842	sec%direction(1:1+iend-istart) = idirec(istart:iend)
843	sec%nb_point = iend-istart+1
844
845	IF( ld_debug )THEN
846	WRITE(numout,*)' Number of points after removepoints :',sec%nb_point
847	WRITE(numout,*)' sec%direction after removepoints :',sec%direction(1:sec%nb_point)
848	ENDIF
849
850	CALL wrk_dealloc( nb_point_max, idirec )
851	CALL wrk_dealloc( 2, nb_point_max, icoord )
852	END SUBROUTINE removepoints
853
854	SUBROUTINE transport(sec,ld_debug,jsec)
855	!!-------------------------------------------------------------------------------------------
856	!! * ROUTINE transport *
857	!!
858	!! Purpose :: Compute the transport for each point in a section
859	!!
860	!! Method :: Loop over each segment, and each vertical level and add the transport
861	!! Be aware :
862	!! One section is a sum of segments
863	!! One segment is defined by 2 consecutive points in sec%listPoint
864	!! All points of sec%listPoint are positioned on the F-point of the cell
865	!!
866	!! There are two loops:
867	!! loop on the segment between 2 nodes
868	!! loop on the level jk !!
869	!!
870	!! ** Output: Arrays containing the volume,density,salinity,temperature etc
871	!! transports for each point in a section, summed over each nn_dct.
872	!!
873	!!-------------------------------------------------------------------------------------------
874	!! * Arguments
875	TYPE(SECTION),INTENT(INOUT) :: sec
876	LOGICAL ,INTENT(IN) :: ld_debug
877	INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section
878
879	!! * Local variables
880	INTEGER :: jk,jseg,jclass, &!loop on level/segment/classes
881	isgnu , isgnv !
882	REAL(wp):: zumid , zvmid , &!U/V velocity on a cell segment
883	zumid_ice , zvmid_ice , &!U/V ice velocity
884	zTnorm !transport of velocity through one cell's sides
885	REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
886
887	TYPE(POINT_SECTION) :: k
888	!!--------------------------------------------------------
889
890	IF( ld_debug )WRITE(numout,*)' Compute transport (jsec,sec%nb_point,sec%slopeSection) : ', jsec,sec%nb_point,sec%slopeSection
891
892	!---------------------------!
893	! COMPUTE TRANSPORT !
894	!---------------------------!
895	IF(sec%nb_point .NE. 0)THEN
896
897	!----------------------------------------------------------------------------------------------------
898	!----------------------------------------------------------------------------------------------------
899	!----------------------------------------------------------------------------------------------------
900	!
901	!
902	! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section
903	!
904	! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection
905	! (isgnu, isgnv)
906	!
907	! They vary for each segment of the section.
908	!
909	!----------------------------------------------------------------------------------------------------
910	!----------------------------------------------------------------------------------------------------
911	!----------------------------------------------------------------------------------------------------
912	!Compute sign for velocities:
913	!
914	!convention:
915	! non horizontal section: direction + is toward left hand of section
916	! horizontal section: direction + is toward north of section
917	!
918	!
919	! slopeSection < 0 slopeSection > 0 slopeSection=inf slopeSection=0
920	! ---------------- ----------------- --------------- --------------
921	!
922	! isgnv=1 direction +
923	! ______ _____ ______
924	! \| //\| \| \| direction +
925	! \| isgnu=1 // \| \|isgnu=1 \|isgnu=1 /\|\
926	! \|_______ // ______\| \\ \| ---\ \|
927	! \| \| isgnv=-1 \\ \| \| ---/ direction + ____________
928	! \| \| __\\\| \|
929	! \| \| direction + \| isgnv=1
930	!
931	!----------------------------------------------------------------------------------------------------
932
933	IF( ld_debug )write(numout,*)"sec%slopeSection isgnu isgnv ",sec%slopeSection,isgnu,isgnv
934
935	!--------------------------------------!
936	! LOOP ON THE SEGMENT BETWEEN 2 NODES !
937	!--------------------------------------!
938	DO jseg=1,MAX(sec%nb_point-1,0)
939
940
941	!Compute sign for velocities:
942
943	!isgnu = 1
944	!isgnv = 1
945	!
946	!changing sign of u and v is dependent on the direction of the section.
947	!isgnu = 1
948	!isgnv = 1
949	!SELECT CASE( sec%direction(jseg) )
950	!CASE(0) ; isgnv = -1
951	!CASE(3) ; isgnu = -1
952	!END SELECT
953
954
955	SELECT CASE( sec%direction(jseg) )
956	CASE(0)
957	isgnu = 1
958	isgnv = -1
959	CASE(1)
960	isgnu = 1
961	isgnv = 1
962	CASE(2)
963	isgnu = 1
964	isgnv = 1
965	CASE(3)
966	isgnu = -1
967	isgnv = 1
968	END SELECT
969
970	!-------------------------------------------------------------------------------------------
971	! Select the appropriate coordinate for computing the velocity of the segment
972	! Corrected by JT 01/09/2018 (#)
973	!
974	! CASE(0) Case (2)
975	! ------- --------
976	! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j)
977	! F(i,j)---------#V(i,j)-------F(i+1,j) \|
978	! --------> \|
979	! \| \|
980	! \| \|
981	! Case (3) \| U(i,j)
982	! -------- \| \|
983	! V \|
984	! listPoint(jseg+1) F(i,j+1) \|
985	! \| \|
986	! \| \|
987	! \| listPoint(jseg+1) F(i,j-1)
988	! ^ \|
989	! \| \|
990	! \| U(i,j+1)
991	! \| \| Case(1)
992	! \| \| ------
993	! \|
994	! \| listPoint(jseg+1) listPoint(jseg)
995	! \| F(i-1,j)----------#V(i-1,j) ------#f(i,j)
996	! listPoint(jseg) F(i,j) <-------
997	!
998	!-------------------------------------------------------------------------------------------
999
1000	SELECT CASE( sec%direction(jseg) )
1001	CASE(0) ; k = sec%listPoint(jseg)
1002	CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
1003	CASE(2) ; k = sec%listPoint(jseg)
1004	CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
1005	END SELECT
1006
1007	!---------------------------\|
1008	! LOOP ON THE LEVEL \|
1009	!---------------------------\|
1010	!Sum of the transport on the vertical
1011	DO jk=1,mbathy(k%I,k%J)
1012
1013	! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
1014	SELECT CASE( sec%direction(jseg) )
1015	CASE(0,1)
1016	ztn = interp(k%I,k%J,jk,'V',0 )
1017	zsn = interp(k%I,k%J,jk,'V',1 )
1018	zrhop = interp(k%I,k%J,jk,'V',2)
1019	zrhoi = interp(k%I,k%J,jk,'V',3)
1020	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) vmask(k%I,k%J,1)
1021	CASE(2,3)
1022	ztn = interp(k%I,k%J,jk,'U',0)
1023	zsn = interp(k%I,k%J,jk,'U',1)
1024	zrhop = interp(k%I,k%J,jk,'U',2)
1025	zrhoi = interp(k%I,k%J,jk,'U',3)
1026	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) umask(k%I,k%J,1)
1027	END SELECT
1028
1029	zfsdep= fsdept(k%I,k%J,jk)
1030
1031	!compute velocity with the correct direction
1032	SELECT CASE( sec%direction(jseg) )
1033	CASE(0,1)
1034	zumid=0.
1035	zvmid=isgnvvn(k%I,k%J,jk)vmask(k%I,k%J,jk)
1036	CASE(2,3)
1037	zumid=isgnuun(k%I,k%J,jk)umask(k%I,k%J,jk)
1038	zvmid=0.
1039	END SELECT
1040
1041	!zTnorm=transport through one cell;
1042	!velocity* cell's length * cell's thickness
1043	zTnorm=zumide2u(k%I,k%J) fse3u(k%I,k%J,jk)+ &
1044	zvmide1v(k%I,k%J) fse3v(k%I,k%J,jk)
1045
1046	#if ! defined key_vvl
1047	!add transport due to free surface
1048	IF( jk==1 )THEN
1049	zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + &
1050	zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk)
1051	ENDIF
1052	#endif
1053	!COMPUTE TRANSPORT
1054
1055	transports_3d(1,jsec,jseg,jk) = transports_3d(1,jsec,jseg,jk) + zTnorm
1056
1057	IF ( sec%llstrpond ) THEN
1058	transports_3d(2,jsec,jseg,jk) = transports_3d(2,jsec,jseg,jk) + zTnorm * zrhoi
1059	transports_3d(3,jsec,jseg,jk) = transports_3d(3,jsec,jseg,jk) + zTnorm * zrhop
1060	transports_3d(4,jsec,jseg,jk) = transports_3d(4,jsec,jseg,jk) + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
1061	transports_3d(5,jsec,jseg,jk) = transports_3d(5,jsec,jseg,jk) + zTnorm * 0.001 * zsn * 1026._wp
1062	ENDIF
1063
1064	ENDDO !end of loop on the level
1065
1066	#if defined key_lim2 \|\| defined key_lim3
1067
1068	!ICE CASE
1069	!------------
1070	IF( sec%ll_ice_section )THEN
1071	SELECT CASE (sec%direction(jseg))
1072	CASE(0)
1073	zumid_ice = 0
1074	zvmid_ice = isgnv0.5(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
1075	CASE(1)
1076	zumid_ice = 0
1077	zvmid_ice = isgnv0.5(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
1078	CASE(2)
1079	zvmid_ice = 0
1080	zumid_ice = isgnu0.5(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
1081	CASE(3)
1082	zvmid_ice = 0
1083	zumid_ice = isgnu0.5(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
1084	END SELECT
1085
1086	zTnorm=zumid_icee2u(k%I,k%J)+zvmid_icee1v(k%I,k%J)
1087
1088	transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* &
1089	(1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1090	*(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + &
1091	hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1092	+zice_vol_pos
1093	transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* &
1094	(1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1095	+zice_surf_pos
1096
1097	ENDIF !end of ice case
1098	#endif
1099
1100	ENDDO !end of loop on the segment
1101
1102	ENDIF !end of sec%nb_point =0 case
1103	!
1104	END SUBROUTINE transport
1105
1106	SUBROUTINE transport_h(sec,ld_debug,jsec)
1107	!!-------------------------------------------------------------------------------------------
1108	!! * ROUTINE hourly_transport *
1109	!!
1110	!! Exactly as routine transport but for data summed at
1111	!! each time step and averaged each hour
1112	!!
1113	!! Purpose :: Compute the transport for each point in a section
1114	!!
1115	!! Method :: Loop over each segment, and each vertical level and add the transport
1116	!! Be aware :
1117	!! One section is a sum of segments
1118	!! One segment is defined by 2 consecutive points in sec%listPoint
1119	!! All points of sec%listPoint are positioned on the F-point of the cell
1120	!!
1121	!! There are two loops:
1122	!! loop on the segment between 2 nodes
1123	!! loop on the level jk
1124	!!
1125	!! ** Output: Arrays containing the volume,density,salinity,temperature etc
1126	!! transports for each point in a section, summed over each nn_dct.
1127	!!
1128	!!-------------------------------------------------------------------------------------------
1129	!! * Arguments
1130	TYPE(SECTION),INTENT(INOUT) :: sec
1131	LOGICAL ,INTENT(IN) :: ld_debug
1132	INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section
1133
1134	!! * Local variables
1135	INTEGER :: jk,jseg,jclass, &!loop on level/segment/classes
1136	isgnu , isgnv !
1137	REAL(wp):: zumid , zvmid , &!U/V velocity on a cell segment
1138	zumid_ice , zvmid_ice , &!U/V ice velocity
1139	zTnorm !transport of velocity through one cell's sides
1140	REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
1141
1142	TYPE(POINT_SECTION) :: k
1143	!!--------------------------------------------------------
1144
1145	!!NIALL IF( ld_debug )WRITE(numout,*)' Compute transport'
1146
1147	!---------------------------!
1148	! COMPUTE TRANSPORT !
1149	!---------------------------!
1150	IF(sec%nb_point .NE. 0)THEN
1151
1152	!----------------------------------------------------------------------------------------------------
1153	!----------------------------------------------------------------------------------------------------
1154	!----------------------------------------------------------------------------------------------------
1155	!
1156	!
1157	! ! ! ! JT 1/09/2018 - changing convention. Always direction + is toward left hand of section
1158	!
1159	! Making sign of the velocities used to calculate the volume transport a function of direction, not slopesection
1160	! (isgnu, isgnv)
1161	!
1162	! They vary for each segment of the section.
1163	!
1164	!----------------------------------------------------------------------------------------------------
1165	!----------------------------------------------------------------------------------------------------
1166	!----------------------------------------------------------------------------------------------------
1167	!Compute sign for velocities:
1168	!
1169	!convention:
1170	! non horizontal section: direction + is toward left hand of section
1171	! horizontal section: direction + is toward north of section
1172	!
1173	!
1174	! slopeSection < 0 slopeSection > 0 slopeSection=inf slopeSection=0
1175	! ---------------- ----------------- --------------- --------------
1176	!
1177	! isgnv=1 direction +
1178	! ______ _____ ______
1179	! \| //\| \| \| direction +
1180	! \| isgnu=1 // \| \|isgnu=1 \|isgnu=1 /\|\
1181	! \|_______ // ______\| \\ \| ---\ \|
1182	! \| \| isgnv=-1 \\ \| \| ---/ direction + ____________
1183	! \| \| __\\\| \|
1184	! \| \| direction + \| isgnv=1
1185	!
1186	!----------------------------------------------------------------------------------------------------
1187
1188	IF( ld_debug )write(numout,*)"isgnu isgnv ",isgnu,isgnv
1189
1190	!--------------------------------------!
1191	! LOOP ON THE SEGMENT BETWEEN 2 NODES !
1192	!--------------------------------------!
1193	DO jseg=1,MAX(sec%nb_point-1,0)
1194
1195
1196	!Compute sign for velocities:
1197
1198	!isgnu = 1
1199	!isgnv = 1
1200	!
1201	! changing sign of u and v is dependent on the direction of the section.
1202	!isgnu = 1
1203	!isgnv = 1
1204	!SELECT CASE( sec%direction(jseg) )
1205	!CASE(0) ; isgnv = -1
1206	!CASE(3) ; isgnu = -1
1207	!END SELECT
1208
1209
1210	SELECT CASE( sec%direction(jseg) )
1211	CASE(0)
1212	isgnu = 1
1213	isgnv = -1
1214	CASE(1)
1215	isgnu = 1
1216	isgnv = 1
1217	CASE(2)
1218	isgnu = 1
1219	isgnv = 1
1220	CASE(3)
1221	isgnu = -1
1222	isgnv = 1
1223	END SELECT
1224
1225	!-------------------------------------------------------------------------------------------
1226	! Select the appropriate coordinate for computing the velocity of the segment
1227	! Corrected by JT 01/09/2018 (#)
1228	!
1229	! CASE(0) Case (2)
1230	! ------- --------
1231	! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j)
1232	! F(i,j)---------#V(i,j)-------F(i+1,j) \|
1233	! --------> \|
1234	! \| \|
1235	! \| \|
1236	! Case (3) \| U(i,j)
1237	! -------- \| \|
1238	! V \|
1239	! listPoint(jseg+1) F(i,j+1) \|
1240	! \| \|
1241	! \| \|
1242	! \| listPoint(jseg+1) F(i,j-1)
1243	! ^ \|
1244	! \| \|
1245	! \| U(i,j+1)
1246	! \| \| Case(1)
1247	! \| \| ------
1248	! \|
1249	! \| listPoint(jseg+1) listPoint(jseg)
1250	! \| F(i-1,j)----------#V(i-1,j) ------#f(i,j)
1251	! listPoint(jseg) F(i,j) <-------
1252	!
1253	!-------------------------------------------------------------------------------------------
1254
1255	SELECT CASE( sec%direction(jseg) )
1256	CASE(0) ; k = sec%listPoint(jseg)
1257	CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
1258	CASE(2) ; k = sec%listPoint(jseg)
1259	CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
1260	END SELECT
1261
1262	!---------------------------\|
1263	! LOOP ON THE LEVEL \|
1264	!---------------------------\|
1265	!Sum of the transport on the vertical
1266	DO jk=1,mbathy(k%I,k%J)
1267
1268	! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
1269	SELECT CASE( sec%direction(jseg) )
1270	CASE(0,1)
1271	ztn = interp(k%I,k%J,jk,'V',0)
1272	zsn = interp(k%I,k%J,jk,'V',1)
1273	zrhop = interp(k%I,k%J,jk,'V',2)
1274	zrhoi = interp(k%I,k%J,jk,'V',3)
1275	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) vmask(k%I,k%J,1)
1276	CASE(2,3)
1277	ztn = interp(k%I,k%J,jk,'U',0)
1278	zsn = interp(k%I,k%J,jk,'U',1)
1279	zrhop = interp(k%I,k%J,jk,'U',2)
1280	zrhoi = interp(k%I,k%J,jk,'U',3)
1281	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) umask(k%I,k%J,1)
1282	END SELECT
1283
1284	zfsdep= fsdept(k%I,k%J,jk)
1285
1286	!compute velocity with the correct direction
1287	SELECT CASE( sec%direction(jseg) )
1288	CASE(0,1)
1289	zumid=0.
1290	zvmid=isgnvvn(k%I,k%J,jk)vmask(k%I,k%J,jk)
1291	CASE(2,3)
1292	zumid=isgnuun(k%I,k%J,jk)umask(k%I,k%J,jk)
1293	zvmid=0.
1294	END SELECT
1295
1296	!zTnorm=transport through one cell;
1297	!velocity* cell's length * cell's thickness
1298	zTnorm=zumide2u(k%I,k%J) fse3u(k%I,k%J,jk)+ &
1299	zvmide1v(k%I,k%J) fse3v(k%I,k%J,jk)
1300
1301	#if ! defined key_vvl
1302	!add transport due to free surface
1303	IF( jk==1 )THEN
1304	zTnorm = zTnorm + zumid* e2u(k%I,k%J) * zsshn * umask(k%I,k%J,jk) + &
1305	zvmid* e1v(k%I,k%J) * zsshn * vmask(k%I,k%J,jk)
1306	ENDIF
1307	#endif
1308	!COMPUTE TRANSPORT
1309
1310	transports_3d_h(1,jsec,jseg,jk) = transports_3d_h(1,jsec,jseg,jk) + zTnorm
1311
1312	IF ( sec%llstrpond ) THEN
1313	transports_3d_h(2,jsec,jseg,jk) = transports_3d_h(2,jsec,jseg,jk) + zTnorm * zrhoi
1314	transports_3d_h(3,jsec,jseg,jk) = transports_3d_h(3,jsec,jseg,jk) + zTnorm * zrhop
1315	transports_3d_h(4,jsec,jseg,jk) = transports_3d_h(4,jsec,jseg,jk) + zTnorm * 4.e+3_wp * (ztn+273.15) * 1026._wp
1316	transports_3d_h(5,jsec,jseg,jk) = transports_3d_h(5,jsec,jseg,jk) + zTnorm * 0.001 * zsn * 1026._wp
1317	ENDIF
1318
1319	ENDDO !end of loop on the level
1320
1321	#if defined key_lim2 \|\| defined key_lim3
1322
1323	!ICE CASE
1324	!------------
1325	IF( sec%ll_ice_section )THEN
1326	SELECT CASE (sec%direction(jseg))
1327	CASE(0)
1328	zumid_ice = 0
1329	zvmid_ice = isgnv0.5(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
1330	CASE(1)
1331	zumid_ice = 0
1332	zvmid_ice = isgnv0.5(v_ice(k%I,k%J+1)+v_ice(k%I+1,k%J+1))
1333	CASE(2)
1334	zvmid_ice = 0
1335	zumid_ice = isgnu0.5(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
1336	CASE(3)
1337	zvmid_ice = 0
1338	zumid_ice = isgnu0.5(u_ice(k%I+1,k%J)+u_ice(k%I+1,k%J+1))
1339	END SELECT
1340
1341	zTnorm=zumid_icee2u(k%I,k%J)+zvmid_icee1v(k%I,k%J)
1342
1343	transports_2d_h(1,jsec,jseg) = transports_2d_h(1,jsec,jseg) + (zTnorm)* &
1344	(1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1345	*(hsnif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J) + &
1346	hicif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1347	+zice_vol_pos
1348	transports_2d_h(2,jsec,jseg) = transports_2d_h(2,jsec,jseg) + (zTnorm)* &
1349	(1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) &
1350	+zice_surf_pos
1351
1352	ENDIF !end of ice case
1353	#endif
1354
1355	ENDDO !end of loop on the segment
1356
1357	ENDIF !end of sec%nb_point =0 case
1358	!
1359	END SUBROUTINE transport_h
1360
1361	SUBROUTINE dia_dct_sum(sec,jsec)
1362	!!-------------------------------------------------------------
1363	!! Purpose: Average the transport over nn_dctwri time steps
1364	!! and sum over the density/salinity/temperature/depth classes
1365	!!
1366	!! Method: Sum over relevant grid cells to obtain values
1367	!! for each class
1368	!! There are several loops:
1369	!! loop on the segment between 2 nodes
1370	!! loop on the level jk
1371	!! loop on the density/temperature/salinity/level classes
1372	!! test on the density/temperature/salinity/level
1373	!!
1374	!! Note: Transport through a given section is equal to the sum of transports
1375	!! computed on each proc.
1376	!! On each proc,transport is equal to the sum of transport computed through
1377	!! segments linking each point of sec%listPoint with the next one.
1378	!!
1379	!!-------------------------------------------------------------
1380	!! * arguments
1381	TYPE(SECTION),INTENT(INOUT) :: sec
1382	INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section
1383
1384	TYPE(POINT_SECTION) :: k
1385	INTEGER :: jk,jseg,jclass ! dummy variables for looping on level/segment/classes
1386	REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
1387	!!-------------------------------------------------------------
1388
1389
1390	!! Sum the relevant segments to obtain values for each class
1391	IF(sec%nb_point .NE. 0)THEN
1392
1393	!--------------------------------------!
1394	! LOOP ON THE SEGMENT BETWEEN 2 NODES !
1395	!--------------------------------------!
1396	DO jseg=1,MAX(sec%nb_point-1,0)
1397
1398	!-------------------------------------------------------------------------------------------
1399	! Select the appropriate coordinate for computing the velocity of the segment
1400	!
1401	! CASE(0) Case (2)
1402	! ------- --------
1403	! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j)
1404	! F(i,j)----------V(i+1,j)-------F(i+1,j) \|
1405	! \|
1406	! \|
1407	! \|
1408	! Case (3) U(i,j)
1409	! -------- \|
1410	! \|
1411	! listPoint(jseg+1) F(i,j+1) \|
1412	! \| \|
1413	! \| \|
1414	! \| listPoint(jseg+1) F(i,j-1)
1415	! \|
1416	! \|
1417	! U(i,j+1)
1418	! \| Case(1)
1419	! \| ------
1420	! \|
1421	! \| listPoint(jseg+1) listPoint(jseg)
1422	! \| F(i-1,j)-----------V(i,j) -------f(jseg)
1423	! listPoint(jseg) F(i,j)
1424	!
1425	!-------------------------------------------------------------------------------------------
1426
1427	SELECT CASE( sec%direction(jseg) )
1428	CASE(0) ; k = sec%listPoint(jseg)
1429	CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
1430	CASE(2) ; k = sec%listPoint(jseg)
1431	CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
1432	END SELECT
1433
1434	!---------------------------\|
1435	! LOOP ON THE LEVEL \|
1436	!---------------------------\|
1437	!Sum of the transport on the vertical
1438	DO jk=1,mbathy(k%I,k%J)
1439
1440	! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
1441	SELECT CASE( sec%direction(jseg) )
1442	CASE(0,1)
1443	ztn = interp(k%I,k%J,jk,'V',0)
1444	zsn = interp(k%I,k%J,jk,'V',1)
1445	zrhop = interp(k%I,k%J,jk,'V',2)
1446	zrhoi = interp(k%I,k%J,jk,'V',3)
1447	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) vmask(k%I,k%J,1)
1448	CASE(2,3)
1449	ztn = interp(k%I,k%J,jk,'U',0)
1450	zsn = interp(k%I,k%J,jk,'U',1)
1451	zrhop = interp(k%I,k%J,jk,'U',2)
1452	zrhoi = interp(k%I,k%J,jk,'U',3)
1453	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) umask(k%I,k%J,1)
1454	END SELECT
1455
1456	zfsdep= fsdept(k%I,k%J,jk)
1457
1458	!-------------------------------
1459	! LOOP ON THE DENSITY CLASSES \|
1460	!-------------------------------
1461	!The computation is made for each density/temperature/salinity/depth class
1462	DO jclass=1,MAX(1,sec%nb_class-1)
1463
1464	!----------------------------------------------!
1465	!TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL!
1466	!----------------------------------------------!
1467
1468	IF ( ( &
1469	((( zrhop .GE. (sec%zsigp(jclass)+1000. )) .AND. &
1470	( zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR. &
1471	( sec%zsigp(jclass) .EQ. 99.)) .AND. &
1472
1473	((( zrhoi .GE. (sec%zsigi(jclass) + 1000. )) .AND. &
1474	( zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR. &
1475	( sec%zsigi(jclass) .EQ. 99.)) .AND. &
1476
1477	((( zsn .GT. sec%zsal(jclass)) .AND. &
1478	( zsn .LE. sec%zsal(jclass+1))) .OR. &
1479	( sec%zsal(jclass) .EQ. 99.)) .AND. &
1480
1481	((( ztn .GE. sec%ztem(jclass)) .AND. &
1482	( ztn .LE. sec%ztem(jclass+1))) .OR. &
1483	( sec%ztem(jclass) .EQ.99.)) .AND. &
1484
1485	((( zfsdep .GE. sec%zlay(jclass)) .AND. &
1486	( zfsdep .LE. sec%zlay(jclass+1))) .OR. &
1487	( sec%zlay(jclass) .EQ. 99. )) &
1488	)) THEN
1489
1490	!SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS
1491	!----------------------------------------------------------------------------
1492	IF (transports_3d(1,jsec,jseg,jk) .GE. 0.0) THEN
1493	sec%transport(1,jclass) = sec%transport(1,jclass)+transports_3d(1,jsec,jseg,jk)
1494	ELSE
1495	sec%transport(2,jclass) = sec%transport(2,jclass)+transports_3d(1,jsec,jseg,jk)
1496	ENDIF
1497	IF( sec%llstrpond )THEN
1498
1499	IF( transports_3d(1,jsec,jseg,jk) .NE. 0._wp ) THEN
1500
1501	IF (transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) .GE. 0.0 ) THEN
1502	sec%transport(3,jclass) = sec%transport(3,jclass)+transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk)
1503	ELSE
1504	sec%transport(4,jclass) = sec%transport(4,jclass)+transports_3d(2,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk)
1505	ENDIF
1506
1507	IF ( transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk) .GE. 0.0 ) THEN
1508	sec%transport(5,jclass) = sec%transport(5,jclass)+transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk)
1509	ELSE
1510	sec%transport(6,jclass) = sec%transport(6,jclass)+transports_3d(3,jsec,jseg,jk)/transports_3d(1,jsec,jseg,jk)
1511	ENDIF
1512
1513	ENDIF
1514
1515	IF ( transports_3d(4,jsec,jseg,jk) .GE. 0.0 ) THEN
1516	sec%transport(7,jclass) = sec%transport(7,jclass)+transports_3d(4,jsec,jseg,jk)
1517	ELSE
1518	sec%transport(8,jclass) = sec%transport(8,jclass)+transports_3d(4,jsec,jseg,jk)
1519	ENDIF
1520
1521	IF ( transports_3d(5,jsec,jseg,jk) .GE. 0.0 ) THEN
1522	sec%transport( 9,jclass) = sec%transport( 9,jclass)+transports_3d(5,jsec,jseg,jk)
1523	ELSE
1524	sec%transport(10,jclass) = sec%transport(10,jclass)+transports_3d(5,jsec,jseg,jk)
1525	ENDIF
1526
1527	ELSE
1528	sec%transport( 3,jclass) = 0._wp
1529	sec%transport( 4,jclass) = 0._wp
1530	sec%transport( 5,jclass) = 0._wp
1531	sec%transport( 6,jclass) = 0._wp
1532	sec%transport( 7,jclass) = 0._wp
1533	sec%transport( 8,jclass) = 0._wp
1534	sec%transport( 9,jclass) = 0._wp
1535	sec%transport(10,jclass) = 0._wp
1536	ENDIF
1537
1538	ENDIF ! end of test if point is in class
1539
1540	ENDDO ! end of loop on the classes
1541
1542	ENDDO ! loop over jk
1543
1544	#if defined key_lim2 \|\| defined key_lim3
1545
1546	!ICE CASE
1547	IF( sec%ll_ice_section )THEN
1548
1549	IF ( transports_2d(1,jsec,jseg) .GE. 0.0 ) THEN
1550	sec%transport(11,1) = sec%transport(11,1)+transports_2d(1,jsec,jseg)
1551	ELSE
1552	sec%transport(12,1) = sec%transport(12,1)+transports_2d(1,jsec,jseg)
1553	ENDIF
1554
1555	IF ( transports_2d(3,jsec,jseg) .GE. 0.0 ) THEN
1556	sec%transport(13,1) = sec%transport(13,1)+transports_2d(2,jsec,jseg)
1557	ELSE
1558	sec%transport(14,1) = sec%transport(14,1)+transports_2d(2,jsec,jseg)
1559	ENDIF
1560
1561	ENDIF !end of ice case
1562	#endif
1563
1564	ENDDO !end of loop on the segment
1565
1566	ELSE !if sec%nb_point =0
1567	sec%transport(1:2,:)=0.
1568	IF (sec%llstrpond) sec%transport(3:10,:)=0.
1569	IF (sec%ll_ice_section) sec%transport( 11:14,:)=0.
1570	ENDIF !end of sec%nb_point =0 case
1571
1572	END SUBROUTINE dia_dct_sum
1573
1574	SUBROUTINE dia_dct_sum_h(sec,jsec)
1575	!!-------------------------------------------------------------
1576	!! Exactly as dia_dct_sum but for hourly files containing data summed at each time step
1577	!!
1578	!! Purpose: Average the transport over nn_dctwri time steps
1579	!! and sum over the density/salinity/temperature/depth classes
1580	!!
1581	!! Method:
1582	!! Sum over relevant grid cells to obtain values
1583	!! for each
1584	!! There are several loops:
1585	!! loop on the segment between 2 nodes
1586	!! loop on the level jk
1587	!! loop on the density/temperature/salinity/level classes
1588	!! test on the density/temperature/salinity/level
1589	!!
1590	!! ** Method :Transport through a given section is equal to the sum of transports
1591	!! computed on each proc.
1592	!! On each proc,transport is equal to the sum of transport computed through
1593	!! segments linking each point of sec%listPoint with the next one.
1594	!!
1595	!!-------------------------------------------------------------
1596	!! * arguments
1597	TYPE(SECTION),INTENT(INOUT) :: sec
1598	INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section
1599
1600	TYPE(POINT_SECTION) :: k
1601	INTEGER :: jk,jseg,jclass !loop on level/segment/classes
1602	REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zfsdep ! temperature/salinity/ssh/potential density /depth at u/v point
1603	!!-------------------------------------------------------------
1604
1605	!! Sum the relevant segments to obtain values for each class
1606	IF(sec%nb_point .NE. 0)THEN
1607
1608	!--------------------------------------!
1609	! LOOP ON THE SEGMENT BETWEEN 2 NODES !
1610	!--------------------------------------!
1611	DO jseg=1,MAX(sec%nb_point-1,0)
1612
1613	!-------------------------------------------------------------------------------------------
1614	! Select the appropriate coordinate for computing the velocity of the segment
1615	!
1616	! CASE(0) Case (2)
1617	! ------- --------
1618	! listPoint(jseg) listPoint(jseg+1) listPoint(jseg) F(i,j)
1619	! F(i,j)----------V(i+1,j)-------F(i+1,j) \|
1620	! \|
1621	! \|
1622	! \|
1623	! Case (3) U(i,j)
1624	! -------- \|
1625	! \|
1626	! listPoint(jseg+1) F(i,j+1) \|
1627	! \| \|
1628	! \| \|
1629	! \| listPoint(jseg+1) F(i,j-1)
1630	! \|
1631	! \|
1632	! U(i,j+1)
1633	! \| Case(1)
1634	! \| ------
1635	! \|
1636	! \| listPoint(jseg+1) listPoint(jseg)
1637	! \| F(i-1,j)-----------V(i,j) -------f(jseg)
1638	! listPoint(jseg) F(i,j)
1639	!
1640	!-------------------------------------------------------------------------------------------
1641
1642	SELECT CASE( sec%direction(jseg) )
1643	CASE(0) ; k = sec%listPoint(jseg)
1644	CASE(1) ; k = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
1645	CASE(2) ; k = sec%listPoint(jseg)
1646	CASE(3) ; k = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
1647	END SELECT
1648
1649	!---------------------------\|
1650	! LOOP ON THE LEVEL \|
1651	!---------------------------\|
1652	!Sum of the transport on the vertical
1653	DO jk=1,mbathy(k%I,k%J)
1654
1655	! compute temperature, salinity, insitu & potential density, ssh and depth at U/V point
1656	SELECT CASE( sec%direction(jseg) )
1657	CASE(0,1)
1658	ztn = interp(k%I,k%J,jk,'V',0)
1659	zsn = interp(k%I,k%J,jk,'V',1)
1660	zrhop = interp(k%I,k%J,jk,'V',2)
1661	zrhoi = interp(k%I,k%J,jk,'V',3)
1662	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I,k%J+1) ) vmask(k%I,k%J,1)
1663	CASE(2,3)
1664	ztn = interp(k%I,k%J,jk,'U',0)
1665	zsn = interp(k%I,k%J,jk,'U',1)
1666	zrhop = interp(k%I,k%J,jk,'U',2)
1667	zrhoi = interp(k%I,k%J,jk,'U',3)
1668	zsshn = 0.5( sshn(k%I,k%J) + sshn(k%I+1,k%J) ) umask(k%I,k%J,1)
1669	END SELECT
1670
1671	zfsdep= fsdept(k%I,k%J,jk)
1672
1673	!-------------------------------
1674	! LOOP ON THE DENSITY CLASSES \|
1675	!-------------------------------
1676	!The computation is made for each density/heat/salt/... class
1677	DO jclass=1,MAX(1,sec%nb_class-1)
1678
1679	!----------------------------------------------!
1680	!TEST ON THE DENSITY/SALINITY/TEMPERATURE/LEVEL!
1681	!----------------------------------------------!
1682
1683	IF ( ( &
1684	((( zrhop .GE. (sec%zsigp(jclass)+1000. )) .AND. &
1685	( zrhop .LE. (sec%zsigp(jclass+1)+1000. ))) .OR. &
1686	( sec%zsigp(jclass) .EQ. 99.)) .AND. &
1687
1688	((( zrhoi .GE. (sec%zsigi(jclass) + 1000. )) .AND. &
1689	( zrhoi .LE. (sec%zsigi(jclass+1)+1000. ))) .OR. &
1690	( sec%zsigi(jclass) .EQ. 99.)) .AND. &
1691
1692	((( zsn .GT. sec%zsal(jclass)) .AND. &
1693	( zsn .LE. sec%zsal(jclass+1))) .OR. &
1694	( sec%zsal(jclass) .EQ. 99.)) .AND. &
1695
1696	((( ztn .GE. sec%ztem(jclass)) .AND. &
1697	( ztn .LE. sec%ztem(jclass+1))) .OR. &
1698	( sec%ztem(jclass) .EQ.99.)) .AND. &
1699
1700	((( zfsdep .GE. sec%zlay(jclass)) .AND. &
1701	( zfsdep .LE. sec%zlay(jclass+1))) .OR. &
1702	( sec%zlay(jclass) .EQ. 99. )) &
1703	)) THEN
1704
1705	!SUM THE TRANSPORTS FOR EACH CLASSES FOR THE POSITIVE AND NEGATIVE DIRECTIONS
1706	!----------------------------------------------------------------------------
1707	IF (transports_3d_h(1,jsec,jseg,jk) .GE. 0.0) THEN
1708	sec%transport_h(1,jclass) = sec%transport_h(1,jclass)+transports_3d_h(1,jsec,jseg,jk)
1709	ELSE
1710	sec%transport_h(2,jclass) = sec%transport_h(2,jclass)+transports_3d_h(1,jsec,jseg,jk)
1711	ENDIF
1712	IF( sec%llstrpond )THEN
1713
1714	IF( transports_3d_h(1,jsec,jseg,jk) .NE. 0._wp ) THEN
1715
1716	IF (transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) .GE. 0.0 ) THEN
1717	sec%transport_h(3,jclass) = sec%transport_h(3,jclass)+transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk)
1718	ELSE
1719	sec%transport_h(4,jclass) = sec%transport_h(4,jclass)+transports_3d_h(2,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk)
1720	ENDIF
1721
1722	IF ( transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk) .GE. 0.0 ) THEN
1723	sec%transport_h(5,jclass) = sec%transport_h(5,jclass)+transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk)
1724	ELSE
1725	sec%transport_h(6,jclass) = sec%transport_h(6,jclass)+transports_3d_h(3,jsec,jseg,jk)/transports_3d_h(1,jsec,jseg,jk)
1726	ENDIF
1727
1728	ENDIF
1729
1730	IF ( transports_3d_h(4,jsec,jseg,jk) .GE. 0.0 ) THEN
1731	sec%transport_h(7,jclass) = sec%transport_h(7,jclass)+transports_3d_h(4,jsec,jseg,jk)
1732	ELSE
1733	sec%transport_h(8,jclass) = sec%transport_h(8,jclass)+transports_3d_h(4,jsec,jseg,jk)
1734	ENDIF
1735
1736	IF ( transports_3d_h(5,jsec,jseg,jk) .GE. 0.0 ) THEN
1737	sec%transport_h( 9,jclass) = sec%transport_h( 9,jclass)+transports_3d_h(5,jsec,jseg,jk)
1738	ELSE
1739	sec%transport_h(10,jclass) = sec%transport_h(10,jclass)+transports_3d_h(5,jsec,jseg,jk)
1740	ENDIF
1741
1742	ELSE
1743	sec%transport_h( 3,jclass) = 0._wp
1744	sec%transport_h( 4,jclass) = 0._wp
1745	sec%transport_h( 5,jclass) = 0._wp
1746	sec%transport_h( 6,jclass) = 0._wp
1747	sec%transport_h( 7,jclass) = 0._wp
1748	sec%transport_h( 8,jclass) = 0._wp
1749	sec%transport_h( 9,jclass) = 0._wp
1750	sec%transport_h(10,jclass) = 0._wp
1751	ENDIF
1752
1753	ENDIF ! end of test if point is in class
1754
1755	ENDDO ! end of loop on the classes
1756
1757	ENDDO ! loop over jk
1758
1759	#if defined key_lim2 \|\| defined key_lim3
1760
1761	!ICE CASE
1762	IF( sec%ll_ice_section )THEN
1763
1764	IF ( transports_2d_h(1,jsec,jseg) .GE. 0.0 ) THEN
1765	sec%transport_h(11,1) = sec%transport_h(11,1)+transports_2d_h(1,jsec,jseg)
1766	ELSE
1767	sec%transport_h(12,1) = sec%transport_h(12,1)+transports_2d_h(1,jsec,jseg)
1768	ENDIF
1769
1770	IF ( transports_2d_h(3,jsec,jseg) .GE. 0.0 ) THEN
1771	sec%transport_h(13,1) = sec%transport_h(13,1)+transports_2d_h(2,jsec,jseg)
1772	ELSE
1773	sec%transport_h(14,1) = sec%transport_h(14,1)+transports_2d_h(2,jsec,jseg)
1774	ENDIF
1775
1776	ENDIF !end of ice case
1777	#endif
1778
1779	ENDDO !end of loop on the segment
1780
1781	ELSE !if sec%nb_point =0
1782	sec%transport_h(1:2,:)=0.
1783	IF (sec%llstrpond) sec%transport_h(3:10,:)=0.
1784	IF (sec%ll_ice_section) sec%transport_h( 11:14,:)=0.
1785	ENDIF !end of sec%nb_point =0 case
1786
1787	END SUBROUTINE dia_dct_sum_h
1788
1789	SUBROUTINE dia_dct_wri_NOOS(kt,ksec,sec)
1790	!!-------------------------------------------------------------
1791	!! Write transport output in numdct using NOOS formatting
1792	!!
1793	!! Purpose: Write transports in ascii files
1794	!!
1795	!! Method:
1796	!! 1. Write volume transports in "volume_transport"
1797	!! Unit: Sv : area * Velocity / 1.e6
1798	!!
1799	!! 2. Write heat transports in "heat_transport"
1800	!! Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15
1801	!!
1802	!! 3. Write salt transports in "salt_transport"
1803	!! Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
1804	!!
1805	!!-------------------------------------------------------------
1806	!!arguments
1807	INTEGER, INTENT(IN) :: kt ! time-step
1808	TYPE(SECTION), INTENT(INOUT) :: sec ! section to write
1809	INTEGER ,INTENT(IN) :: ksec ! section number
1810
1811	!!local declarations
1812	INTEGER :: jclass,ji ! Dummy loop
1813	CHARACTER(len=2) :: classe ! Classname
1814	REAL(wp) :: zbnd1,zbnd2 ! Class bounds
1815	REAL(wp) :: zslope ! section's slope coeff
1816	!
1817	REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace
1818	CHARACTER(len=3) :: noos_sect_name ! Classname
1819	CHARACTER(len=25) :: noos_var_sect_name
1820	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: noos_iom_dummy
1821	INTEGER :: IERR
1822
1823	REAL(wp), DIMENSION(3) :: tmp_iom_output
1824	REAL(wp) :: max_iom_val
1825
1826	!!-------------------------------------------------------------
1827
1828
1829
1830	IF( lwp ) THEN
1831	WRITE(numout,*) " "
1832	WRITE(numout,*) "dia_dct_wri_NOOS: write transports through sections at timestep: ", kt
1833	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
1834	ENDIF
1835
1836	CALL wrk_alloc(nb_type_class , zsumclasses )
1837
1838	zsumclasses(:)=0._wp
1839	zslope = sec%slopeSection
1840
1841	IF( lwp ) THEN
1842	IF ( ln_dct_ascii ) THEN
1843	WRITE(numdct_NOOS,'(I4,a1,I2,a1,I2,a12,i3,a17,i3,a10,a25)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1,' Name: ',sec%name
1844	ELSE
1845	WRITE(numdct_NOOS) nyear,nmonth,nday,ksec-1,sec%nb_class-1,sec%name
1846	ENDIF
1847	ENDIF
1848
1849	! Sum all classes together, to give one values per type (pos tran, neg vol trans etc...).
1850	DO jclass=1,MAX(1,sec%nb_class-1)
1851	zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
1852	ENDDO
1853
1854	classe = 'total '
1855	zbnd1 = 0._wp
1856	zbnd2 = 0._wp
1857
1858
1859
1860	write (noos_sect_name, "(I0.3)") ksec
1861
1862	IF ( ln_dct_iom_cont ) THEN
1863	max_iom_val = 1.e10
1864	ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr )
1865	IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS: failed to allocate noos_iom_dummy array' )
1866	ENDIF
1867
1868	! JT I think changing the sign on the output based on the zslope value is redunant.
1869	!
1870	! IF ( zslope .gt. 0._wp .and. zslope .ne. 10000._wp ) THEN
1871	!
1872	! IF( lwp ) THEN
1873	! WRITE(numdct_NOOS,'(9e12.4E2)') -(zsumclasses( 1)+zsumclasses( 2)), -zsumclasses( 2),-zsumclasses( 1), &
1874	! -(zsumclasses( 7)+zsumclasses( 8)), -zsumclasses( 8),-zsumclasses( 7), &
1875	! -(zsumclasses( 9)+zsumclasses(10)), -zsumclasses(10),-zsumclasses( 9)
1876	! CALL FLUSH(numdct_NOOS)
1877	! endif
1878
1879	!
1880	! IF ( ln_dct_iom_cont ) THEN
1881	!
1882	! noos_iom_dummy(:,:,:) = 0.
1883	!
1884	! tmp_iom_output(:) = 0.
1885	! tmp_iom_output(1) = -(zsumclasses( 1)+zsumclasses( 2))
1886	! tmp_iom_output(2) = -zsumclasses( 2)
1887	! tmp_iom_output(3) = -zsumclasses( 1)
1888	!
1889	! ! Convert to Sv
1890	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
1891	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
1892	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
1893	!
1894	! ! limit maximum and minimum values in iom_put
1895	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
1896	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
1897	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
1898	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
1899	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
1900	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
1901	!
1902	! ! Set NaN's to Zero
1903	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
1904	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
1905	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
1906	!
1907	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
1908	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
1909	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
1910	!
1911	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans'
1912	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
1913	! CALL iom_put( noos_var_sect_name, noos_iom_dummy )
1914	! noos_iom_dummy(:,:,:) = 0.
1915	! tmp_iom_output(:) = 0.
1916	! tmp_iom_output(1) = -(zsumclasses( 7)+zsumclasses( 8))
1917	! tmp_iom_output(2) = -zsumclasses( 8)
1918	! tmp_iom_output(3) = -zsumclasses( 7)
1919	!
1920	! ! Convert to TJ/s
1921	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12
1922	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12
1923	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12
1924	!
1925	! ! limit maximum and minimum values in iom_put
1926	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
1927	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
1928	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
1929	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
1930	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
1931	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
1932	!
1933	! ! Set NaN's to Zero
1934	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
1935	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
1936	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
1937	!
1938	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
1939	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
1940	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
1941	!
1942	! !noos_iom_dummy(:,:,1) = -(zsumclasses( 7)+zsumclasses( 8))
1943	! !noos_iom_dummy(:,:,2) = -zsumclasses( 8)
1944	! !noos_iom_dummy(:,:,3) = -zsumclasses( 7)
1945	!
1946	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat'
1947	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
1948	! CALL iom_put( noos_var_sect_name, noos_iom_dummy )
1949	!
1950	! noos_iom_dummy(:,:,:) = 0.
1951	! tmp_iom_output(:) = 0.
1952	! tmp_iom_output(1) = -(zsumclasses( 9)+zsumclasses( 10))
1953	! tmp_iom_output(2) = -zsumclasses( 10)
1954	! tmp_iom_output(3) = -zsumclasses( 9)
1955	!
1956	! ! Convert to MT/s
1957	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
1958	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
1959	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
1960	!
1961	! ! limit maximum and minimum values in iom_put
1962	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
1963	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
1964	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
1965	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
1966	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
1967	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
1968	!
1969	! ! Set NaN's to Zero
1970	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
1971	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
1972	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
1973	!
1974	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
1975	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
1976	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
1977	!
1978	! !noos_iom_dummy(:,:,1) = -(zsumclasses( 9)+zsumclasses( 10))
1979	! !noos_iom_dummy(:,:,2) = -zsumclasses( 10)
1980	! !noos_iom_dummy(:,:,3) = -zsumclasses( 9)
1981	!
1982	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt'
1983	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
1984	! CALL iom_put( noos_var_sect_name, noos_iom_dummy )
1985	! noos_iom_dummy(:,:,:) = 0.
1986	! tmp_iom_output(:) = 0.
1987	! ENDIF
1988	! ELSE
1989	! IF( lwp ) THEN
1990	! WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), &
1991	! zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), &
1992	! zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10)
1993	! CALL FLUSH(numdct_NOOS)
1994	! endif
1995	!
1996	!
1997	! IF ( ln_dct_iom_cont ) THEN
1998	!
1999	! noos_iom_dummy(:,:,:) = 0.
2000	! tmp_iom_output(:) = 0.
2001	!
2002	! tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2))
2003	! tmp_iom_output(2) = zsumclasses( 1)
2004	! tmp_iom_output(3) = zsumclasses( 2)
2005	!
2006	! ! Convert to Sv
2007	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
2008	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
2009	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
2010	!
2011	! ! limit maximum and minimum values in iom_put
2012	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2013	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2014	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2015	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2016	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2017	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2018	!
2019	! ! Set NaN's to Zero
2020	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2021	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2022	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2023	!
2024	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2025	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2026	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2027	!
2028	! !noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2))
2029	! !noos_iom_dummy(:,:,2) = zsumclasses( 1)
2030	! !noos_iom_dummy(:,:,3) = zsumclasses( 2)
2031	!
2032	!
2033	!
2034	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans'
2035	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2036	! CALL iom_put( noos_var_sect_name, noos_iom_dummy )
2037	! noos_iom_dummy(:,:,:) = 0.
2038	! tmp_iom_output(:) = 0.
2039	!
2040	! tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8))
2041	! tmp_iom_output(2) = zsumclasses( 7)
2042	! tmp_iom_output(3) = zsumclasses( 8)
2043	!
2044	! ! Convert to TJ/s
2045	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-12
2046	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-12
2047	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-12
2048	!
2049	! ! limit maximum and minimum values in iom_put
2050	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2051	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2052	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2053	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2054	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2055	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2056	!
2057	! ! Set NaN's to Zero
2058	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2059	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2060	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2061	!
2062	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2063	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2064	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2065	!
2066	! !noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8))
2067	! !noos_iom_dummy(:,:,2) = zsumclasses( 7)
2068	! !noos_iom_dummy(:,:,3) = zsumclasses( 8)
2069	!
2070	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat'
2071	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2072	! CALL iom_put(noos_var_sect_name, noos_iom_dummy )
2073	! noos_iom_dummy(:,:,:) = 0.
2074	! tmp_iom_output(:) = 0.
2075	!
2076	! tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10))
2077	! tmp_iom_output(2) = zsumclasses( 9)
2078	! tmp_iom_output(3) = zsumclasses( 10)
2079	!
2080	! ! Convert to MT/s
2081	! tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
2082	! tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
2083	! tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
2084	!
2085	!
2086	! ! limit maximum and minimum values in iom_put
2087	! if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2088	! if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2089	! if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2090	! if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2091	! if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2092	! if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2093	!
2094	! ! Set NaN's to Zero
2095	! if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2096	! if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2097	! if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2098	!
2099	! noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2100	! noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2101	! noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2102	!
2103	! !noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10))
2104	! !noos_iom_dummy(:,:,2) = zsumclasses( 9)
2105	! !noos_iom_dummy(:,:,3) = zsumclasses( 10)
2106	!
2107	! noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt'
2108	! if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2109	! CALL iom_put(noos_var_sect_name, noos_iom_dummy )
2110	! noos_iom_dummy(:,:,:) = 0.
2111	! tmp_iom_output(:) = 0.
2112	! ENDIF
2113	!
2114	! ENDIF
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125	IF( lwp ) THEN
2126	IF ( ln_dct_ascii ) THEN
2127	!WRITE(numdct_NOOS,'(9e12.4E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), &
2128	WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), &
2129	zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), &
2130	zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10)
2131	CALL FLUSH(numdct_NOOS)
2132	ELSE
2133	WRITE(numdct_NOOS) zsumclasses( 1)+zsumclasses( 2) , zsumclasses( 1), zsumclasses( 2), &
2134	zsumclasses( 7)+zsumclasses( 8) , zsumclasses( 7), zsumclasses( 8), &
2135	zsumclasses( 9)+zsumclasses(10) , zsumclasses( 9), zsumclasses(10)
2136	CALL FLUSH(numdct_NOOS)
2137	ENDIF
2138	ENDIF
2139
2140	IF ( ln_dct_iom_cont ) THEN
2141
2142	noos_iom_dummy(:,:,:) = 0.
2143	tmp_iom_output(:) = 0.
2144
2145	tmp_iom_output(1) = (zsumclasses( 1)+zsumclasses( 2))
2146	tmp_iom_output(2) = zsumclasses( 1)
2147	tmp_iom_output(3) = zsumclasses( 2)
2148
2149	! Convert to Sv
2150	tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
2151	tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
2152	tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
2153
2154	! limit maximum and minimum values in iom_put
2155	if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2156	if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2157	if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2158	if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2159	if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2160	if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2161
2162	! Set NaN's to Zero
2163	if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2164	if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2165	if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2166
2167	noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2168	noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2169	noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2170
2171	!noos_iom_dummy(:,:,1) = (zsumclasses( 1)+zsumclasses( 2))
2172	!noos_iom_dummy(:,:,2) = zsumclasses( 1)
2173	!noos_iom_dummy(:,:,3) = zsumclasses( 2)
2174
2175
2176
2177	noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_trans'
2178	if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2179	CALL iom_put( noos_var_sect_name, noos_iom_dummy )
2180	noos_iom_dummy(:,:,:) = 0.
2181	tmp_iom_output(:) = 0.
2182
2183	tmp_iom_output(1) = (zsumclasses( 7)+zsumclasses( 8))
2184	tmp_iom_output(2) = zsumclasses( 7)
2185	tmp_iom_output(3) = zsumclasses( 8)
2186
2187	! Convert to TJ/s
2188	tmp_iom_output(1) = tmp_iom_output(1)*1.E-12
2189	tmp_iom_output(2) = tmp_iom_output(2)*1.E-12
2190	tmp_iom_output(3) = tmp_iom_output(3)*1.E-12
2191
2192	! limit maximum and minimum values in iom_put
2193	if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2194	if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2195	if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2196	if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2197	if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2198	if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2199
2200	! Set NaN's to Zero
2201	if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2202	if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2203	if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2204
2205	noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2206	noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2207	noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2208
2209	!noos_iom_dummy(:,:,1) = (zsumclasses( 7)+zsumclasses( 8))
2210	!noos_iom_dummy(:,:,2) = zsumclasses( 7)
2211	!noos_iom_dummy(:,:,3) = zsumclasses( 8)
2212
2213	noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_heat'
2214	if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2215	CALL iom_put(noos_var_sect_name, noos_iom_dummy )
2216	noos_iom_dummy(:,:,:) = 0.
2217	tmp_iom_output(:) = 0.
2218
2219	tmp_iom_output(1) = (zsumclasses( 9)+zsumclasses( 10))
2220	tmp_iom_output(2) = zsumclasses( 9)
2221	tmp_iom_output(3) = zsumclasses( 10)
2222
2223	! Convert to MT/s
2224	tmp_iom_output(1) = tmp_iom_output(1)*1.E-6
2225	tmp_iom_output(2) = tmp_iom_output(2)*1.E-6
2226	tmp_iom_output(3) = tmp_iom_output(3)*1.E-6
2227
2228
2229	! limit maximum and minimum values in iom_put
2230	if ( tmp_iom_output(1) .gt. max_iom_val ) tmp_iom_output(1) = max_iom_val
2231	if ( tmp_iom_output(1) .lt. -max_iom_val ) tmp_iom_output(1) = -max_iom_val
2232	if ( tmp_iom_output(2) .gt. max_iom_val ) tmp_iom_output(2) = max_iom_val
2233	if ( tmp_iom_output(2) .lt. -max_iom_val ) tmp_iom_output(2) = -max_iom_val
2234	if ( tmp_iom_output(3) .gt. max_iom_val ) tmp_iom_output(3) = max_iom_val
2235	if ( tmp_iom_output(3) .lt. -max_iom_val ) tmp_iom_output(3) = -max_iom_val
2236
2237	! Set NaN's to Zero
2238	if ( tmp_iom_output(1) .ne. tmp_iom_output(1) ) tmp_iom_output(1) = max_iom_val*2
2239	if ( tmp_iom_output(2) .ne. tmp_iom_output(2) ) tmp_iom_output(1) = max_iom_val*2
2240	if ( tmp_iom_output(3) .ne. tmp_iom_output(3) ) tmp_iom_output(1) = max_iom_val*2
2241
2242	noos_iom_dummy(:,:,1) = tmp_iom_output(1)
2243	noos_iom_dummy(:,:,2) = tmp_iom_output(2)
2244	noos_iom_dummy(:,:,3) = tmp_iom_output(3)
2245
2246	!noos_iom_dummy(:,:,1) = (zsumclasses( 9)+zsumclasses( 10))
2247	!noos_iom_dummy(:,:,2) = zsumclasses( 9)
2248	!noos_iom_dummy(:,:,3) = zsumclasses( 10)
2249
2250	noos_var_sect_name = "noos_" // trim(noos_sect_name) // '_salt'
2251	if ( lwp ) WRITE(numout,*) 'dia_dct_wri_NOOS iom_put: ', kt,ksec, noos_var_sect_name
2252	CALL iom_put(noos_var_sect_name, noos_iom_dummy )
2253	noos_iom_dummy(:,:,:) = 0.
2254	tmp_iom_output(:) = 0.
2255
2256
2257	DEALLOCATE(noos_iom_dummy)
2258	ENDIF
2259
2260
2261	DO jclass=1,MAX(1,sec%nb_class-1)
2262
2263	classe = 'N '
2264	zbnd1 = 0._wp
2265	zbnd2 = 0._wp
2266
2267	!insitu density classes transports
2268	IF( ( sec%zsigi(jclass) .NE. 99._wp ) .AND. &
2269	( sec%zsigi(jclass+1) .NE. 99._wp ) )THEN
2270	classe = 'DI '
2271	zbnd1 = sec%zsigi(jclass)
2272	zbnd2 = sec%zsigi(jclass+1)
2273	ENDIF
2274	!potential density classes transports
2275	IF( ( sec%zsigp(jclass) .NE. 99._wp ) .AND. &
2276	( sec%zsigp(jclass+1) .NE. 99._wp ) )THEN
2277	classe = 'DP '
2278	zbnd1 = sec%zsigp(jclass)
2279	zbnd2 = sec%zsigp(jclass+1)
2280	ENDIF
2281	!depth classes transports
2282	IF( ( sec%zlay(jclass) .NE. 99._wp ) .AND. &
2283	( sec%zlay(jclass+1) .NE. 99._wp ) )THEN
2284	classe = 'Z '
2285	zbnd1 = sec%zlay(jclass)
2286	zbnd2 = sec%zlay(jclass+1)
2287	ENDIF
2288	!salinity classes transports
2289	IF( ( sec%zsal(jclass) .NE. 99._wp ) .AND. &
2290	( sec%zsal(jclass+1) .NE. 99._wp ) )THEN
2291	classe = 'S '
2292	zbnd1 = sec%zsal(jclass)
2293	zbnd2 = sec%zsal(jclass+1)
2294	ENDIF
2295	!temperature classes transports
2296	IF( ( sec%ztem(jclass) .NE. 99._wp ) .AND. &
2297	( sec%ztem(jclass+1) .NE. 99._wp ) ) THEN
2298	classe = 'T '
2299	zbnd1 = sec%ztem(jclass)
2300	zbnd2 = sec%ztem(jclass+1)
2301	ENDIF
2302
2303	!write volume transport per class
2304	IF( lwp ) THEN
2305
2306	IF ( ln_dct_ascii ) THEN
2307	CALL FLUSH(numdct_NOOS)
2308
2309	!WRITE(numdct_NOOS,'(9e12.4E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), &
2310	! sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), &
2311	! sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass)
2312	WRITE(numdct_NOOS,'(3F18.3,6e16.8E2)') sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), &
2313	sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), &
2314	sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass)
2315	ELSE
2316
2317	CALL FLUSH(numdct_NOOS)
2318	WRITE(numdct_NOOS) sec%transport( 1,jclass)+sec%transport( 2,jclass) , sec%transport( 1,jclass), sec%transport( 2,jclass), &
2319	sec%transport( 7,jclass)+sec%transport( 8,jclass) , sec%transport( 7,jclass), sec%transport( 8,jclass), &
2320	sec%transport( 9,jclass)+sec%transport(10,jclass) , sec%transport( 9,jclass), sec%transport(10,jclass)
2321	ENDIF
2322	ENDIF
2323
2324	ENDDO
2325
2326	!IF ( ln_dct_ascii ) THEN
2327	if ( lwp ) CALL FLUSH(numdct_NOOS)
2328	!ENDIF
2329
2330	CALL wrk_dealloc(nb_type_class , zsumclasses )
2331
2332	END SUBROUTINE dia_dct_wri_NOOS
2333
2334	SUBROUTINE dia_dct_wri_NOOS_h(hr,ksec,sec)
2335	!!-------------------------------------------------------------
2336	!! As routine dia_dct_wri_NOOS but for hourly output files
2337	!!
2338	!! Write transport output in numdct using NOOS formatting
2339	!!
2340	!! Purpose: Write transports in ascii files
2341	!!
2342	!! Method:
2343	!! 1. Write volume transports in "volume_transport"
2344	!! Unit: Sv : area * Velocity / 1.e6
2345	!!
2346	!!-------------------------------------------------------------
2347	!!arguments
2348	INTEGER, INTENT(IN) :: hr ! hour => effectively kt/12
2349	TYPE(SECTION), INTENT(INOUT) :: sec ! section to write
2350	INTEGER ,INTENT(IN) :: ksec ! section number
2351
2352	!!local declarations
2353	INTEGER :: jclass,jhr ! Dummy loop
2354	CHARACTER(len=2) :: classe ! Classname
2355	REAL(wp) :: zbnd1,zbnd2 ! Class bounds
2356	REAL(wp) :: zslope ! section's slope coeff
2357	!
2358	REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace
2359	CHARACTER(len=3) :: noos_sect_name ! Classname
2360	CHARACTER(len=25) :: noos_var_sect_name
2361	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: noos_iom_dummy
2362	INTEGER :: IERR
2363
2364	!!-------------------------------------------------------------
2365
2366	IF( lwp ) THEN
2367	WRITE(numout,*) " "
2368	WRITE(numout,*) "dia_dct_wri_NOOS_h: write transports through section Transect:",ksec-1," at timestep: ", hr
2369	WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~"
2370	ENDIF
2371
2372	CALL wrk_alloc(nb_type_class , zsumclasses )
2373
2374
2375	write (noos_sect_name, "(I03)") ksec
2376
2377	ALLOCATE( noos_iom_dummy(jpi,jpj,3), STAT= ierr )
2378	IF( ierr /= 0 ) CALL ctl_stop( 'dia_dct_wri_NOOS_h: failed to allocate noos_iom_dummy array' )
2379
2380
2381
2382
2383
2384	zsumclasses(:)=0._wp
2385	zslope = sec%slopeSection
2386
2387	! Sum up all classes, to give the total per type (pos vol trans, neg vol trans etc...)
2388	DO jclass=1,MAX(1,sec%nb_class-1)
2389	zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport_h(1:nb_type_class,jclass)
2390	ENDDO
2391
2392
2393	! JT I think changing the sign of output according to the zslope is redundant
2394
2395	!write volume transport per class
2396	! Sum positive and vol trans for all classes in first cell of array
2397
2398	z_hr_output(ksec,1,1)= (zsumclasses(1)+zsumclasses(2))
2399	z_hr_output(ksec,2,1)= zsumclasses(1)
2400	z_hr_output(ksec,3,1)= zsumclasses(2)
2401
2402	! Sum positive and vol trans for each classes in following cell of array
2403	DO jclass=1,MAX(1,sec%nb_class-1)
2404	z_hr_output(ksec,1,jclass+1)= (sec%transport_h(1,jclass)+sec%transport_h(2,jclass))
2405	z_hr_output(ksec,2,jclass+1)= sec%transport_h(1,jclass)
2406	z_hr_output(ksec,3,jclass+1)= sec%transport_h(2,jclass)
2407	ENDDO
2408
2409
2410	IF( lwp ) THEN
2411	! JT IF ( hr .eq. 48._wp ) THEN
2412	! JT WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1
2413	! JT DO jhr=25,48
2414	! JT WRITE(numdct_NOOS_h,'(11F12.1)') z_hr_output(ksec,jhr,1), (z_hr_output(ksec,jhr,jclass+1), jclass=1,MAX(1,10) )
2415	! JT ENDDO
2416	! JT ENDIF
2417
2418
2419
2420	IF ( ln_dct_ascii ) THEN
2421	WRITE(numdct_NOOS_h,'(I4,a1,I2,a1,I2,a1,I2,a1,I2,a12,i3,a17,i3)') nyear,'.',nmonth,'.',nday,'.',MOD(hr,24),'.',0,' Transect:',ksec-1,' No. of layers:',sec%nb_class-1
2422	WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) )
2423	WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) )
2424	WRITE(numdct_NOOS_h,'(11F18.3)') z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) )
2425	CALL FLUSH(numdct_NOOS_h)
2426	ELSE
2427	WRITE(numdct_NOOS_h) nyear,nmonth,nday,MOD(hr,24),ksec-1,sec%nb_class-1
2428	WRITE(numdct_NOOS_h) z_hr_output(ksec,1,1), (z_hr_output(ksec,1,jclass+1), jclass=1,MAX(1,10) )
2429	WRITE(numdct_NOOS_h) z_hr_output(ksec,2,1), (z_hr_output(ksec,2,jclass+1), jclass=1,MAX(1,10) )
2430	WRITE(numdct_NOOS_h) z_hr_output(ksec,3,1), (z_hr_output(ksec,3,jclass+1), jclass=1,MAX(1,10) )
2431	CALL FLUSH(numdct_NOOS_h)
2432	ENDIF
2433
2434
2435	ENDIF
2436
2437
2438	CALL wrk_dealloc(nb_type_class , zsumclasses )
2439
2440	DEALLOCATE(noos_iom_dummy)
2441
2442
2443
2444	END SUBROUTINE dia_dct_wri_NOOS_h
2445
2446	SUBROUTINE dia_dct_wri(kt,ksec,sec)
2447	!!-------------------------------------------------------------
2448	!! Write transport output in numdct
2449	!!
2450	!! Purpose: Write transports in ascii files
2451	!!
2452	!! Method:
2453	!! 1. Write volume transports in "volume_transport"
2454	!! Unit: Sv : area * Velocity / 1.e6
2455	!!
2456	!! 2. Write heat transports in "heat_transport"
2457	!! Unit: Peta W : area * Velocity * T * rhau * Cp / 1.e15
2458	!!
2459	!! 3. Write salt transports in "salt_transport"
2460	!! Unit: 10^9 g m^3 / s : area * Velocity * S / 1.e6
2461	!!
2462	!!-------------------------------------------------------------
2463	!!arguments
2464	INTEGER, INTENT(IN) :: kt ! time-step
2465	TYPE(SECTION), INTENT(INOUT) :: sec ! section to write
2466	INTEGER ,INTENT(IN) :: ksec ! section number
2467
2468	!!local declarations
2469	INTEGER :: jclass ! Dummy loop
2470	CHARACTER(len=2) :: classe ! Classname
2471	REAL(wp) :: zbnd1,zbnd2 ! Class bounds
2472	REAL(wp) :: zslope ! section's slope coeff
2473	!
2474	REAL(wp), POINTER, DIMENSION(:):: zsumclasses ! 1D workspace
2475	!!-------------------------------------------------------------
2476	CALL wrk_alloc(nb_type_class , zsumclasses )
2477
2478	zsumclasses(:)=0._wp
2479	zslope = sec%slopeSection
2480
2481
2482	DO jclass=1,MAX(1,sec%nb_class-1)
2483
2484	classe = 'N '
2485	zbnd1 = 0._wp
2486	zbnd2 = 0._wp
2487	zsumclasses(1:nb_type_class)=zsumclasses(1:nb_type_class)+sec%transport(1:nb_type_class,jclass)
2488
2489
2490	!insitu density classes transports
2491	IF( ( sec%zsigi(jclass) .NE. 99._wp ) .AND. &
2492	( sec%zsigi(jclass+1) .NE. 99._wp ) )THEN
2493	classe = 'DI '
2494	zbnd1 = sec%zsigi(jclass)
2495	zbnd2 = sec%zsigi(jclass+1)
2496	ENDIF
2497	!potential density classes transports
2498	IF( ( sec%zsigp(jclass) .NE. 99._wp ) .AND. &
2499	( sec%zsigp(jclass+1) .NE. 99._wp ) )THEN
2500	classe = 'DP '
2501	zbnd1 = sec%zsigp(jclass)
2502	zbnd2 = sec%zsigp(jclass+1)
2503	ENDIF
2504	!depth classes transports
2505	IF( ( sec%zlay(jclass) .NE. 99._wp ) .AND. &
2506	( sec%zlay(jclass+1) .NE. 99._wp ) )THEN
2507	classe = 'Z '
2508	zbnd1 = sec%zlay(jclass)
2509	zbnd2 = sec%zlay(jclass+1)
2510	ENDIF
2511	!salinity classes transports
2512	IF( ( sec%zsal(jclass) .NE. 99._wp ) .AND. &
2513	( sec%zsal(jclass+1) .NE. 99._wp ) )THEN
2514	classe = 'S '
2515	zbnd1 = sec%zsal(jclass)
2516	zbnd2 = sec%zsal(jclass+1)
2517	ENDIF
2518	!temperature classes transports
2519	IF( ( sec%ztem(jclass) .NE. 99._wp ) .AND. &
2520	( sec%ztem(jclass+1) .NE. 99._wp ) ) THEN
2521	classe = 'T '
2522	zbnd1 = sec%ztem(jclass)
2523	zbnd2 = sec%ztem(jclass+1)
2524	ENDIF
2525
2526	!write volume transport per class
2527	WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
2528	jclass,classe,zbnd1,zbnd2,&
2529	sec%transport(1,jclass),sec%transport(2,jclass), &
2530	sec%transport(1,jclass)+sec%transport(2,jclass)
2531
2532	IF( sec%llstrpond )THEN
2533
2534	!write heat transport per class:
2535	WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
2536	jclass,classe,zbnd1,zbnd2,&
2537	sec%transport(7,jclass)1000._wprcp/1.e15,sec%transport(8,jclass)1000._wprcp/1.e15, &
2538	( sec%transport(7,jclass)+sec%transport(8,jclass) )1000._wprcp/1.e15
2539	!write salt transport per class
2540	WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
2541	jclass,classe,zbnd1,zbnd2,&
2542	sec%transport(9,jclass)1000._wp/1.e9,sec%transport(10,jclass)1000._wp/1.e9,&
2543	(sec%transport(9,jclass)+sec%transport(10,jclass))*1000._wp/1.e9
2544	ENDIF
2545
2546	ENDDO
2547
2548	zbnd1 = 0._wp
2549	zbnd2 = 0._wp
2550	jclass=0
2551
2552	!write total volume transport
2553	WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope, &
2554	jclass,"total",zbnd1,zbnd2,&
2555	zsumclasses(1),zsumclasses(2),zsumclasses(1)+zsumclasses(2)
2556
2557	IF( sec%llstrpond )THEN
2558
2559	!write total heat transport
2560	WRITE(numdct_heat,119) ndastp,kt,ksec,sec%name,zslope, &
2561	jclass,"total",zbnd1,zbnd2,&
2562	zsumclasses(7)* 1000._wprcp/1.e15,zsumclasses(8) 1000._wp*rcp/1.e15,&
2563	(zsumclasses(7)+zsumclasses(8) )* 1000._wp*rcp/1.e15
2564	!write total salt transport
2565	WRITE(numdct_salt,119) ndastp,kt,ksec,sec%name,zslope, &
2566	jclass,"total",zbnd1,zbnd2,&
2567	zsumclasses(9)1000._wp/1.e9,zsumclasses(10)1000._wp/1.e9,&
2568	(zsumclasses(9)+zsumclasses(10))*1000._wp/1.e9
2569	ENDIF
2570
2571
2572	IF ( sec%ll_ice_section) THEN
2573	!write total ice volume transport
2574	WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
2575	jclass,"ice_vol",zbnd1,zbnd2,&
2576	sec%transport(11,1),sec%transport(12,1),&
2577	sec%transport(11,1)+sec%transport(12,1)
2578	!write total ice surface transport
2579	WRITE(numdct_vol,118) ndastp,kt,ksec,sec%name,zslope,&
2580	jclass,"ice_surf",zbnd1,zbnd2,&
2581	sec%transport(13,1),sec%transport(14,1), &
2582	sec%transport(13,1)+sec%transport(14,1)
2583	ENDIF
2584
2585	118 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4)
2586	119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6)
2587
2588	CALL wrk_dealloc(nb_type_class , zsumclasses )
2589	END SUBROUTINE dia_dct_wri
2590
2591	PURE FUNCTION interp(ki, kj, kk, cd_point,var)
2592	!!----------------------------------------------------------------------
2593	!!
2594	!! Purpose: compute temperature/salinity/density at U-point or V-point
2595	!! --------
2596	!!
2597	!! Method:
2598	!! ------
2599	!!
2600	!! ====> full step and partial step
2601	!!
2602	!!
2603	!! \| I \| I+1 \| Z=temperature/salinity/density at U-poinT
2604	!! \| \| \|
2605	!! ---------------------------------------- 1. Veritcale interpolation: compute zbis
2606	!! \| \| \| interpolation between ptab(I,J,K) and ptab(I,J,K+1)
2607	!! \| \| \| zbis =
2608	!! \| \| \| [ e3w(I+1,J,K)ptab(I,J,K) + ( e3w(I,J,K) - e3w(I+1,J,K) ) ptab(I,J,K-1) ]
2609	!! \| \| \| /[ e3w(I+1,J,K) + e3w(I,J,K) - e3w(I+1,J,K) ]
2610	!! \| \| \|
2611	!! \| \| \| 2. Horizontal interpolation: compute value at U/V point
2612	!!K-1 \| ptab(I,J,K-1) \| \| interpolation between zbis and ptab(I+1,J,K)
2613	!! \| . \| \|
2614	!! \| . \| \| interp = ( 0.5zet2zbis + 0.5zet1ptab(I+1,J,K) )/(0.5zet2+0.5zet1)
2615	!! \| . \| \|
2616	!! ------------------------------------------
2617	!! \| . \| \|
2618	!! \| . \| \|
2619	!! \| . \| \|
2620	!!K \| zbis.......U...ptab(I+1,J,K) \|
2621	!! \| . \| \|
2622	!! \| ptab(I,J,K) \| \|
2623	!! \| \|------------------\|
2624	!! \| \| partials \|
2625	!! \| \| steps \|
2626	!! -------------------------------------------
2627	!! <----zet1------><----zet2--------->
2628	!!
2629	!!
2630	!! ====> s-coordinate
2631	!!
2632	!! \| \| \| 1. Compute distance between T1 and U points: SQRT( zdep1^2 + (0.5 * zet1 )^2
2633	!! \| \| \| Compute distance between T2 and U points: SQRT( zdep2^2 + (0.5 * zet2 )^2
2634	!! \| \| ptab(I+1,J,K) \|
2635	!! \| \| T2 \| 2. Interpolation between T1 and T2 values at U point
2636	!! \| \| ^ \|
2637	!! \| \| \| zdep2 \|
2638	!! \| \| \| \|
2639	!! \| ^ U v \|
2640	!! \| \| \| \|
2641	!! \| \| zdep1 \| \|
2642	!! \| v \| \|
2643	!! \| T1 \| \|
2644	!! \| ptab(I,J,K) \| \|
2645	!! \| \| \|
2646	!! \| \| \|
2647	!!
2648	!! <----zet1--------><----zet2--------->
2649	!!
2650	!!----------------------------------------------------------------------
2651	!*arguments
2652	INTEGER, INTENT(IN) :: ki, kj, kk ! coordinate of point
2653	INTEGER, INTENT(IN) :: var ! which variable
2654	CHARACTER(len=1), INTENT(IN) :: cd_point ! type of point (U, V)
2655	REAL(wp) :: interp ! interpolated variable
2656
2657	!*local declations
2658	INTEGER :: ii1, ij1, ii2, ij2 ! local integer
2659	REAL(wp):: ze3t, zfse3, zwgt1, zwgt2, zbis, zdepu ! local real
2660	REAL(wp):: zet1, zet2 ! weight for interpolation
2661	REAL(wp):: zdep1,zdep2 ! differences of depth
2662	REAL(wp):: zmsk ! mask value
2663	!!----------------------------------------------------------------------
2664
2665
2666
2667	IF( cd_point=='U' )THEN
2668	ii1 = ki ; ij1 = kj
2669	ii2 = ki+1 ; ij2 = kj
2670
2671	zet1=e1t(ii1,ij1)
2672	zet2=e1t(ii2,ij2)
2673	zmsk=umask(ii1,ij1,kk)
2674
2675
2676	ELSE ! cd_point=='V'
2677	ii1 = ki ; ij1 = kj
2678	ii2 = ki ; ij2 = kj+1
2679
2680	zet1=e2t(ii1,ij1)
2681	zet2=e2t(ii2,ij2)
2682	zmsk=vmask(ii1,ij1,kk)
2683
2684	ENDIF
2685
2686	IF( ln_sco )THEN ! s-coordinate case
2687
2688	zdepu = ( fsdept(ii1,ij1,kk) + fsdept(ii2,ij2,kk) ) /2
2689	zdep1 = fsdept(ii1,ij1,kk) - zdepu
2690	zdep2 = fsdept(ii2,ij2,kk) - zdepu
2691
2692	! weights
2693	zwgt1 = SQRT( ( 0.5 * zet1 ) * ( 0.5 * zet1 ) + ( zdep1 * zdep1 ) )
2694	zwgt2 = SQRT( ( 0.5 * zet2 ) * ( 0.5 * zet2 ) + ( zdep2 * zdep2 ) )
2695
2696	! result
2697	SELECT CASE( var )
2698	CASE(0) ; interp = zmsk * ( zwgt2 * tsn(ii1,ij1,kk,jp_tem) + zwgt1 * tsn(ii1,ij1,kk,jp_tem) ) / ( zwgt2 + zwgt1 )
2699	CASE(1) ; interp = zmsk * ( zwgt2 * tsn(ii1,ij1,kk,jp_sal) + zwgt1 * tsn(ii1,ij1,kk,jp_sal) ) / ( zwgt2 + zwgt1 )
2700	CASE(2) ; interp = zmsk * ( zwgt2 * rhop(ii1,ij1,kk) + zwgt1 * rhop(ii1,ij1,kk) ) / ( zwgt2 + zwgt1 )
2701	CASE(3) ; interp = zmsk * ( zwgt2 * (rhd(ii1,ij1,kk)rau0+rau0) + zwgt1 (rhd(ii1,ij1,kk)*rau0+rau0) ) / ( zwgt2 + zwgt1 )
2702	END SELECT
2703
2704	ELSE ! full step or partial step case
2705
2706	#if defined key_vvl
2707
2708	ze3t = fse3t_n(ii2,ij2,kk) - fse3t_n(ii1,ij1,kk)
2709	zwgt1 = ( fse3w_n(ii2,ij2,kk) - fse3w_n(ii1,ij1,kk) ) / fse3w_n(ii2,ij2,kk)
2710	zwgt2 = ( fse3w_n(ii1,ij1,kk) - fse3w_n(ii2,ij2,kk) ) / fse3w_n(ii1,ij1,kk)
2711
2712	#else
2713
2714	ze3t = fse3t(ii2,ij2,kk) - fse3t(ii1,ij1,kk)
2715	zwgt1 = ( fse3w(ii2,ij2,kk) - fse3w(ii1,ij1,kk) ) / fse3w(ii2,ij2,kk)
2716	zwgt2 = ( fse3w(ii1,ij1,kk) - fse3w(ii2,ij2,kk) ) / fse3w(ii1,ij1,kk)
2717
2718	#endif
2719
2720	IF(kk .NE. 1)THEN
2721
2722	IF( ze3t >= 0. )THEN
2723	! zbis
2724	SELECT CASE( var )
2725	CASE(0)
2726	zbis = tsn(ii2,ij2,kk,jp_tem) + zwgt1 * (tsn(ii2,ij2,kk-1,jp_tem)-tsn(ii2,ij2,kk,jp_tem) )
2727	interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * zbis )/( zet1 + zet2 )
2728	CASE(1)
2729	zbis = tsn(ii2,ij2,kk,jp_sal) + zwgt1 * (tsn(ii2,ij2,kk-1,jp_sal)-tsn(ii2,ij2,kk,jp_sal) )
2730	interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * zbis )/( zet1 + zet2 )
2731	CASE(2)
2732	zbis = rhop(ii2,ij2,kk) + zwgt1 * (rhop(ii2,ij2,kk-1)-rhop(ii2,ij2,kk) )
2733	interp = zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * zbis )/( zet1 + zet2 )
2734	CASE(3)
2735	zbis = (rhd(ii2,ij2,kk)rau0+rau0) + zwgt1 ( (rhd(ii2,ij2,kk-1)rau0+rau0)-(rhd(ii2,ij2,kk)rau0+rau0) )
2736	interp = zmsk * ( zet2 * (rhd(ii1,ij1,kk)rau0+rau0) + zet1 zbis )/( zet1 + zet2 )
2737	END SELECT
2738	! result
2739	ELSE
2740	! zbis
2741	SELECT CASE( var )
2742	CASE(0)
2743	zbis = tsn(ii1,ij1,kk,jp_tem) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_tem) - tsn(ii1,ij2,kk,jp_tem) )
2744	interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
2745	CASE(1)
2746	zbis = tsn(ii1,ij1,kk,jp_sal) + zwgt2 * ( tsn(ii1,ij1,kk-1,jp_sal) - tsn(ii1,ij2,kk,jp_sal) )
2747	interp = zmsk * ( zet2 * zbis + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
2748	CASE(2)
2749	zbis = rhop(ii1,ij1,kk) + zwgt2 * ( rhop(ii1,ij1,kk-1) - rhop(ii1,ij2,kk) )
2750	interp = zmsk * ( zet2 * zbis + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
2751	CASE(3)
2752	zbis = (rhd(ii1,ij1,kk)rau0+rau0) + zwgt2 ( (rhd(ii1,ij1,kk-1)rau0+rau0) - (rhd(ii1,ij2,kk)rau0+rau0) )
2753	interp = zmsk * ( zet2 * zbis + zet1 * (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
2754	END SELECT
2755	ENDIF
2756
2757	ELSE
2758	SELECT CASE( var )
2759	CASE(0)
2760	interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_tem) + zet1 * tsn(ii2,ij2,kk,jp_tem) )/( zet1 + zet2 )
2761	CASE(1)
2762	interp = zmsk * ( zet2 * tsn(ii1,ij1,kk,jp_sal) + zet1 * tsn(ii2,ij2,kk,jp_sal) )/( zet1 + zet2 )
2763	CASE(2)
2764	interp = zmsk * ( zet2 * rhop(ii1,ij1,kk) + zet1 * rhop(ii2,ij2,kk) )/( zet1 + zet2 )
2765	CASE(3)
2766	interp = zmsk * ( zet2 * (rhd(ii1,ij1,kk)rau0+rau0) + zet1 (rhd(ii2,ij2,kk)*rau0+rau0) )/( zet1 + zet2 )
2767	END SELECT
2768	ENDIF
2769
2770	ENDIF
2771
2772	END FUNCTION interp
2773
2774	#else
2775	!!----------------------------------------------------------------------
2776	!! Default option : Dummy module
2777	!!----------------------------------------------------------------------
2778	LOGICAL, PUBLIC, PARAMETER :: lk_diadct = .FALSE. !: diamht flag
2779	PUBLIC
2780	!! $Id$
2781	CONTAINS
2782
2783	SUBROUTINE dia_dct_init ! Dummy routine
2784	WRITE(,) 'dia_dct_init: You should not have seen this print! error?', kt
2785	END SUBROUTINE dia_dct_init
2786
2787	SUBROUTINE dia_dct( kt ) ! Dummy routine
2788	INTEGER, INTENT( in ) :: kt ! ocean time-step index
2789	WRITE(,) 'dia_dct: You should not have seen this print! error?', kt
2790	END SUBROUTINE dia_dct
2791	#endif
2792
2793	END MODULE diadct

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

Download in other formats: