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

Last change on this file since 14714 was 14714, checked in by rrenshaw, 4 months ago

section transports, hardwire calculation of 1-hour and 24-hour means

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