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

Last change on this file since 11066 was 11066, checked in by rrenshaw, 19 months ago

changes to add regional means output and correction for section transports

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