Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

diadct.F90

Last change on this file was 14714, checked in by rrenshaw, 3 years ago
section transports, hardwire calculation of 1-hour and 24-hour means
Property svn:executable set to ``*
File size: 132.8 KB

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

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

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

Context Navigation

source: branches/UKMO/AMM15_v3_6_STABLE_package_reanalysis4/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

Download in other formats: