Index: trunk/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder
===================================================================
--- trunk/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/BDY_TOOLS/bdy_reorder	(revision 3294)
@@ -0,0 +1,58 @@
+#!/bin/ksh
+
+# CALLS: bdy_reorder.exe
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  bdy_reorder"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-c] file_in file_out"
+   echo
+   echo "  flags:    -c          target file is a coordinates.bdy.nc file"
+   echo "            -t          template file"
+   echo
+   exit 1
+}
+
+ln_coordinates=".false."
+file_template=""
+
+while getopts ct: opt
+do
+  case ${opt} in
+      c) 
+         ln_coordinates=".true." 
+      ;;
+      t) 
+         file_template=${OPTARG}
+      ;;
+      [?]) usage
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# < 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file_in=$1
+file_out=$2
+
+cat > nam_bdy_reorder << EOC
+&nam_bdy_reorder
+file_in='${file_in}'
+file_out='${file_out}'
+file_template='${file_template}'
+ln_coordinates=${ln_coordinates}
+EOC
+echo "/" >> nam_bdy_reorder
+
+${script_dir}/bdy_reorder.exe 
+
+exit 0
Index: trunk/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/BDY_TOOLS/src/bdy_reorder.f90	(revision 3294)
@@ -0,0 +1,609 @@
+PROGRAM bdy_reorder
+
+!===============================================================================
+! A routine to reorder old BDY data files to make them compatible with NEMO 3.4.
+!
+! This routine has 2 modes:
+!   1. If no template file is given then it will re-order the data in the input
+!      file so that it is in order of increasing nbr. 
+!   2. If a template file is given it will re-order the data in the input file 
+!      be consistent with the order of the data in the template file. This is 
+!      useful for making old barotropic and baroclinic data files consistent. 
+!      For older versions of NEMO the barotropic boundary data did not have to
+!      be in the same order as the baroclinic boundary data. The rimwidth 
+!      value can be different in the input file and template file; in this case 
+!      the routine will just re-order the data that the two files have in common. 
+!
+! The routine is mainly for re-ordering BDY data files, but can also be used to
+! re-order BDY coordinate files if ln_coordinates is set to .true.
+!
+! Author: Dave Storkey  Aug 2011
+! Bug notifications etc to:  dave.storkey@metoffice.gov.uk
+!
+!===============================================================================
+  
+      USE netcdf
+
+      IMPLICIT NONE
+
+      INTEGER,PARAMETER         :: numnam=11
+      INTEGER,PARAMETER         :: sp=SELECTED_REAL_KIND(6,37)
+      INTEGER,PARAMETER         :: dp=SELECTED_REAL_KIND(12,307)
+      INTEGER                   :: chunksize = 32000000
+
+      INTEGER                   :: jpbgrd, iostat, ncid_in, ncid_out, ncid_template, nbrid(4), nbrid_template(4)
+      INTEGER                   :: dimids(10), unlimitedDimId
+      INTEGER                   :: xtype, dimid, varid, ndims, ndims_var, nvars, natts, nblen(4), nblen_template(4), dimlen(10)
+      INTEGER                   :: lenvar(10), igrid, ib, ib1, ir, idim, jgrid, jv, icount, attid, len1, idepth, itime
+      INTEGER                   :: idim_time, idim_xb, idim_yb, idim_depth
+      INTEGER                   :: nbr_min, nbr_max, nbr_min_template, nbr_max_template, strlen, nbr_match
+
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr, imap
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi, nbj
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbi_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbj_template
+      INTEGER, ALLOCATABLE, DIMENSION(:,:)   :: nbr_template
+
+      INTEGER, ALLOCATABLE, DIMENSION(:)     :: nbi_extract, nbj_extract
+
+      INTEGER,  ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_int, varout_int
+      REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_float, varout_float
+      REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:)  :: varin_dble, varout_dble
+
+      LOGICAL                   :: ln_coordinates
+      LOGICAL                   :: ln_template
+
+      CHARACTER(LEN=nf90_max_name)        :: attname, dimname, varname, time, date, zone, timestamp
+      CHARACTER(LEN=nf90_max_name)        :: file_in, file_out, file_template, nbi_name, nbj_name, nbr_name
+      CHARACTER(LEN=1),DIMENSION(4)       :: cgrid
+      CHARACTER(LEN=1)                    :: end_letter
+
+      NAMELIST/nam_bdy_reorder/ file_in, file_out, file_template, ln_coordinates, nbr_match
+
+!=============================================================================
+
+!-----------------------------------------------------------------------------
+! 0. Read namelist and initialise parameters
+!----------------------------------------------------------------------------- 
+
+      file_in = ''
+      file_out = ''
+      file_template = ''
+      ln_coordinates = .false.
+      nbr_match = 0
+
+      OPEN( UNIT=numnam, FILE='nam_bdy_reorder', FORM='FORMATTED', STATUS='OLD' )
+      READ( numnam, nam_bdy_reorder )
+      CLOSE( UNIT=numnam )
+
+      IF( ln_coordinates ) THEN
+         WRITE(*,*) 'Input file is a coordinates.bdy.nc file.'
+         jpbgrd = 4
+      ELSE
+          WRITE(*,*) 'Input file is a boundary data file.'
+         jpbgrd = 1
+      ENDIF
+ 
+      IF( LEN_TRIM(file_template) > 0 ) THEN 
+         WRITE(*,*) 'Reordering data to match template file.'
+         ln_template = .true.
+      ELSE 
+         WRITE(*,*) 'Reordering data in order of increasing nbr values.'
+         ln_template = .false.
+      ENDIF
+
+      cgrid= (/'t','u','v','f'/)
+
+!-----------------------------------------------------------------------------
+! 1. Read in nbr variables from file and create mapping. 
+!----------------------------------------------------------------------------- 
+
+! 1.1 Open input files
+
+      iostat = nf90_open( TRIM(file_in), nf90_nowrite, ncid_in )
+      IF (iostat /= nf90_noerr) THEN
+        WRITE(6,*) TRIM(nf90_strerror(iostat))
+        STOP
+      ENDIF
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+      IF( ln_template ) THEN
+         iostat = nf90_open( TRIM(file_template), nf90_nowrite, ncid_template )
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+      ENDIF
+
+      DO igrid=1,jpbgrd
+
+! 1.2 Find dimensions of data in input files and allocate arrays
+
+         IF( ln_coordinates ) THEN
+            nbr_name = 'nbr'//cgrid(igrid)
+         ELSE
+            nbr_name = 'nbrdta'
+         ENDIF
+
+         iostat = nf90_inq_varid( ncid_in, nbr_name , nbrid(igrid) )
+         IF (iostat /= nf90_noerr) THEN
+            WRITE(6,*) TRIM(nf90_strerror(iostat))
+            STOP
+         ENDIF
+         iostat = nf90_inquire_variable( ncid_in, nbrid(igrid), ndims=ndims, dimids=dimids )
+         IF( ndims .ne. 2 ) THEN
+            WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            STOP
+         ENDIF
+         iostat = nf90_inquire_dimension( ncid_in, dimids(1), len=nblen(igrid))
+         iostat = nf90_inquire_dimension( ncid_in, dimids(2), len=len1)
+         WRITE(*,*) 'nblen(igrid), len1 : ',nblen(igrid), len1
+         IF( len1 .ne. 1 ) THEN 
+            WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+            WRITE(*,*) '        in file ',TRIM(file_in)
+            WRITE(*,*) '        len1 = ',len1
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            iostat = nf90_inq_varid( ncid_template, nbr_name , nbrid_template(igrid) )
+            IF (iostat /= nf90_noerr) THEN
+               WRITE(6,*) TRIM(nf90_strerror(iostat))
+               STOP
+            ENDIF
+            iostat = nf90_inquire_variable( ncid_template, nbrid_template(igrid), ndims=ndims, dimids=dimids )
+            IF( ndims .ne. 2 ) THEN
+               WRITE(*,*) 'ERROR : ',TRIM(nbr_name),' does not have exactly 2 dimensions.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               STOP
+            ENDIF
+            iostat = nf90_inquire_dimension( ncid_template, dimids(1), len=nblen_template(igrid))
+            iostat = nf90_inquire_dimension( ncid_template, dimids(2), len=len1)
+            WRITE(*,*) 'nblen_template(igrid), len1 : ',nblen_template(igrid), len1
+            IF( len1 .ne. 1 ) THEN 
+               WRITE(*,*) 'ERROR : second dimension of ',TRIM(nbr_name),' does not have length 1.'
+               WRITE(*,*) '        in file ',TRIM(file_template)
+               WRITE(*,*) '        len1 = ',len1
+               STOP
+            ENDIF
+
+         ENDIF ! ln_template
+
+      ENDDO  ! jpbgrd
+
+      ALLOCATE( nbr(MAXVAL(nblen),1), imap(MAXVAL(nblen),jpbgrd) )
+      IF( ln_template ) THEN 
+         ALLOCATE( nbi(MAXVAL(nblen),1), nbj(MAXVAL(nblen),1) )
+         ALLOCATE( nbi_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbj_template(MAXVAL(nblen_template),1) )
+         ALLOCATE( nbr_template(MAXVAL(nblen_template),1) )
+      ENDIF
+
+! 1.3 Read in nbr variables and generate mapping.
+
+      nbr(:,:) = -1
+      imap(:,:) = -1    
+      IF( ln_template ) THEN 
+         nbi(:,:) = -1
+         nbj(:,:) = -1
+         nbi_template(:,:) = -1
+         nbj_template(:,:) = -1
+         nbr_template(:,:) = -1
+      ENDIF
+
+      WRITE(*,*) '>>> Generating map.'
+      DO igrid=1,jpbgrd
+
+         iostat = nf90_get_var( ncid_in, nbrid(igrid), nbr(1:nblen(igrid),1:1) ) 
+         IF (iostat /= nf90_noerr) THEN
+           WRITE(6,*) TRIM(nf90_strerror(iostat))
+           STOP
+         ENDIF
+
+         nbr_min = MINVAL( nbr(1:nblen(igrid),1) )
+         nbr_max = MAXVAL( nbr(1:nblen(igrid),1) )
+         IF( nbr_min .ne. 1 ) THEN
+            WRITE(*,*) 'Something wrong with input file ',file_in
+            WRITE(*,*) 'MIN(nbr) /= 1'
+            STOP
+         ENDIF
+
+         IF( ln_template ) THEN 
+
+            IF( ln_coordinates ) THEN
+               nbi_name = 'nbi'//cgrid(igrid)
+               nbj_name = 'nbj'//cgrid(igrid)
+            ELSE
+               nbi_name = 'nbidta'            
+               nbj_name = 'nbjdta'            
+            ENDIF
+
+            ! read in nbi, nbj values from input file
+            iostat = nf90_inq_varid( ncid_in, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbi(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_in, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_in, varid, nbj(1:nblen(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            ! read in nbi, nbj, nbr values from template file
+            iostat = nf90_inq_varid( ncid_template, nbi_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbi_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_inq_varid( ncid_template, nbj_name, varid ) 
+            IF (iostat == nf90_noerr) iostat = nf90_get_var( ncid_template, varid, nbj_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+            iostat = nf90_get_var( ncid_template, nbrid_template(igrid), nbr_template(1:nblen_template(igrid),1:1) ) 
+            IF (iostat /= nf90_noerr) THEN
+              WRITE(6,*) TRIM(nf90_strerror(iostat))
+              STOP
+            ENDIF
+
+            nbr_min_template = MINVAL( nbr_template(1:nblen_template(igrid),1) )
+            nbr_max_template = MAXVAL( nbr_template(1:nblen_template(igrid),1) )
+            IF( nbr_min_template .ne. 1 ) THEN
+               WRITE(*,*) 'Something wrong with template file ',file_template
+               WRITE(*,*) 'MIN(nbr) /= 1'
+               STOP
+            ENDIF
+
+            IF( nbr_match .lt. 1 ) nbr_match = MIN(nbr_max, nbr_max_template)
+
+            ! initialise imap to the identity mapping
+            DO ib = 1, nblen(igrid)
+               imap(ib, igrid) = ib
+            ENDDO
+
+            ! allocate "extract" arrays
+            icount = 0
+            DO ib = 1, nblen_template(igrid)
+               IF( nbr_template(ib,1) .eq. 1 ) THEN
+                  icount = icount+1
+               ENDIF
+            ENDDO
+            ALLOCATE( nbi_extract(icount), nbj_extract(icount) )
+
+            DO ir = 1, nbr_match
+
+               ! extract values from template array for this ir value
+               icount = 0
+               DO ib = 1, nblen_template(igrid)
+                  IF( nbr_template(ib,1) .eq. ir ) THEN
+                     icount = icount+1
+                     nbi_extract(icount) = nbi_template(ib,1)               
+                     nbj_extract(icount) = nbj_template(ib,1)               
+                  ENDIF
+               ENDDO
+
+               ! work out the mapping for this ir value
+               icount = 1
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN                  
+                     DO ib1 = 1, nblen(igrid)
+                        IF( nbi(ib1,1) .eq. nbi_extract(icount) .and. &
+                       &    nbj(ib1,1) .eq. nbj_extract(icount)       ) THEN
+                           imap(ib,igrid) = ib1
+                           icount = icount + 1
+                           EXIT
+                        ENDIF                        
+                     ENDDO ! ib1
+                  ENDIF           
+               ENDDO ! ib
+
+            ENDDO ! ir
+            
+            DEALLOCATE( nbi_extract, nbj_extract )
+
+         ELSE 
+
+            icount = 0
+            DO ir = nbr_min, nbr_max
+               DO ib = 1, nblen(igrid)
+                  IF( nbr(ib,1) .eq. ir ) THEN
+                     icount = icount + 1
+                     imap(icount,igrid) = ib
+                  ENDIF           
+               ENDDO
+            ENDDO
+
+         ENDIF
+     
+      ENDDO  ! jpbgrd
+
+!-----------------------------------------------------------------------------
+! 2. Open output file and copy dimensions and attributes across
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_inquire( ncid_in, ndims, nvars, natts )
+
+! 2.1 Create the output file  
+
+      WRITE(*,*) '>>> Initialising output file.'
+      iostat = nf90_create( TRIM(file_out), nf90_64bit_offset, ncid_out, chunksize=chunksize)
+
+! 2.2 Copy the dimensions into the output file.
+
+      iostat = nf90_inquire( ncid_in, unlimitedDimId = unlimitedDimId )
+      dimlen(:) = 1
+      DO idim = 1, ndims
+         iostat = nf90_inquire_dimension(ncid_in, idim, dimname, dimlen(idim))
+         IF (idim == unlimitedDimId) THEN
+            iostat = nf90_def_dim( ncid_out, dimname, nf90_unlimited, dimid)    
+            idim_time = idim
+         ELSE
+            iostat = nf90_def_dim( ncid_out, dimname, dimlen(idim), dimid)
+            IF( INDEX(dimname,'x') .gt. 0 ) THEN
+               idim_xb = idim
+            ELSE IF( INDEX(dimname,'y') .gt. 0 ) THEN
+               idim_yb = idim
+            ELSE IF( INDEX(dimname,'depth') .gt. 0 .or. INDEX(dimname,'z') .gt. 0 ) THEN
+               idim_depth = idim
+            ELSE
+               WRITE(*,*) 'ERROR: Unrecognised dimension : ',dimname
+               STOP
+            ENDIF            
+         ENDIF
+      END DO
+      
+
+! 2.2 Copy the global attributes into the output file.
+!     Also need to change the file_name attribute and the TimeStamp attribute.
+
+      DO attid = 1, natts
+         iostat = nf90_inq_attname( ncid_in, nf90_global, attid, attname )
+         WRITE(6,*)'>>> Copying attribute '//TRIM(attname)//' into destination file...'
+         iostat = nf90_copy_att( ncid_in, nf90_global, attname, ncid_out, nf90_global )  
+      END DO
+      iostat = nf90_put_att( ncid_out, nf90_global, "file_name", TRIM(file_out))
+      CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+      timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+                  time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+                  zone  
+      iostat = nf90_put_att( ncid_out, nf90_global, "TimeStamp", timestamp)
+  
+! 2.3 Copy the variable definitions and attributes into the output file.
+
+      DO jv = 1, nvars
+         iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids, natts )
+         iostat = nf90_def_var( ncid_out, varname, xtype, dimids(1:ndims_var), varid )
+            IF (natts > 0) THEN
+            DO attid = 1, natts
+               iostat = nf90_inq_attname(ncid_in, varid, attid, attname)
+               iostat = nf90_copy_att( ncid_in, varid, attname, ncid_out, varid )   
+            END DO
+         ENDIF
+      END DO
+ 
+! 2.4 End definitions in output file
+
+      iostat = nf90_enddef( ncid_out )    
+
+!-----------------------------------------------------------------------------
+! 3. Read in variables from input file, re-order and write to output file
+!----------------------------------------------------------------------------- 
+
+     IF( ln_coordinates ) THEN
+        ALLOCATE( varin_int(MAXVAL(nblen),1,1,1), varout_int(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_float(MAXVAL(nblen),1,1,1), varout_float(MAXVAL(nblen),1,1,1) )
+        ALLOCATE( varin_dble(MAXVAL(nblen),1,1,1), varout_dble(MAXVAL(nblen),1,1,1) )
+     ELSE
+        SELECT CASE( ndims ) 
+           CASE( 2 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,1) )
+           CASE ( 3 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),1,dimlen(idim_time)) )
+           CASE ( 4 )
+              ALLOCATE(  varin_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_int(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_float(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+              ALLOCATE(  varin_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) ) 
+              ALLOCATE( varout_dble(dimlen(idim_xb),dimlen(idim_yb),dimlen(idim_depth),dimlen(idim_time)) )
+           CASE DEFAULT
+              WRITE(*,*) 'ERROR : Can only cope with 2, 3 or 4 dimensions in the boundary data files.'
+              WRITE(*,*) '        This file appears to have ',ndims,' dimensions.'
+              STOP
+        END SELECT
+     ENDIF
+
+     DO jv = 1, nvars
+       iostat = nf90_inquire_variable( ncid_in, jv, varname, xtype, ndims_var, dimids )
+       DO idim = 1, ndims_var
+          lenvar(idim) = dimlen(dimids(idim))
+       ENDDO
+
+       IF( ndims_var .eq. 1 ) THEN
+          WRITE(*,*) '>>> Copying coordinate variable ',TRIM(varname)
+       ELSE
+          WRITE(*,*) '>>> Reordering variable ',TRIM(varname)
+       ENDIF
+       ! Error check here
+
+       IF( ln_coordinates ) THEN
+          strlen = len_trim(varname)
+          end_letter = varname(strlen:strlen)
+          jgrid = -1
+          DO igrid = 1,4
+             IF( end_letter .eq. cgrid(igrid) ) jgrid = igrid
+          END DO
+          IF( jgrid .lt. 0 ) THEN
+             WRITE(*,*) 'ERROR : Could not identify grid for variable ',TRIM(varname)
+             WRITE(*,*) ' varname : ',TRIM(varname),'!'
+             WRITE(*,*) ' strlen : ',strlen
+             WRITE(*,*) ' end_letter : ',end_letter
+             WRITE(*,*) ' cgrid(1) : ',cgrid(1)
+             WRITE(*,*) ' cgrid(2) : ',cgrid(2)
+             WRITE(*,*) ' cgrid(3) : ',cgrid(3)
+             WRITE(*,*) ' cgrid(4) : ',cgrid(4)
+             STOP
+          ENDIF
+       ELSE
+          jgrid=1
+       ENDIF
+           
+       SELECT CASE(xtype)
+
+          CASE( NF90_INT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D integer.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D integer.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_int(ib,1,1,1) = varin_int(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D integer.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_int(ib,1,1,itime) = varin_int(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D integer.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_int(ib,1,idepth,itime) = varin_int(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_int(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_FLOAT ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D float.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D float.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_float(ib,1,1,1) = varin_float(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D float.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_float(ib,1,1,itime) = varin_float(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D float.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_float(ib,1,idepth,itime) = varin_float(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_float(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+          CASE( NF90_DOUBLE ) 
+             SELECT CASE(ndims_var)
+                CASE( 1 )
+                   WRITE(*,*) 'This is a 1D double.'
+                   ! Assume this is a depth or time coordinate variable and copy across unchanged.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1,1,1) )
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1,1,1) ) 
+                CASE( 2 )
+                   WRITE(*,*) 'This is a 2D double.'
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1) )
+                   DO ib = 1,lenvar(1)
+                      varout_dble(ib,1,1,1) = varin_dble(imap(ib,jgrid),1,1,1)
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1) ) 
+                CASE( 3 )
+                   WRITE(*,*) 'This is a 3D double.'
+                   ! Assume third dimension is time.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1,1:lenvar(3)) )
+                   DO itime = 1,lenvar(3)
+                      DO ib = 1,lenvar(1)
+                         varout_dble(ib,1,1,itime) = varin_dble(imap(ib,jgrid),1,1,itime)
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1,1:lenvar(3)) ) 
+                CASE( 4 )
+                   WRITE(*,*) 'This is a 4D double.'
+                   ! Assume third and fourth dimensions are depth and time respectively.
+                   iostat = nf90_get_var( ncid_in, jv, varin_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) )
+                   DO itime = 1,lenvar(4)
+                      DO idepth = 1,lenvar(3)
+                         DO ib = 1,lenvar(1)
+                            varout_dble(ib,1,idepth,itime) = varin_dble(imap(ib,jgrid),1,idepth,itime)
+                         END DO
+                      END DO
+                   END DO
+                   iostat = nf90_put_var( ncid_out, jv, varout_dble(1:lenvar(1),1:1,1:lenvar(3),1:lenvar(4)) ) 
+                CASE DEFAULT
+                   WRITE(*,*) 'ERROR : Variable with ',ndims_var,' dimensions. Case not coded.'
+                   STOP
+             END SELECT
+
+             CASE DEFAULT
+                WRITE(*,*) 'ERROR : Unrecognised data type.'           
+                STOP
+
+       END SELECT
+
+       END DO ! jv
+
+!-----------------------------------------------------------------------------
+! 4. Close input and output files
+!----------------------------------------------------------------------------- 
+
+      iostat = nf90_close( ncid_out )
+      iostat = nf90_close( ncid_in )
+
+
+END PROGRAM bdy_reorder
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_archfile.sh	(revision 3294)
@@ -69,4 +69,13 @@
    fi
 else
-   ln -sf ${MAIN_DIR}/ARCH/arch-${2}.fcm ${COMPIL_DIR}/$1
+   myfile=$( find ${MAIN_DIR}/ARCH -name arch-${2}.fcm -print )
+   if [ ${#myfile} -gt 0 ]; then
+      ln -sf  ${myfile} ${COMPIL_DIR}/$1
+   else
+      echo "Warning !!!"
+      echo "Compiler not existing"
+      echo "Try makenemo -h for help"
+      echo "EXITING..."
+      exit 1       
+   fi   
 fi
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcheck_config.sh	(revision 3294)
@@ -39,5 +39,5 @@
 # - Nothing set, use the previous in use 
 #
-# We use TOOLS/COMPILE/cfg.txt to check if the onfiguration exists.
+# We use TOOLS/CONFIG_DIR/cfg.txt to check if the onfiguration exists.
 #
 # EXAMPLES
@@ -68,8 +68,8 @@
 declare -a ZTAB
 if [ ${#2} -eq 0 ]; then
-   tail -1  ${COMPIL_DIR}/$1	> ${COMPIL_DIR}/cfg.tmp
-   read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+   tail -1  ${CONFIG_DIR}/$1	> ${CONFIG_DIR}/cfg.tmp
+   read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
    NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
-   \rm ${COMPIL_DIR}/cfg.tmp
+   \rm ${CONFIG_DIR}/cfg.tmp
    echo "Warning !!!"
    echo "No configuration specified"
@@ -79,8 +79,8 @@
 fi
 if [ "$1" == cfg.txt ]; then
-   cat ${COMPIL_DIR}/$1 | grep "${NEW_CONF} " > ${COMPIL_DIR}/cfg.tmp
-   read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+   cat ${CONFIG_DIR}/$1 | grep "${NEW_CONF} " > ${CONFIG_DIR}/cfg.tmp
+   read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
    NEW_CONF=${ZTAB[0]} ; TAB=( ${ZTAB[@]:1} )
-   \rm ${COMPIL_DIR}/cfg.tmp
+   \rm ${CONFIG_DIR}/cfg.tmp
 fi
 
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fclean_config.sh	(revision 3294)
@@ -64,23 +64,27 @@
 #-
  NEW_CONF=${x_n}
- echo "Are you sure that you want to remove this directory ? [y/n] "
- read answer
- answer=`echo $answer | sed 's/^[y].*$/y/'`
- if [  -z "$answer" -o "x$answer" = "xy" ]; then
- 	# testing if configuration exists
- 	if [ "$(cat ${COMPIL_DIR}/cfg.txt | grep "${NEW_CONF} ")"  == "" ] ; then
-		echo "The configuration ${NEW_CONF} does not exist in file cfg.txt"     
-		echo "No removing configuration"
-		echo " "
+ if [ ${#NEW_CONF} -eq 0 ] ; then
+ 	   echo " "
+	   echo "No configuration specified, please use makenemo -n CONFIG clean_config "
+ else
+    echo "Are you sure that you want to remove this directory $NEW_CONF? [y/n] "
+    read answer
+    answer=`echo $answer | sed 's/^[y].*$/y/'`
+    if [  -z "$answer" -o "x$answer" = "xy" ]; then
+ 	   # testing if configuration exists
+ 	   if [ "$(cat ${CONFIG_DIR}/cfg.txt | grep "${NEW_CONF} ")"  == "" ] ; then
+		  echo "The configuration ${NEW_CONF} does not exist in file cfg.txt"     
+		  echo "No removing configuration"
+		  echo " "
         else
-		rm -rf ${CONFIG_DIR}/${NEW_CONF}
-		sed -e "/${NEW_CONF} /d"  ${COMPIL_DIR}/cfg.txt >  ${COMPIL_DIR}/cfg.tmp
-		mv  ${COMPIL_DIR}/cfg.tmp  ${COMPIL_DIR}/cfg.txt
-		echo "${NEW_CONF} configuration REMOVED" 
+		  rm -rf ${CONFIG_DIR}/${NEW_CONF}
+		  sed -e "/${NEW_CONF} /d"  ${CONFIG_DIR}/cfg.txt >  ${CONFIG_DIR}/cfg.tmp
+		  mv  ${CONFIG_DIR}/cfg.tmp  ${CONFIG_DIR}/cfg.txt
+		  echo "${NEW_CONF} configuration REMOVED" 
         fi
- else
-	echo " "
-	echo "nothing to remove"
- fi
-
+    else
+	   echo " "
+	   echo "nothing to remove"
+    fi
+ fi 
  unset -v answer
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fcopy_dir.sh	(revision 3294)
@@ -55,8 +55,8 @@
 
 declare -a ZTAB
-grep "$1 " ${COMPIL_DIR}/cfg.txt > ${COMPIL_DIR}/cfg.tmp
-read -a ZTAB < ${COMPIL_DIR}/cfg.tmp
+grep "$1 " ${CONFIG_DIR}/cfg.txt > ${CONFIG_DIR}/cfg.tmp
+read -a ZTAB < ${CONFIG_DIR}/cfg.tmp
 TAB=( ${ZTAB[@]:1} )
-\rm ${COMPIL_DIR}/cfg.tmp
+\rm ${CONFIG_DIR}/cfg.tmp
 
 unset -v ZTAB
Index: trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Flist_archfile.sh	(revision 3294)
@@ -19,5 +19,5 @@
 # ::
 #
-#  $ Flist_archfile.sh
+#  $ Flist_archfile.sh Institute
 #
 #
@@ -37,4 +37,5 @@
 #  $ ./Flist_archfile.sh 
 #
+#  $ ./Flist_archfile.sh CNRS
 #
 # TODO
@@ -54,6 +55,11 @@
 #
 #-
+
+if [ -n "$2" ]; then
+shift
+fi
+
 echo "Available compilers for -m option :"
-for file in `ls ${MAIN_DIR}/ARCH`
+for file in  $(ls ${MAIN_DIR}/ARCH | grep fcm )
 do
 zvar1=${file#arch-}
@@ -62,2 +68,33 @@
 printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
 done
+
+
+if [ "$1" == "all" ]; then
+   for dir  in  $(ls ${MAIN_DIR}/ARCH | grep -v fcm )
+   do 
+      echo "Available compilers at ${dir} :"
+      for file in  $(ls ${MAIN_DIR}/ARCH/${dir} | grep  fcm )
+      do
+      zvar1=${file#arch-}
+      zvar2=$(head -1 ${MAIN_DIR}/ARCH/${dir}/$file)
+      #echo "${zvar1%.fcm} : ${zvar2#\#}"
+      printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+      done
+   done
+elif [ -d ${MAIN_DIR}/ARCH/${1} ]; then
+      echo "Available compilers at $1 :"
+      for file in  $(ls ${MAIN_DIR}/ARCH/$1 | grep fcm )
+      do
+      zvar1=${file#arch-}
+      zvar2=$(head -1 ${MAIN_DIR}/ARCH/${1}/$file)
+      #echo "${zvar1%.fcm} : ${zvar2#\#}"
+      printf "%-20s %s %-s\n" "${zvar1%.fcm}" : "${zvar2#\#}"
+      done
+else
+      echo "Available consortium member sub-directories :"
+      for dir  in  $(ls ${MAIN_DIR}/ARCH | grep -v fcm )
+      do
+         echo ${dir}
+      done
+      echo "use \"makenemo -h all\" or \"makenemo -m help\" to see compilers available in member's sub-directories"
+fi
Index: trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/COMPILE/Fmake_WORK.sh	(revision 3294)
@@ -64,13 +64,24 @@
 #
 #-
-declare ZCONF=$1 ; shift 
+declare ZSRC=$1 ; shift 
+declare ZCONF=$1 ; shift
 ZTAB=( $@ )
 declare i=0 ; declare NDIR=${#ZTAB[@]}
 
 echo "Creating ${ZCONF}/WORK = ${ZTAB[*]} for ${ZCONF}"
-echo ""
 
 [ ! -d ${ZCONF}/MY_SRC ] && \mkdir ${ZCONF}/MY_SRC
 [   -d ${ZCONF}/WORK   ] || \mkdir ${ZCONF}/WORK
+
+if [ "${ZSRC}" != "none" ] ; then 
+  if [ -d ${ZSRC} ] ; then 
+     ln -sf ${ZSRC}/*.[Ffh]90 ${ZCONF}/MY_SRC/. 
+     echo "MY_SRC content is linked to ${ZSRC}" 
+  else
+     echo "External directory for MY_SRC does not exist. Using default."
+  fi
+else 
+echo "MY_SRC directory is : ${ZCONF}/MY_SRC"
+fi
 
 \rm -f ../${1}/WORK/*
Index: trunk/NEMOGCM/TOOLS/COMPILE/cfg.txt
===================================================================
--- trunk/NEMOGCM/TOOLS/COMPILE/cfg.txt	(revision 2734)
+++ 	(revision )
@@ -1,7 +1,0 @@
-GYRE OPA_SRC
-ORCA2_LIM_PISCES OPA_SRC LIM_SRC_2 NST_SRC TOP_SRC
-GYRE_LOBSTER OPA_SRC TOP_SRC
-ORCA2_OFF_PISCES OPA_SRC OFF_SRC TOP_SRC
-POMME OPA_SRC NST_SRC
-ORCA2_LIM3 OPA_SRC LIM_SRC_3
-ORCA2_LIM OPA_SRC LIM_SRC_2 NST_SRC
Index: trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh	(revision 3294)
@@ -0,0 +1,33 @@
+#!/bin/bash
+#
+# purpose:
+#   small script to check in all *90 files of the current directory and subdirectories 
+#   if all lines with wrk_alloc have their corresponding lines with wrk_dealloc
+#
+# use:
+#   call chk_wrk_alloc.sh from the directory you want to check
+#
+# example:
+#   cd ~/dev_NEMO_MERGE_2011/NEMOGCM/NEMO
+#   ../TOOLS/MISCELLANEOUS/chk_wrk_alloc.sh
+#
+set -ue
+#
+echo "check for all *90 files contained in "$( pwd )" and its subdirectories"
+#
+for ff in $( grep -il wrk_nemo_2 $( find . -name "*90" ) )
+do
+
+    # number of lines with wrk_alloc
+    n1=$( grep -ic "call *wrk_alloc *(" $ff )  
+    # replace wrk_alloc with wrk_dealloc and count the lines
+    n2=$( sed -e "s/wrk_alloc/wrk_dealloc/" $ff | grep -ic "call *wrk_dealloc *(" )
+    # we should get n2 = 2 * n1...
+    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_alloc in $ff" 
+   
+    # same story but for wrk_dealloc
+    n1=$( grep -ic "call *wrk_dealloc *(" $ff )  
+    n2=$( sed -e "s/wrk_dealloc/wrk_alloc/" $ff | grep -ic "call *wrk_alloc *(" )
+    [ $(( 2 * $n1 )) -ne $n2 ] && echo "problem with wrk_dealloc in $ff" 
+   
+done
Index: trunk/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh
===================================================================
--- trunk/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/MISCELLANEOUS/rewrite_nemo.sh	(revision 3294)
@@ -0,0 +1,166 @@
+#!/bin/bash
+#
+set -u
+#set -xv
+#
+# for on each file containing a call to work alloc (exept BDY files that are too complicated...)
+#for i in $( ack -il "^ *call *wrk_alloc *\(" | grep -v BDY )
+for i in $( egrep -iRl "^ *call *wrk_alloc *\(" * | grep "90$" | grep -v BDY )
+do
+# create a temporary file that will be easier to process...
+    sed -e "s/dimension/DIMENSION/" -e "s/pointer/POINTER/" $i > tmp$$
+# replace "dimension(...), pointer" to "pointer, dimension(...)"
+    sed -e "s/, *DIMENSION *(\([^)]*\)) *, *POINTER/, POINTER, DIMENSION(\1)/" tmp$$ > tmp2$$
+    mv tmp2$$ tmp$$ 
+# remove all comments in $i
+    sed -e "s/\!.*//" tmp$$ > tmp2$$
+    mv tmp2$$ tmp$$
+# numbers of the lines defining the beginning and the end of each subroutine or functions
+    n1=$( egrep -ic "(^ *subroutine *[0-9a-zA-Z_]|function *[0-9a-zA-Z_][0-9a-zA-Z_]* *\(.*\))" tmp$$ )
+    n2=$( egrep -ic "(^ *end *subroutine|^ *end *function)" tmp$$ )
+    if [ $n1 -ne $n2 ]
+    then
+	echo "error with the definition of subroutine/function blocks in $i" 
+	exit
+    fi
+    linesbegin=$( egrep -in "(^ *subroutine *[0-9a-zA-Z_]|function *[0-9a-zA-Z_][0-9a-zA-Z_]* *\(.*\))" tmp$$ | sed -e "s/:.*//" )
+    linesend=$( egrep -in "(^ *end *subroutine|^ *end *function)" tmp$$ | sed -e "s/:.*//" | sort -rn )
+#
+# number of the lines containing wrk_alloc
+    cnt=$( grep -ci "^ *call *wrk_alloc *(" tmp$$ )
+# for each of these lines
+    ll=1
+    while [ $ll -le $cnt ]
+    do
+# get the line with its number
+	line=$( grep -in "^ *call *wrk_alloc *(" tmp$$ | sed -n ${ll}p | sed -e "s/\!.*//" )
+# get its number
+	lline=$( echo $line | sed -e "s/:.*//" )
+# keep only the arument of wrk_alloc between ()
+	line=$( echo $line | sed -e "s/[^(]*\((.*)\).*/\1/" | sed -e "s/, *k[ijkl]start *=[^,]*,/,/" | sed -e "s/, *k[ijkl]start *=.*)/ )/" )
+# find in which subroutine or function is located this call to wrk_alloc: l1 beginning l2: end
+	for lll in $linesbegin
+	do
+	    [ $lline -gt $lll ] && l1=$lll
+	done
+	for lll in $linesend
+	do
+	    [ $lline -lt $lll ] && l2=$lll
+	done
+	if [ $l2 -le $l1 ]
+	then
+	    echo "error in $i in the indentification subroutine/function block containing line $lline"
+	    exit
+	fi
+# get the last argument of the call to wrk_alloc (between the last "," and ")"
+	lw=$( echo $line | sed -e "s/.*,\(.*\)).*/\1/" | sed -e "s/ *//g" )
+# get the line containing the definition of this argument and from it get the number of dimension of the argument
+	tst=$( sed -n ${l1},${l2}p tmp$$  | grep -i "POINTER *, *DIMENSION *(.*) *::.*"${lw} | egrep -ic "[^0-9a-zA-Z_]("${lw}" *$|"${lw}" *,)" )
+	if [ $tst -ne 1 ]
+	then
+	    echo "error with ${lw} definition in $i" 
+	    exit
+	fi
+	dimsz=$( sed -n ${l1},${l2}p tmp$$  | grep -i "POINTER *, *DIMENSION *(.*) *::.*"${lw} | egrep -i "[^0-9a-zA-Z_]("${lw}" *$|"${lw}" *,)" | sed -e "s/.*POINTER *, *DIMENSION *(\(.*\)) *::.*/\1/" | sed -e "s/ //g" | wc -c )
+	dimsz=$(( $dimsz / 2 ))
+# get the number of variables concerned by the call to wrk_alloc (keep anly the , and count them)
+	nvar=$( echo $line | sed -e "s/[^,]//g" | wc -c )
+	nvar=$(( $nvar - $dimsz ))
+# get the définition of the size of the dimensions from the call to wrk_alloc 
+	case $dimsz in
+	    1) dim=$( echo $line | sed -e "s/( *\([^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 1st ,
+	    2) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 2nd ,
+	    3) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 3rd ,
+	    4) dim=$( echo $line | sed -e "s/( *\([^,]*,[^,]*,[^,]*,[^,]*\),.*)/\1/" | sed -e "s/ //g" ) ;; # keep between ( and the 4th ,
+	    *) echo "error with the number of dimensions of $lw in $i"; exit ;;
+	esac
+# for each variable, change its definition...
+	nn=1 
+	var=$lw # start from the last argument
+	while [ $nn -le $nvar ]
+	do
+# get the line where this variable is defined.	
+	    tst=$( sed -n ${l1},${l2}p tmp$$  | grep -ni "POINTER *, *DIMENSION *(.*) *::.*"${var} | egrep -ic "[^0-9a-zA-Z_]("${var}" *$|"${var}" *,)" )
+	    if [ $tst -ne 1 ]
+	    then
+		echo "error with ${lw} definition in $i" 
+		exit
+	    fi
+# get the line number where the variable is defined
+	    lvar=$( sed -n ${l1},${l2}p tmp$$  | grep -ni "POINTER *, *DIMENSION *(.*) *::.*"${var} | egrep -i "[^0-9a-zA-Z_]("${var}" *$|"${var}" *,)" | sed -e "s/:.*//" )
+	    lvar=$(( $lvar + $l1 - 1 ))
+# get the dimension definition and compare it to ${dim}
+	    dim2=$( sed -n -e "${lvar}p" $i | sed -e "s/dimension/DIMENSION/" -e "s/\!.*//" | sed -e "s/.*, *DIMENSION *(\(.*\)).*/\1/" | sed -e "s/ //g" )
+	    if [ $( echo $dim2 | wc -c ) -ne $(( $dimsz * 2 )) ] 
+	    then 
+		if [ "$dim2" != "$dim" ] 
+		then 
+		    echo "problem in $i in the defininition of variable $var: its size is $dim but we have $dim2"
+		    sed -n -e "${lvar}p" $i
+		    exit
+		fi
+	    fi
+# remove pointer
+	    sed -e "${lvar}s/pointer/POINTER/" $i | sed -e "${lvar}s/, *POINTER *,/,/" | sed -e "${lvar}s/, *POINTER */ /" > tmp2$$
+	    mv tmp2$$ $i
+# redefine the dimensions 
+	    case $dimsz in
+		1) sed -e "${lvar}s/\(DIMENSION *(\) *: *)/\1${dim})/" $i > tmp2$$ ;;
+		2) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+		3) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+		4) sed -e "${lvar}s/\(DIMENSION *(\) *: *, *: *, *: *, *: *)/\1${dim})/" $i > tmp2$$ ;;
+	    esac
+	    mv tmp2$$ $i
+	    
+# define the next variable (previous argument)
+	    var=$( echo $line | sed -e "s/.*,\(.*\), *[^0-9a-zA-Z_]*${var}[^0-9a-zA-Z_]*[,)].*/\1/" | sed -e "s/ *//g" )
+	    nn=$(( $nn + 1 ))
+	done
+	
+	ll=$(( $ll + 1 ))
+    done
+#delete wrk_alloc line
+    sed -e "/call *wrk_alloc *(/d" -e "/CALL *wrk_alloc *(/d" \
+	-e "/call *wrk_dealloc *(/d" -e "/CALL *wrk_dealloc *(/d" \
+	-e "/USE wrk_nemo/d"  -e "/use wrk_nemo/d" $i > tmp$$
+    mv tmp$$ $i
+    
+    echo $i done
+done
+#
+# some specific changes...
+#
+# OPA_SRC/SBC/albedo.F90
+sed -e "s/DIMENSION(jpi,jpj,ijpl)/DIMENSION(jpi,jpj,SIZE(pt_ice,3))/" OPA_SRC/SBC/albedo.F90 > tmp$$
+mv tmp$$ OPA_SRC/SBC/albedo.F90
+# LIM_SRC_2/limrhg_2.F90
+sed -e "s/DIMENSION(jpi,jpj+2)/DIMENSION(jpi,0:jpj+1)/" LIM_SRC_2/limrhg_2.F90 > tmp$$
+mv tmp$$ LIM_SRC_2/limrhg_2.F90
+# LIM_SRC_3/limitd_me.F90
+sed -e "s/DIMENSION(jpi,jpj,jpl+2)/DIMENSION(jpi,jpj,-1:jpl)/" LIM_SRC_3/limitd_me.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limitd_me.F90
+# LIM_SRC_3/limitd_th.F90
+sed -e "s/DIMENSION(jpi,jpj,jpl+1)/DIMENSION(jpi,jpj,0:jpl)/" LIM_SRC_3/limitd_th.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limitd_th.F90
+# LIM_SRC_3/limthd_dif.F90
+sed -e "s/DIMENSION(kiut,nlay_i+1)/DIMENSION(kiut,0:nlay_i)/" \
+    -e "s/DIMENSION(kiut,nlay_s+1)/DIMENSION(kiut,0:nlay_s)/" LIM_SRC_3/limthd_dif.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_dif.F90
+# LIM_SRC_3/limthd_ent.F90
+sed -e "s/DIMENSION(jpij,jkmax+4)/DIMENSION(jpij,0:jkmax+3)/" \
+    -e "s/DIMENSION(jkmax+4,jkmax+4)/DIMENSION(0:jkmax+3,0:jkmax+3)/" LIM_SRC_3/limthd_ent.F90 > tmp$$
+mv tmp$$ LIM_SRC_3/limthd_ent.F90
+# OPA_SRC/DYN/divcur.F90
+sed -e "s/DIMENSION(jpi+4,jpj)/DIMENSION(-1:jpi+2,jpj)/" OPA_SRC/DYN/divcur.F90 > tmp$$
+mv tmp$$ OPA_SRC/DYN/divcur.F90
+# OPA_SRC/LDF/ldfslp.F90
+sed -e "s/DIMENSION(jpi,jpj,jpk,2)/DIMENSION(jpi,jpj,jpk,0:1)/" \
+    -e "s/DIMENSION(jpi,jpj,2,2)/DIMENSION(jpi,jpj,0:1,0:1)/" OPA_SRC/LDF/ldfslp.F90 > tmp$$
+mv tmp$$ OPA_SRC/LDF/ldfslp.F90
+# OPA_SRC/ZDF/zdfkpp.F90
+sed -e "s/DIMENSION(jpi,3) *::* zmoek/DIMENSION(jpi,0:2) ::   zmoek/" OPA_SRC/ZDF/zdfkpp.F90 > tmp$$
+mv tmp$$ OPA_SRC/ZDF/zdfkpp.F90
+
+# link for limrhg.F90...
+cd LIM_SRC_2
+ln -sf ../LIM_SRC_3/limrhg.F90 .
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/README	(revision 3294)
@@ -0,0 +1,12 @@
+dataplot.pro - IDL widget based program to read in netcdf feedback and data
+files and plot observation and background values.
+
+example calls:
+
+dataplot,filenamearray
+dataplot,filenamearray,/batchplot,/gif
+dataplot,filenamearray,/batchplot,/ps
+
+use
+
+man,'dataplot' in idl for more information
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/colorbar_idl.pro	(revision 3294)
@@ -0,0 +1,212 @@
+;+
+PRO colorbar_idl, datain, colors, lablevels, datalevels, data=data, $
+	textcolor=textcolor, mincolor=mincolor, position=position
+;--------------------------------------------------------------------
+; datain - gives the range of values which are represented by colors
+; colors - color values
+; lablevels - label levels
+;
+; Author:  D. J. Lea    Nov 2008
+;--------------------------------------------------------------------
+
+; keep current graphics keywords
+
+psave=!p
+xsave=!x
+ysize=!y
+
+	if (n_elements(mincolor) eq 3) then $
+	      TVLCT,mincolor(0),mincolor(1),mincolor(2),0 
+
+    mx=max(datain,min=mn)
+
+	normal=1
+	if (keyword_set(data)) then normal=0
+
+    
+    if (keyword_set(data)) then begin				; data coords
+    y1 = !y.crange(0)-0.1*(!y.crange(1)-!y.crange(0))     
+    y2 = !y.crange(0)-0.05*(!y.crange(1)-!y.crange(0))
+    x1 = !x.crange(0)+0.1*(!x.crange(1)-!x.crange(0))
+    x2 = !x.crange(0)+0.9*(!x.crange(1)-!x.crange(0))
+    endif else begin						; normal coords
+    y1 = !y.window(0)-0.11*(!y.window(1)-!y.window(0))     
+    y2 = !y.window(0)-0.05*(!y.window(1)-!y.window(0))
+;;    y1 = !y.window(0)+0.05*(!y.window(1)-!y.window(0))     
+;;    y2 = !y.window(0)+0.1*(!y.window(1)-!y.window(0))
+    x1 = !x.window(0)+0.076*(!x.window(1)-!x.window(0))
+    x2 = !x.window(0)+0.924*(!x.window(1)-!x.window(0))
+    endelse
+
+    if (n_elements(position) eq 4) then begin
+    	coords=position
+    endif else begin
+	coords=[x1,y1,x2,y2]
+    endelse
+
+    print,'coords: ',coords
+	print, 'normal: ',normal, ' data: ',keyword_set(data)
+
+;    nb = N_ELEMENTS(colors)               
+;    x=coords(0)+(coords(2)-coords(0))*findgen(nb+1)/nb
+;    
+;    FOR i=0,nb-1 DO BEGIN
+;;    print,colors(i)
+;    polyfill, transpose([[x(i),x(i+1),x(i+1),x(i),x(i)],$
+;      [coords(1),coords(1),coords(3),coords(3),coords(1)]]),$
+;      color=colors(i), data=data, normal=normal
+;    ENDFOR
+
+;Position is always in normal units will need to do a conversion if 
+; data units required...
+
+    fill=0
+    cell_fill=1
+
+    maxdat=mx
+    mindat=mn
+    if (n_elements(datalevels) gt 0) then begin
+	    maxdat=max(datalevels,min=mindat)
+;            mindat=mindat+(1./!d.table_size)*(maxdat-mindat)
+;            print,'datalevels ',datalevels
+    endif
+
+; fix to prevent zero contour range
+    if (maxdat eq mindat) then begin
+        if (maxdat eq 0) then begin
+    	maxdat = maxdat + 1e-20
+        mindat = mindat - 1e-20
+        endif else begin
+        maxdat = maxdat * 1.01
+        mindat = mindat * 0.99
+        if (maxdat lt mindat) then begin
+        	tmp = mindat
+                mindat = maxdat
+                maxdat = tmp
+        endif
+        endelse
+    endif
+    
+    array1d=(findgen(!d.table_size+1))/!d.table_size*(maxdat-mindat)+mindat
+;    array1d=(findgen(!d.table_size+10)-10)/!d.table_size*(maxdat-mindat)+mindat
+
+	print,'!d.table_size ',!d.table_size
+
+;	print,'array1d ',array1d
+        print,'min array1d ',min(array1d), max(array1d)
+        print,'datain ',datain
+        print,'mx ',mx,' mn ',mn
+
+    if (n_elements(datalevels) gt 0) then print, 'datalevels ', datalevels
+        
+    array2d=array1d#replicate(1,2)
+    if (n_elements(datalevels) lt 2) then datalevels=array1d
+    
+;    print, 'datalevels ', datalevels
+;	print,'cell_fill ',cell_fill
+
+    TVLCT, R, G, B, /get
+    TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+	if (n_elements(data) gt 0) then print,'data = ',data
+        if (n_elements(normal) gt 0) then print,'normal = ',normal
+        print,coords
+
+; draw a few times to remove gaps
+    nel=n_elements(datalevels)
+    print, 'datalevels ',datalevels(0), datalevels(nel-1), nel
+    print, 'array2d ',min(array2d), max(array2d)
+    if (datalevels(0) lt datalevels(nel-1)) then begin 
+    for i=0,2 do begin    
+    contour, array2d, levels=datalevels, fill=fill, cell_fill=cell_fill, $
+    POSITION=coords, /noerase, xstyle=5, ystyle=5, data=data, normal=normal
+    endfor
+    endif
+
+    TVLCT,R(0),G(0),B(0),0 
+
+    numlablevels=n_elements(lablevels)
+    sigfig=1
+	strlabs=strarr(numlablevels)
+
+	repeat begin
+        widstr=strtrim(string(sigfig+8),2)
+; output 2 significant figures except if 0.
+
+        for i = 0, numlablevels-1 do begin
+        format='(g'+widstr+'.'+strtrim(string(sigfig),2)+')'
+	strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all)
+
+;	print,i,'.',strlabs(i),'.',format
+
+        if (strmid(strlabs(i),0,1) eq '0' or strmid(strlabs(i),0,2) eq '-0') then begin
+        	format='(g'+widstr+'.'+strtrim(string(sigfig-1),2)+')'
+	        strlabs(i)=strcompress(string(lablevels(i),format=format),/remove_all) 
+;                print,i,'.',strlabs(i),'.',format               
+        endif
+
+;	print,i,'.',strlabs(i),'.',format 
+
+; trim out spaces
+	strlabs(i)=strtrim(strlabs(i),2)
+       
+        strtemp=strlabs(i)
+; strip off last two characters if there is 0 after the decimal place
+; with a number thereafter
+        ptpos=strpos(strtemp,'.0')
+        len=strlen(strtemp)
+;        if ptpos gt 0 then print,ptpos,len
+        if ptpos gt 0 and len-2 ge ptpos then begin
+		strlabs(i)=strmid(strtemp,0,len-1)		        
+        endif
+
+;if the remaining last character is a point (.) then get rid of it
+	ptpos=strpos(strlabs(i),'.')
+        len=strlen(strlabs(i))
+;	print,ptpos, len
+	if ptpos gt 0 and ptpos eq len-1 then begin
+        	strlabs(i)=strmid(strlabs(i),0,len-1)
+        endif
+        
+        endfor
+;        print,strlabs
+;        print,strlen(strlabs)
+        sigfig=sigfig+1
+        whe=where(strpos(strlabs,'e') gt 0, numexps)
+;        print,'whe ',whe, numexps
+; all labels should be unique
+; should be all exps or none 
+; give up if sigfigs 255       
+	endrep until (n_elements(unique(strlabs)) eq numlablevels $
+        	and (numexps eq 0 or numexps eq numlablevels) $
+        	or sigfig gt 255) 
+
+    pcharsize=!p.charsize
+    if (pcharsize lt 1) then pcharsize=1
+;    tolx=0.01*pcharsize*(!x.crange(1)-!x.crange(0))
+    tolx=0.01*(x2-x1)
+    
+    ypos = y1-0.02*pcharsize*(!y.crange(1)-!y.crange(0))
+    for i = 0, numlablevels-1 do begin
+;      xpos = x1 + float(i)/float(n_elements(lablevels)-1)*(x2-x1)
+	xpos = x1 + (lablevels(i)-mn)/(mx-mn)*(x2-x1)		; position labels correctly relative 
+
+	if (xpos ge x1-tolx and xpos le x2+tolx) then begin 	; don't print any labels off the edge 
+
+;      xyouts, xpos, ypos, strcompress(string(lablevels(i),format='(f7.2)'),/remove_all), $
+;              color=!d.table_size-1, data=data, normal=normal, align=0.5
+
+	if (n_elements(textcolor) eq 3) then $
+	      TVLCT,textcolor(0),textcolor(1),textcolor(2),0 
+;	print,'xyouts ',xpos, ypos, ' ',strlabs(i)
+        xyouts, xpos, ypos, strlabs(i), data=data, normal=normal, align=0.5 
+	endif
+
+    endfor
+
+; restore graphics keywords
+!p=psave
+!x=xsave
+!y=ysize
+                    
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot.pro	(revision 3294)
@@ -0,0 +1,4517 @@
+;+----------------------------------------------------------------------------------------
+; dataplot.pro
+; IDL widget based plotting routine for plotting observation and background values
+;
+; Author: D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+;example calls:
+;
+;dataplot,filenamearray
+;dataplot,filenamearray,/batch,/gif			; plots data directly to a gif
+;dataplot,filenamearray,/batch,/ps			; plots data directly to a ps
+;dataplot,filenamearray,/batch,area=area            ; area 4 element array or descriptive string
+;dataplot, longitude, latitude, deparr, dayarr, valarr, bkgarr
+;dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr], rmdi=rmdi, filename=filename 
+;
+;optional keywords
+;area			descriptive string or array [minlon,minlat,maxlon,maxlat]
+;typeplot=1-5 		plot obs-bkg or obs bkg etc 
+;alldays=1 		plot all days otherwise just plot first day    
+;depths			[depmin,depmax] in metres
+;showmdt		plot mdt
+;obstypeselect		string array of selected obs types to plot 
+;printobstypes		keyword to print unique obs types to the terminal
+;
+;+-----------------------------------------------------------------------------------------
+; Note the upper two slider bars control the depth range
+; the lower two slider bars control the day range
+;------------------------------------------------------------------------------------------
+
+
+; Event-handling procedure. 
+PRO dataplot_event, ev 
+ 
+  ; Retrieve the anonymous structure contained in the user value of 
+  ; the top-level base widget.  
+ 
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+
+;  print,uval
+
+;  print,'event'
+;  print,stash.depmin
+
+;  position = [!X.Window[0], !Y.Window[0], !X.Window[1], !Y.Window[1]]
+;  print,position 
+;  xsize = (position(2) - position(0)) * !D.X_VSIZE
+;  ysize = (position(3) - position(1)) * !D.Y_VSIZE
+;  xstart = position(0) * !D.X_VSIZE
+;  ystart = position(1) * !D.Y_VSIZE
+;  print,xsize,ysize,xstart,ystart
+  
+  ; If the event is generated in the draw widget, update the 
+  ; label values with the current cursor position and the value 
+  ; of the data point under the cursor. Note that since we have 
+  ; passed a pointer to the image array rather than the array 
+  ; itself, we must dereference the pointer in the 'image' field 
+  ; of the stash structure before getting the subscripted value. 
+ 
+  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_DRAW') THEN BEGIN 
+	xdev= ev.X 
+	ydev= ev.Y
+        
+;        print, 'xdev ',xdev, ' ydev ',ydev
+        
+; convert the pointer position to a data position
+  	arr=CONVERT_COORD( xdev, ydev, /device, /to_data) 
+  	xdata=arr(0)
+	ydata=arr(1)
+
+;	print, xdata , ydata        
+        
+;        print, 'xdev: ',xdev,' ydev: ',ydev,' xdata: ',xdata, ' ydata: ',ydata
+;    WIDGET_CONTROL, stash.label1, $ 
+;      SET_VALUE='X position: ' + STRING(xdata) 
+;    WIDGET_CONTROL, stash.label2, $ 
+;      SET_VALUE='Y position: ' + STRING(ydata) 
+;;    WIDGET_CONTROL, stash.label3, $ 
+;;      SET_VALUE='Value: ' + $ 
+;;      STRING((*stash.imagePtr)[ev.X, ev.Y], FORMAT='(Z12)') 
+;    WIDGET_CONTROL, stash.label3, $ 
+
+
+   ; What kind of event is this?
+
+;eventTypes = ['DOWN', 'UP', 'MOTION']
+;0 1 2
+;thisEvent = ev.type
+
+;print, 'ev.type ',ev.type
+
+CASE ev.type OF
+   0: BEGIN
+; dragbox start
+   print, 'down ',xdev,ydev, xdata, ydata
+         ; Turn motion events on for the draw widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=1
+
+	; dragbox
+         ; Create a pixmap. Store its ID. Copy window contents into it.
+
+      Window, /Free, /Pixmap, XSize=stash.im_size(1), YSize=stash.im_size(2)
+      stash.pixID = !D.Window
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.drawID]
+;      WSet, stash.drawID
+
+	print,stash.im_size(0), stash.im_size(1), stash.im_size(2), stash.pixID, stash.drawID
+      
+      stash.xcorn=xdev
+      stash.ycorn=ydev
+      
+      stash.xdatacorn=xdata
+      stash.ydatacorn=ydata
+   
+;   RETURN
+   ENDCASE
+   1: BEGIN
+; dragbox close
+   print, 'up ',xdev,ydev, xdata, ydata
+         ; Turn draw motion events off. Clear any events queued for widget.
+
+      Widget_Control, stash.draw, Draw_Motion_Events=0, Clear_Events=1
+
+       WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+      WDelete, stash.pixID
+           
+      ; zoom in
+
+; dragbox   
+; avoid zooming if no dragging has occurred
+	pixdiffx = min([abs(stash.xcorn-xdev),abs(stash.ycorn-ydev)])       
+        print, '** Pixdiffx ',pixdiffx, stash.xcorn-xdev, stash.ycorn-ydev
+        if (pixdiffx gt 1 and finite(xdata) and finite(ydata)) then begin
+
+   	minxdata = min([stash.xdatacorn, xdata], max=maxxdata)
+        minydata = min([stash.ydatacorn, ydata], max=maxydata)
+
+
+	if (minxdata ge -180 and maxxdata le 360 and minydata ge -90 and maxydata le 90) then begin
+
+                stash.xrange=[minxdata,maxxdata]
+        	stash.yrange=[minydata,maxydata]
+                
+	        plotpoints,stash
+        endif
+        endif	
+           
+;   RETURN
+   ENDCASE
+   2: BEGIN
+; drag box motion
+;   print, 'motion: ',ev.x, ev.y
+
+      WSet, stash.drawID
+      Device, Copy=[0, 0, stash.im_size(1), stash.im_size(2), 0, 0, stash.pixID]
+
+   
+   sx = stash.xcorn
+   sy = stash.ycorn
+
+      PlotS, [sx, sx, xdev, xdev, sx], [sy, ydev, ydev, sy, sy], /Device, $
+          Color=!p.color
+;         Color=255
+   
+   ENDCASE
+   
+;   RETURN
+   7: begin
+		print,'mouse wheel event ',ev.clicks
+		if (ev.clicks eq 1 or ev.clicks eq -1) then begin
+		print,'zoom in/out'
+
+		print,'stash.depmin ',stash.depmin
+
+		print,'xdata ',xdata
+                
+                if (finite(xdata) and finite(ydata)) then begin
+
+; make an adjustment if we're in the Pacific
+	xrange=stash.xrange
+        typeproj=stash.typeproj
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+       
+
+		oxrange=stash.xrange
+		oyrange=stash.yrange
+
+		dataplot_zoom, stash, xdata, ydata, ev.clicks
+
+; plot only if a change has been made
+		if (stash.xrange(0) ne oxrange(0) or stash.yrange(0) ne oyrange(0) $
+                    or stash.xrange(1) ne oxrange(1) or stash.yrange(1) ne oyrange(1)) then $
+			plotpoints, stash
+
+		endif
+                
+                endif
+
+   ENDCASE
+ENDCASE
+
+
+
+
+
+
+
+
+;      SET_VALUE='Value: ' + STRING(ev.release) 
+
+;	if(ev.release eq 1) then begin
+;		print,'left click - search for nearest point'
+	if(ev.release eq 1 or ev.release eq 4) then begin		; mouse click
+
+; might want a generalised point selection routine
+; for this routine and for plotpoints
+
+		print,'xdata ',xdata, ' ydata ',ydata
+                print,'xdev ',xdev, 'ydev ',ydev
+
+		if (finite(xdata) and finite(ydata)) then begin
+
+		print, 'finite'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+                obstypes1=stash.obstypes
+ 		xrange=stash.xrange
+		yrange=stash.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash.rmdi
+;                if (stash.salinity eq 0) then begin
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;                 qcarr1=stash.qcarr
+;                endif else begin
+;		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;                 qcarr1=stash.qcarr2
+;		endelse                		
+                typeproj=stash.typeproj
+
+; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xdata lt 0) then xdata=xdata+360 
+
+; set reasonable dist criteria
+
+		distmax=(xs/100.)^2+(ys/100.)^2
+;		print,'distmax ',distmax
+
+
+		selpoints,stash,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr 
+
+; get max min daysel
+		mindaysel=min(daysel, max=maxdaysel)
+
+;		print, 'selpoints ',obnumsel
+
+		if (n_elements(lonsel) gt 0) then begin
+		dist=((lonsel-xdata)^2+(latsel-ydata)^2)
+		res=min(dist,whd)		; whd is the minumum dist point index
+
+;		print,lonsel
+
+	xselstr=""
+	yselstr=""
+	valselstr=""
+	qcselstr=""
+	datestr=""
+        obnumselstr=""
+        mindatestr=""
+        maxdatestr=""
+
+;	print,'whd(0) ',whd(0)
+;        print,'res ',res, ' distmax ',distmax
+
+	obstypstr=""		
+	if (whd(0) gt -1 and res lt distmax) then begin		
+	xsel=lonsel(whd)
+	ysel=latsel(whd)
+ 
+ 	print,'xsel ',xsel,' ysel ',ysel       
+ ; make an adjustment if we're in the Pacific
+	if (xrange(1) gt 180 and typeproj eq 1) then if (xsel gt 180) then xsel=xsel-360 
+               
+	valsel=innovsel(whd)
+	qcsel=qcsel(whd)
+	datesel=daysel(whd)
+	obstypsel=obstypsel(whd)
+	obnumsel=obnumsel(whd)
+
+	xselstr=string(xsel)
+	yselstr=string(ysel)
+	valselstr=string(valsel)	
+	qcselstr=string(qcsel)
+;	datestr=string(datesel)
+	obstypstr=string(obstypsel(0))
+        obnumselstr=string(obnumsel(0))
+        print,'datesel(0) ',datesel(0) 
+        print,'obnumsel(0) ',obnumsel(0)
+	jul_to_dtstr,datesel(0),datestr
+        jul_to_dtstr,mindaysel,mindatestr
+        jul_to_dtstr,maxdaysel,maxdatestr
+   
+	if (ev.release eq 4) then begin
+        
+        	print,'ev.release ',ev.release
+
+;		window
+		wh=where(xarr1 eq xsel and yarr1 eq ysel)
+                print,'xsel ',xsel
+;                print,'xarr1 ',xarr1
+		dep2=dep1(wh)
+
+		if (wh(0) gt -1) then begin
+		if (stash.density eq 0) then begin
+
+         if (stash.salinity eq 0) then begin
+;                  print,'salinity eq 0'
+            obs2=stash.obs(wh)
+		      bkg2=stash.bkg(wh)
+            qcarr2=stash.qcarr(wh)
+         endif else begin
+;                  print,'salinity eq 1'
+		      obs2=stash.obs2(wh)
+		      bkg2=stash.bkg2(wh)
+            qcarr2=stash.qcarr2(wh)
+		   endelse
+
+      endif else begin
+
+         if (stash.filetype eq 'CRT') then begin
+
+            bkgU=stash.bkg(wh)
+            bkgV=stash.bkg2(wh)
+            bkg2=sqrt(bkgU*bkgU + bkgV*bkgV)
+
+            obsU=stash.obs(wh)
+            obsV=stash.obs2(wh)
+            obs2=sqrt(obsU*obsU + obsV*obsV)
+
+            qcarr2=stash.qcarr(wh)
+
+         endif else begin
+
+;            print,'density eq 1'
+            bkgt=stash.bkg(wh)
+            bkgs=stash.bkg2(wh)
+            obst=stash.obs(wh)
+            obss=stash.obs2(wh)                  
+;		       obs2=obst+obss
+;            bkg2=bkgt+bkgs
+		      obs2=eos_nemo(obst,obss)
+            bkg2=eos_nemo(bkgt,bkgs)
+            wh2=where(bkgt eq rmdi or bkgs eq rmdi)
+            if (wh2(0) gt -1) then begin
+               obs2(wh2)=rmdi
+               bkg2(wh2)=rmdi
+            endif
+            qcarr2=max([[stash.qcarr(wh)],[stash.qcarr2(wh)]],dim=2)                                		
+
+         endelse
+
+		endelse
+
+;		val2=abs(obs1(wh)-bkg1(wh))
+		val2=abs(obs2-bkg2)
+;		obs2=obs1(wh)
+;		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+;                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+;		val2=sqrt(val1(wh)^2)
+		
+;		print,'val2 ',val2(wh2)
+;		print,'dep2 ',dep2(wh2)
+;		plot,val2(wh2),dep2(wh2),ystyle=1,xstyle=1
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash.salinity, $
+                	plot_bad_obs=stash.plot_bad_obs, white_on_black=stash.white_on_black, coltable=stash.coltable, $
+                        	depmax=stash.depmax, depmin=stash.depmin
+
+
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+                
+                endif     ; wh(0)>-1
+
+	endif			; ev.release 4 (right mouse)
+        endif         
+	endif			; left or right mouse click
+	
+    WIDGET_CONTROL, stash.label1, $ 
+      SET_VALUE=stash.labt1 + strtrim(xselstr,1) 
+    WIDGET_CONTROL, stash.label2, $ 
+      SET_VALUE=stash.labt2 + strtrim(yselstr,1) 
+     WIDGET_CONTROL, stash.label3, $ 
+      SET_VALUE=typestr+': ' + strtrim(valselstr,1) 
+     WIDGET_CONTROL, stash.label4, $ 
+      SET_VALUE=stash.labt4 + strtrim(qcselstr,1) 
+     WIDGET_CONTROL, stash.label5, $
+      SET_VALUE=stash.labt5 + strtrim(datestr,1)
+     WIDGET_CONTROL, stash.label6, $ 
+      SET_VALUE=stash.labt6 + strtrim(valselstr,1) 
+;     WIDGET_CONTROL, stash.label7, $ 
+;      SET_VALUE=stash.labt7 + strtrim(string(innovsd),1)
+     WIDGET_CONTROL, stash.label8, $
+      SET_VALUE=stash.labt8 + strtrim(obstypstr,1)
+     WIDGET_CONTROL, stash.label9, $
+      SET_VALUE=stash.labt9 + strtrim(obnumselstr,1)
+     WIDGET_CONTROL, stash.label10, $
+      SET_VALUE=stash.labt10 + string(mindatestr) + ' ' + string(maxdatestr)
+		
+	endif else begin			; not finite
+
+	print, 'not finite'
+        
+; check for colorbar click
+		if (ydev lt 80) then begin        
+ 	        toplevel=stash.base
+	        fmx=stash.fmx
+        	fmn=stash.fmn
+      	        mx=stash.mx
+        	mn=stash.mn
+   		inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+		if (success eq 1) then begin
+        	stash.fmx=fmx
+        	stash.fmn=fmn
+        	plotpoints,stash
+        	endif
+                endif
+        
+        endelse			; finite
+
+	endif
+
+		
+      
+;      print,tag_names(ev)
+;      print,ev.id
+;      print,ev.top
+;      print,ev.handler
+;      print,ev.type
+;      print,ev.press
+;      print,ev.release
+;      print,ev.clicks
+;      print,ev.modifiers
+;      print,ev.ch
+;      print,ev.key
+       
+   ENDIF                   ; end of widget draw events
+ 
+  ; If the event is generated in a button, destroy the widget 
+  ; hierarchy. We know we can use this simple test because there 
+  ; is only one button in the application. 
+ 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_COMBOBOX') THEN BEGIN
+;   IF (uval eq 'LEVELLIST') THEN BEGIN
+
+   IF (uval eq 'LEVELCHOICE') THEN BEGIN
+
+	stash.depmin=ev.value
+
+		print,'levelchoice'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmin ge stash.depmax) then begin
+		stash.depmax=stash.depmin
+	if (stash.depmax gt stash.depmaxl) then stash.depmax=stash.depmaxl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.sliderb, set_value=stash.depmax
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+   IF (uval eq 'LEVELCHOICEB') THEN BEGIN
+
+	stash.depmax=ev.value
+
+		print,'levelchoiceb'
+	print, 'stash.depmin: ',stash.depmin
+	print, 'stash.depmax: ',stash.depmax
+
+	if (stash.depmax le stash.depmin) then begin
+		stash.depmin=stash.depmax
+	if (stash.depmin lt stash.depminl) then stash.depmin=stash.depminl
+
+;set sliderb position
+	WIDGET_CONTROL, stash.slider, set_value=stash.depmin
+
+	endif
+	
+
+		plotpoints, stash
+
+		
+;		   print,ev.index,widget_info(ev.id,/combobox_gettext)
+  
+  ENDIF
+
+
+  IF (uval eq 'DATERANGE1') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymin=ev.value
+;	print, 'ev.drag ',ev.drag
+
+; set slider label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	if (stash.daymin ge stash.daymax) then begin
+;		stash.daymax=stash.daymin+1
+		stash.daymax=stash.daymin
+	if (stash.daymax gt stash.daymaxl) then stash.daymax=stash.daymaxl
+
+;set slider2 position
+	WIDGET_CONTROL, stash.slider2, set_value=stash.daymax
+; set slider 2 label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+	
+        
+	endif
+	
+	print,'daterange1'
+;	if (ev.drag eq 0) then
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+	
+  ENDIF
+  IF (uval eq 'DATERANGE2') THEN BEGIN
+
+	odaymin=stash.daymin
+        odaymax=stash.daymax
+  
+  	stash.daymax=ev.value
+
+; set slider label
+	jul_to_dtstr,stash.daymax,daymaxstr, /notime
+        WIDGET_CONTROL, stash.slider2label, $ 
+        SET_VALUE='max date: '+daymaxstr 
+
+	if (stash.daymax le stash.daymin) then begin
+;		stash.daymin=stash.daymax-1
+		stash.daymin=stash.daymax
+	if (stash.daymin lt stash.dayminl) then stash.daymin=stash.dayminl
+
+;set slider1 position
+	WIDGET_CONTROL, stash.slider1, set_value=stash.daymin
+; set slider 2 label
+	jul_to_dtstr,stash.daymin,dayminstr, /notime
+        WIDGET_CONTROL, stash.slider1label, $ 
+        SET_VALUE='min date: '+dayminstr 
+
+	endif
+	
+	print,'daterange2'
+;	if (ev.drag eq 0) then 
+        if (stash.daymin ne odaymin or stash.daymax ne odaymax) then plotpoints,stash
+
+  ENDIF
+  
+	IF (uval eq "RADIO1") THEN BEGIN
+		print,'uval eq RADIO1'
+		stash.typeplot=1
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO2") THEN BEGIN
+		print,'uval eq RADIO2'	
+		stash.typeplot=2
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO3") THEN BEGIN
+		print,'uval eq RADIO3'
+		stash.typeplot=3
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO4") THEN BEGIN
+		print,'uval eq RADIO4'
+		stash.typeplot=4
+                print, 'typeplot ',stash.typeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO5") THEN BEGIN
+		print,'uval eq RADIO5'
+		stash.ombtypeplot=1
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO6") THEN BEGIN
+		print,'uval eq RADIO6'
+		stash.ombtypeplot=2
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO7") THEN BEGIN
+		print,'uval eq RADIO7'
+		stash.ombtypeplot=3
+                print, 'ombtypeplot ',stash.ombtypeplot
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO01") THEN BEGIN
+		print,'uval eq RADIO01'
+		stash.typeproj=1
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+	IF (uval eq "RADIO02") THEN BEGIN
+		print,'uval eq RADIO02'	
+		stash.typeproj=2
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+  	IF (uval eq "RADIO03") THEN BEGIN
+		print,'uval eq RADIO03'
+		stash.typeproj=3
+		stash.xrange=stash.xrangedef
+		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+	IF (uval eq "RADIO001") THEN BEGIN
+		print,'uval eq RADIO001 ev.select: ',ev.select
+		stash.plot_bad_obs=ev.select
+;		stash.xrange=stash.xrangedef
+;		stash.yrange=stash.yrangedef
+		plotpoints,stash
+	ENDIF
+
+
+	IF (uval eq "RADIOSAL") THEN BEGIN
+	    print,'uval eq RADIOSAL ev.select: ',ev.select
+	    salinity=ev.select
+;            if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin 
+	       stash.salinity=salinity
+  	       plotpoints,stash
+;	    endif
+	ENDIF
+
+
+	IF (uval eq "RADIODENSITY") THEN BEGIN
+            print,'uval eq RADIODENSITY ev.select: ',ev.select
+            density=ev.select
+            if (stash.filetype eq "CRT") then stash.salinity=0
+;            if (stash.filetype eq "Prof" or stash.filetype eq "CRT") then begin
+               stash.density=density  
+       	      plotpoints,stash
+;	         endif
+	ENDIF
+
+
+  IF (uval eq "PRINT") THEN BEGIN
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  	plotpoints,stash
+	prend2,/view
+  ENDIF
+
+  IF (uval eq "SAVE") THEN BEGIN
+
+	thisDevice = !D.Name
+        psave=!p
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=stash.picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+
+;	if (stash.white_on_black eq 0) then begin
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+;
+;        endif
+;        print,'!p.color,!p.background ',!p.color,!p.background
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+; plot data
+  	plotpoints,stash
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+;        !p.charsize=0.0
+	!p=psave
+        
+        spawn,'xv '+stash.outfile+'.gif'
+
+  ENDIF
+
+;Area selection
+
+  xrange=stash.xrange
+  yrange=stash.yrange
+  areasel,uval,xrange,yrange,success, toplevel=stash.base
+  if (success eq 1) then begin
+  stash.xrange=xrange
+  stash.yrange=yrange
+  plotpoints,stash
+  endif
+
+      
+  IF (uval eq "Timeseries") THEN BEGIN
+  	stash.numtimeseries=0
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+;; 		print,'ev release'
+;;		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Num timeseries") THEN BEGIN
+	stash.numtimeseries=1  
+        timeserieswindow,stash
+; set graphics back to main window
+;  		WSET, stash.drawID
+ 		print,'ev release'
+		plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "TS diagram") THEN BEGIN
+        tsdiagramwindow,stash
+; set graphics back to main window
+;  	WSET, stash.drawID
+ 	print,'ev release'
+	plotpoints,stash
+
+  ENDIF
+
+  IF (uval eq "Worst points") THEN BEGIN
+        worstpointswindow,stash
+  ENDIF
+
+  IF (uval eq "Filter type") THEN BEGIN
+  	filterwindow, stash
+  ENDIF
+
+  IF (uval eq "Low res map") THEN BEGIN
+;        stash.map_file=""
+        stash.hires_map=0       
+        Widget_Control, stash.loresmap, Set_Button=1
+        Widget_Control, stash.hiresmap, Set_Button=0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Hi res map") THEN BEGIN
+;        stash.map_file="/opt/ukmo/wave/ukmo/data/map_europe.xdr"
+	stash.hires_map=1
+        Widget_Control, stash.loresmap, Set_Button=0
+        Widget_Control, stash.hiresmap, Set_Button=1
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Plot only bad obs") THEN BEGIN
+  	stash.plot_only_bad_obs = 1-stash.plot_only_bad_obs
+        Widget_Control, stash.pltonbado, Set_Button=stash.plot_only_bad_obs
+        if (stash.plot_bad_obs eq 1) then plotpoints,stash
+  ENDIF
+
+  IF (uval eq "White on black") THEN BEGIN
+        print,uval,' !p.color,!p.background ',!p.color,!p.background
+  	stash.white_on_black = 1-stash.white_on_black
+        Widget_Control, stash.whtonblack, Set_Button=stash.white_on_black
+;        IF (!d.name eq 'X') then begin 
+;                	WSET, stash.drawID
+;; flip background and foreground color
+;                        pcolor=!p.color
+;                        pbackground=!p.background
+;                        !p.color=pbackground
+;                        !p.background=pcolor
+
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+			
+                        plotpoints,stash
+;	endif
+
+
+  ENDIF
+
+
+  IF (uval eq "Square psym") THEN BEGIN
+        stash.sym=1
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "Round psym") THEN BEGIN
+        stash.sym=2
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "incsym") THEN BEGIN
+  	stash.symscale=stash.symscale*1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "decsym") THEN BEGIN
+  	stash.symscale=stash.symscale/1.41421
+        plotpoints,stash
+  ENDIF
+  IF (uval eq "resetsym") THEN BEGIN
+  	stash.symscale=1.0
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "vertgrad") THEN BEGIN
+  	stash.vertgrad=1-stash.vertgrad
+        Widget_Control, stash.vertgradmenu, Set_Button=stash.vertgrad
+        plotpoints,stash
+  ENDIF
+
+  IF (uval eq "Info") THEN BEGIN
+         infowindow
+  ENDIF
+
+  IF (uval eq "input max/min") THEN BEGIN
+        toplevel=stash.base
+        fmx=stash.fmx
+        fmn=stash.fmn
+        mx=stash.mx
+        mn=stash.mn
+   	inputmxmnwindow, fmx, fmn, mx, mn, stash.rmdi, toplevel, success
+	if (success eq 1) then begin
+        stash.fmx=fmx
+        stash.fmn=fmn
+        plotpoints,stash
+        endif
+        
+;        stash.mx=mx
+;        stash.mn=mn      
+;        info,stash.fmx
+;        info,stash.fmn
+;        info,stash.mx
+;        info,stash.mn
+
+  ENDIF
+
+	  
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash 
+
+;  IF (TAG_NAMES(ev, /STRUCTURE_NAME) eq 'WIDGET_BUTTON') THEN BEGIN 
+  IF (uval eq "DONE") THEN BEGIN
+;    WIDGET_CONTROL, ev.TOP, /DESTROY 
+    WIDGET_CONTROL, stash.base, /DESTROY 
+  ENDIF 
+
+
+
+;	WIDGET_CONTROL, stash.label3, SET_VALUE=TAG_NAMES(ev, /STRUCTURE_NAME)
+;	print,TAG_NAMES(ev, /STRUCTURE_NAME), uval
+ 
+END 
+
+;-----------------
+; proceedures
+;-----------------
+
+;setup area ranges
+
+PRO areasel, uval, xrange, yrange, success, toplevel=toplevel
+
+;info, xrange
+;info, yrange
+
+success=0
+  
+  IF (uval eq "Global") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "Arctic") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[70.,90.]
+        success=1
+  ENDIF
+  IF (uval eq "N Atl") THEN BEGIN
+    	xrange=[-100.,0.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Atl") THEN BEGIN
+    	xrange=[-80.,20.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Atl") THEN BEGIN
+    	xrange=[-70.,20.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "N Pac") THEN BEGIN		
+        xrange=[120.,-100.+360.]
+        yrange=[25.,70.]
+        success=1
+  ENDIF
+  IF (uval eq "Trop Pac") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-25.,25.]
+        success=1
+  ENDIF
+  IF (uval eq "S Pac") THEN BEGIN
+    	xrange=[120.,-70.+360.]
+        yrange=[-50.,-25.]
+        success=1
+  ENDIF
+  IF (uval eq "Indian") THEN BEGIN
+    	xrange=[20.,120.]
+        yrange=[-50.,30.]
+        success=1
+  ENDIF
+  IF (uval eq "S Ocean") THEN BEGIN
+    	xrange=[-180.,180.]
+        yrange=[-90.,-50.]
+        success=1
+  ENDIF
+  IF (uval eq "Pacific") THEN BEGIN
+    	xrange=[120.,-80.+360.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Atlantic") THEN BEGIN
+    	xrange=[-100.,20.]
+        yrange=[-50.,70.]
+        success=1
+  ENDIF
+   IF (uval eq "Med") THEN BEGIN
+    	xrange=[-15.,38.]
+        yrange=[30.,46.]
+        success=1
+  ENDIF
+   IF (uval eq "NWS") THEN BEGIN
+    	xrange=[-20.,13.]
+        yrange=[40.,65.]
+        success=1
+  ENDIF
+   IF (uval eq "Input Area") THEN BEGIN
+   	IF (n_elements(toplevel) gt 0) THEN BEGIN
+        print,'success b4',success
+   	inputareawindow, xrange, yrange, toplevel, success
+        print,'success af',success
+        ENDIF
+   ENDIF
+
+END
+
+ 
+;select points to plot
+
+PRO selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+	daymin=daymin, daymax=daymax, salinity=salinity, rmsmean=rmsmean, innovsel2=innovsel2
+
+;		print, 'calling selpoints ',stash.netcdf, stash.txt
+      print, 'calling selpoints'
+
+		xarr1=stash.xarr
+		yarr1=stash.yarr
+		dep1=stash.dep
+                if (n_elements(salinity) eq 0) then salinity=stash.salinity
+		density=stash.density
+                mld=stash.mld
+      filetype=stash.filetype
+
+		obnum=stash.obnum
+;		obnum=lindgen(n_elements(xarr1))	; generate an array of observation numbers
+;                					; starting with zero
+
+;	        if (salinity eq 0) then begin                  
+;		  obs1=stash.obs
+;		  bkg1=stash.bkg
+;		  qcarr=stash.qcarr
+;                endif else begin
+;  		  obs1=stash.obs2
+;		  bkg1=stash.bkg2
+;		  qcarr=stash.qcarr2
+;                endelse              
+
+		if (salinity eq 0) then qcarr=stash.qcarr
+      if (salinity eq 1 or mld eq 1) then qcarr=stash.qcarr2
+      if (density  eq 1) then begin
+         if (filetype eq 'CRT') then qcarr=stash.qcarr $
+         else qcarr=max([[stash.qcarr],[stash.qcarr2]],dim=2)
+      endif
+
+		obstypes1=stash.obstypes
+		depmin=stash.depmin
+		depmax=stash.depmax
+		xrange=stash.xrange
+		yrange=stash.yrange
+		dayarr=stash.dayarr
+                fdayarr=long(dayarr+stash.dayshi)	; 0:00 hours should be plotted in prev day 
+		if (n_elements(daymin) eq 0) then daymin=stash.daymin
+		if (n_elements(daymax) eq 0) then daymax=stash.daymax
+		fdaymin=long(daymin)
+                fdaymax=long(daymax)
+		typeplot=stash.typeplot
+                ombtypeplot=stash.ombtypeplot
+		typeproj=stash.typeproj
+		xrange=stash.xrange
+		yrange=stash.yrange
+		rmdi=stash.rmdi
+
+		print,'dayarr ',max(dayarr)-2454710d, min(dayarr)-2454710d
+                print,'dayarr a',max(dayarr+stash.dayshi)-2454710d,min(dayarr+stash.dayshi)-2454710d
+		print,'stash.dayshi ',stash.dayshi
+
+		print,'fdayarr mx/mn ',max(fdayarr),min(fdayarr)
+                print,'fdaymin ',fdaymin,' fdaymax ',fdaymax
+
+		plot_bad_obs=stash.plot_bad_obs
+		
+		typestr=''
+
+		if (typeproj eq 2) then begin
+			xrange=[-999., 999.]
+			yrange=[0., 90.]
+		endif
+		if (typeproj eq 3) then begin
+			xrange=[-999., 999.]
+			yrange=[-90, 0.]
+		endif
+
+; add 360 if we're in the pacific
+
+		if (xrange(1) gt 180 and typeproj eq 1) then begin
+                print,'xrange(1) gt 180 ',xrange
+		    wh=where(xarr1 lt 0)
+                    xarr1(wh)=xarr1(wh)+360
+                endif
+
+		print,'dayarr(0): ',dayarr(0),fdayarr(0), daymin, daymax
+		
+;		if (plot_bad_obs eq 1) then begin
+		wh=where(dep1 ge depmin and dep1 le depmax and $
+			fdayarr ge fdaymin and fdayarr le fdaymax and $
+			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+			yarr1 ge yrange(0) and yarr1 le yrange(1))
+;		endif else begin
+;		wh=where(dep1 ge depmin and dep1 le depmax and $
+;			fdayarr ge fdaymin and fdayarr le fdaymax and $
+;			xarr1 ge xrange(0) and xarr1 le xrange(1) and $
+;			yarr1 ge yrange(0) and yarr1 le yrange(1) and qcarr eq 0)
+;		endelse		
+
+		nelwh=n_elements(wh)
+
+		print,'nelwh ',nelwh
+	
+		if (wh(0) gt -1) then begin
+;		   obssel=obs1(wh)
+;		   bkgsel=bkg1(wh)
+                                     
+		   qcsel=qcarr(wh)
+		   lonsel=xarr1(wh)
+		   latsel=yarr1(wh)
+		   daysel=dayarr(wh)
+		   depsel=dep1(wh)
+		   obstypsel=obstypes1(wh)
+         obnumsel=obnum(wh)
+         numsel=lonarr(nelwh)
+
+		   nel=n_elements(obssel)
+                   
+; select points here to avoid unnecessary density calculations                   
+
+         obssel1=stash.obs(wh)
+         bkgsel1=stash.bkg(wh)
+         obssel2=stash.obs2(wh)
+         bkgsel2=stash.bkg2(wh)
+
+         if (density eq 0 and mld eq 0) then begin   
+            if (salinity eq 0) then begin                  
+      		   obssel=obssel1
+		         bkgsel=bkgsel1
+            endif else begin
+  		         obssel=obssel2
+		         bkgsel=bkgsel2
+            endelse              
+         endif else begin
+            if (filetype eq 'CRT') then begin			 
+               bkgsel=sqrt(bkgsel1*bkgsel1 + bkgsel2*bkgsel2)
+               if (salinity eq 0) then begin
+                  obssel=sqrt(obssel1*obssel1 + obssel2*obssel2)
+               endif else begin
+                  obssel=stash.obs3(wh)                
+               endelse
+            endif else begin				; calculate density if mld flag set
+               obssel=eos_nemo(obssel1,obssel2)
+               bkgsel=eos_nemo(bkgsel1,bkgsel2)
+            endelse
+         endelse
+
+; create an array to store the sum of the square differences for calculating profile rms
+;		   omb2sel=(obssel - bkgsel)^2
+         nel=n_elements(obssel)
+      endif else begin			; if there are no obs then exit subroutine
+         nel=0
+			return
+                endelse  
+
+		if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+			innovseli=obssel^2
+                        innovseli2=bkgsel^2
+                        innovseli3=(obssel-bkgsel)^2
+                        innovseli4=obssel*bkgsel
+		endif else begin
+
+                             
+		if (ombtypeplot eq 1) then begin
+                	typestr='obs - bkg'
+                        innovseli=obssel-bkgsel
+                endif
+		if (ombtypeplot eq 2) then begin
+                	typestr='obs'
+                        innovseli=obssel
+                endif
+		if (ombtypeplot eq 3) then begin
+                	typestr='bkg'
+                        innovseli=bkgsel
+                endif
+
+		if (keyword_set(rmsmean)) then begin
+                	innovseli=innovseli
+                        innovseli2=innovseli^2
+                endif else begin
+
+		if (typeplot eq 1) then begin
+                	typestr='mean '+typestr
+                endif
+                if (typeplot eq 2) then begin
+                	typestr='rms '+typestr
+                        innovseli=innovseli^2
+                endif
+		if (typeplot eq 3) then begin
+                	typestr='sd '+typestr
+                        innovseli=innovseli^2		; ?
+                endif
+                if (typeplot eq 4) then begin
+                	typestr='mean sq '+typestr
+                        innovseli=innovseli^2
+                endif
+
+		endelse
+
+		endelse
+
+;      print,'bkgsel ',bkgsel
+;      print,'obssel ',obssel
+
+; tolerance check
+
+		if (wh(0) gt -1) then begin
+		   wh2=[-1]
+
+;	print,qcsel
+                   
+                   if (plot_bad_obs eq 0) then begin
+;		   if (typeplot eq 1 or typeplot eq 2 $
+;			or typeplot eq 3) then $
+		   if (ombtypeplot eq 1) then $
+;			wh2=where(bkgsel ne rmdi and obssel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and abs(obssel-rmdi) gt $
+	                        abs(rmdi)*0.01 and qcsel eq 0)	; tolerance rmdi check
+		   if (ombtypeplot eq 2) then $
+;                   if (typeplot eq 4) then $
+;		   	wh2=where(obssel ne rmdi)
+			wh2=where(abs(obssel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+		   if (ombtypeplot eq 3) then $
+;		   if (typeplot eq 5) then $	
+;			wh2=where(bkgsel ne rmdi)
+			wh2=where(abs(bkgsel-rmdi) gt abs(rmdi)*0.01 and qcsel eq 0)	;tol rmdi check
+
+; check for bad observations
+;		if (plot_bad_obs eq 1) then begin
+		endif else if (plot_bad_obs eq 1 and stash.plot_only_bad_obs eq 1) then begin
+;                	wh2=where(qcsel ne 0 or obssel eq rmdi or bkgsel eq rmdi, count)
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01,count) 
+			wh2=where(qcsel ne 0 and obssel ne rmdi)
+
+;                        wh2=where(qcsel ne 0 or abs(obssel-rmdi) lt abs(rmdi)*0.01 or abs(bkgsel-rmdi) lt abs(rmdi)*0.01,count) 
+;                        print,'bad obs: ',count
+;                        whtmp=where(qcsel eq 0, count)
+;                        print,'qcsel eq 0: ',count
+;                        whtmp=where(obssel eq 0, count)
+;                        print,'obssel eq 0: ',count
+;                        whtmp=where(bkgsel eq 0, count)
+;                        print,'bkgsel eq 0: ',count
+                endif else begin				; plot all observations
+;                	wh2=where(obssel)       
+                        wh2=where(obssel ne rmdi)
+                endelse
+
+		   if (wh2(0) gt -1) then begin
+		      obssel=obssel(wh2)
+		      bkgsel=bkgsel(wh2)
+                      innovseli=innovseli(wh2)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh2)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh2)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh2)
+;		      endif
+		      qcsel=qcsel(wh2)
+		      lonsel=lonsel(wh2)
+		      latsel=latsel(wh2)
+		      daysel=daysel(wh2)
+		      depsel=depsel(wh2)
+		      obstypsel=obstypsel(wh2)
+                      obnumsel=obnumsel(wh2)
+;                      numsel=numsel(wh2)
+		   endif
+
+		print,'nelwh2 ',n_elements(wh2), typeplot, ombtypeplot
+		       
+		if (wh2(0) gt -1) then begin
+                
+                ; calculate vertical gradients if required
+	if (stash.filetype eq "Prof" and stash.vertgrad eq 1) then $
+	calcvertgrad, lonsel, latsel, daysel, obssel, bkgsel, qcsel, depsel, rmdi
+
+; average profiles on the same latitude and longitude
+; goes through each point and puts the average in the first instance and flags 
+; the others for later removal
+; this routine can also be used to bin data
+		depmx=max(depsel,min=depmn)
+		print,'depmn/mx: ',depmn, depmx
+		if (depmx gt depmn or stash.duplicates gt 0 or stash.differences or stash.bindata) then begin
+
+; sort by lat and lon
+; presumably will average in time also...
+
+		if (stash.bindata) then begin		; if we are binning data (in 1 deg bins)
+                					; use +0.5 to get nearest round number 
+		  latbin=double(fix((latsel+stash.binsize(1)/2.)*(1/stash.binsize(1))))/(1/stash.binsize(1))
+		  lonbin=double(fix((lonsel+stash.binsize(0)/2.)*(1/stash.binsize(0))))/(1/stash.binsize(0))			
+		  latlon=long(latbin*10000000d)+double(lonbin+180d)/360d
+                endif else begin
+		  latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+                endelse
+                
+		elsort=sort(latlon)
+
+		latsel=latsel(elsort)
+		lonsel=lonsel(elsort)
+		obssel=obssel(elsort)
+                bkgsel=bkgsel(elsort)
+                innovseli=innovseli(elsort)
+;                if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(elsort)
+                if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(elsort)
+                if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(elsort)
+;		endif
+		qcsel=qcsel(elsort)
+                daysel=daysel(elsort)
+                depsel=depsel(elsort)
+		obstypsel=obstypsel(elsort)
+                obnumsel=obnumsel(elsort)
+;                numsel=numsel(elsort)
+		latlon=latlon(elsort)
+		
+		nel=n_elements(obssel)
+                accum=0
+                isave=0
+                lon1=-99999.0
+                lat1=-99999.0
+                latlon1=-99999.0
+                day1=-99999
+                num=0
+ 
+; 		if (nel gt 100) then begin
+;                info,latsel
+; 		print,latsel(0:100)
+;                info,lonsel
+;                print,lonsel(0:100)
+;                info,latlon
+;		print,latlon(0:100)
+ 
+; 		latsel(0:100)=latsel(50)
+;                lonsel(0:100)=lonsel(50)
+; 		latlon=long(double(latsel)*10000000d)+double(lonsel+180d)/360d
+ 
+;                endif
+                
+
+		print,'DJL ',max(daysel),min(daysel)
+
+; loop through the data averaging profiles at the same location               
+ 
+                sign=1                                            
+                if (stash.duplicates eq 2) then sign=-1		; plot the difference rather than the average	
+  
+                numsel=lonarr(nel)
+		for i=0L,nel-1 do begin
+                
+                if i mod 100000 eq 0 then print,i,nel
+
+;		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+;                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+		
+; 		if (lonsel(i) ne lon1 or latsel(i) ne lat1) then begin
+
+; check for new profile or reaching the end of the data
+; check for the end of a day added
+
+		if ((latlon(i) ne latlon1) or (i eq nel-1) or (long(daysel(i)) ne long(day1))) then begin		
+
+;		print,i, latlon(i), latlon1, daysel(i), day1                
+;                if i gt 0 then stop
+		
+; average last profile
+		  if (isave ge 0 and num gt 0) then begin
+                
+                    if (num gt 1) then begin    
+                
+;                	print,num
+                        numsave=num
+                        if (stash.duplicates eq 2) then num=1
+
+			if (stash.bindata) then begin 
+ 			latsel(isave)=latsel(isave)/num
+                        lonsel(isave)=lonsel(isave)/num
+                        endif                          
+                	obssel(isave)=obssel(isave)/num
+                        bkgsel(isave)=bkgsel(isave)/num
+                        daysel(isave)=daysel(isave)/num
+                        depsel(isave)=depsel(isave)/num
+                        innovseli(isave)=innovseli(isave)/num
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)/num
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)/num
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)/num
+;		        endif
+
+                        num=numsave
+
+; save the num	
+			numsel(isave)=num
+
+;                        if (fix(lonsel(isave)) eq -7297 and $
+;                            fix(latsel(isave)) eq -5935) then begin
+;                         print,'completed ',isave, num                        
+;			 print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                         endif
+                         
+                    endif else begin
+                    	numsel(isave)=num
+                    endelse
+                    if ((stash.duplicates gt 0 and num eq 1) or (stash.differences and num gt 1)) then begin
+                        obssel(isave)=rmdi
+                        bkgsel(isave)=rmdi
+                        lonsel(isave)=rmdi
+                        latsel(isave)=rmdi
+                        qcsel(isave)=rmdi
+                        innovseli(isave)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=rmdi
+;  		        endif
+                        
+                    endif
+                                           
+		  endif 
+
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+
+; start a new profile
+       		      lon1=lonsel(i)
+		      lat1=latsel(i)
+                      latlon1=latlon(i)
+                      day1=daysel(i)
+                      isave=i
+                      accum=1
+                      num=1
+
+		endif		; plot_bad_obs ...
+                      
+ ; accumulating                     
+                      
+		endif else begin
+                	
+		if (plot_bad_obs eq 0 and obssel(i) ne rmdi) or $
+                      	(plot_bad_obs eq 1 and lonsel(i) ne rmdi) then begin
+                        
+                	num=num+1
+
+			if (stash.bindata) then begin
+                        latsel(isave)=latsel(isave)+double(fix((1./stash.binsize(1))*(latsel(i)+stash.binsize(1)/2.)))/(1./stash.binsize(1))	;latsel(isave)+fix(latsel(i)+0.5)
+                        lonsel(isave)=lonsel(isave)+double(fix((1./stash.binsize(0))*(lonsel(i)+stash.binsize(0)/2.)))/(1./stash.binsize(0))	;lonsel(isave)+fix(lonsel(i)+0.5)
+                        endif
+
+                        obssel(isave)=obssel(isave)+obssel(i)*sign
+                        bkgsel(isave)=bkgsel(isave)+bkgsel(i)*sign
+                        innovseli(isave)=innovseli(isave)+innovseli(i)*sign
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(isave)=innovseli2(isave)+innovseli2(i)*sign
+                        if (n_elements(innovseli3) gt 0) then innovseli3(isave)=innovseli3(isave)+innovseli3(i)*sign
+                        if (n_elements(innovseli4) gt 0) then innovseli4(isave)=innovseli4(isave)+innovseli4(i)*sign
+; 		        endif
+
+                        qcsel(isave)=min([qcsel(isave),qcsel(i)])
+                        daysel(isave)=daysel(isave)+daysel(i)
+                        depsel(isave)=depsel(isave)+depsel(i)
+
+			if (stash.bindata) then begin
+                        latsel(i)=rmdi
+                        lonsel(i)=rmdi               
+                        endif         
+                        obssel(i)=rmdi
+                        bkgsel(i)=rmdi
+                        innovseli(i)=rmdi
+;                        if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                        if (n_elements(innovseli2) gt 0) then innovseli2(i)=rmdi
+                        if (n_elements(innovseli3) gt 0) then innovseli3(i)=rmdi
+                        if (n_elements(innovseli4) gt 0) then innovseli4(i)=rmdi
+; 		        endif
+                        lonsel(i)=rmdi
+                        latsel(i)=rmdi
+                        qcsel(i)=rmdi
+
+;                        if (fix(lonsel(isave)*100) eq -7297 and $
+;                       	    fix(latsel(isave)*100) eq -5935) then begin
+;                         print,'isave ',isave, num                        
+;			  print,'obssel ',obssel(isave)
+;                         print,'bkgsel ',bkgsel(isave)
+;                        endif
+
+		endif		; plot_bad_obs ...
+                        
+                endelse 
+                      
+;                endif
+
+                endfor		; i  nobs
+
+		print,'DJL2x ',max(daysel),min(daysel)
+
+
+		wh5=where(lonsel ne rmdi)				; clears out but the averaged profiles
+                if (wh5(0) gt -1) then begin
+		      obssel=obssel(wh5)
+		      bkgsel=bkgsel(wh5)
+                      innovseli=innovseli(wh5)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh5)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh5)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh5)
+;		      endif
+		      qcsel=qcsel(wh5)
+		      lonsel=lonsel(wh5)
+		      latsel=latsel(wh5)
+		      daysel=daysel(wh5)
+		      obstypsel=obstypsel(wh5)
+                      obnumsel=obnumsel(wh5)
+                      numsel=numsel(wh5)
+                      nel=n_elements(obssel)
+                endif else begin			; if there are no obs then exit subroutine
+                	nel=0
+			return
+                endelse               
+		endif
+
+		print,'nel wh5 ',n_elements(wh5)
+		print,'DJL3 ',max(daysel),min(daysel)
+
+		typeselect=stash.obstypeselect
+;                print, 'typeselect ',typeselect
+		if (typeselect(0) ne "") then begin
+;                typeselecta=strsplit(typeselect,' ,',/extract)		; split string on commas or spaces
+		typeselecta=strsplit(typeselect,',',/extract)		; split string on commas only
+                nel=n_elements(typeselecta)
+                print,'n_elements(typeselecta) ',nel
+                for i=0L,nel-1 do begin
+                ; string matching (understands * ?)
+                st1=strtrim(string(obstypsel),2)		; strip tailing and leading spaces
+                st2=strtrim(typeselecta(i),2)
+                wh6t=where(strmatch(st1,st2,/FOLD_CASE) EQ 1)	
+;                print, 'wh6t ',typeselecta(i), wh6t
+		if i eq 0 then wh6=wh6t else wh6=[wh6,wh6t]
+                endfor 
+;                print,n_elements(wh6)
+;                print,wh6
+                wh=where(wh6 gt -1)
+;                print,wh
+                if (wh(0) gt -1) then begin
+                      wh6=wh6(wh)
+		      obssel=obssel(wh6)
+		      bkgsel=bkgsel(wh6)
+                      innovseli=innovseli(wh6)
+;                      if ((stash.txt eq 1 or stash.netcdf eq 1) and stash.bindata eq 1) then begin
+                      if (n_elements(innovseli2) gt 0) then innovseli2=innovseli2(wh6)
+                      if (n_elements(innovseli3) gt 0) then innovseli3=innovseli3(wh6)
+                      if (n_elements(innovseli4) gt 0) then innovseli4=innovseli4(wh6)
+;		      endif
+		      qcsel=qcsel(wh6)
+		      lonsel=lonsel(wh6)
+		      latsel=latsel(wh6)
+		      daysel=daysel(wh6)
+		      obstypsel=obstypsel(wh6)
+                      obnumsel=obnumsel(wh6)
+                      numsel=numsel(wh6)
+                      nel=n_elements(obssel)
+;                      print, 'nel (in obstypeselect) ',nel
+                endif else begin			; if there are no obs then exit subroutine
+                	print,'no matching obs'
+			nel=0
+                endelse               
+		endif                	
+                
+                if (stash.printobstypes eq 1) then begin
+		s=sort(obstypsel)
+                sobstypsel=obstypsel(s)
+		u=uniq(sobstypsel)
+		print,"unique obs types: ",sobstypsel(u) 
+		endif
+
+		print,'nel ',nel
+		stash.symsize=1.0
+		if (nel gt 250) then stash.symsize=0.75
+		if (nel gt 1000) then stash.symsize=0.5
+		if (nel gt 2000) then stash.symsize=0.25
+		if (nel lt 20) then stash.symsize=2.0
+
+		if (!d.name eq 'Z') then stash.symsize=stash.symsize/2
+
+		print,'stash.symsize: ',stash.symsize
+
+; save data for mean and rms plots
+; for ombtypeplot=3 typeplot=2 innovsel = (obs - bkg)^2		mean value available from obssel(i) - bkgsel(i)
+
+; copy innovseli to innovsel (if we've got some valid data to plot / save)
+		if (nel gt 0) then innovsel=innovseli
+
+		if (stash.txt eq 1 and stash.bindata eq 1) then begin
+ 
+; The file contains:  longitude, latitude, num of points, obs mean, bkg mean
+;         mean sq obs,    mean sq bkg,        mean sq obs - bkg, 	mean obs * bkg 
+                
+                outfile=stash.outfile+'_selpoints.txt'
+                print, 'saving data to ',outfile
+                OPENW, unit, outfile, /get_lun
+;   	           printf,unit,'Output selpoints data: '
+                printf,unit, 3					; file version
+                printf,unit, typeplot
+                printf,unit, stash.bindata
+                printf,unit, xrange, yrange
+                printf,unit, min(daysel), max(daysel) 
+
+                for i=0L,nel-1 do begin
+                	   printf,unit, lonsel(i), latsel(i), numsel(i), obssel(i), bkgsel(i), $
+                        	   innovseli(i), innovseli2(i), innovseli3(i), innovseli4(i), $
+                        	   format='(2d10.3, i8, 6d18.8)'
+                endfor
+                FREE_LUN, unit
+               
+      endif
+
+		if (stash.netcdf eq 1 and stash.bindata eq 1) then begin
+
+                outfile=stash.outfile+'_selpoints.nc'
+                print, 'saving data to ',outfile
+
+                nid=NCDF_CREATE( outfile, /CLOBBER )
+                
+                NCDF_ATTPUT, nid, 'version', 3, /SHORT, /GLOBAL
+                NCDF_ATTPUT, nid, 'bindata', stash.bindata, /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange0', xrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'xrange1', xrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange0', yrange(0), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'yrange1', yrange(1), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'mindaysel', min(daysel), /FLOAT, /GLOBAL
+                NCDF_ATTPUT, nid, 'maxdaysel', max(daysel), /FLOAT, /GLOBAL
+                
+                print, 'nel ',nel
+                nelid = NCDF_DIMDEF( nid, 'n', nel )
+                
+                lonid = NCDF_VARDEF ( nid, 'longitudes', [nelid], /FLOAT )
+                latid = NCDF_VARDEF ( nid, 'latitudes', [nelid], /FLOAT ) 
+                numid = NCDF_VARDEF ( nid, 'num', [nelid], /LONG )
+                obsid = NCDF_VARDEF ( nid, 'obs_mean', [nelid], /FLOAT )
+                bkgid = NCDF_VARDEF ( nid, 'bkg_mean', [nelid], /FLOAT )
+                innovseli1id = NCDF_VARDEF ( nid, 'obs_mean_sq', [nelid], /FLOAT )
+                innovseli2id = NCDF_VARDEF ( nid, 'bkg_mean_sq', [nelid], /FLOAT )
+                innovseli3id = NCDF_VARDEF ( nid, 'omb_mean_sq', [nelid], /FLOAT )
+                innovseli4id = NCDF_VARDEF ( nid, 'otimesb_mean', [nelid], /FLOAT )
+                NCDF_CONTROL, nid, /ENDEF
+                
+                if (nel gt 0) then begin
+                NCDF_VARPUT, nid, lonid, lonsel
+                NCDF_VARPUT, nid, latid, latsel
+                NCDF_VARPUT, nid, numid, numsel
+                NCDF_VARPUT, nid, obsid, obssel
+                NCDF_VARPUT, nid, bkgid, bkgsel
+                NCDF_VARPUT, nid, innovseli1id, innovseli
+                NCDF_VARPUT, nid, innovseli2id, innovseli2
+                NCDF_VARPUT, nid, innovseli3id, innovseli3
+                NCDF_VARPUT, nid, innovseli4id, innovseli4
+                endif
+                
+                NCDF_CLOSE, nid
+                
+		endif
+
+      if (stash.filterout ne '') then begin
+
+         ; write out filtered feedback file in new feedback format
+         ; with some filthy fudges to emulate NEMOVAR format
+         if (nel gt 0) then begin
+
+            print, 'writing filtered feedback file ',stash.filterout
+
+            ; split type string in two to be used as STATION_IDENTIFIER and STATION_TYPE
+            typesel=strarr(nel)
+            instsel=strarr(nel)
+
+            for iob = 0, nel-1 do begin
+               tempsel=strsplit(obstypsel[iob],/extract)
+               typesel[iob]=tempsel[0]
+               ; catch for data without space and instrument id in types (e.g. altimeter)
+               instsel[iob]=''
+               if (n_elements(tempsel) gt 1 ) then $
+                  instsel[iob]=tempsel[1]
+            endfor
+
+            ; setup netcdf file
+            nid=NCDF_CREATE( stash.filterout, /CLOBBER )
+
+            ; global attribute to emulate NEMOVAR feedback files
+            NCDF_ATTPUT, nid, 'title', "NEMO observation operator output", /GLOBAL
+            if (stash.obstypeselect ne '' ) then $
+               NCDF_ATTPUT, nid, 'filter', stash.obstypeselect, /GLOBAL
+            NCDF_ATTPUT, nid, 'minday', min(daysel), /FLOAT, /GLOBAL
+            NCDF_ATTPUT, nid, 'maxday', max(daysel), /FLOAT, /GLOBAL
+
+            nobid = NCDF_DIMDEF( nid, 'N_OBS', nel )
+            ndepid = NCDF_DIMDEF( nid, 'N_LEVELS', 1 ) ; temporarily input 1d profile arrays
+
+            if (stash.filetype eq 'feedback') then begin
+
+               ncvars = stash.varname
+               nnvars = n_elements(ncvars)
+
+            endif else begin
+
+               nnvars = 1
+               ncvars = stash.filetype
+               if (stash.filetype eq 'Prof') then begin
+                  ncvars = 'POTM'
+                  if (salinity eq 1) then ncvars = 'PSAL'
+                  nextid = NCDF_DIMDEF( nid, 'N_EXTRA', 1 )
+               endif 
+
+            endelse
+
+            nvarid = NCDF_DIMDEF( nid, 'N_VARS', nnvars )
+
+            nentid = NCDF_DIMDEF( nid, 'N_ENTRIES', 1 )
+
+            nstrnamid = NCDF_DIMDEF( nid, 'STRINGNAM', 8 )
+            nstrwmoid = NCDF_DIMDEF( nid, 'STRINGWMO', 8 )
+            nstrtypid = NCDF_DIMDEF( nid, 'STRINGTYP', 4 )
+            nstrjulid = NCDF_DIMDEF( nid, 'STRINGJULD', 14 )
+
+            varid = NCDF_VARDEF ( nid, 'VARIABLES', [nstrnamid,nvarid], /CHAR )
+            entid = NCDF_VARDEF ( nid, 'ENTRIES', [nstrnamid,nentid], /CHAR )
+            signid = NCDF_VARDEF ( nid, 'STATION_IDENTIFIER', [nstrwmoid,nobid], /CHAR )
+            typeid = NCDF_VARDEF ( nid, 'STATION_TYPE', [nstrtypid,nobid], /CHAR )
+
+            lonid = NCDF_VARDEF ( nid, 'LONGITUDE', [nobid], /DOUBLE )
+            latid = NCDF_VARDEF ( nid, 'LATITUDE', [nobid], /DOUBLE )
+            depid = NCDF_VARDEF ( nid, 'DEPTH', [nobid], /DOUBLE )
+;            depid = NCDF_VARDEF ( nid, 'DEPTH', [ndepid,nobid], /DOUBLE )
+            julid = NCDF_VARDEF ( nid, 'JULD', [nobid], /DOUBLE )
+            jrefid = NCDF_VARDEF ( nid, 'JULD_REFERENCE', [nstrjulid], /CHAR )
+
+            obsqcid = NCDF_VARDEF ( nid, 'OBSERVATION_QC', [nobid], /LONG )
+
+            FillVal=9999
+            NCDF_ATTPUT, nid, depid, '_Fillvalue', FillVal, /DOUBLE
+            NCDF_ATTPUT, nid, obsqcid, '_Fillvalue', FillVal, /LONG
+
+            obsids=intarr(nnvars)
+            bkgids=intarr(nnvars)
+            qcids=intarr(nnvars)
+            lqcids=intarr(nnvars)
+
+            for ivar = 0, nnvars-1 do begin
+
+               obsids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_OBS', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, obsids[ivar], '_Fillvalue', FillVal, /FLOAT
+               bkgids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_Hx', [nobid], /FLOAT )
+               NCDF_ATTPUT, nid, bkgids[ivar], '_Fillvalue', FillVal, /FLOAT
+               qcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, qcids[ivar], '_Fillvalue', FillVal, /FLOAT
+               lqcids[ivar] = NCDF_VARDEF ( nid, ncvars[ivar]+'_LEVEL_QC', [nobid], /LONG )
+               NCDF_ATTPUT, nid, lqcids[ivar], '_Fillvalue', FillVal, /FLOAT
+
+            endfor
+
+            NCDF_CONTROL, nid, /ENDEF
+
+            JulDRef = '19500101000000'
+            NCDF_VARPUT, nid, jrefid, JulDRef
+            RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                             fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+            NCDF_VARPUT, nid, julid,daysel-RefDate 
+
+            NCDF_VARPUT, nid, varid, ncvars 
+            NCDF_VARPUT, nid, entid, 'Hx'
+
+            NCDF_VARPUT, nid, lonid, lonsel
+            NCDF_VARPUT, nid, latid, latsel
+
+            NCDF_VARPUT, nid, depid, fltarr(nel)
+            NCDF_VARPUT, nid, obsqcid, fltarr(nel)+1
+
+            for ivar = 0, nnvars-1 do begin
+
+               NCDF_VARPUT, nid, obsids[ivar], obssel
+               NCDF_VARPUT, nid, bkgids[ivar], bkgsel
+               NCDF_VARPUT, nid, qcids[ivar], qcsel+1
+               NCDF_VARPUT, nid, lqcids[ivar], fltarr(nel)+1
+
+            endfor
+
+            NCDF_VARPUT, nid, typeid, typesel
+            NCDF_VARPUT, nid, signid, instsel
+
+         endif
+
+         NCDF_CLOSE, nid
+
+      endif ; filterout
+
+		if (nel gt 0) then begin	
+
+		   if (typeplot eq 2) then begin
+                        innovsel=sqrt(innovsel)
+                   endif
+		   if (typeplot eq 3) then begin
+;  std dev = sqrt ( mean x2 - (mean x)^2)
+			x2=innovsel
+			print,'typeplot ',typeplot,' ombtypeplot ',ombtypeplot
+			if (ombtypeplot eq 1) then $
+                        	innovsel=sqrt(x2-(obssel-bkgsel)^2)
+                        if (ombtypeplot eq 2) then $
+                        	innovsel=sqrt(x2-(obssel)^2)                        
+                        if (ombtypeplot eq 3) then $
+                        	innovsel=sqrt(x2-(bkgsel)^2)                        
+                   endif
+
+		   if (keyword_set(rmsmean)) then begin
+                   	innovsel=innovseli						; mean 
+                        if (n_elements(innovseli2) gt 0) then innovsel2=innovseli2	; rms                  
+                   endif
+
+
+		   innovmean=total(innovsel)/nel
+		   innovmean2=total(innovsel^2)/nel
+		   innovsd=sqrt(innovmean2-innovmean^2)
+		   print,'mean innovsel ',innovmean
+		   print,'sd innovsel ',innovsd
+
+		endif
+
+		
+
+		endif
+
+		endif
+
+		wh=where(numsel eq 0)
+                if (wh(0) gt -1) then numsel(wh)=1
+
+END
+
+PRO setupct, r, g, b, coltable=coltable, white_on_black=white_on_black
+
+if (coltable eq 0 or coltable lt -2) then begin
+; get color table and modify
+                loadct, 13
+                stretch, -40, 256
+;                tvlct,r,g,b,/get                
+;                r(0)=0
+;                g(0)=0
+;                b(0)=0
+;                r(255)=255
+;                g(255)=255
+;                b(255)=255              
+;                tvlct,r,g,b
+endif else begin
+	if (coltable eq -1) then begin
+		restore_colors, 'spectrum.clr'
+	endif else if (coltable eq -2) then begin
+                restore_colors, '~frbe/spectrum_alt.xdr',/asis
+        endif else begin
+		loadct,coltable
+        endelse            
+endelse
+
+tvlct,r,g,b,/get
+i0=0
+i1=255
+if (n_elements(white_on_black) eq 1 and !d.name ne "PS") then begin
+	if (white_on_black eq 0) then begin
+     		i0=255
+                i1=0   
+        endif
+endif
+r(i0)=0
+g(i0)=0
+b(i0)=0
+r(i1)=255
+g(i1)=255
+b(i1)=255              
+tvlct,r,g,b
+
+END
+
+PRO plotpoints, stash
+
+		nplots=1
+                if (stash.pmulti eq 2) then nplots=stash.pmulti
+
+		for nplot=0,nplots-1 do begin
+
+		if (stash.busy eq 1) then return
+		stash.busy = 1
+
+		num_cols=254
+
+		print,"!d.name ",!d.name 
+		IF (stash.drawID gt -1) then begin
+  		IF (!d.name eq 'X' or !d.name eq 'Z') then begin 
+                        device, decomposed=0
+	        endif
+                IF (!d.name eq 'X') then WSET, stash.drawID
+		endif
+
+		IF (!d.name ne 'Z') then setupct, r, g, b, $
+                   coltable=stash.coltable,white_on_black=stash.white_on_black		; setup color table
+
+		noerase=0
+		if (stash.pmulti eq 2) then begin
+                	if (stash.pmultinum gt 0) then noerase=1
+                	!p.multi=[stash.pmultinum,2,1]
+                        stash.pmultinum=(stash.pmultinum+1) mod 2
+                endif else begin
+                	!p.multi=0
+                endelse
+                
+;		xarr1=stash.xarr
+;		yarr1=stash.yarr
+;		dep1=stash.dep
+;		obs1=stash.obs
+;		bkg1=stash.bkg
+;		depmin=stash.depmin
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+;		typeplot=stash.typeplot
+		typeproj=stash.typeproj
+;                print,"stash.map_file: ",stash.map_file
+;		if (strlen(stash.map_file) gt 0) then map_file=stash.map_file
+                                
+;		print,depmin,xrange,yrange
+
+  		dummy=[0,0]
+		
+		
+;		plot,dummy,/nodata,yrange=[-90,90],xrange=[-180,180]
+;		plot,dummy,/nodata,yrange=[-50,80],xrange=[-110,40],$
+;			xstyle=1,ystyle=1, xtitle='Longitude',ytitle='Latitude'
+
+		if (typeproj ne 1) then begin
+		    	origlon=0.
+			if (typeproj eq 2) then begin 
+                        	origlat=90.
+                                if (yrange(0) lt 0) then yrange(0)=45
+                                if (yrange(1) lt 0) then yrange(1)=90
+                        endif
+			if (typeproj eq 3) then begin 
+                        	origlat=-90.
+                                if (yrange(0) gt 0) then yrange(0)=-90
+                                if (yrange(1) gt 0) then yrange(1)=-45                               
+                        endif      
+			;scale=0.35
+                        smap = map_proj_init('Polar Stereographic')
+		endif
+
+		; select points to plot
+		typestr=""
+                
+spawn,'echo plotpoints 1 `date`'
+                
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+                
+spawn,'echo plotpoints 2 `date`'
+
+		if (stash.txt eq 0 and stash.netcdf eq 0) then begin
+		nelsel=n_elements(innovsel)
+
+                nptsstr=strtrim(string(nelsel),2)
+                print,nptsstr, nelsel
+
+;		if (nelsel gt 0) then begin
+
+
+
+		;convert lats and lons to projection positions
+;                if (nelsel gt 0) then begin
+;                print,'min/max lonsel: ',min(lonsel),max(lonsel)
+;		if (typeproj ne 1) then begin
+;                  coords = map_proj_forward(lonsel,latsel,MAP=smap)
+;		  lonsel=coords(0,*)
+;		  latsel=coords(1,*)
+;		endif
+;                endif
+
+
+
+		print,'nelsel: ',nelsel
+		nelinnov=n_elements(innovsel)
+		print,'nelinnov: ',nelinnov
+
+                jul_to_dtstr, daymin, dateminstr, /notime
+                jul_to_dtstr, daymax, datemaxstr, /notime		
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq "Prof" or stash.filetype eq "feedback") then begin
+                	   strtsal='T:  '
+                     if (stash.salinity eq 1) then strtsal='S:  '
+                     if (stash.density  eq 1) then strtsal='Density:  '
+                     if (stash.mld eq 1) then strtsal='MLD:  '
+                endif else begin
+                     if (stash.filetype eq "CRT") then begin
+                	      strtsal='U:  '
+                        if (stash.salinity eq 1) then strtsal='V:  '
+                        if (stash.density  eq 1) then strtsal='Speed:  '
+                        if (stash.salinity eq 1 and stash.density  eq 1) then strtsal='Total Speed:  '
+                     endif else begin
+                	      strtsal=stash.filetype+':  '
+                     endelse
+                endelse
+                if (stash.vertgrad eq 1) then strtsal='Grad '+strtsal
+		nptsstr2='Points: '+nptsstr+'  '
+		titlestr=strtsal+typestr+': '+dateminstr+' to '+datemaxstr
+		print,'titlestr ',titlestr
+
+; get max and min values
+		mx=0
+                mn=0
+                meaninnov=0
+                rmsinnov=0
+		if (nelinnov gt 0) then begin
+; NB these values are just the rms and mean of the points plotted...
+; and do not take account of the datapoints used in profiles plotted...
+		   mx=max(innovsel)
+                   mn=min(innovsel)
+		   meaninnov=avg(innovsel)
+                   rmsinnov=sqrt(avg(innovsel^2))
+;                   n=total(numsel)
+;                   wh=where(numsel gt 0)
+;                   print, 'innovsel: ',max(innovsel), min(innovsel)
+;                   print, 'numsel: ',max(numsel), min(numsel)
+;                   if (n gt 0) then begin
+;                      x=total(innovsel(wh)*numsel(wh))
+;                      x2=total(innovsel(wh)^2*numsel(wh))
+;                      meaninnov=x/n
+;                      rmsinnov=sqrt(x2/n)
+;                   endif
+                endif
+
+		subtitle=''
+		subtitle=nptsstr2+'depths: '+strtrim(string(long(stash.depmin)),2)+'-'+$
+                	strtrim(string(long(stash.depmax)),2)
+                if (stash.obstypeselect ne "") then subtitle=subtitle+'  filtered type: '+stash.obstypeselect        
+ 		subtitle=subtitle+'  extrema: '+$
+                	strtrim(string(mn,format='(G0.4)'),2)+', '+strtrim(string(mx,format='(G0.4)'),2)
+		subtitle=subtitle+'  mean: '+strtrim(string(meaninnov,format='(G0.4)'))+$
+                	' rms: '+strtrim(string(rmsinnov,format='(G0.4)'))
+		
+;                print,'noerase ',noerase
+                
+		if (typeproj ne 1) then begin                 
+                 map_set, /STEREOGRAPHIC, origlat, 0, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase
+                endif else begin        
+                  P0lon=0
+                  P0lat=0
+                  if (xrange(1) gt 180) then P0lon=180
+                  print,'ranges: ',yrange(0),xrange(0),yrange(1),xrange(1)
+                  map_set, P0lat, P0lon, /continents, title=titlestr+'!C'+subtitle, $
+                         ymargin=[10.,5.], /label, latlab=xrange(0), lonlab=yrange(0), $
+                         limit=[yrange(0),xrange(0),yrange(1),xrange(1)],/isotropic, hires=stash.hires_map, noerase=noerase  
+                endelse
+
+                                                                 
+		if (nelsel eq 0 or nelinnov eq 0) then begin 
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+		endif else begin
+;			pp_contour,fld,title=titlestr,/nodata, /proportional, map_file=map_file
+                          
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+
+		print,'setting stash mx/mn'
+		stash.mx=mx
+                stash.mn=mn
+
+;		levs=contour_levels([mn,mx],nlevels=15)
+;		levs=findgen(10+1)/10.*(mx-mn)+mn
+
+		print, 'mn mx ',mn,mx
+
+
+
+;; De-select points outside window?
+;		
+;    xnd= [ -!X.s(0), 1. ]/!X.s(1)
+;    ynd= [ -!Y.s(0), 1. ]/!Y.s(1) 
+;    ov=0                ; overlap 
+;    clip_data= [ (!ppp.position(0)-ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(1)-ov)*ynd(1) + ynd(0) , $
+;                 (!ppp.position(2)+ov)*xnd(1) + xnd(0) , $
+;                 (!ppp.position(3)+ov)*ynd(1) + ynd(0) ]
+;
+;	wh=where(lonsel ge clip_data(0) and lonsel le clip_data(2)  and $
+;               latsel ge clip_data(1) and latsel  le clip_data(3))
+;	       if (wh(0) gt -1) then begin
+;	       	latsel=latsel(wh)
+;		lonsel=lonsel(wh)
+;		innovsel=innovsel(wh)
+;	       endif
+
+
+		print,'daymin=',daymin
+		print,'daymax=',daymax
+;		print,dayarr(wh)
+
+	
+;		titlestr=typestr+': '+titlestr
+		
+
+
+		mx=max(innovsel)
+                mn=min(innovsel)
+                if (stash.fmx ne stash.rmdi) then mx=stash.fmx
+                if (stash.fmn ne stash.rmdi) then mn=stash.fmn
+                
+;                stash.mx=mx
+;                stash.mn=mn
+                
+;		levs=contour_levels([mn,mx],nlevels=30)
+		levs=findgen(15)/15.*(mx-mn)+mn
+                                
+                print, 'typeproj: ',typeproj
+		
+;		wh=sort(innovsel)
+;		print,'innovsel ',innovsel(wh)
+
+		clr=fix((innovsel-mn)/(mx-mn)*(num_cols-1))+1
+
+; prevent colours going out of range
+		wh=where(clr lt 1)
+                if (wh(0) gt -1) then clr(wh)=1
+                wh=where(clr gt num_cols)
+                if (wh(0) gt -1) then clr(wh)=num_cols
+
+;		print,'clr ',clr(wh)
+
+                case stash.sym of
+		1: USERSYM, [-1,-1,1,1,-1],[1,-1,-1,1,1], /FILL
+                2: usersym, cos(2.0*!pi*indgen(17)/16.0), sin(2.0*!pi*indgen(17)/16.0), thick=2.0, /fill
+                endcase
+                 
+                 spawn,'echo plotpoints 3 `date`'
+                 
+;;		rgb=transpose(reform(color24_to_rgb(clr),nelwh,3))
+
+		symsize=stash.symsize*stash.symscale  
+;		for i=0L,nelsel-1 do $
+;	        plots,lonsel(i),latsel(i),psym=8,color=clr,symsize=symsize
+
+		if (stash.bindata eq 0) then begin
+        	plots,lonsel,latsel,psym=8,color=clr,symsize=symsize,noclip=0
+;       	        plots,lonsel,latsel,psym=3,color=clr
+
+;		print, 'lonsel latsel'
+;		print,lonsel, format='(4g20.10)'
+;                print,latsel, format='(4g20.10)'
+		endif
+                
+                
+;                print, 'lonseld latseld'
+;		print,lonsel - lonsel(0), format='(4g20.10)'
+;                print,latsel - latsel(0), format='(4g20.10)'
+
+;		wh=where(lonsel eq lonsel(0) and latsel eq latsel(0))
+;                print,wh
+
+		endelse
+
+                 spawn,'echo plotpoints 4 `date`'
+		print,"stash.symsize ",stash.symsize
+
+		print,'limit=',[yrange(0),xrange(0),yrange(1),xrange(1)]
+
+;		endif       ; nel lonsel > 0 
+                
+		if (stash.bindata) then begin
+                     fillval=-32000
+                     mxlat=max(latsel)
+                     mnlat=min(latsel)
+                     mxlon=max(lonsel)
+                     mnlon=min(lonsel)
+                     dlon=stash.binsize(0)
+                     dlat=stash.binsize(1)
+                     nlats=(mxlat-mnlat)/dlat+1
+                     nlons=(mxlon-mnlon)/dlon+1
+                     print,'nlons ',nlons,' nlats ',nlats
+                     if (nlats ge 2 and nlons ge 2) then begin
+                     innovsel2=fltarr(nlons,nlats)
+;                     latsel2=fltarr(nlons,nlats)
+;                     lonsel2=fltarr(nlons,nlats)
+			latsel2=findgen(nlats)*dlat+mnlat
+                        lonsel2=findgen(nlons)*dlon+mnlon
+                     innovsel2(*)=fillval			; missing data
+;                     latsel2(*)=fillval
+;                     lonsel2(*)=fillval
+                     nelin=n_elements(innovsel)
+                     print,mnlat,mnlon
+                     iiarr=(lonsel-mnlon)/dlon
+                     ijarr=(latsel-mnlat)/dlat
+                     print,min(ijarr),max(ijarr),min(ijarr),max(ijarr)
+                     info,latsel2
+                     info,lonsel2
+                     for i=0L,nelin-1 do begin
+                     ii=iiarr(i)
+                     iip=ii+1
+                     if (iip ge nlons-1) then iip=ii
+                     iim=ii-1
+                     if (iim lt 0) then iim=0
+                     ij=ijarr(i)
+                     ijp=ij+1
+                     if (ijp ge nlats-1) then ijp=ij
+                     ijm=ij-1
+                     if (ijm lt 0) then ijm=0
+
+                     innovsel2(ii,ij)=innovsel(i)
+                     ; fill in gaps
+                     if (innovsel2(iip,ij) eq fillval) then innovsel2(iip,ij)=innovsel(i)
+                     if (innovsel2(ii,ijp) eq fillval) then innovsel2(ii,ijp)=innovsel(i)
+                     if (innovsel2(iim,ij) eq fillval) then innovsel2(iim,ij)=innovsel(i)
+                     if (innovsel2(ii,ijm) eq fillval) then innovsel2(ii,ijm)=innovsel(i)
+;                     latsel2(ii,ij)=latsel(i)
+;                     lonsel2(ii,ij)=lonsel(i)
+                     endfor 
+                     info,latsel2
+                     print,latsel2
+                     info,lonsel2
+                     print,lonsel2
+                     
+                     TVLCT, R, G, B, /get
+		     TVLCT,R(1),G(1),B(1),0        ; bodge fix for wrong black contour   
+
+			wh=where(innovsel2 gt mx-(mx-mn)*0.001 and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mx-(mx-mn)*0.001
+			wh=where(innovsel2 lt mn and innovsel2 ne fillval)
+                        if (wh(0) gt -1) then innovsel2(wh)=mn
+
+		     levs2=nice_contourlevels([mn,mx],nlevels=50)
+
+ 		     contour,innovsel2,lonsel2,latsel2,levels=levs2, /overplot, /cell_fill, min_value=-1000
+                     
+                     TVLCT,R(0),G(0),B(0),0		; restore original colour table
+                     endif
+                     
+		endif
+
+		if (daymin eq daymax and daymin eq 0) then begin
+                	print,'No data file'
+                        xyouts, 0.15, 0.5, 'No data files', /normal, charsize=8
+                endif
+
+; plot colorbar
+		levs=nice_contourlevels([mn,mx],nlevels=10)
+
+		print, levs
+                
+		barclr=findgen(num_cols)+1
+                colorbar_idl, [mn,mx], barclr, levs
+		endif				; stash.txt eq 0
+
+		stash.busy=0
+
+                if (stash.pmulti eq 2) then begin
+                	typeproj=stash.typeproj
+                        print, 'old stash.typeproj: ',stash.typeproj	
+                	if (typeproj eq 2) then stash.typeproj=3		;plot north and south poles 
+                	if (typeproj eq 3) then stash.typeproj=2
+                        print, 'new stash.typeproj: ',stash.typeproj
+                endif
+
+		endfor			; nplots
+
+
+end
+
+;------------------------------------------
+;Profile plotting window and event handling
+;------------------------------------------
+
+PRO profilewindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq "PRINTPW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/plotprofile.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		plotprofile,stash2
+		prend2,/view
+	endif
+        if (uval eq "SAVEPW") then begin
+  		thisDevice = !D.Name
+        	psave=!p
+
+        	Set_Plot, 'Z'			; do graphics in the background
+		Device, Set_Resolution=[640,480]    ; clear any existing stuff
+        	!p.charsize=0.75
+
+		if (stash2.white_on_black eq 0) then begin
+; flip background and foreground color
+                        pcolor=!p.color
+                        pbackground=!p.background
+                        !p.color=pbackground
+                        !p.background=pcolor
+
+        	endif
+        	print,'!p.color,!p.background ',!p.color,!p.background
+
+        	setupct, r, g, b, $
+                   coltable=stash2.coltable,white_on_black=stash2.white_on_black		; setup color table
+; plot data
+  		plotprofile,stash2
+		snapshot = TVRD()
+        	WRITE_GIF,"~/plotprofile.gif",snapshot, r, g, b
+        	Device, Z_Buffer=1		; reset graphics mode
+        	Set_Plot, thisDevice
+		!p=psave
+        
+        	spawn,'xv ~/plotprofile.gif'
+        
+        endif
+        if (uval eq "TXTPW") then begin
+        	plotprofile,stash2,/txt
+        endif
+end
+
+PRO plotprofile,stash2, txt=txt
+
+	if (n_elements(txt) eq 0) then txt=0
+
+;** need to deal with multiple times
+
+	dep2=stash2.dep2
+	val2=stash2.val2
+	obs2=stash2.obs2
+	bkg2=stash2.bkg2
+	obstype2=stash2.obstype2
+        qcarr2=stash2.qcarr2
+        dayarr2=stash2.dayarr2
+	datestr=stash2.datestr
+	xselstr=stash2.xselstr
+	yselstr=stash2.yselstr
+	rmdi=stash2.rmdi
+
+        multstr=""
+	mindayarr2=min(dayarr2,max=maxdayarr2)
+        
+        whs=sort(dayarr2)
+        u=uniq(dayarr2)
+
+        nu=n_elements(u)
+        dayarr2u=dayarr2(u)
+
+        print,'dayarr2u: ',dayarr2u
+        
+        if (maxdayarr2 ne mindayarr2) then multstr="mult times "+strtrim(string(nu),2)
+
+;	print,'obstype2 ',obstype2
+
+	print,'profile plot_bad_obs: ',stash2.plot_bad_obs
+	print, obs2
+        print, bkg2
+        print, qcarr2
+
+		if (stash2.plot_bad_obs eq 0) then begin
+		wh=where(obs2 ne rmdi and qcarr2 eq 0)
+                endif else begin
+;                wh=where(obs2 eq obs2)
+		wh=where(obs2 ne rmdi)
+                endelse
+                
+		if (wh(0) gt -1) then begin
+		depo1=dep2(wh)
+		valo1=val2(wh)
+		obso1=obs2(wh)
+		bkgo1=bkg2(wh)
+                qcarro1=qcarr2(wh)
+		endif
+                
+                
+		if (stash2.plot_bad_obs eq 0) then begin
+ 		wh=where(bkg2 ne rmdi and qcarr2 eq 0)
+		endif else begin
+;                wh=where(bkg2 eq bkg2)
+		wh=where(bkg2 ne rmdi)
+                endelse
+
+		if (wh(0) gt -1) then begin
+		depb1=dep2(wh)
+		valb1=val2(wh)
+		obsb1=obs2(wh)
+		bkgb1=bkg2(wh)
+                qcarrb1=qcarr2(wh)
+		endif
+                
+
+;loop thru times
+
+		if (n_elements(bkgb1) gt 0) then begin 
+                	xmx=max([obso1,bkgb1],min=xmn)
+                        ymx=max([depo1,depb1],min=ymn)
+                endif else begin
+                	xmx=max(obso1,min=xmn)
+                        ymx=max(depo1,min=ymn)
+                endelse
+
+; set max and min depth based on selection of depths from the main window
+		if (ymx gt stash2.depmax) then ymx=stash2.depmax
+                if (ymn lt stash2.depmin) then ymn=stash2.depmin
+
+; reset xrange based on new ymx and ymn
+		if (n_elements(bkgb1) gt 0) then begin 
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                        wh2=where(depb1 ge ymn and depb1 le ymx)
+                	if (wh1(0) gt -1 and wh2(0) gt -1) then xmx=max([obso1(wh1),bkgb1(wh2)],min=xmn)
+                endif else begin
+                        wh1=where(depo1 ge ymn and depo1 le ymx)
+                	if (wh1(0) gt -1) then xmx=max(obso1(wh1),min=xmn)
+                endelse
+
+; add a little bit to xrange to make plots look better
+		if (xmn eq xmx) then begin 
+                	xmn=xmn-0.5
+                        xmx=xmx+0.5
+                endif
+		dxrange=(xmx-xmn)*0.02
+                xmx=xmx+dxrange
+                xmn=xmn-dxrange
+
+; add a little bit to yrange to make plots look better
+		if (ymn eq ymx) then begin 
+                	ymn=ymn-0.5
+                        ymx=ymx+0.5
+                endif
+		dyrange=(ymx-ymn)*0.01
+                ymx=ymx+dyrange
+                ymn=ymn-dyrange
+		print,'** yrange: ',ymn, ymx
+
+		if (txt eq 1) then begin
+		        outfile='dataplot_profile.txt'
+			print, 'saving data to ',outfile
+			OPENW, unit, outfile, /get_lun
+                endif
+	
+		for t=0,nu-1 do begin					; loop through times
+
+		wht=where(dayarr2 eq dayarr2u(t))
+		depo=depo1(wht)
+                valo=valo1(wht)
+                obso=obso1(wht)
+                bkgo=bkgo1(wht)
+                qcarro=qcarro1(wht)
+                dayarro=dayarr2(wht)
+		if (n_elements(depb1) gt 0) then depb=depb1(wht)
+                if (n_elements(valb1) gt 0) then valb=valb1(wht)
+                if (n_elements(obsb1) gt 0) then obsb=obsb1(wht)
+                if (n_elements(bkgb1) gt 0) then bkgb=bkgb1(wht)
+                if (n_elements(qcarrb1) gt 0) then qcarrb=qcarrb1(wht)
+                
+
+
+;print data
+
+;		if (txt eq 1) then begin
+;		print,'rmdi: ',rmdi
+;                print,'profile data'
+;		for i=0,n_elements(depo)-1 do begin
+;                	print,depo(i),obso(i),bkgo(i),qcarro(i)
+;                endfor
+;                print,'profile data'
+;		for i=0,n_elements(depb)-1 do begin
+;                	print,depb(i),obsb(i),bkgb(i),qcarrb(i)
+;                endfor
+;		endif
+
+		typestr="type: "+string(obstype2(0))
+	
+;get variable type
+		vartype=size(obstype2,/type)
+		if (vartype ne 7) then begin
+			if (obstype2(0) eq rmdi) then typestr=""
+		endif
+
+; line thickness
+		thick1=2
+                thick2=2
+
+;		color1='FFCC66'x
+		color1=102
+		color2=!p.color
+                color3=234
+                
+                linestyle1=0
+                linestyle2=0
+                
+		who=sort(depo)
+                whb=sort(depb)
+
+		obso_srto=obso(who)
+                depo_srto=depo(who)
+                qcarro_srto=qcarro(who)
+                whbad=where(qcarro ne 0)
+                
+                if (txt eq 0) then begin
+                
+                if (t eq 0) then $
+ 		plot,obso_srto,depo_srto,ystyle=1,xstyle=1,linestyle=linestyle1,$
+			xrange=[xmn,xmx],yrange=[ymx,ymn],thick=thick1, $
+			psym=-4,ytitle='Level',xtitle='Value', $
+			title=datestr+" "+multstr+" ("+xselstr+","+yselstr+")   "+typestr, /nodata
+               
+                oplot,obso_srto,depo_srto,linestyle=linestyle1,psym=-4, thick=thick1, color=color1
+                if (whbad(0) gt -1) then begin
+                	oplot,obso_srto(whbad),depo_srto(whbad),psym=4, thick=thick1, color=color3
+                        oplot,obso_srto(whbad),depo_srto(whbad),psym=1, thick=thick1, color=color3
+                endif
+		if (n_elements(bkgb) gt 0) then oplot,bkgb(whb),depb(whb),psym=-5,thick=thick2, color=color2,$
+                	linestyle=linestyle2
+		xcoord=0.8
+		ycoord=0.2
+;                if (stash2.salinity eq 1) then xcoord=0.15	; left corner legend for salinity
+		nel=n_elements(who)
+                if (obso(who(0)) lt obso(who(nel-1))) then xcoord=0.15 
+                if (t eq 0) then $
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=-4, linestyle=linestyle1, /normal, $
+                  	thick=thick1, color=color1
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=-5, linestyle=linestyle2, /normal, $
+                  	thick=thick2, color=color2
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+                
+                endif else begin	; txt
+                  
+                  printf, unit,'observations ',n_elements(who)              
+                  for i=0L,n_elements(who)-1 do begin              
+                  	printf, unit, depo(i), obso(i), dayarro(i), format='(3f18.5)'
+                  endfor
+                  printf, unit, 'background ',n_elements(who) 
+                  for i=0L,n_elements(whb)-1 do begin
+                  	printf, unit, depb(i), bkgb(i), dayarro(i), format='(3f18.5)'
+                  endfor              
+                                
+                endelse
+                                        
+                endfor  ; t
+                
+                if (txt eq 1) then FREE_LUN, unit
+                
+end
+
+PRO profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi,salinity=salinity, $
+		plot_bad_obs=plot_bad_obs, density=density, white_on_black=white_on_black, coltable=coltable, $
+                depmax=depmax, depmin=depmin
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttonBase = Widget_Base(basepw, Row=1)
+	buttonpw = WIDGET_BUTTON(buttonBase, VALUE='Print',uvalue="PRINTPW") 
+	button2pw = WIDGET_BUTTON(buttonBase, VALUE='Save',uvalue="SAVEPW")
+        button3pw = WIDGET_BUTTON(buttonBase, VALUE='Text file',uvalue="TXTPW")
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        if (n_elements(salinity) eq 0) then salinity=0
+        if (n_elements(density) eq 0) then density=0
+	if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0
+        if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+		stash2 = { dep2:dep2,val2:val2,obs2:obs2, bkg2:bkg2, $
+			obstype2:obstype2, qcarr2:qcarr2, dayarr2:dayarr2, $
+			datestr:datestr,xselstr:xselstr, yselstr:yselstr, $
+			rmdi:rmdi, salinity:salinity, plot_bad_obs:plot_bad_obs,$
+                        density:density, white_on_black:white_on_black, $
+                        coltable:coltable, depmax:depmax, depmin:depmin }
+
+		plotprofile,stash2
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2	
+
+	XMANAGER, 'profilewindow', basepw, /NO_BLOCK	
+end
+
+;---------------------------------------
+;Worst points, window and event handling
+;---------------------------------------
+
+PRO worstpoints,stash2
+
+;stash2 is a combination of main stash and worstpoints specific stuff
+
+        xrange=stash2.xrange
+        yrange=stash2.yrange
+        selpoints,stash2,lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, obnumsel, numsel, typestr 
+
+	str1='Worst points in '+$
+        '   lons ('+strtrim(string(xrange(0)),2)+','+strtrim(string(xrange(1)),2)+$
+                	')   lats ('+strtrim(string(yrange(0)),2)+','+strtrim(string(yrange(1)),2)+')'+$
+        '   depths '+strtrim(string(long(stash2.depmin)),2)+'-'+strtrim(string(long(stash2.depmax)),2)                
+        print,str1
+
+	WIDGET_CONTROL, stash2.wwlabel1, set_value=str1
+
+        count=n_elements(innovsel)
+        wh=sort(abs(innovsel))
+        wh0=reverse(wh)			; reverse order starting with the largest        
+        cmax=min([count,10])
+	stash2.lonselw(0:cmax-1)=lonsel(wh0(0:cmax-1))
+        stash2.latselw(0:cmax-1)=latsel(wh0(0:cmax-1))
+        stash2.dayselw(0:cmax-1)=daysel(wh0(0:cmax-1))
+        print,'lon      lat       '+typestr+'     qc         date    '
+        for j1=1,cmax do begin
+           j=j1-1
+	    jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+	   
+           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+                qcsel(wh0(j)),' ',datestr
+
+        endfor
+        
+        if (n_elements(stash2) gt 0) then begin
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lon" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="Lat" & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value=typestr & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,0), set_value="QC" & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,0), set_value="Date" & i=i+1
+        
+        for j1=1,cmax do begin
+           j=j1-1
+           jul_to_dtstr,daysel(wh0(j)),datestr
+;           datedt=jul_to_dt(daysel(wh0(j)))
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+        i=0
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(lonsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), $
+        	set_value=strtrim(string(latsel(wh0(j)),format='(f9.3)'),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(innovsel(wh0(j))),2) & i=i+1
+	WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(string(qcsel(wh0(j))),2) & i=i+1
+        WIDGET_CONTROL, stash2.labels2(i,j1), set_value=strtrim(datestr,2) & i=i+1
+
+;           print,lonsel(wh0(j)),latsel(wh0(j)),innovsel(wh0(j)),$
+;                qcsel(wh0(j)),' ',datestr
+
+        endfor
+
+        
+        endif
+	        
+
+
+
+end
+
+pro worstpointswindow,stash
+	basepw=WIDGET_BASE(/column)
+;	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+
+	wwlabel1 = WIDGET_LABEL(basepw, XSIZE=480, VALUE="Worst points")
+                
+        nj=11
+        ni=5
+	labels=intarr(nj)
+        for j=0,nj-1 do begin        
+          labels(j)=Widget_Base(basepw,row=1)
+        endfor
+
+        labsiz=[50,50,50,50,125]
+	labels2=intarr(ni+2,nj)
+        for j=0,nj-1 do begin
+         for i=0,ni-1 do begin
+         labels2(i,j) = WIDGET_LABEL(labels(j), XSIZE=labsiz(i), $ 
+    VALUE="a") 
+ 	 endfor
+         if (j gt 0) then begin
+         labels2(i,j) = WIDGET_BUTTON(labels(j), VALUE='Zoom to', uvalue="Zoom to "+strtrim(string(j),2))
+         labels2(i+1,j) = WIDGET_BUTTON(labels(j), VALUE='Profile', uvalue="Profile "+strtrim(string(j),2))
+         endif
+        endfor
+
+        stashb={ wwlabel1:wwlabel1, labels2:labels2, ni:ni, nj:nj, lonselw:dblarr(10), latselw:dblarr(10), dayselw:dblarr(10)}
+	stash2=CREATE_STRUCT(stash,stashb)
+
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue="PRINTPW") 
+               
+	WIDGET_CONTROL, basepw, /REALIZE
+        worstpoints,stash2
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO worstpointswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+
+		xarr1=stash2.xarr
+		yarr1=stash2.yarr
+		dep1=stash2.dep
+		dayarr=stash2.dayarr
+		daymin=stash2.daymin
+		daymax=stash2.daymax
+                obstypes1=stash2.obstypes
+                xrange=stash2.xrange
+		yrange=stash2.yrange
+		xs=xrange(1)-xrange(0)
+		ys=yrange(1)-yrange(0)
+		rmdi=stash2.rmdi
+                if (stash2.salinity eq 0) then begin
+		  obs1=stash2.obs
+		  bkg1=stash2.bkg
+                  qcarr1=stash2.qcarr
+                endif else begin
+		  obs1=stash2.obs2
+		  bkg1=stash2.bkg2
+                  qcarr1=stash2.qcarr2
+		endelse                	
+
+	if (uval eq "PRINTTSW") then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file="~/worstpoints.ps",landscape=landscape,ps=ps,eps=eps,color=1
+		worstpoints,stash2
+		prend2,/view
+	endif
+        print,strmid(uval,0,7)
+        if (strcmp(strmid(uval,0,7),"Zoom to")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                print,num,xsel,ysel  
+                dataplot_zoom,stash2, xsel, ysel, 1
+                plotpoints,stash2              
+                           
+        endif
+        if (strcmp(strmid(uval,0,7),"Profile")) then begin
+        	num=fix(strmid(uval,7,3))
+                xsel=stash2.lonselw(num-1)
+                ysel=stash2.latselw(num-1)
+                daysel=stash2.dayselw(num-1)
+;                print,num,xsel,ysel,daysel,daysel-long(daysel),float(daysel)
+;                info,dayarr
+;                info,daysel
+;		info,xarr1
+;                info,ysel
+;                info,yarr1
+;                info,xsel
+                
+                wh1=where(xarr1 eq xsel and yarr1 eq ysel)
+;                print,'dayarr(wh1) ',dayarr(wh1), float(dayarr(wh1))
+;                print,'dayarr(wh1)-long ',dayarr(wh1)-long(dayarr(wh1))
+;                print,'dep1(wh1) ',dep1(wh1)
+                wh2=where(xarr1 eq xsel and yarr1 eq ysel and float(dayarr) eq float(daysel))
+;                print,'wh2 ',wh2
+;                if (wh2(0) gt -1) then print,'daysel(wh2) ',daysel(wh2)
+       
+        	wh=where(xarr1 eq xsel and yarr1 eq ysel and long(dayarr) eq long(daysel))
+                if (wh(0) gt -1) then begin
+		dep2=dep1(wh)
+		val2=abs(obs1(wh)-bkg1(wh))
+		obs2=obs1(wh)
+		bkg2=bkg1(wh)
+		obstype2=obstypes1(wh)
+                qcarr2=qcarr1(wh)
+                dayarr2=dayarr(wh)
+		jul_to_dtstr,stash2.dayselw(num-1),datestr
+		xselstr=string(xsel)
+		yselstr=string(ysel)
+
+		profilewindow,dep2,val2,obs2,bkg2,obstype2,qcarr2,dayarr2,datestr,xselstr,yselstr,rmdi, salinity=stash2.salinity, $
+                	white_on_black=stash.white_on_black, coltable=stash.coltable, depmax=stash.depmax, depmin=stash.depmin
+                endif
+	endif
+
+; store values
+  WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2 
+
+end
+
+PRO filterwindow, stash
+
+	val=stash.obstypeselect
+
+	obstypes=stash.obstypes
+        uniquetypes=strjoin(obstypes(uniq(obstypes, sort(obstypes))),string(10b))
+        
+	base = WIDGET_BASE(GROUP_LEADER=stash.base ,/modal,/column) 
+        
+        
+	intextid = CW_FIELD(base, TITLE = "Filter type", /FRAME, value=val, uvalue='intext', /RETURN_EVENTS) 
+        outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid:intextid }
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'filterwindow', base        
+
+        theText = (*ptr).text
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',theText, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (stash.obstypeselect ne theText and nocancel eq 1) then begin
+                stash.obstypeselect=theText
+        	plotpoints,stash
+        endif
+        
+        
+end
+
+PRO filterwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq "accept" or uval eq "intext") then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid, Get_Value=theText
+	print,'the text ',theText
+
+        (*stash2.ptr).text=theText
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input area
+;--------------------------------------
+
+PRO inputareawindow, xrange, yrange, toplevel, success
+
+        val1=xrange(0)
+        val2=xrange(1)
+        val3=yrange(0)
+        val4=yrange(1)
+        
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "lon1", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "lon2", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+	intextid3 = CW_FIELD(base, TITLE = "lat1", /FRAME, value=val3, uvalue='intext3', /RETURN_EVENTS) 
+	intextid4 = CW_FIELD(base, TITLE = "lat2", /FRAME, value=val4, uvalue='intext4', /RETURN_EVENTS) 
+
+;       outtextid = WIDGET_TEXT(base, value="Choose from:"+string(10b)+uniquetypes, $
+;        	scr_xsize=200, scr_ysize=200, /scroll) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept', uvalue='accept')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", text3:"", text4:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2, $
+         	intextid3:intextid3, intextid4:intextid4}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputareawindow', base        
+
+        lon1 = (*ptr).text1
+        lon2 = (*ptr).text2
+        lat1 = (*ptr).text3
+        lat2 = (*ptr).text4
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',lon1, lon2, lat1, lat2, nocancel
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin
+		xrange=[float(lon1),float(lon2)]
+                yrange=[float(lat1),float(lat2)]
+                xrange=xrange(sort(xrange))
+                yrange=yrange(sort(yrange))
+                wh=where(xrange gt 360)
+                if (wh(0) gt -1) then xrange(wh)=360
+                wh=where(xrange lt -180)
+                if (wh(0) gt -1) then xrange(wh)=-180
+                wh=where(yrange gt 90)
+                if (wh(0) gt -1) then yrange(wh)=90
+                wh=where(yrange lt -90)
+                if (wh(0) gt -1) then yrange(wh)=-90
+                
+                if (xrange(0) eq xrange(1)) then xrange(1)=xrange(1)+0.1 
+                if (yrange(0) eq yrange(1)) then yrange(1)=yrange(1)+0.1
+                
+                success=1
+        endif
+        
+        
+end
+
+PRO inputareawindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,uval
+        print,val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+        Widget_Control, stash2.intextid3, Get_Value=theText3
+        Widget_Control, stash2.intextid4, Get_Value=theText4
+	print,'the text ',theText1, theText2, theText3, theText4
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).text3=theText3
+        (*stash2.ptr).text4=theText4
+        (*stash2.ptr).nocancel=1
+        endif         
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+;--------------------------------------
+; Input max min
+;--------------------------------------
+
+PRO inputmxmnwindow, fmx, fmn, mx, mn, rmdi, toplevel, success
+
+	print,'fmx/mn ',fmx,fmn
+        print,'mx/mn ',mx,mn
+
+        val1=mx
+        val2=mn
+
+	base = WIDGET_BASE(GROUP_LEADER=toplevel,/modal,/column) 
+                
+	intextid1 = CW_FIELD(base, TITLE = "mx", /FRAME, value=val1, uvalue='intext1', /RETURN_EVENTS) 
+ 	intextid2 = CW_FIELD(base, TITLE = "mn", /FRAME, value=val2, uvalue='intext2', /RETURN_EVENTS) 
+
+	text="Max and min not locked"
+        if (fmx ne rmdi) then text="Max locked"
+        if (fmn ne rmdi) then text="Min Locked"
+        if (fmx ne rmdi and fmn ne rmdi) then text="Max and min locked"
+        outtextid = WIDGET_TEXT(base, value=text, $
+        	scr_xsize=200, scr_ysize=40) 
+
+	buttonBase = Widget_Base(base, Row=1)
+	   acceptID = Widget_Button(buttonBase, Value='Accept/lock', uvalue='accept')
+           resetID = Widget_Button(buttonBase, Value='Reset/free', uvalue='reset')
+	   cancelID = Widget_Button(buttonBase, Value='Cancel', uvalue='cancel')
+           
+
+	WIDGET_CONTROL, base, /REALIZE 
+
+	ptr = Ptr_New({text1:"", text2:"", nocancel:0})
+
+	stash2={ ptr:ptr, intextid1:intextid1,  intextid2:intextid2}
+        WIDGET_CONTROL, base, SET_UVALUE=stash2, /No_Copy
+
+	XMANAGER, 'inputmxmnwindow', base        
+
+        fmx = float((*ptr).text1)
+        fmn = float((*ptr).text2)
+
+	info, fmx
+        info, fmn
+
+        nocancel = (*ptr).nocancel
+        Ptr_Free, ptr
+        
+        print, 'finished ',fmx,fmn, mx, mn
+
+; if obstypeselect has changed then replot the points
+                
+        if (nocancel eq 1) then begin                
+                success=1
+        endif
+	if (nocancel eq 2) then begin
+        	fmx=rmdi
+                fmn=rmdi
+                success=1
+        endif
+ 
+end
+
+PRO inputmxmnwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash2 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval
+  WIDGET_CONTROL, ev.ID, GET_VALUE=val
+;  	info,uval
+;        info,val
+	print,'uval ',uval,' val ',val
+
+	if (uval eq 'accept') then begin
+;        stash2.val=val
+
+	Widget_Control, stash2.intextid1, Get_Value=theText1
+	Widget_Control, stash2.intextid2, Get_Value=theText2
+	print,'the text ',theText1, theText2
+
+        (*stash2.ptr).text1=theText1
+        (*stash2.ptr).text2=theText2
+        (*stash2.ptr).nocancel=1
+        endif         
+
+	if (uval eq 'reset') then begin
+        (*stash2.ptr).nocancel=2
+        endif
+        
+;   WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash2       
+        
+        WIDGET_CONTROL, ev.top, /DESTROY
+
+end
+
+
+
+pro infowindow
+	basepw=WIDGET_BASE(/column)
+	xsz=360
+
+        iwlabel0 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="Dataplot")
+        iwlabela = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="--------")
+        iwlabelb = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="")      
+	iwlabel1 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="To report bugs or for help")
+        iwlabel2 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="contact Dan Lea")
+        iwlabel3 = WIDGET_LABEL(basepw, XSIZE=xsz, VALUE="daniel.lea@metoffice.gov.uk")
+ 	               
+	WIDGET_CONTROL, basepw, /REALIZE
+
+;	WIDGET_CONTROL, basepw, SET_UVALUE=stash2
+;	XMANAGER, 'worstpointswindow', basepw, /NO_BLOCK
+end
+
+PRO dataplot_zoom, stash, xdata, ydata, zoominout
+
+		xrange=stash.xrange
+		yrange=stash.yrange
+		xrangedef=stash.xrangedef
+		yrangedef=stash.yrangedef
+	
+
+		print,xrange,yrange
+
+;		zx=xrange(0)
+;		zy=yrange(0)
+		sx=xrange(1)-xrange(0)
+		sy=yrange(1)-yrange(0)
+		sxd=xrangedef(1)-xrangedef(0)
+		syd=yrangedef(1)-yrangedef(0)
+
+		print,sx,sy
+
+		if (zoominout eq 1) then begin
+		sx=sx/2.
+		sy=sy/2.
+; try to squarify for zoomed in version
+		sx2=(sx+sy)/2.
+;		sx=max(sx,sx2)
+;		sy=max(sy,sx2) 
+;		sx=(sx+sx2)/2.
+;		sy=(sy+sx2)/2.
+
+; try to tend to initial proportions for zooming in
+		sx=(sx+1.0*(sxd*0.5/(sxd+syd)))/2.
+                sy=(sy+1.0*(syd*0.5/(sxd+syd)))/2.
+
+		endif
+		if (zoominout eq -1) then begin
+		sx=sx*2.
+		sy=sy*2.
+ ; try to make similar to initial proportions for zooming out               
+                sx2=(sx+sy)*2.
+		sx=(sx+sx2*(sxd*0.5/(sxd+syd)))/2.
+		sy=(sy+sx2*(syd*0.5/(sxd+syd)))/2.
+                
+		endif
+		
+
+		print,'sx sy ',sx,sy, xdata, ydata
+
+                oxrange=xrange                
+		
+		xrange=[xdata-sx/2.,xdata+sx/2.]
+		yrange=[ydata-sy/2.,ydata+sy/2.]
+
+		if (oxrange(1) le 180) then begin		; 0 longitude centred
+		if (xrange(0) lt xrangedef(0)) then xrange(0)=xrangedef(0)
+		if (xrange(1) gt xrangedef(1)) then xrange(1)=xrangedef(1)
+		endif else begin				; 180 longitude centred
+ 		if (xrange(0) lt xrangedef(0)+180) then xrange(0)=xrangedef(0)+180
+		if (xrange(1) gt xrangedef(1)+180) then xrange(1)=xrangedef(1)+180
+		endelse               
+
+		if (yrange(0) lt yrangedef(0)) then yrange(0)=yrangedef(0)
+		if (yrange(1) gt yrangedef(1)) then yrange(1)=yrangedef(1)
+
+		print,'xrange ',xrange,' yrange ',yrange
+                
+                stash.xrange=xrange
+		stash.yrange=yrange
+
+end
+
+;---------------------------------------
+;Time series plotting and event handling
+;---------------------------------------
+
+PRO plottimeseries, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+      daymaxl=stash.daymaxl
+
+		numtimeseries=stash.numtimeseries		; if 1 then plot number of points
+
+;		print,depmin,xrange,yrange
+
+;		wh=where(dep1 eq ev.index)
+;		wh=where(dep1 eq depmin and $
+;			dayarr ge daymin and dayarr le daymax)
+
+;	
+
+;		nelwh=n_elements(wh)
+
+		; select points to plot
+		typestr=''
+
+		if (stash.plottssel eq 1) then begin
+         dayminl=daymin
+         daymaxl=daymax
+      endif
+
+		print,'djl ',dayminl,daymaxl, min(stash.dayarr), max(stash.dayarr)
+
+		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, /rmsmean, innovsel2=innovsel2
+
+		print,'djl ',min(daysel), max(daysel)
+
+		if (stash.plottssel eq 1) then begin
+                	daymaxl=daymaxl+1
+                endif
+		   
+
+;		plot,daysel, ystyle=1
+
+		print,'n_elements(daysel) ',n_elements(daysel), min(daysel), max(daysel) 
+		print, dayminl, daymaxl
+
+; group in 1/4 day bins
+
+;		binspday=double(4.0)    ; every 6 hours
+;                binspday=double(8.0)    ; every 3 hours
+		binspday=double(stash.binspday)
+		nbins=(daymaxl-dayminl)*binspday+1
+
+		print, daymaxl, dayminl, binspday
+
+                x2arr=dblarr(nbins)
+                xarr=dblarr(nbins)
+                narr=dblarr(nbins)
+                tarr=dblarr(nbins)
+		meants=dblarr(nbins)
+                rmsts=dblarr(nbins)
+  
+		print, 'nbins: ',nbins
+
+		if n_elements(innovsel) gt 0 then begin
+
+		print,max(daysel),min(daysel)
+  
+                for ibin=0L,nbins-1 do begin
+                  timmn=double(dayminl)+ibin/binspday
+                  timmx=timmn+1/binspday
+;                  print, ibin, timmn, timmx, timmx-timmn
+                  wh=where(daysel ge timmn and daysel lt timmx, count)
+                  print, 'ibin ',ibin, timmn, timmx, count
+; redo based on the number of observations
+                  if (wh(0) ne -1) then begin
+                  innovsels=innovsel(wh)
+                  innovsel2s=innovsel2(wh)
+                  numsels=numsel(wh)
+                  
+		  x2arr(ibin)=total(innovsel2s*numsels)
+		  xarr(ibin)=total(innovsels*numsels)
+;		  narr(ibin)=n_elements(innovsels)
+		  narr(ibin)=total(numsels)
+;                  print,ibin, x2arr(ibin), xarr(ibin)
+                  endif
+                  tarr(ibin)=timmn
+                endfor
+
+		meants=xarr/narr
+                rmsts=sqrt(x2arr/narr)
+
+;		print,'meants: ',meants
+;		print,'rmsts: ',rmsts
+
+		endif	; n_elements(innovsel)
+
+		wh=where(finite(meants))		; find finite values
+		ymx=max([meants(wh),rmsts(wh)],min=ymn)
+
+;put a bit of white space around ymx,ymn
+		dymxmn=(ymx-ymn)*0.02
+                ymx=ymx+dymxmn
+                ymn=ymn-dymxmn
+
+		print,'ymx/mn ',ymx,ymn
+
+                strtsal=''
+;                print,'stash.filetype ',stash.filetype
+                if (stash.filetype eq 'Prof' or stash.filetype eq 'feedback') then begin
+                	strtsal='T:  '
+                        if (stash.salinity eq 1) then strtsal='S:  '
+                endif else begin
+                	strtsal=stash.filetype+':  '
+                endelse
+
+                title=strtsal+typestr+'   lons ('+string(xrange(0))+','+string(xrange(1))+$
+                	')   lats ('+string(yrange(0))+','+string(yrange(1))+')'  
+                print,title            
+
+;                dtarr=jul_to_dt(tarr)   
+		dtarr=tarr-0.5			; convert back to julian day
+
+		xmx=max(dtarr,min=xmn)
+;put a bit of white space around xmx,xmn
+		dxmxmn=(xmx-xmn)*0.02
+                xmx=xmx+dxmxmn
+                xmn=xmn-dxmxmn
+
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%I:%S', '%H', '%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+	if (stash.txt eq 0) then begin
+	if (numtimeseries ne 1) then begin                       
+		plot,dtarr, meants, xstyle=1, linestyle=1, yrange=[ymn,ymx], title=title, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4] 
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+		plot, dtarr, rmsts, xstyle=1, yrange=[ymn,ymx], /noerase, $
+                       ytitle=typestr, xrange=[xmn,xmx], $
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['RMS','mean'],linestyle=[0,1],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+	endif else begin
+		plot,dtarr, narr, xstyle=1, title=title, $
+                       ytitle='number of obs', $ 
+                       XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+      
+	endelse
+	endif else begin
+
+        outfile=stash.outfile+'_timeseries.txt'
+	print, 'saving data to ',outfile
+	OPENW, unit, outfile, /get_lun
+;   		printf,unit,'Output timeseries data: '
+		printf,unit, strtsal
+                printf,unit, typestr
+                printf,unit, xrange, yrange
+                printf,unit, binspday
+                nel=n_elements(dtarr)
+                for i=0L,nel-1 do begin
+                	printf,unit, dtarr(i), narr(i), meants(i), rmsts(i),format='(d18.8,d18.2,d18.8,d18.8)'
+                endfor
+        FREE_LUN, unit
+
+	endelse
+
+;		print,'min/max lonsel: ',min(lonsel),max(lonsel)
+
+end
+
+PRO timeserieswindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+        buttons=Widget_Base(basepw,row=1)
+        
+        tlb = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=400,$
+       /Exclusive)
+; no_release only sends select events (not release ones)
+   	buttonp1 = Widget_Button(tlb, Value='1 bin per day',uvalue='RADIO1',/no_release)
+   	buttonp2 = Widget_Button(tlb, Value='2 bins',uvalue='RADIO2',/no_release)
+   	buttonp3=  Widget_Button(tlb, Value='4 bins',uvalue='RADIO3',/no_release)
+   	buttonp4 = Widget_Button(tlb, Value='8 bins',uvalue='RADIO4',/no_release)
+
+	if (stash.binspday eq 1) then Widget_Control, buttonp1, Set_Button=1
+	if (stash.binspday eq 2) then Widget_Control, buttonp2, Set_Button=1
+       	if (stash.binspday eq 4) then Widget_Control, buttonp3, Set_Button=1
+	if (stash.binspday eq 8) then Widget_Control, buttonp4, Set_Button=1
+ 
+        tlb2 = Widget_Base(buttons,Title='Push-Buttons', row=1, Scr_XSize=100,$
+       /NonExclusive)
+	buttonpa1= Widget_Button(tlb2, Value='plot selected period',uvalue='PLOTSEL')
+
+
+	Widget_Control, buttonpa1, Set_Button=stash.plottssel
+        
+	buttonpw = WIDGET_BUTTON(buttons, VALUE='Print',uvalue='PRINTTSW') 
+        buttonpw2 = WIDGET_BUTTON(buttons, VALUE='Output',uvalue='OUTPUTTSW')
+        
+	WIDGET_CONTROL, basepw, /REALIZE
+
+	xyouts,0.2,0.5,'working...',/normal,charsize=2.5
+	
+        plottimeseries,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'timeserieswindow', basepw, /NO_BLOCK	
+end
+
+PRO timeserieswindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottimeseries,stash
+		prend2,/view
+	endif
+        if (uval eq 'OUTPUTTSW') then begin
+        	savetxt=stash.txt
+                stash.txt=1
+        	plottimeseries,stash
+                stash.txt=savetxt
+        endif
+        if (uval eq 'RADIO1') then begin
+        	stash.binspday=1
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO2') then begin
+        	stash.binspday=2
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO3') then begin
+        	stash.binspday=4
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'RADIO4') then begin
+        	stash.binspday=8
+                plottimeseries,stash        	
+        endif
+        if (uval eq 'PLOTSEL') then begin
+        	stash.plottssel=1-stash.plottssel
+                print,'stash.plottssel ',stash.plottssel
+                WIDGET_CONTROL, ev.TOP, SET_UVALUE=stash
+                plottimeseries,stash        
+        endif
+
+        
+end
+
+;----------------------------------------
+; T-S diagram plotting and event handling
+;----------------------------------------
+
+PRO plottsdiagram, stash
+ 
+		xrange=stash.xrange
+		yrange=stash.yrange
+;		dayarr=stash.dayarr
+		daymin=stash.daymin
+		daymax=stash.daymax
+		dayminl=stash.dayminl
+                daymaxl=stash.daymaxl
+                xarr=stash.xarr
+                yarr=stash.yarr
+                rmdi=stash.rmdi
+
+		; select T and S points to plot
+		typestr=''
+      		selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr, $
+                	daymin=dayminl, daymax=daymaxl, salinity=1
+                        
+                ; select points with salinity
+                
+                nel=n_elements(lonsel)
+                
+                if (nel gt 0) then begin
+
+		  bkg=stash.bkg
+                  bkg2=stash.bkg2
+                  obs=stash.obs
+                  obs2=stash.obs2
+                  dep=stash.dep
+                  strtarr=0
+ 		  depmin=stash.depmin
+		  depmax=stash.depmax
+                 
+		  for i=0L,nel-1 do begin
+			wh=where(lonsel(i) eq xarr and latsel(i) eq yarr and $
+                          dep ge depmin and dep le depmax )
+                        if (wh(0) gt -1) then begin
+                        if (strtarr eq 0) then begin
+                          strtarr=1
+                          bkgsel=bkg(wh)
+                          bkg2sel=bkg2(wh)
+                          obssel=obs(wh)
+                          obs2sel=obs2(wh)
+                        endif else begin
+		          bkgsel=[bkgsel,bkg(wh)]
+                          bkg2sel=[bkg2sel,bkg2(wh)]
+		          obssel=[obssel,obs(wh)]
+                          obs2sel=[obs2sel,obs2(wh)]
+                        endelse
+                        endif              
+                  endfor
+
+               ;filter out points with missing data
+               
+               wh=where(bkgsel ne rmdi and bkg2sel ne rmdi $
+                    and obssel ne rmdi and obs2sel ne rmdi)
+               
+                if (wh(0) gt -1) then begin
+                  obssel=obssel(wh)
+                  bkgsel=bkgsel(wh)
+                  obs2sel=obs2sel(wh)
+                  bkg2sel=bkg2sel(wh)              
+                  
+                  xmn=min([obssel,bkgsel],max=xmx)
+                  ymn=min([obs2sel,bkg2sel],max=ymx)
+               
+               title='T-S diagram: dep '+string(depmin)+'-'+string(depmax)
+               
+		plot,obssel,obs2sel,psym=4, color='FFFFFF'x, xtitle='Temperature',ytitle='Salinity',$
+                	xrange=[xmn,xmx], yrange=[ymn,ymx],xstyle=1,ystyle=1, title=title
+                oplot,bkgsel,bkg2sel,psym=5, color='FFCC66'x
+
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.2
+;		ukmo_legend,xcoord=xcoord,ycoord=ycoord,delta_y=0.05,$
+;			['obs','bkg'],psym=[4,5],color=['FFFFFF'x, 'FFCC66'x],/normal
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], psym=4, color='FFFFFF'x, /normal
+                  xyouts, xcoord+0.05, ycoord, 'obs', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], psym=5, color='FFCC66'x, /normal
+                  xyouts, xcoord+0.05, ycoord2, 'bkg',/normal                
+
+
+               endif
+               endif
+
+end
+
+PRO tsdiagramwindow, stash
+	basepw=WIDGET_BASE(/column)
+	drawpw = WIDGET_DRAW(basepw, XSIZE=640, YSIZE=480)
+	buttonpw = WIDGET_BUTTON(basepw, VALUE='Print',uvalue='PRINTTSW') 
+	WIDGET_CONTROL, basepw, /REALIZE
+	
+        plottsdiagram,stash
+
+	WIDGET_CONTROL, basepw, SET_UVALUE=stash	
+
+	XMANAGER, 'tsdiagramwindow', basepw, /NO_BLOCK	
+end
+
+PRO tsdiagramwindow_event, ev
+  WIDGET_CONTROL, ev.TOP, GET_UVALUE=stash 
+  WIDGET_CONTROL, ev.ID, GET_UVALUE=uval 
+	print,uval
+	if (uval eq 'PRINTTSW') then begin
+		ps=1
+		eps=0
+		landscape=1
+		pr2,file='~/tsdiagram.ps',landscape=landscape,ps=ps,eps=eps,color=1
+		plottsdiagram,stash
+		prend2,/view
+	endif
+end
+
+PRO jul_to_dtstr, daysel, datestr, notime=notime
+
+;print,'called jul_to_dtstr ',daysel
+
+; IDL Julian days start at 12 noon
+
+	CALDAT, daysel(0)-0.5, Month, Day, Year, Hour, Minute, Second
+           datestr=strtrim(fix(year),2)+'/'+ $
+	     strtrim(string(fix(month),format='(i2.2)'),2)+'/'+ $
+	     strtrim(string(fix(day),format='(i2.2)'),2)
+             
+             if (n_elements(notime) eq 0) then $
+             	datestr=datestr+' '+$
+	     strtrim(string(fix(hour),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(minute),format='(i2.2)'),2)+':'+ $
+	     strtrim(string(fix(second),format='(i2.2)'),2)
+
+;           datedt=jul_to_dt(daysel)
+;           datedt=datedt(0)
+;           datestr=strtrim(fix(datedt.year),2)+'/'+ $
+;	     strtrim(string(fix(datedt.month),format='(i2.2)'),2)+'/'+ $
+;	     strtrim(string(fix(datedt.day),format='(i2.2)'),2)+' '+ $
+;	     strtrim(string(fix(datedt.hour),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.minute),format='(i2.2)'),2)+':'+ $
+;	     strtrim(string(fix(datedt.second),format='(i2.2)'),2)
+
+;print,datestr
+
+END
+
+;-----------------------------------------------------------------------
+; MAIN routine
+; Widget creation routine. 
+;  dataplot, [longitude, latitude, deparr, dayarr, valarr, bkgarr]
+;+
+PRO dataplot, indata, rmdi=rmdi, filename=filename, salinity=salinity, batch=batch, $
+	ps=ps, gif=gif, area=area, typeplot=typeplot, ombtypeplot=ombtypeplot, $
+        alldays=alldays, depths=depths, $
+        mx=mx, mn=mn, showmdt=showmdt, obstypeselect=obstypeselect, printobstypes=printobstypes, $
+        daterange=daterange, timeseries=timeseries, binspday=binspday, plot_bad_obs=plot_bad_obs, $
+        plot_only_bad_obs=plot_only_bad_obs, $
+        numtimeseries=numtimeseries, txt=txt, netcdf=netcdf, vertgrad=vertgrad, healthcheck=healthcheck, $
+        duplicates=duplicates, differences=differences, outfile=outfile, white_on_black=white_on_black, $
+        bindata=bindata, symscale=symscale, hiresmap=hiresmap, coltable=coltable, $
+        picsize=picsize, pmulti=pmulti, typeproj=typeproj, dayrange=dayrange, $
+        notfussy=notfussy, mld=mld, binsize=binsize, filterout=filterout
+;-
+	
+; DJL switch off wave compatibility mode
+res=execute('waveoff')
+
+; string array obstypeselect
+
+if (n_elements(obstypeselect) eq 0) then obstypeselect=''
+if (n_elements(printobstypes) eq 0) then printobstypes=''
+if (n_elements(filterout) eq 0) then filterout=''
+
+if (n_elements(binspday) eq 0) then binspday=4		; plot timeseries every 6 hours
+plottssel=0	; plot selected period of timeseries
+if (n_elements(plot_bad_obs) eq 0) then plot_bad_obs=0	; don't plot bad obs
+
+if (n_elements(plot_only_bad_obs) eq 0) then plot_only_bad_obs=1	; plot only bad obs if selected
+if (n_elements(white_on_black) eq 0) then white_on_black=1
+
+if (n_elements(duplicates) eq 0) then duplicates=0	; plot only duplicates if selected
+if (n_elements(differences) eq 0) then differences=0	; plot only differences if selected
+
+if (n_elements(numtimeseries) eq 0) then numtimeseries=0	; plot time series of O-B
+
+if (n_elements(txt) eq 0) then txt=0
+
+if (n_elements(netcdf) eq 0) then netcdf=0			; if 1 the output netcdf data
+
+print,obstypeselect
+
+if (n_elements(salinity) eq 0) then salinity=0
+density=0
+if (n_elements(vertgrad) eq 0) then vertgrad=0
+
+if (n_elements(mld) eq 0) then mld=0
+
+if (n_elements(outfile) eq 0) then outfile="dataplot"
+
+if (n_elements(bindata) eq 0) then bindata=0
+
+if (n_elements(binsize) eq 0) then binsize=[1.0,1.0]
+
+if (n_elements(symscale) eq 0) then symscale=1.0
+
+if (n_elements(hiresmap) eq 0) then begin
+	hires_map=0
+endif else begin
+	hires_map=hiresmap
+endelse
+
+if (n_elements(rmdi) eq 0) then rmdi=0
+
+if (n_elements(coltable) eq 0) then begin
+	coltable=-1
+endif
+
+if (n_elements(picsize) ne 2) then picsize=[800,512]	; default gif resolution
+
+if (n_elements(pmulti) eq 0) then pmulti=0		; default pmulti
+
+sz=size(indata)
+nsz=n_elements(sz)
+type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+if (type eq 7) then filename=indata
+
+if (type ne 7) then begin
+   nel=n_elements(indata)
+   nel8=nel/8
+   numobs=nel8
+
+   ; get input values
+   if (nel gt 0) then begin
+      indata=reform(indata,numobs,8)
+      xarr=indata(*,0)
+      yarr=indata(*,1)
+      dep=indata(*,2)
+      dayarrin=indata(*,3)
+      obs=indata(*,4)
+      bkg=indata(*,5)
+      obs2=rmdi
+      obs3=rmdi
+      bkg2=rmdi
+      qcarr=long(indata(*,6))
+      qcarr2=rmdi
+      obnum=rmdi
+      obstypes=long(indata(*,7))
+      filetype="generic"
+      
+      print, 'djl max/min dayarrin ',max(dayarrin), min(dayarrin)
+      print, 'djl max/min qcarr ',max(qcarr), min(qcarr)
+      
+   endif
+endif else begin
+   if (n_elements(filename) eq 0) then begin
+       print,'ERROR: No filename supplied'
+       print,'call: dataplot, filenamearr'
+       return
+   endif
+endelse
+
+;read in data
+if (n_elements(filename) gt 0) then begin
+	read_cdfobs, filename, numobs=numobs, Latitudes=yarr, Longitudes=xarr, $
+	      obs=obs, modelvals=bkg, qcs=qcarr, $
+         ob2=obs2, modelval2=bkg2, qc2=qcarr2, $
+         ob3=obs3, $
+         Dates=dayarrin, rmdi=rmdi, $
+	      depths=dep, nodates=0, types=obstypes, $
+         filetype=filetype, iobs=iobs, jobs=jobs, MDT=MDT, error=error, profilenum=obnum, $
+         notfussy=notfussy, VarName=varname
+
+	if (error eq 1) then begin
+           numobs=0
+           dayarrin=0
+           rmdi=-99999
+           xarr=rmdi
+           yarr=rmdi
+           obs=rmdi
+           bkg=rmdi
+           qcarr=1
+           dayarrin=rmdi
+           dayarr=rmdi
+           dep=rmdi
+           filetype=""
+           obstypes=rmdi
+           obnum=0
+	endif 
+
+	print,'error ',error, numobs
+
+	if (numobs gt 0) then begin
+        print, 'numobs ',numobs
+
+;setup obnum if it is not produced by read_cdfobs
+
+	if (n_elements(obnum) ne numobs and numobs gt 0) then begin
+		obnum=lindgen(n_elements(numobs))	; generate an array of observation numbers
+                					; starting with zero
+        endif
+
+
+
+;if gt 180 then make longitudes negative
+
+	  wh=where(xarr ge 180 and xarr le 360)
+	  if (wh(0) gt -1) then begin
+ 	    xarr(wh)=xarr(wh)-360
+	  endif
+
+
+;calculate vertical gradient
+;
+;	  if (filetype eq "Prof") then $
+;	  calcvertgrad, xarr, yarr, dayarrin, obs, bkg, qcarr, obs2,bkg2, qcarr2, dep, rmdi
+
+; adjust qc values for profile obs data (1 = good)
+	  wh=where(bkg ne rmdi)
+          if (n_elements(bkg2) gt 0) then begin
+            wh2=where(bkg2 ne rmdi)
+	    if (filetype eq "Prof" and wh(0) eq -1 and wh2(0) eq -1) then begin
+              qcarr=qcarr-1 
+              qcarr2=qcarr2-1
+	    endif
+	  endif
+ 
+          if (keyword_set(showmdt) eq 1) then begin
+	    bkg=MDT
+          endif
+
+
+	  print,'rmdi ',rmdi
+
+	  print,'file read in'
+
+spawn,'echo part 1 `date`'
+
+	  if (n_elements(rmdi) eq 0) then rmdi=-1.07374e+09
+
+	  qcarr=fix(qcarr)
+
+	endif		; numobs
+
+	print,'endif numobs'
+
+; select area
+
+        sz=size(area)
+        nsz=n_elements(sz)
+        type=sz(nsz-2)	; get type 2 integer, 4 float, 7 string
+        if (type eq 7) then areasel, area, xrange, yrange, success
+        if (type eq 4 or type eq 2) then begin
+	  if (nsz eq 4) then begin
+             xrange=[area(0),area(2)]
+             yrange=[area(1),area(3)]
+          endif
+	endif			
+
+; set missing obs types to missing data
+        if (n_elements(obs2) eq 0) then begin
+          obs2=rmdi
+          bkg2=rmdi
+          qcarr2=rmdi
+       endif
+        if (n_elements(obs3) eq 0) then begin
+          obs3=rmdi
+          bkg3=rmdi
+          qcarr3=rmdi
+       endif
+
+endif		; filename
+
+if (n_elements(varname) eq 0) then varname=''
+
+	  if (n_elements(dayarrin) ne numobs) then dayarrin=replicate(1,numobs)
+;	    dep=replicate(0,numobs)
+
+
+	  if (size(dayarrin,/type) eq 8) then begin 
+  	    dayarr=dayarrin.julian
+          endif else begin
+  	    dayarr=dayarrin
+            dayarr=dayarr+0.5			; dataplot prefers each day to be a different integer
+          endelse
+
+print,'xxx'
+
+;set contour range mn, mx
+if (n_elements(mx) eq 0) then fmx=rmdi else fmx=mx
+if (n_elements(mn) eq 0) then fmn=rmdi else fmn=mn
+mx=fmx
+mn=fmn
+
+
+
+  ; Define a monochrome image array for use in the application. 
+;  READ_PNG, FILEPATH('mineral.png', $ 
+;    SUBDIR=['examples', 'data']), image 
+ 
+  ; Place the image array in a pointer heap variable, so we can 
+  ; pass the pointer to the event routine rather than passing the 
+  ; entire image array. 
+;  imagePtr=PTR_NEW(image, /NO_COPY) 
+ 
+  ; Retrieve the size information from the image array. 
+;  im_size=SIZE(*imagePtr) 
+
+;---------------
+;Setup defaults
+;---------------
+
+  busy=0
+  wh=where(dep ge 0)
+  depminl=0.
+  depmaxl=1.
+  if( wh(0) gt -1) then depminl=min(dep(wh),max=depmaxl)
+  depscl=fix((depmaxl-depminl)/100.)
+  if (depscl lt 1) then depscl=1
+  depmin=depminl
+;  depmax=depmin+depscl  
+  depmax=depmaxl
+  pmultinum=0
+
+if (n_elements(depths) eq 2) then begin
+
+ depmin=max([depminl,depths(0)])
+ depmax=min([depmaxl,depths(1)])
+endif
+
+	print,'n_elements(typeplot) ',n_elements(typeplot)
+
+   if (n_elements(typeplot) eq 0) then typeplot=1
+;   if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+;   	typeplot=3
+;   endif else begin
+;   	typeplot=4
+;   endelse
+;   endif
+   if (typeplot gt 4) then typeplot=4
+   if (typeplot lt 1) then typeplot=1
+   
+   if (n_elements(ombtypeplot) eq 0) then begin
+    if (n_elements(where(bkg ne bkg(0))) gt 1) then begin
+   	ombtypeplot=1
+    endif else begin
+   	ombtypeplot=2
+    endelse
+   endif
+   if (ombtypeplot gt 3) then ombtypeplot=3
+   if (ombtypeplot lt 1) then ombtypeplot=1
+
+   	print,'typeplot ',typeplot, ' ombtypeplot ',ombtypeplot
+   
+    if (n_elements(typeproj) eq 0) then typeproj=1
+
+	xrangedef=[-110.,40.]
+	yrangedef=[-50.,80.]
+	wh=where(xarr lt xrangedef(0) or xarr gt xrangedef(1) or $
+		yarr lt yrangedef(0) or yarr gt yrangedef(1),count)
+	if (count gt 0) then begin
+		xrangedef=[-180.,180.]
+		yrangedef=[-90.,90.]
+	endif
+
+	if (n_elements(xrange) eq 0) then begin
+ 	xrange=xrangedef
+	yrange=yrangedef
+        endif
+	symsize=1.0
+
+;  map_file=""
+
+;  plot_bad_obs=0
+
+  dayshi=-10.d/86400.		; small shift to group 0:00 hours with the previous day
+;  dayshi=-0.1d
+
+  wh=where(dayarr gt 0 and dayarr lt 9000000)
+;  print,dayarr
+;  print,wh(0)
+  if (wh(0) gt -1) then begin
+    daymin=min(dayarr(wh)+dayshi,max=daymax)
+  endif else begin
+    daymax=0
+    daymin=0
+  endelse
+;  daymax=maxday
+;  daymin=minday
+  dayminl=daymin
+  daymaxl=daymax
+  
+
+  print,'** dayminl daymaxl ', dayminl, daymaxl
+
+; ** Health check file   
+	if (keyword_set(healthcheck)) then begin
+		OPENW, unit, outfile+'_health.txt', /get_lun
+   		printf,unit,' Health check data '
+                printf,unit,'-------------------'
+                printf,unit,' Number of files ',n_elements(filename)
+                printf,unit,' List of files '
+		printf,unit,filename
+                printf,unit,' Filetype ',filetype
+                printf,unit,' Number of observations ',numobs
+                printf,unit,' Date range in julian days ',dayminl, daymaxl,format='(a,2f20.8)'
+		jul_to_dtstr,dayminl,datestr1
+                jul_to_dtstr,daymaxl,datestr2
+		printf,unit,' Date range ',datestr1,' - ',datestr2
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0
+                rmsomb=0 & meanomb=0
+;                info,obs
+;                print,obs
+;                info,bkg
+;                print,bkg 
+;                print,'rmdi: ',rmdi
+;                wh=where(obs ne rmdi and qcarr lt 1,counto)
+; check for missing data within a tolerance 
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and qcarr lt 1, counto)
+;                print,'min ',min(abs((bkg(wh)-rmdi)/rmdi))
+;                print,'min ',min(bkg(wh)), min(obs(wh))
+;                print,'min ',max(bkg(wh)), max(obs(wh))
+                if (counto gt 0) then mxo=max(obs(wh),min=mno)
+;               wh=where(bkg ne rmdi and qcarr lt 1,countb)
+		wh=where(abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countb)
+                if (countb gt 0) then mxb=max(bkg(wh),min=mnb)
+;                wh=where(obs ne rmdi and bkg ne rmdi and qcarr lt 1,countob)
+		wh=where(abs((obs-rmdi)/rmdi) gt 0.01 and $
+                	abs((bkg-rmdi)/rmdi) gt 0.01 and qcarr lt 1, countob)
+                if (countob gt 0) then mxob=max(obs(wh)-bkg(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs(wh)-bkg(wh))
+                   x2=total((obs(wh)-bkg(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+ 
+                printf,unit,' Max/min obs ',mxo,mno
+                printf,unit,' Max/min bkg ',mxb,mnb
+                printf,unit,' Max/min obs-bkg ',mxob,mnob
+                printf,unit,' RMS/mean obs-bkg ',rmsomb,meanomb
+                printf,unit,' Number of good observations ',counto
+                printf,unit,' Number of bad observations ', numobs-counto
+
+                mxo=0 & mno=0 
+                mxb=0 & mnb=0 
+                mxob=0 & mnob=0 
+                rmsomb=0 & meanomb=0 
+                wh=where(obs2 ne rmdi and qcarr2 lt 1,counto) 
+                if (counto gt 0) then mxo=max(obs2(wh),min=mno)
+                wh=where(bkg2 ne rmdi and qcarr2 lt 1,countb)
+                if (countb gt 0) then mxb=max(bkg2(wh),min=mnb)
+                wh=where(obs2 ne rmdi and bkg2 ne rmdi and qcarr2 lt 1,countob)
+                if (countob gt 0) then mxob=max(obs2(wh)-bkg2(wh),min=mnob)
+; calculate rms / mean
+		if (countob gt 0) then begin
+		   x=total(obs2(wh)-bkg2(wh))
+                   x2=total((obs2(wh)-bkg2(wh))^2)
+                   nel=n_elements(wh)
+                   meanomb=x/nel
+                   rmsomb=sqrt(x2/nel)
+                endif
+                
+                printf,unit,' Max/min obs2 ',mxo,mno
+                printf,unit,' Max/min bkg2 ',mxb,mnb
+                printf,unit,' Max/min obs2-bkg2 ',mxob,mnob
+                printf,unit,' RMS/mean obs2-bkg2 ',rmsomb,meanomb                
+                printf,unit,' Number of good observations2 ',counto
+                printf,unit,' Number of bad observations2 ', numobs-counto
+
+	        FREE_LUN,unit
+        endif
+
+        daymax=daymaxl			; default to show everything
+        if (keyword_set(alldays)) then daymax=daymaxl         ;print alldays
+        if (n_elements(daterange) eq 2) then begin
+        	daymin=daterange(0)
+                if (daterange(0) lt dayminl) then daymin=dayminl
+                if (daterange(0) gt daymaxl) then daymin=daymaxl
+                if (daterange(1) gt dayminl and daterange(1) le daymaxl) then begin
+                	daymax=daterange(1)
+                endif else begin
+                daymax=daymaxl                
+                endelse
+        endif
+        if (n_elements(daterange) eq 1) then begin		; select number of days before end or after beginning
+             	print,'daymin b4: ',daymin, daymax
+                daymax=daymaxl
+                daymin=dayminl
+                if (daterange(0) lt 0) then begin
+                	if (daterange(0) eq -9999) then begin
+                        	daymin=daymax
+                        endif else begin
+	                	daymin=daymax+daterange(0)
+                        endelse
+                endif
+                if (daterange(0) gt 0) then daymax=daymin+daterange(0)
+        endif                                 
+
+; select day from the start day
+	if (n_elements(dayrange) eq 1) then begin
+        	daymin=dayminl+dayrange
+                daymax=daymin
+        endif
+
+	if (n_elements(dayrange) eq 2) then begin
+        	daymin=dayminl+dayrange(0)
+                daymax=dayminl+dayrange(1)
+        endif
+
+
+; prevent error where only one day plotted  
+	daymaxsl=daymaxl
+        dayminsl=dayminl
+	if (daymaxsl le dayminsl+1) then daymaxsl=dayminsl+1
+; stop day going out of range
+	if (daymax gt daymaxl) then daymax=daymaxl
+        if (daymax lt dayminl) then daymax=dayminl
+        if (daymin lt dayminl) then daymin=dayminl
+        if (daymin gt daymaxl) then daymin=daymaxl
+
+	print,'daymin af: ',daymin, daymax
+
+  sym=1
+   
+;-------------
+;Setup window
+;-------------
+
+if (not keyword_set(batch)) then begin 
+  ; Create a base widget to hold the application. 
+;	base0=WIDGET_BASE()
+
+  base = WIDGET_BASE(/COLUMN,mbar=bar) 
+;   base = WIDGET_BASE(/row)
+
+ 
+  ; setup menu bar
+  
+  menu1 = WIDGET_BUTTON(bar, VALUE='Areas', /MENU) 
+button1 = WIDGET_BUTTON(menu1, VALUE='Global', uvalue='Global') 
+button2 = WIDGET_BUTTON(menu1, VALUE='Arctic', uvalue='Arctic')
+button2a = WIDGET_BUTTON(menu1, VALUE='Atlantic', uvalue='Atlantic') 
+button3 = WIDGET_BUTTON(menu1, VALUE='N Atl', uvalue='N Atl')
+button4 = WIDGET_BUTTON(menu1, VALUE='Trop Atl', uvalue='Trop Atl')
+button5 = WIDGET_BUTTON(menu1, VALUE='S Atl', uvalue='S Atl')
+button5a = WIDGET_BUTTON(menu1, VALUE='Pacific', uvalue='Pacific')
+button6 = WIDGET_BUTTON(menu1, VALUE='N Pac', uvalue='N Pac')
+button7 = WIDGET_BUTTON(menu1, VALUE='Trop Pac', uvalue='Trop Pac')
+button8 = WIDGET_BUTTON(menu1, VALUE='S Pac', uvalue='S Pac')
+button9 = WIDGET_BUTTON(menu1, VALUE='Indian', uvalue='Indian')
+button10 = WIDGET_BUTTON(menu1, VALUE='S Ocean', uvalue='S Ocean')
+button11 = WIDGET_BUTTON(menu1, VALUE='Med', uvalue='Med')
+button12 = WIDGET_BUTTON(menu1, VALUE='N West Shelf', uvalue='NWS')
+button13 = WIDGET_BUTTON(menu1, VALUE='Input Area', uvalue='Input Area')
+
+  menu2 = WIDGET_BUTTON(bar, VALUE='Plot', /MENU)
+button1 = WIDGET_BUTTON(menu2, VALUE='Timeseries', uvalue='Timeseries')
+button1a =  WIDGET_BUTTON(menu2, VALUE='Num timeseries', uvalue='Num timeseries')
+button2 = WIDGET_BUTTON(menu2, VALUE='T-S diagram', uvalue='TS diagram') 
+
+  menu1a = WIDGET_BUTTON(bar, VALUE='Find',/MENU)
+button1a= WIDGET_BUTTON(menu1a, VALUE='Worst points', uvalue='Worst points')
+button1a1 = WIDGET_BUTTON(menu1a, VALUE='Filter type', uvalue='Filter type')
+
+  menu3 = WIDGET_BUTTON(bar, VALUE='Config', /MENU)
+loresmap = WIDGET_BUTTON(menu3, VALUE='Low res map', uvalue='Low res map', /checked_menu)
+hiresmap = WIDGET_BUTTON(menu3, VALUE='Hi res map', uvalue='Hi res map', /checked_menu)
+
+button3 = WIDGET_BUTTON(menu3, VALUE='Square psym', uvalue='Square psym')
+button4 = WIDGET_BUTTON(menu3, VALUE='Round psym', uvalue='Round psym')
+
+pltonbado = WIDGET_BUTTON(menu3, VALUE='Plot only bad obs', uvalue='Plot only bad obs', /checked_menu)
+
+whtonblack = WIDGET_BUTTON(menu3, VALUE='White on black', uvalue='White on black', /checked_menu)
+
+incsym = WIDGET_BUTTON(menu3, VALUE='Psym size+ ', uvalue='incsym')
+decsym = WIDGET_BUTTON(menu3, VALUE='Psym size- ', uvalue='decsym')
+resetsym = WIDGET_BUTTON(menu3, VALUE='Psym size reset ', uvalue='resetsym')
+
+vertgradmenu = WIDGET_BUTTON(menu3, VALUE='Vert gradient', uvalue='vertgrad', /checked_menu)
+button12 = WIDGET_BUTTON(menu3, VALUE='Input max/min', uvalue='input max/min')
+
+
+  menu4 = WIDGET_BUTTON(bar, VALUE='Help', /MENU)
+help1 = WIDGET_BUTTON(menu4, VALUE='Info', uvalue='Info')
+
+if (n_elements(filename) gt 0) then begin
+  menu5 = WIDGET_BUTTON(bar, VALUE=filename[0])
+nel=n_elements(filename)
+nel2=nel
+nelmx=32
+if (nel2 gt nelmx) then nel2=nelmx
+for i=0L, nel2-1 do begin
+  id = WIDGET_BUTTON(menu5, VALUE=filename[i])
+endfor
+if (nel gt nelmx) then id=WIDGET_BUTTON(menu5, VALUE='... etc ...')
+endif
+
+Widget_Control, loresmap, Set_Button=1
+Widget_Control, vertgradmenu, Set_Button=vertgrad 
+
+Widget_Control, pltonbado, Set_Button=plot_only_bad_obs
+Widget_Control, whtonblack, Set_Button=white_on_black
+ 
+  ; Create a draw widget based on the size of the image, and 
+  ; set the MOTION_EVENTS keyword so that events are generated 
+  ; as the cursor moves across the image. Setting the BUTTON_EVENTS 
+  ; keyword rather than MOTION_EVENTS would require the user to 
+  ; click on the image before an event is generated. 
+
+;	im_size=[2,1024,800]
+;	im_size=[2,800,800]
+;	im_size=[2,800,720]
+;	im_size=[2,1024,720]
+        im_size=[2,1024,680]
+;	im_size=[2,800,640]
+
+  draw = WIDGET_DRAW(base, XSIZE=im_size[1], YSIZE=im_size[2], $ 
+    /BUTTON_EVENTS,/WHEEL_EVENTS, uvalue='MAPWINDOW') 
+
+;	base2=widget_base(GROUP_LEADER=base,/column)
+
+;  droplist = WIDGET_COMBOBOX(base2,value=string([indgen(101)]),$
+;  	uvalue='LEVELLIST', FRAME=2)
+
+;  button = WIDGET_BUTTON(base2, value='test',uvalue='test')
+
+
+;	print,'depminl/maxl ',depminl, depmaxl
+;        print,'value depmin ',depmin
+;        print,'value depmax ',depmax
+
+depmaxlsl=depmaxl
+depminlsl=depminl
+if (depmaxlsl eq depminlsl) then depmaxlsl=depmaxlsl+1
+print, 'depminlsl, depmaxlsl ',depminlsl, depmaxlsl
+  slider = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl,scroll=depscl,$
+  	value=depmin,uvalue='LEVELCHOICE', ysize=32)
+
+  sliderb = WIDGET_SLIDER(base,maximum=depmaxlsl,minimum=depminlsl, scroll=depscl,$
+        value=depmax,uvalue='LEVELCHOICEB', ysize=32)
+
+
+  jul_to_dtstr,daymin,dayminstr,/notime
+  slider1label = WIDGET_LABEL(base, VALUE="min date: "+dayminstr, xsize=800,ysize=14)
+  slider1 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymin,uvalue='DATERANGE1',/suppress_value,/drag)
+
+  jul_to_dtstr,daymax,daymaxstr,/notime
+  slider2label = WIDGET_LABEL(base, VALUE="max date: "+daymaxstr, xsize=800,ysize=14)
+  slider2 = WIDGET_SLIDER(base,minimum=dayminsl,maximum=daymaxsl,scroll=1,$
+  	value=daymax,uvalue='DATERANGE2',/suppress_value,/drag)
+
+
+
+;  slider1 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymin,uvalue='DATERANGE1',PRO_SET_VALUE="datesliderset",/drag)
+;
+;  slider2 = WIDGET_SLIDER(base,minimum=dayminl,maximum=daymaxl,scroll=1,$
+;  	value=daymax,uvalue='DATERANGE2',PRO_SET_VALUE="datesliderset",/drag)
+	 
+  ; Labels for stats
+   
+  labt1='Lon: '
+  labt2='Lat: '
+  labt3='Value: '
+  labt4='QC: '
+  labt5='Date: '
+  labt6='Value: '
+  labt7=' '
+  labt8='Type: ' 
+  labt9='obnum: '
+  labt10='visible date range: '
+  
+  ; Create label widgets to hold the cursor position and 
+  ; Hexadecimal value of the pixel under the cursor. 
+  labelb=Widget_Base(base,row=1)
+  
+  labsiz=105
+  labsizl1=150
+  labsizlg=150
+  labsizl2=135
+  label7=0
+  lb_ysize=14
+  label1 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt1, ysize=lb_ysize) 
+  label2 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt2, ysize=lb_ysize) 
+  label3 = WIDGET_LABEL(labelb, XSIZE=labsizl1, $ 
+    VALUE=labt3, ysize=lb_ysize) 
+  label4 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt4, ysize=lb_ysize)
+  label5 = WIDGET_LABEL(labelb, XSIZE=labsizlg, $ 
+    VALUE=labt5, ysize=lb_ysize) 
+  label6 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt6, ysize=lb_ysize)
+;  label7 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+;    VALUE=labt7, ysize=lb_ysize)
+  label8 = WIDGET_LABEL(labelb, XSIZE=labsizl2, $ 
+    VALUE=labt8, ysize=lb_ysize)
+  label9 = WIDGET_LABEL(labelb, XSIZE=labsiz, $ 
+    VALUE=labt9, ysize=lb_ysize)
+
+  labelb2 = Widget_Base(base,row=1)
+  label10 = WIDGET_LABEL(labelb2, XSIZE=1024, $
+    VALUE=labt10, ysize=lb_ysize)
+
+   tlba = Widget_Base(base,row=1)
+
+   t1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button1 = Widget_Button(t1b, Value='mean',uvalue='RADIO1',/no_release)
+   button2 = Widget_Button(t1b, Value='rms',uvalue='RADIO2',/no_release)
+   button3 = Widget_Button(t1b, Value='sd',uvalue='RADIO3',/no_release)
+   button4 = Widget_Button(t1b, Value='ms',uvalue='RADIO4',/no_release)
+
+   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+  
+   t1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=200,$
+   /Exclusive)
+   button5 = Widget_Button(t1c, Value='obs - bkg', uvalue='RADIO5',/no_release)
+   button6 = Widget_Button(t1c, Value='obs', uvalue='RADIO6',/no_release)
+   button7 = Widget_Button(t1c, Value='bkg', uvalue='RADIO7',/no_release)
+
+   if (ombtypeplot eq 1) then Widget_Control, button5, /Set_Button
+   if (ombtypeplot eq 2) then Widget_Control, button6, /Set_Button
+   if (ombtypeplot eq 3) then Widget_Control, button7, /Set_Button
+
+;   tlb = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=400,$
+;   /Exclusive)
+;; no_release only sends select events (not release ones)
+;   button1 = Widget_Button(tlb, Value='rms Obs - Bkg',uvalue='RADIO1',/no_release)
+;   button2 = Widget_Button(tlb, Value='sum(Obs - Bkg)^2',uvalue='RADIO2',/no_release)
+;   button3=  Widget_Button(tlb, Value='Obs - Bkg',uvalue='RADIO3',/no_release)
+;   button4 = Widget_Button(tlb, Value='Obs',uvalue='RADIO4',/no_release)
+;   button5 = Widget_Button(tlb, Value='Bkg',uvalue='RADIO5',/no_release)
+;
+;   if (typeplot eq 1) then Widget_Control, button1, Set_Button=typeplot
+;   if (typeplot eq 2) then Widget_Control, button2, Set_Button=typeplot
+;   if (typeplot eq 3) then Widget_Control, button3, Set_Button=typeplot
+;   if (typeplot eq 4) then Widget_Control, button4, Set_Button=typeplot
+;   if (typeplot eq 5) then Widget_Control, button5, Set_Button=typeplot
+  
+   tlb1 = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=220,$
+   /Exclusive)
+   button01 = Widget_Button(tlb1, Value='Lat/Lon',uvalue='RADIO01',/no_release)
+   button02 = Widget_Button(tlb1, Value='N Polar',uvalue='RADIO02',/no_release)
+   button03 = Widget_Button(tlb1, Value='S Polar',uvalue='RADIO03',/no_release)
+
+    Widget_Control, button01, Set_Button=typeproj
+
+
+   tlb1a = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=250,$
+   /NonExclusive)
+   button001 = Widget_Button(tlb1a, Value='Plot Bad Obs', uvalue='RADIO001')
+
+   Widget_Control, button001, Set_Button=plot_bad_obs
+
+
+   if filetype eq 'CRT' then begin
+
+      button002 = Widget_Button(tlb1a, Value='Meridional', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+
+      button003 = Widget_Button(tlb1a, Value='Speed', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+
+   endif else begin
+;         tlb1b = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;         /NonExclusive)
+      button002 = Widget_Button(tlb1a, Value='Salinity', uvalue='RADIOSAL')
+      Widget_Control, button002, Set_Button=salinity
+;         tlb1c = Widget_Base(tlba,Title='Push-Buttons', row=1, Scr_XSize=90,$
+;          /NonExclusive)
+      button003 = Widget_Button(tlb1a, Value='Density', uvalue='RADIODENSITY')
+      Widget_Control, button003, Set_Button=density
+   endelse
+
+ 
+   tlb2= Widget_Base(tlba,row=1)
+  button = WIDGET_BUTTON(tlb2, VALUE='Print',uvalue="PRINT") 
+  button = WIDGET_BUTTON(tlb2, VALUE='Save',uvalue="SAVE")
+   
+  button = WIDGET_BUTTON(tlb2, VALUE='Done',uvalue="DONE") 
+
+
+
+  ; Realize the widget hierarchy. 
+  WIDGET_CONTROL, base, /REALIZE 
+;  WIDGET_CONTROL, base2, /REALIZE 
+;   WIDGET_CONTROL, tlb, /REALIZE 
+
+  ; Retrieve the widget ID of the draw widget. Note that the widget 
+  ; hierarchy must be realized before you can retrieve this value. 
+  WIDGET_CONTROL, draw, GET_VALUE=drawID 
+
+ 
+  ; Create an anonymous array to hold the image data and widget IDs 
+  ; of the label widgets. 
+;  stash = { imagePtr:imagePtr, label1:label1, label2:label2, $ 
+;            label3:label3, $
+;	    xarr:xarr, yarr:yarr, dep:dep, val:val } 
+
+
+spawn,'echo part 2 `date`'
+
+
+  stash = { label1:label1, label2:label2, $ 
+            label3:label3, label4:label4, $
+            label5:label5, label6:label6, $
+            label7:label7, label8:label8, $
+            label9:label9, label10:label10, $
+            labt1:labt1, labt2:labt2, $
+            labt3:labt3, labt4:labt4, $
+            labt5:labt5, labt6:labt6, $
+            labt7:labt7, labt8:labt8, $
+            labt9:labt9, labt10:labt10, $
+            slider1label:slider1label, $
+            slider2label:slider2label, $
+            drawID:drawID, draw:draw, base:base, $
+            im_size:im_size, pixID:0, $
+            xcorn:0, ycorn:0, xdatacorn:0.0, ydatacorn:0.0, $
+            slider1:slider1, slider2:slider2, $
+            slider:slider, sliderb:sliderb, $
+            hiresmap:hiresmap, loresmap:loresmap, vertgradmenu:vertgradmenu, $
+            pltonbado:pltonbado, plot_only_bad_obs:plot_only_bad_obs, $
+            whtonblack:whtonblack, white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata:bindata, binsize:binsize, $
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, obs3:obs3, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+	     
+  ; Set the user value of the top-level base widget equal to the 
+  ; 'stash' array. 
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+ 
+  ; Make the draw widget the current IDL drawable area. 
+  WSET, drawID 
+
+spawn,'echo part 3 `date`' 
+
+  ; Draw the image into the draw widget. 
+  plotpoints, stash
+
+; plotpoints updates mx/mn values make sure these are included
+  WIDGET_CONTROL, base, SET_UVALUE=stash 
+
+spawn,'echo part 4 `date`' 
+
+  ; Call XMANAGER to manage the widgets. 
+  XMANAGER, 'dataplot', base, /NO_BLOCK
+;  XMANAGER, 'dataplot', base
+endif else begin
+
+;do batch
+
+print,"batch"
+
+drawID=-1
+
+print, 'filetype: ',filetype
+
+  stash = { drawID:drawID,$	    
+            filetype:filetype, $
+            xarr:xarr, yarr:yarr, dep:dep, dayarr:dayarr, $
+            obs:obs, bkg:bkg, qcarr:qcarr, obstypes: obstypes, $
+            obs2:obs2, bkg2:bkg2, qcarr2:qcarr2, $
+            obnum:obnum, $
+            depmin:depmin, typeplot:typeplot, ombtypeplot:ombtypeplot, $
+            typeproj:typeproj, $
+            hires_map:hires_map, $
+            plot_only_bad_obs:plot_only_bad_obs, $
+            white_on_black:white_on_black, $
+            duplicates:duplicates, differences:differences, $
+            bindata: bindata, binsize:binsize, $
+            plot_bad_obs:plot_bad_obs, salinity: salinity, $
+            density:density, vertgrad:vertgrad, mld:mld, $
+            daymin:daymin, daymax:daymax, dayminl:dayminl, daymaxl:daymaxl, $
+            dayshi:dayshi, $            
+            depminl:depminl, depmaxl:depmaxl, depmax:depmax, depscl:depscl, $
+            xrange:xrange, yrange:yrange, $
+            fmx:fmx, fmn:fmn, mx:mx, mn:mn, $
+            symsize:symsize, sym:sym, picsize:picsize, $
+            pmulti:pmulti, pmultinum:pmultinum, $ 
+            outfile:outfile, $ 
+            xrangedef:xrangedef, yrangedef:yrangedef, rmdi:rmdi, $
+            obstypeselect:obstypeselect, printobstypes:printobstypes, $
+            plottssel:plottssel, $
+            binspday:binspday, numtimeseries:numtimeseries, txt:txt, netcdf:netcdf, $
+            busy:busy, symscale:symscale, coltable:coltable, $
+            filterout:filterout, varname:varname } 
+
+if (keyword_set(ps)) then begin
+  	ps=1
+	eps=0
+	landscape=1
+  	pr2,file=stash.outfile+'.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+	prend2,view=0
+
+endif 
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+;	Device, Set_Resolution=[800,512], decomposed=0
+        Device, Set_Resolution=picsize, decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+        setupct, r, g, b, coltable=stash.coltable, $
+        	white_on_black=stash.white_on_black		; setup color table
+
+; plot data
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+	endelse
+
+;	if (keyword_set(gif)) then begin
+;        IMAGE_GRAB, /gif, filename=stash.outfile+'.gif',/overwrite        
+	snapshot = TVRD()
+        WRITE_GIF,stash.outfile+'.gif',snapshot, r, g, b
+;        endif
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(txt)) then begin
+	if keyword_set(timeseries) then	begin	; plot timeseries if keyword is set
+        	plottimeseries,stash
+        endif else begin			; otherwise plot points on a map
+  		plotpoints,stash
+;		print,'no txt version of plotpoints!'
+	endelse
+endif	
+
+if (keyword_set(netcdf)) then begin
+	if keyword_set(timeseries) then begin
+        	print,'no netcdf version of timeseries!'
+        endif else begin
+  		plotpoints,stash        
+        endelse
+endif
+
+if (stash.filterout ne '') then begin
+
+   selpoints, stash, lonsel, latsel, innovsel, qcsel, daysel, obstypsel, obnumsel, numsel, typestr
+
+endif
+
+endelse            ; batch
+ 
+END 
+
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/dataplot_txttimeseries.pro	(revision 3294)
@@ -0,0 +1,452 @@
+pro plotts1, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+;+--------------------------------------------------------
+; plot mean and rms timeseries
+;
+; Author:  D. J. Lea      Feb 2008
+;+--------------------------------------------------------
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D', '%M, %Y']) 
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+; sort times (in case of a repeated day)
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+num=arrsv(1,timsrt)
+yaxis=arrsv(2,timsrt)
+yaxis2=arrsv(3,timsrt)
+
+; remove any zero times or non-finite values
+wh=where(taxis gt 0 and finite(yaxis) and finite(yaxis2))
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+
+; remove any with num lt than a specific value
+if (n_elements(minperc) eq 1) then begin
+maxnum=max(num,min=minnum)
+wh=where(num gt maxnum*minperc)
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+num=num(wh)
+yaxis=yaxis(wh)
+yaxis2=yaxis2(wh)
+endif
+endif
+
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+ymx=max([yaxis,yaxis2],min=ymn)
+
+print, 'ymn ymx ',ymn,ymx
+
+;create a small amount of space around the max and min
+
+spc=(ymx-ymn)*0.05
+
+ymn=ymn-spc*3
+ymx=ymx+spc
+
+if (n_elements(emax) gt 0) then ymx=emax
+if (n_elements(emin) gt 0) then ymn=emin
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then begin
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;plot, arrsv(0,timsrt), arrsv(2,timsrt), xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, arrsv(0,timsrt), arrsv(3,timsrt), xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE','LABEL_DATE'],$
+;   XTICKUNITS = ['Day','Month']
+
+;plot, taxis, yaxis, xstyle=1, linestyle=1, $
+;   yrange=[ymn,ymx], $
+;   ytitle=typestr, title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+;   
+;plot, taxis, yaxis2, xstyle=1, /noerase, $
+;   yrange=[ymn,ymx], $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+plot, taxis, yaxis, xstyle=1, ystyle=1, linestyle=1, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   ytitle=typestr, title=title, $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+plot, taxis, yaxis2, xstyle=4+1, ystyle=4+1, /noerase, $
+   yrange=[ymn,ymx], xrange=[xmn,xmx], $
+   XTICKUNITS=['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+	
+
+
+; key
+		xcoord=0.8
+		ycoord=0.9
+		ycoord=0.35
+                ycoord=0.2
+
+                  ycoord2=ycoord-0.05
+                  xcoord2=xcoord+0.03
+                  xcoord3=xcoord+0.05
+                  plots, [xcoord,xcoord2],[ycoord,ycoord], linestyle=0, /normal
+                  xyouts, xcoord3, ycoord, 'RMS', /normal
+                  plots, [xcoord,xcoord2],[ycoord2,ycoord2], linestyle=1, /normal
+                  xyouts, xcoord3, ycoord2, 'mean',/normal                
+
+endif
+
+end
+
+
+; plot number
+
+pro plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+   
+
+; number
+;
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%D %M, %Y']) 
+
+;date_label = LABEL_DATE(DATE_FORMAT = $ 
+;   ['%M %Y']) 
+
+date_label = LABEL_DATE(DATE_FORMAT=['%D-%M','%Y'])
+
+
+
+timsrt=sort(arrsv(0,*))
+
+taxis=arrsv(0,timsrt)
+yaxis=arrsv(1,timsrt)
+
+wh=where(taxis gt 0 and finite(yaxis))	 ; remove any zero times and non-finite vals
+if (wh(0) gt -1) then begin
+taxis=taxis(wh)
+yaxis=yaxis(wh)
+endif
+mxt=max(taxis,min=mnt)
+print, 'mnt mxt ',mnt, mxt
+
+;plot, arrsv(0,timsrt), arrsv(1,timsrt), xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE'], $ 
+;   XTICKUNITS = ['Day'], $ 
+;   XTICKINTERVAL = 4 
+
+;info, taxis
+;info, yaxis
+
+;print,taxis, yaxis
+
+;plot, taxis, yaxis, xstyle=1, $
+;   ytitle='Number of obs assim', title=title, $
+;   XTICKFORMAT = ['LABEL_DATE']
+
+ymx=max(yaxis)*1.05
+
+; setup time axis range
+
+skip=0
+xmx=max(taxis,min=xmn)
+if (n_elements(juldatemin) gt 0) then begin
+	if (xmn le juldatemin) then xmn=juldatemin
+        if (xmx le juldatemin) then skip=1
+endif
+if (n_elements(juldatemax) gt 0) then begin
+	if (xmx ge juldatemax) then xmx=juldatemax
+        if (xmn ge juldatemin) then skip=1
+endif
+
+if (skip eq 0) then $
+plot, taxis, yaxis, xstyle=1, ystyle=1, $
+   ytitle='Number of obs assim', title=title, yrange=[0,ymx], xrange=[xmn,xmx],$
+   XTICKUNITS = ['Time', 'Time'], XTICKFORMAT = ['LABEL_DATE'],YMARGIN=[6,4]
+
+
+print,'min time ',min(arrsv(0,timsrt)),max(arrsv(0,timsrt)) 
+
+end
+
+PRO dataplot_txttimeseries, files, gif=gif, ps=ps, filtstr=filtstr, view=view, $
+	bin=bin, minperc=minperc, datemin=datemin, datemax=datemax, notitle=notitle, $
+        emax=emax, emin=emin
+
+; DJL switch off wave compatibility mode
+res=execute("waveoff")
+
+if (n_elements(filtstr) eq 0) then filtstr=""
+if (n_elements(view) eq 0) then view=0
+
+print, 'dataplot_txttimeseries '
+
+if (n_elements(datemin) gt 0) then begin
+	; month, day, year
+	juldatemin=julday(datemin(1),datemin(2), datemin(0))
+        print, 'juldatemin set:', juldatemin, datemin
+endif
+if (n_elements(datemax) gt 0) then begin
+	; month, day, year
+	juldatemax=julday(datemax(1),datemax(2), datemax(0))
+        print, 'juldatemax set:', juldatemax, datemax
+endif
+
+
+
+numfiles=n_elements(files)
+
+print,'numfiles ',numfiles
+
+imax=500
+	arrs=dblarr(4,imax)
+	arr=dblarr(4)
+	arrsv=dblarr(4,10000)
+
+j=0L		; position in full array
+for ii=0,numfiles-1 do begin
+	print,files(ii)
+        OPENR, unit, files(ii), /get_lun
+        obstypestr=""
+        readf,unit,obstypestr
+        typestr=""
+        readf,unit,typestr
+        xrange=fltarr(2)
+        readf,unit,xrange
+        yrange=fltarr(2)
+        readf,unit,yrange
+        binspday=0.0
+        readf,unit,binspday
+
+	i=0
+	while (~ eof(unit) and i lt imax) do begin        
+        readf,unit,arr
+	print,i,arr
+        if arr(1) eq 0 then arr(2:*)=0
+        print,arr
+        arrs(*,i)=arr
+        i=i+1
+        endwhile
+ 
+	numtimes=i
+	print, 'numtimes ',numtimes
+        
+        if (numtimes ge binspday) then begin
+        	print,arrs(*,numtimes-binspday:numtimes-1)
+
+; store daily values from each file in full time series array
+
+	arrsv(*,j:j+binspday-1)=arrs(*,numtimes-binspday:numtimes-1)
+        j=j+binspday
+
+	endif else begin 
+        if (numtimes gt 0) then begin
+        
+        print, '** numtimes ',numtimes
+        print, arrs(*,0:numtimes-1)  
+        arrsv(*,j:j+numtimes-1)=arrs(*,0:numtimes-1)        
+        j=j+numtimes
+                
+        endif
+        endelse
+                
+        FREE_LUN, unit
+        
+        print, obstypestr
+        print, typestr
+        print, xrange
+        print, yrange
+        print, binspday
+endfor	
+
+print, 'j ',j
+
+arrsv=arrsv(*,0:j-1)
+
+;stop
+
+; bin up the data
+
+;print,arrsv
+
+if (n_elements(bin) gt 0) then begin
+if (bin gt 1) then begin
+; time 0 num 1 mean 2 rms 3
+arrsv2=dblarr(4,j/bin)
+for i=0,j/bin-1 do begin
+
+	arrsvtemp=arrsv(*,i*bin:(i+1)*bin-1)
+        print,arrsvtemp
+	wh=where(arrsvtemp(1,*) gt 0)		; number of obs gt 0
+;        print,wh
+        if (wh(0) gt -1) then begin 
+
+; number of obs
+        arrsv2(1,i)=total(arrsvtemp(1,wh))
+; mean
+        arrsv2(2,i)=total(arrsvtemp(2,wh)*arrsvtemp(1,wh))/arrsv2(1,i)
+; rms
+        arrsv2(3,i)=sqrt(total(arrsvtemp(3,wh)^2*arrsvtemp(1,wh))/arrsv2(1,i))
+; date (average)
+;	print,arrsv(0,i*bin)
+	arrsv2(0,i)=total(arrsvtemp(0,*))/bin
+;	print,arrsv2(0,i)
+
+	endif
+
+endfor
+
+info, arrsv2
+
+arrsv=arrsv2
+	
+endif
+endif
+
+nel=n_elements(arrsv(0,*))
+
+; produce 1 month/3 month/all average values
+
+finaltime=arrsv(0,nel-1)
+onemon=finaltime-30
+threemon=finaltime-90
+
+print,arrsv
+
+wh1=where(arrsv(0,*) gt onemon and arrsv(1,*) gt 0)
+wh3=where(arrsv(0,*) gt threemon and arrsv(1,*) gt 0)
+wh0=where(arrsv(1,*) gt 0)
+
+num1=total(arrsv(1,wh1))
+mean1=total(arrsv(2,wh1)*arrsv(1,wh1))/num1
+rms1=sqrt(total(arrsv(3,wh1)^2*arrsv(1,wh1))/num1)
+print,num1
+
+num3=total(arrsv(1,wh3))
+mean3=total(arrsv(2,wh3)*arrsv(1,wh3))/num3
+rms3=sqrt(total(arrsv(3,wh3)^2*arrsv(1,wh3))/num3)
+print,num3
+
+num0=total(arrsv(1,wh0))
+mean0=total(arrsv(2,wh0)*arrsv(1,wh0))/num0
+rms0=sqrt(total(arrsv(3,wh0)^2*arrsv(1,wh0))/num0)
+print,num0
+
+if (keyword_set(notitle)) then begin
+title1=""
+title=""
+endif else begin 
+subtitle=          'rms (mean), 1 month: '+strtrim(string(rms1,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean1,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', 3 month: '+strtrim(string(rms3,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean3,format='(G0.3)'),2)+')'
+subtitle=subtitle+ ', all: '+strtrim(string(rms0,format='(G0.4)'),2)+$
+	'('+strtrim(string(mean0,format='(G0.3)'),2)+')'
+
+
+fullfiltstr=''
+if (filtstr ne '') then fullfiltstr=' Type: '+filtstr
+
+title=obstypestr+typestr+'   lons ('+strtrim(string(xrange(0),format='(F0.2)'),2)+$
+	','+strtrim(string(xrange(1),format='(F0.2)'),2)+$
+        ')   lats ('+strtrim(string(yrange(0),format='(F0.2)'),2)+','+$
+        strtrim(string(yrange(1),format='(F0.2)'),2)+')'+fullfiltstr
+
+title1=title+'!C'+subtitle
+endelse
+
+if (keyword_set(gif)) then begin
+	thisDevice = !D.Name
+
+        Set_Plot, 'Z'			; do graphics in the background
+;	Device, Set_Resolution=[640,512], decomposed=0
+	Device, Set_Resolution=[800,512], decomposed=0
+        Erase                           ; clear any existing stuff
+        !p.charsize=0.75
+;        setupct, r, g, b		; setup color table
+
+	plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+
+
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_timeseries.gif',snapshot, r, g, b
+
+	plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+
+        
+	snapshot = TVRD()
+        WRITE_GIF,'dataplot_numtimeseries.gif',snapshot, r, g, b
+
+        Device, Z_Buffer=1		; reset graphics mode
+        Set_Plot, thisDevice
+        !p.charsize=0.0
+
+endif
+
+if (keyword_set(ps)) then begin
+  ps=1
+  eps=0
+  landscape=1
+  pr2o,file='dataplot_timeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts1, arrsv, title1, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax, $
+        emax=emax, emin=emin
+  prend2o,view=view
+  
+  pr2o,file='dataplot_numtimeseries.ps',landscape=landscape,ps=ps,eps=eps,color=1	
+  plotts2, arrsv, title, typestr, minperc=minperc, $
+	juldatemin=juldatemin, juldatemax=juldatemax
+  prend2o,view=view
+
+endif 
+
+end
+
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/eos_nemo.pro	(revision 3294)
@@ -0,0 +1,79 @@
+function eos_nemo, t_in, psal
+;------------------------------------------------------------------------------
+;
+; Purpose:
+;       To calculate the density using the equation of state used in NEMO.
+;       This is based on the Jackett and McDougall (1994) equation of state
+;       for calculating the in situ density based on potential temperature
+;       and salinity.
+;
+; Inputs:
+;       temperature    =>  1d array potential temperature (deg C)
+;       salinity       =>  1d array salinity (PSU)
+;
+; Outputs:
+;       rhop            =>  1d array pot density (kg/m**3)
+;
+; could add use a difference reference pressure
+; observations are in-situ temperature?
+;
+; Author:
+;       D. J. Lea. Dec 2006.
+;------------------------------------------------------------------------------
+
+          zws = SQRT( ABS( psal ) )
+
+	sz=size(t_in)
+	ndim=sz(0)
+	NO_LEVS=sz(ndim)
+	
+	prhop=psal*0.
+
+;                 
+          for jk = 0L, NO_LEVS-1 do begin  
+
+                   zt = T_IN(jk)
+                   zs = psal(jk)
+; * depth
+;                   zh = O_DEP_LEVS(jk)		;used in calculating insitu density only
+                   zsr= zws(jk)
+; * compute volumic mass pure water at atm pressure
+                   zr1= ( ( ( ( 6.536332e-9*zt-1.120083e-6 )*zt+1.001685e-4)*zt   $
+                      -9.095290e-3 )*zt+6.793952e-2 )*zt+999.842594
+; * seawater volumic mass atm pressure
+                   zr2= ( ( ( 5.3875e-9*zt-8.2467e-7 ) *zt+7.6438e-5 ) *zt   $
+                      -4.0899e-3 ) *zt+0.824493
+                   zr3= ( -1.6546e-6*zt+1.0227e-4 ) *zt-5.72466e-3
+                   zr4= 4.8314e-4
+
+; * potential volumic mass (reference to the surface)
+                   zrhop= ( zr4*zs + zr3*zsr + zr2 ) *zs + zr1
+
+; * save potential volumic mass
+                   prhop(jk) = zrhop
+
+; * add the compression terms
+                   ze = ( -3.508914e-8*zt-1.248266e-8 ) *zt-2.595994e-6
+                   zbw= (  1.296821e-6*zt-5.782165e-9 ) *zt+1.045941e-4
+                   zb = zbw + ze * zs
+
+                   zd = -2.042967e-2
+                   zc =   (-7.267926e-5*zt+2.598241e-3 ) *zt+0.1571896
+                   zaw= ( ( 5.939910e-6*zt+2.512549e-3 ) *zt-0.1028859 ) *zt - 4.721788
+                   za = ( zd*zsr + zc ) *zs + zaw
+
+                   zb1=   (-0.1909078*zt+7.390729 ) *zt-55.87545
+                   za1= ( ( 2.326469e-3*zt+1.553190)*zt-65.00517 ) *zt+1044.077
+                   zkw= ( ( (-1.361629e-4*zt-1.852732e-2 ) *zt-30.41638 ) *zt + 2098.925 ) *zt+190925.6
+                   zk0= ( zb1*zsr + za1 )*zs + zkw
+
+;                   ; in situ density anomaly
+;                   prd(jk) = zrhop / (  1.0 - zh / ( zk0 - zh * ( za - zh * zb ) )  )
+;
+          endfor  
+
+
+
+return, prhop
+
+END                  
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/nice_contourlevels.pro	(revision 3294)
@@ -0,0 +1,60 @@
+function nice_contourlevels, data, nlevels=nlevels
+;+----------------------------------------------------------------------------------------
+; nice_contourlevels.pro
+;
+; Select nice contour levels based on the data input and the number of levels
+;
+; Author:  D. J. Lea     -  Feb 2008
+;
+;+----------------------------------------------------------------------------------------
+
+if (n_elements(nlevels) eq 0) then nlevels=15
+
+mx=max(data)
+mn=min(data)
+
+; use this to select colors to plot and labels
+
+clevels=findgen(nlevels)/nlevels*(mx-mn)+mn
+
+ocint=1./nlevels*(mx-mn)
+print,'ocint ',ocint
+
+; contour interval at 2 sig figs
+;digits=2
+;p10 = floor(alog10(abs(ocint)))
+;expo = 10.0d^(digits -1 - p10)
+;cint = long(ocint*expo)/expo
+;print,'cint ',cint
+
+;does it end in 5 or 0?
+digits=1
+p10 = floor(alog10(abs(ocint)))
+expo = 10.0d^(digits -1 - p10)
+cint = long(ocint*expo)/expo
+print,'cint ',cint
+
+if (mx ne mn) then begin
+mxfix=fix(mx/cint)*cint
+mnfix=fix(mn/cint)*cint
+print, mx, mxfix
+print, mn, mnfix
+
+; nice contour values
+
+;calculate new nlevels
+nlevels=fix((mxfix-mnfix)/cint+1)
+
+;print,nlevels
+if (nlevels gt 0) then begin
+	clevels=findgen(nlevels)*cint+mnfix
+endif else begin
+	clevels=mnfix
+endelse
+endif else begin
+	clevels=mn
+endelse
+
+return, clevels
+
+end
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/pr2.pro	(revision 3294)
@@ -0,0 +1,55 @@
+  PRO Pr2,device,$
+         bw=bw,$
+         color=o_color,$
+         pcl=pcl,$
+         ps=ps,$
+         cps=cps,$
+         eps=eps,$
+         cgm=cgm,$
+         screen=screen,$
+         transparency=o_transparency,$
+         encapsulated=encapsulated,$
+         bpp=bpp,$
+         portrait=portrait,$
+         landscape=landscape,$
+         table=table,$
+         reread=reread,$
+         noflip=noflip,$
+         verbose=verbose,$
+         xsize=xsize,$
+         ysize=ysize,$
+         xoffset=xoff,$
+         yoffset=yoff,$
+         scale=scale,$
+         file=file,$
+         destination=destination
+;+----------------------------------------------------------
+; NAME:pr2
+; like pr, but uses nice fonts
+;
+; Author:  D. J. Lea        Feb 2008
+;+----------------------------------------------------------
+
+COMMON pr2, view_landscape
+
+	set_plot,'ps'
+
+	if (n_elements(color) eq 0) then color=1
+        if (n_elements(landscape) eq 0) then landscape=1
+        if (keyword_set(portrait)) then landscape=0
+        encapsulated=1
+        if (keyword_set(eps)) then encapsulated=1
+        if (keyword_set(ps)) then encapsulated=0
+        
+        view_landscape=landscape
+        
+	DEVICE, filename=file, COLOR=color, landscape=landscape, $
+        	encapsulated=encapsulated, xsize=xsize, ysize=ysize
+
+
+!p.font=0
+device,/helv
+	 
+;return
+
+end
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/prend2.pro	(revision 3294)
@@ -0,0 +1,38 @@
+PRO PREND2,in_printer,keep=keep,noprint=noprint,double=double,$
+    view=view,spin_landscape_ps=spin_landscape_ps,$
+    eps_preview=eps_preview,colour_preview=colour_preview,$
+    dpi_preview=dpi_preview, suppress_stderr=suppress_stderr
+;+
+; NAME:prend
+; 
+; Author:  D. J. Lea       Feb 2008
+
+COMMON pr2, view_landscape
+
+; get filename of postscript device  
+
+r = fstat(!D.UNIT)
+filename = r.name
+
+device,/close          
+set_plot,'x'
+
+if keyword_set(view) then begin
+
+   if (view_landscape) then begin
+      spawn,'gv -orientation=landscape -swap '+filename
+   endif else begin
+      spawn,'gv '+filename 
+   endelse
+
+endif
+
+!p.font=-1
+!p.charsize=0
+!p.charthick=0
+!p.thick=0
+!p.background=0
+
+;return
+
+end
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_cdfobs.pro	(revision 3294)
@@ -0,0 +1,221 @@
+;+---------------------------------------------------------------------------
+PRO read_cdfobs, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, Depths=Depths, $
+               Obs=Observations, ModelVals=ModelVals, qcs=QCs, $
+               Ob2=Observations2, ModelVal2=ModelVals2, qc2=QCs2, $
+               Ob3=Observations3, $
+               Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, kobs=kobs, $
+	            Salinity=Salinity, nodates=nodates, types=types, $
+	            filetype=ObsType, quiet=quiet, MDT=MDT, $
+               ProfileNum=ProfileNum, error=error, $
+               notfussy=notfussy,VarName=VarName  
+;+--------------------------------------------------------------------------
+; Read in observation and feedback files
+; detects filetype and calls the appropriate reading routine
+;
+; Author:  D. J. Lea       Feb 2008
+;+--------------------------------------------------------------------------
+
+; Declare error label. 
+ON_IOERROR, IOERROR 
+	       
+error=0
+title=''
+
+; Set types to undefined
+types=-1 & tempvar=size(temporary(types))
+
+; Read in netcdf data file and observation operator
+;2. Work out which type of data is in the files by looking at the first one.
+ncid = ncdf_open(Files(0), /nowrite)
+if ncid lt 0 then message, 'Error opening file '+File
+result = NCDF_ATTINQ( ncid, 'title', /global)
+if result.datatype ne 'UNKNOWN' then ncdf_attget, ncid, 'title', Title, /global
+
+if string(Title) eq "NEMO observation operator output" then ObsType='feedback' $
+else $
+if string(Title) eq "Forecast class 4 file" then ObsType='ForecastClass4' $
+else $
+ObsType = 'none'
+
+if ObsType eq 'none' then begin
+  varid = ncdf_varid(ncid, 'POTM_CORRECTED')  
+  if varid ge 0 then ObsType = 'Prof' 
+  
+  varid = ncdf_varid(ncid, 'SLA')
+  if varid ge 0 then ObsType = 'SSH'
+  
+  varid = ncdf_varid(ncid, 'SST')
+  varid2 = ncdf_varid(ncid, 'sea_surface_temperature')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SST'
+  
+  varid = ncdf_varid(ncid, 'SEAICE')
+  varid2 = ncdf_varid(ncid, 'sea_ice_concentration')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'SEAICE'    
+  
+  varid = ncdf_varid(ncid, 'LOGCHL')
+  varid2 = ncdf_varid(ncid, 'LogChl')
+  varid3 = ncdf_varid(ncid, 'CHL1_mean')
+  varid=max([varid,varid2,varid3])
+  if varid ge 0 then ObsType = 'LOGCHL'    
+  
+  varid = ncdf_varid(ncid, 'PCO2')
+  if varid ge 0 then ObsType = 'PCO2'
+
+  varid = ncdf_varid(ncid, 'UCRT')
+  varid2 = ncdf_varid(ncid, 'VCRT')
+  varid=max([varid,varid2])
+  if varid ge 0 then ObsType = 'CRT'    
+endif
+ 
+ncdf_close, ncid
+
+if not keyword_set(quiet) then print, 'Reading in data as type ',ObsType
+
+  if ObsType eq 'feedback' then begin
+  
+    if n_elements(DepRange) eq 0 then DepRange=[0,5000]  
+  
+    read_feedback, Files, DepRange=DepRange, VarName=VarName, NumData=numobs, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                OutInstruments=Instruments, OutPlatform=Platform, $
+                OutDeps=Depths,  $
+                OutObs1=Observations, OutObs2=Observations2, $
+                OutMod1=ModelVals, OutMod2=ModelVals2, $
+                OutQC1=QCs, OutQC2=QCs2, $
+                MDT=MDT, OutDates=Dates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=ProfileNum
+                
+;                info, instruments
+;                info, platform
+                
+                types=Platform
+                if n_elements(instruments) gt 0 then types=Platform+' '+Instruments
+                
+  print, 'Varname: ',VarName
+  endif else if ObsType eq 'Prof' then begin
+  
+    if keyword_set(PlotModel) then begin
+      OutTMod = 1
+      OutSMod = 1
+    endif
+
+	if n_elements(DepRange) eq 0 then DepRange=[0,5000]
+    
+  read_enact, Files, DepRange=DepRange, NumData=NumData, $
+                OutLats=Latitudes, OutLons=Longitudes, $
+                Instruments=Instruments, Platform=Platform, $
+                OutDeps=Depths, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=Dates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=iobs, jobs=jobs, kobs=kobs, $
+                ProfileNum=ProfileNum
+
+	types=Instruments+' '+Platform
+
+; if salinity keyword is set then put salinity values first  
+    if keyword_set(Salinity) then begin		
+      Observations = OutSObs
+      ModelVals    = OutSMod    
+      QCs          = OutSQC
+      Observations2 = OutTObs
+      ModelVals2    = OutTMod
+      QCs2          = OutTQC
+    endif else begin
+      Observations = OutTObs
+      ModelVals    = OutTMod
+      QCs          = OutTQC
+      Observations2 = OutSObs
+      ModelVals2    = OutSMod
+      QCs2          = OutSQC
+    endelse 
+
+	numobs=numdata
+        numobs=n_elements(latitudes)
+	              
+  endif else if ObsType eq 'SSH' then begin
+    
+    read_sla, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSLA=Observations, ModSLA=ModelVals, SLAQC=QCs, $
+              MDT=MDT, Satellites=Satellites, types=types, Dates=Dates, rmdi=rmdi, $
+	      iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet
+    Depths = fltarr(NumObs)
+    
+  endif else if ObsType eq 'SST' then begin
+     
+    read_sst, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              ObsSST=Observations, ModSST=ModelVals, SSTQC=QCs, $
+              Dates=Dates, rmdi=rmdi, types=types, iobs=iobs, jobs=jobs, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+  endif else if ObsType eq 'SEAICE' then begin
+  
+    read_seaice, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+  
+  endif else if ObsType eq 'LOGCHL' then begin
+      
+    read_chl, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+             
+   endif else if ObsType eq 'PCO2' then begin
+      
+    read_pco2, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Obs=Observations, Modarr=ModelVals, QC=QCs, $
+              Dates=Dates, rmdi=rmdi, iobs=iobs, jobs=jobs, nodates=nodates, $
+              quiet=quiet
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'CRT' then begin
+
+    read_crt, Files, NumObs=NumObs, $
+              OutLats=Latitudes, OutLons=Longitudes, $
+              OutTypes=Types, OutDates=Dates, $
+              OutUObs=Observations, OutVObs=Observations2, $
+              OutUMod=ModelVals, OutVMod=ModelVals2, Quiet=Quiet, $
+              FloatNum=FloatNum, QC=QCs, OutSpeed=Observations3
+    rmdi=0.0
+    QCs2=QCs
+    Depths = fltarr(NumObs)
+
+   endif else if ObsType eq 'ForecastClass4' then begin
+   
+    print, 'reading forecast class 4 files'
+    read_forc_class4, Files, NumObs=NumObs, $
+              Latitudes=Latitudes, Longitudes=Longitudes, $
+              Depths=Depths, $
+              Types=types, Dates=Dates, $
+              Obsarr=Observations, Obs2arr=Observations2, $
+              Modarr=ModelVals, Mod2arr=ModelVals2, $
+              QCs1=QCs, QCs2=QCs2, rmdi=rmdi, $
+              notfussy=notfussy
+                  
+  endif else message, 'Error: ObsType is not set correctly'                 
+
+  if (n_elements(types) eq 0) then begin
+  	  types=replicate(rmdi,NumObs)
+  endif
+
+  goto, NOERROR
+  
+IOERROR: error=1
+	 print,'read_cdfobs: an error occurred trying read files: ',files
+
+NOERROR:
+	
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_enact.pro	(revision 3294)
@@ -0,0 +1,313 @@
+PRO read_enact, Files, DepRange=DepRange, $
+                NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, Instruments=OutInst, $
+		Platform=OutPlatform, $
+                OutDeps=OutDeps, OutSObs=OutSObs, OutSQC=OutSQC, $
+                OutTObs=OutTObs, OutTQC=OutTQC, OutDates=OutDates, $
+                OutTMod=OutTMod, OutSMod=OutSMod, rmdi=rmdi, quiet=quiet, $
+                iobs=outiobs, jobs=outjobs, kobs=outkobs, $
+                ProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from an ENACT format file containing profile data.
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+;        NumProfs    => Number of profiles  -Integer
+;        Latitudes   => Latitudes(NumProfs) -Real
+;        Longitudes  => Longitudes(NumProfs) -Real
+;        Dates       => Dates(NumProfs)  -Date/time structure.
+;        Instruments => Instrument type (NumProfs) -String
+;        Depths      => Depths of each ob (NumProfs)  -Real
+;        Salinity    => Salinity (psu) (NumProfs)  -Real
+;        SalQC       => QC flag for salinity (NumProfs) 1=> Good  -Int
+;        Temperature => Temperature (deg C) (NumProfs)  -Real
+;        TempQC      => QC flag for temperature (NumProfs) 1=> Good  -Int
+;        ModelT      => Model temperature (deg C) (NumProfs)  -Real
+;        ModelS      => Model salinity (psu) (NumProfs)  -Real
+;        rmdi        => Missing data indicator  -Real
+;
+;Author: Matt Martin. 5/10/07.
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+;  if not keyword_set(quiet) then , ncinfo
+  ;3. Read in the relevant dimensions
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_PROF' then NumProfs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'STRING4' then str4 = dimlen
+  endfor
+ 
+  ;4. Set up arrays and read in the data
+
+  if (NumProfs gt 0) then begin  
+  JulDays = fltarr(NumProfs)
+  Latitudes = fltarr(NumProfs)
+  Longitudes = fltarr(NumProfs)
+  BytInsts = intarr(4, NumProfs)
+  Instruments = strarr(NumProfs)
+  Platforms = strarr(NumProfs)
+  Instrumentsa = strarr(NumLevels, NumProfs)
+  Platformsa = strarr(NumLevels, NumProfs)
+  Depths = fltarr(NumLevels, NumProfs)
+  Salinity = fltarr(NumLevels, NumProfs)
+  SalQC = intarr(NumLevels, NumProfs)
+  Temperature = fltarr(NumLevels, NumProfs)
+  TempQC = intarr(NumLevels, NumProfs)
+  ModelT = fltarr(NumLevels, NumProfs)
+  ModelS = fltarr(NumLevels, NumProfs)
+  ProfileNum = replicate(1,NumLevels)#indgen(NumProfs)
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  ncdf_varget, ncid, varid, JulDays
+  
+;  print,JulDays
+  
+;  BaseDate = var_to_dt(1950,1,1)
+;  BaseDate=JULDAY(1,1,1950,0,0)
+  BaseDate=double(JULDAY(1,1,1950,0,0))		;should be at 0 UTC
+;  info,BaseDate
+  Dates = replicate(BaseDate, NumLevels,NumProfs)
+;  info,dates
+  for iprof = 0L, NumProfs-1 do begin
+    secs = JulDays(iprof)* 24. * 60. * 60.
+;    dt = dt_add(BaseDate, second=secs)
+    dt=BaseDate+JulDays(iprof)
+;    CALDAT, dt, mon, day, year, hour, minute, second
+;    print,dt-BaseDate, mon, day, year, hour, minute, second
+    Dates(0:NumLevels-1,iprof) = replicate(dt,NumLevels)
+  endfor
+
+  
+ 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, Longitudes
+
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, Latitudes
+
+  varid = ncdf_varid(ncid, 'DEPH_CORRECTED')
+  ncdf_varget, ncid, varid, Depths
+  res = ncdf_attinq( ncid, varid , '_FillValue')
+  if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+  else begin
+    res = ncdf_attinq( ncid, varid , '_fillvalue')
+    ncdf_attget, ncid, varid, '_fillvalue', FillVal
+  endelse
+  pts = where(Depths eq FillVal, count)
+  if count gt 0 then Depths(pts) = rmdi
+
+;  if keyword_set(Salinity) then begin
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading psal_corrected'
+    ncdf_varget, ncid, varid, Salinity
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(Salinity eq FillVal, count)
+    if count gt 0 then Salinity(pts) = rmdi
+   endif      
+    varid = ncdf_varid(ncid, 'PSAL_CORRECTED_QC')
+    ncdf_varget, ncid, varid, SalQC
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    SalQC = SalQC - 48
+;  endif
+
+;  if keyword_set(Temperature) then begin
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED')
+    if (varid ne -1) then  begin
+;    if not keyword_set(quiet) then print,'reading potm_corrected'
+    ncdf_varget, ncid, varid, Temperature
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+;    if not keyword_set(quiet) then print,'Temp fill value ',fillval
+    pts = where(Temperature eq FillVal, count)
+    if count gt 0 then Temperature(pts) = rmdi
+   endif   
+    varid = ncdf_varid(ncid, 'POTM_CORRECTED_QC')
+    ncdf_varget, ncid, varid, TempQC
+    TempQC = TempQC - 48
+;   endif
+
+;  if keyword_set(OutTMod) then begin
+    varid = ncdf_varid(ncid, 'POTM_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelT
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelT eq FillVal, count)
+    if count gt 0 then ModelT(pts) = rmdi
+    endif else begin
+	ModelT=rmdi
+    endelse
+;   endif
+
+;  if keyword_set(OutSMod) then begin
+    varid = ncdf_varid(ncid, 'PSAL_Hx')
+    if (varid ne -1) then begin
+    ncdf_varget, ncid, varid, ModelS
+    res = ncdf_attinq( ncid, varid , '_FillValue')
+    if res.length gt 0 and res.datatype ne "UNKNOWN" then ncdf_attget, ncid, varid, '_FillValue', FillVal $
+    else begin
+      res = ncdf_attinq( ncid, varid , '_fillvalue')
+      ncdf_attget, ncid, varid, '_fillvalue', FillVal
+    endelse
+    pts = where(ModelS eq FillVal, count)
+    if count gt 0 then ModelS(pts) = rmdi
+    endif else begin
+	ModelS=rmdi
+    endelse
+;  endif
+
+  varid = ncdf_varid(ncid, 'WMO_INST_TYPE')
+  ncdf_varget, ncid, varid, BytInsts
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 50 and $
+              BytInsts(3,*) eq 48, count)
+  if count gt 0 then Instruments(pts) = 'BUOYS'  ; 820
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 52 and $
+              BytInsts(2,*) eq 48 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'XBT'    ; 401
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 55 and $
+              BytInsts(2,*) eq 52 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'TESAC'  ; 741
+  
+  pts = where(BytInsts(0,*) eq 32 and $
+              BytInsts(1,*) eq 56 and $
+              BytInsts(2,*) eq 51 and $
+              BytInsts(3,*) eq 49, count)
+  if count gt 0 then Instruments(pts) = 'ARGO'   ; 831
+  
+  pts = where(Instruments eq '', count) 
+  if count gt 0 then Instruments(pts) = 'UNKNOWN'
+  
+  varid = ncdf_varid(ncid, 'PLATFORM_NUMBER')
+  ncdf_varget, ncid, varid, platforms
+  platforms=string(platforms)
+  
+  for i=0,numlevels-1 do begin
+    platformsa(i,*)=platforms
+    instrumentsa(i,*)=instruments
+  endfor
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'KOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, kobsval
+    
+  ;Select those obs in the required depth range
+;  Lats = replv(Latitudes(*), [NumLevels,NumProfs],1)
+;  Lons = replv(Longitudes(*), [NumLevels,NumProfs],1)
+
+	Lons=fltarr(NumLevels,NumProfs)
+        Lats=fltarr(NumLevels,NumProfs)
+	iobs=fltarr(NumLevels,NumProfs)
+        jobs=fltarr(NumLevels,NumProfs)
+        
+	for i=0L,NumProfs-1 do begin
+          Lats(*,i)=Latitudes(i)
+          Lons(*,i)=Longitudes(i)
+          if (n_elements(iobsval) gt 0) then $
+	          iobs(*,i)=iobsval(i)
+          if (n_elements(jobsval) gt 0) then $
+          	  jobs(*,i)=jobsval(i)
+        endfor  
+  
+  pts = where(Depths ge DepRange(0) and Depths le DepRange(1), NumData)
+  
+  if ifile2 eq 0 then begin  
+    OutTObs = [Temperature(pts)]
+    OutSObs = [Salinity(pts)]
+    OutTMod = [ModelT(pts)]
+    OutSMod = [ModelS(pts)]
+    OutTQC  = [TempQC(pts)]
+    OutSQC  = [SalQC(pts)]
+    OutDeps = [Depths(pts)]
+    OutLats = [Lats(pts)]
+    OutLons = [Lons(pts)]
+    OutDates= [Dates(pts)]
+    OutInst= [Instrumentsa(pts)]    
+    OutPlatform= [Platformsa(pts)]
+    OutProfileNum = [ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [kobsval(pts)]
+    
+  endif else begin
+    OutTObs = [OutTObs,Temperature(pts)]
+    OutSObs = [OutSObs,Salinity(pts)]
+    OutTMod = [OutTMod,ModelT(pts)]
+    OutSMod = [OutSMod,ModelS(pts)]
+    OutTQC  = [OutTQC,TempQC(pts)]
+    OutSQC  = [OutSQC,SalQC(pts)]
+    OutDeps = [OutDeps,Depths(pts)]
+    OutLats = [OutLats,Lats(pts)]
+    OutLons = [OutLons,Lons(pts)]
+    OutDates= [OutDates,Dates(pts)]
+    OutInst= [OutInst,Instrumentsa(pts)]
+    OutPlatform = [OutPlatform, Platformsa(pts)]
+    OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+    if (n_elements(iobsval) gt 0) then outiobs = [outiobs, iobs(pts)]
+    if (n_elements(jobsval) gt 0) then outjobs = [outjobs, jobs(pts)]
+    if (n_elements(kobsval) gt 0) then outkobs = [outkobs, kobsval(pts)]
+
+  endelse
+
+	ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+
+
+	endif
+  
+endfor ;ifile
+
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_feedback.pro	(revision 3294)
@@ -0,0 +1,283 @@
+PRO read_feedback, Files, DepRange=DepRange, VarName=VarNames, NumData=NumData, $
+                OutLats=OutLats, OutLons=OutLons, $
+                OutInstruments=OutInst, OutPlatform=OutPlatform, $
+                OutDeps=OutDeps,  $
+                OutObs1=OutObs1, OutObs2=OutObs2, $
+                OutMod1=OutMod1, OutMod2=OutMod2, $
+                OutQC1=OutQC1, OutQC2=OutQC2, $
+                MDT=MDT, OutDates=OutDates, $
+                rmdi=rmdi, quiet=quiet, $
+                OutProfileNum=OutProfileNum
+
+;------------------------------------------------------------------------------------------
+;Program to read in data from a feedback format file
+;
+; Inputs:
+;        File        => File name to be read in
+;        DepRange    => (optional) Range of depths for which the data is to be extracted.
+;
+; Outputs:
+
+;
+;Author: Matt Martin. 29/09/09
+;------------------------------------------------------------------------------------------
+rmdi = 99999.
+if NOT keyword_set(DepRange) then DepRange=[0.,1.e1]   ;Default to top 10 metres.
+NumFiles=n_elements(Files)
+
+ifile2=0
+numdata=0
+for ifile = 0, NumFiles-1 do begin
+  File = Files(ifile)
+  
+;1. Open the netcdf file
+  ncid = ncdf_open(File, /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+File
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+File+' successfully'
+  
+  ;2. Get info about file
+  ncinfo = ncdf_inquire(ncid)
+
+  ;3. Read in the relevant dimensions
+  NumExtra = 0
+  for idim = 0, ncinfo.ndims-1 do begin
+    ncdf_diminq, ncid, idim, name, dimlen
+    if name eq 'N_OBS' then NumObs = dimlen $
+    else if name eq 'N_LEVELS' then NumLevels = dimlen $
+    else if name eq 'N_VARS' then NumVars = dimlen $
+    else if name eq 'N_QCF' then NumFlags = dimlen $
+    else if name eq 'N_ENTRIES' then NumEntries = dimlen $
+    else if name eq 'N_EXTRA' then NumExtra = dimlen $
+    else if name eq 'STRINGNAM' then strnam = dimlen $
+    else if name eq 'STRINGGRID' then strgrid = dimlen $
+    else if name eq 'STRINGWMO' then strwmo = dimlen $
+    else if name eq 'STRINGTYP' then strtyp = dimlen $
+    else if name eq 'STRINGJULD' then strjuld = dimlen
+  endfor
+ 
+  ;4. Set up arrays 
+
+  if (NumObs gt 0) then begin  
+    ByteNam = intarr(strnam, NumVars)
+    if (n_elements(NumEntries) eq 1) then ByteEntries = intarr(strnam, NumEntries)
+    ByteId = intarr(strwmo, NumObs)
+    ByteType = intarr(strtyp, NumObs)
+    ByteJulDRef = intarr(strjuld)
+    VarNames = strarr(NumVars)
+    if (n_elements(NumEntries) eq 1) then Entries = strarr(NumEntries)
+    Id = strarr(NumObs)
+    Type = strarr(NumObs)
+    if NumExtra gt 0 then begin
+      ByteExtra = intarr(strnam, NumExtra)    
+      Extra = strarr(NumExtra)    
+    endif 
+    Longitude = fltarr(NumObs)
+    Latitude  = fltarr(NumObs)
+    Depth     = fltarr(NumLevels, NumObs)
+    DepQC     = intarr(NumLevels, NumObs)
+    JulD      = dblarr(NumObs)
+    ObsQC     = intarr(NumObs)
+    PosQC     = intarr(NumObs)
+    JulDQC    = intarr(NumObs)
+    Obs       = fltarr(NumLevels, NumObs, NumVars)
+    Hx        = fltarr(NumLevels, NumObs, NumVars)
+    VarQC     = intarr(NumObs, NumVars)
+    LevelQC   = intarr(NumLevels, NumObs, NumVars)
+    
+  ;5. Read in the data  
+    varid = ncdf_varid(ncid, 'VARIABLES')
+    ncdf_varget, ncid, varid, ByteNam
+;    info, VarNames
+;    info, ByteNam
+    for ivar= 0, NumVars-1 do begin
+      VarNames(ivar) = string(ByteNam(*,ivar))
+    endfor
+    
+    if ifile2 eq 0 then VarName = VarNames(0)
+    if VarName ne VarNames(0) then message, 'Can only read in from files containing the same variables'
+    
+    varid = ncdf_varid(ncid, 'JULD_REFERENCE')
+    ncdf_varget, ncid, varid, ByteJulDRef
+    JulDRef = string(ByteJulDRef)
+    RefDate = JULDAY(fix(strmid(JulDRef,4,2)), fix(strmid(JulDRef,6,2)), fix(strmid(JulDRef,0,4)), $
+                     fix(strmid(JulDRef,8,2)), fix(strmid(JulDRef,10,2)), fix(strmid(JulDRef,12,2)))
+	print, 'RefDate: ',RefDate
+    varid = ncdf_varid(ncid, 'JULD')
+    ncdf_varget, ncid, varid, JulD
+;    print, JulD
+    Dates = dblarr(NumLevels, NumObs)
+    for iob = 0L, long(NumObs)-1L do begin
+      dt = RefDate + JulD(iob)
+;      print,dt, JulD(iob)
+      Dates(0:NumLevels-1, iob) = replicate(dt, NumLevels)
+    endfor
+    
+    varid = ncdf_varid(ncid, 'STATION_IDENTIFIER')
+    ncdf_varget, ncid, varid, ByteId
+    Identifier = string(ByteId)
+    
+    varid = ncdf_varid(ncid, 'STATION_TYPE')
+    ncdf_varget, ncid, varid, ByteType
+    Type = string(ByteType)
+   
+    varid = ncdf_varid(ncid, 'LONGITUDE')
+    ncdf_varget, ncid, varid, Longitude
+  
+    varid = ncdf_varid(ncid, 'LATITUDE')
+    ncdf_varget, ncid, varid, Latitude
+  
+    varid = ncdf_varid(ncid, 'DEPTH')
+    ncdf_varget, ncid, varid, Depth
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(Depth eq FillVal, count)
+    if count gt 0 then Depth(pts) = rmdi
+    
+    varid = ncdf_varid(ncid, 'OBSERVATION_QC')
+    ncdf_varget, ncid, varid, ObsQC
+    ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+    pts = where(ObsQC eq FillVal, count)
+    if count gt 0 then ObsQC(pts) = rmdi      
+    
+    for ivar = 0, NumVars-1 do begin
+    
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_OBS')
+      ncdf_varget, ncid, varid, tmp
+      Obs(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValObs
+  
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_Hx')
+      if (varid gt -1) then begin
+         ncdf_varget, ncid, varid, tmp
+         Hx(*,*,ivar) = tmp
+         ncdf_attget, ncid, varid, '_Fillvalue', FillValHx
+      endif else begin
+         FillValHx=0
+      endelse 
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_QC')
+      ncdf_varget, ncid, varid, tmp
+      VarQC(*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValQC
+      
+      
+      varid = ncdf_varid(ncid, strtrim(VarNames(ivar))+'_LEVEL_QC')
+      ncdf_varget, ncid, varid, tmp
+      LevelQC(*,*,ivar) = tmp
+      ncdf_attget, ncid, varid, '_Fillvalue', FillValLevQC
+          
+    endfor        
+ 
+; 	print,' DJL levelqc(*,218,0) ',levelqc(*,218,0)
+; 	print,' DJL levelqc(*,218,1) ',levelqc(*,218,1)
+    
+    pts = where(Obs eq FillValObs, count)
+    if count gt 0 then Obs(pts) = rmdi
+    pts = where(Hx eq FillValHx, count)
+    if count gt 0 then Hx(pts) = rmdi   
+    pts = where(VarQC eq FillValQC, count)
+    if count gt 0 then VarQC(pts) = rmdi  
+    pts = where(LevelQC eq FillValLevQC, count)
+    if count gt 0 then LevelQC(pts) = rmdi        
+
+    Obs1 = Obs(*,*,0)
+    Hx1  = Hx(*,*,0)
+    VarQC1=LevelQC(*,*,0)    
+    if NumVars gt 1 then begin
+      Obs2 = Obs(*,*,1)
+      Hx2  = Hx(*,*,1)
+      VarQC2=LevelQC(*,*,1)    
+    endif
+    
+    if strtrim(VarName,2) eq 'SLA' then begin
+      MDT = fltarr(NumLevels, NumObs)
+      print, NumLevels, NumObs
+      varid = ncdf_varid(ncid, 'MDT')
+      ncdf_varget, ncid, varid, MDT
+      ncdf_attget, ncid, varid, '_Fillvalue', FillVal
+      pts = where(MDT eq FillVal, count)
+      if count gt 0 then MDT(pts) = rmdi   
+      Obs2 = MDT
+    endif
+          
+    ;6. Put the data into the correct form to be output from this routine
+    Platformsa = strarr(NumLevels, NumObs)
+    Instrumentsa = strarr(NumLevels, NumObs)
+    Lons = fltarr(NumLevels,NumObs)
+    Lats = fltarr(NumLevels,NumObs)
+    ProfileNum = lonarr(NumLevels,NumObs)
+        
+    for i=0,NumLevels-1 do begin
+      Platformsa(i,*)=Type
+      Instrumentsa(i,*)=Identifier
+    endfor
+      
+    for i=0L,long(NumObs)-1L do begin
+      Lats(*,i)=Latitude(i)
+      Lons(*,i)=Longitude(i)
+      ProfileNum(*,i) = i+1
+    endfor  
+;   
+   pts = where(Depth ge DepRange(0) and Depth le DepRange(1), NumDataInc)
+   NumData=NumData+NumDataInc
+;   
+   if ifile2 eq 0 then begin  
+     OutObs1 = [Obs1(pts)]
+     OutMod1 = [Hx1(pts)]
+     OutQC1  = [VarQC1(pts)]
+     OutDeps = [Depth(pts)]
+     OutLats = [Lats(pts)]
+     OutLons = [Lons(pts)]
+     OutDates= [Dates(pts)]
+     OutInst= [Instrumentsa(pts)]    
+     OutPlatform= [Platformsa(pts)]
+     OutProfileNum = [ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [Obs2(pts)]     
+       OutMod2 = [Hx2(pts)]     
+       OutQC2  = [VarQC2(pts)]
+     endif
+   endif else begin
+     OutObs1 = [OutObs1, Obs1(pts)]
+     OutMod1 = [OutMod1, Hx1(pts)]
+     OutQC1  = [OutQC1, VarQC1(pts)]
+     OutDeps = [OutDeps, Depth(pts)]
+     OutLats = [OutLats, Lats(pts)]
+     OutLons = [OutLons, Lons(pts)]
+     OutDates= [OutDates, Dates(pts)]
+     OutInst= [OutInst, Instrumentsa(pts)]    
+     OutPlatform= [OutPlatform, Platformsa(pts)]
+     OutProfileNum = [OutProfileNum, ProfileNum(pts)]
+     if NumVars eq 2 then begin
+       OutObs2 = [OutObs2, Obs2(pts)]     
+       OutMod2 = [OutMod2, Hx2(pts)]     
+       OutQC2  = [OutQC2, VarQC2(pts)]
+     endif
+   endelse
+   
+   if NumVars eq 1 then begin
+     if VarName ne 'SLA' then OutObs2 = fltarr(n_elements(OutObs1)) + rmdi
+     OutMod2 = fltarr(n_elements(OutMod1)) + rmdi
+     OutQC2  = fltarr(n_elements(OutQC1)) + rmdi
+   endif
+; 
+   ifile2=ifile2+1
+   endif
+  ncdf_close, ncid
+  
+  endif
+  
+endfor ;ifile
+
+pts1 = where(OutQC1 eq 1, count1)
+pts2 = where(OutQC1 ne 1, count2)
+if count1 gt 0 then OutQc1(pts1) = 0
+if count2 gt 0 then OutQc1(pts2) = 1
+if NumVars gt 1 then begin
+  pts1 = where(OutQC2 eq 1, count1)
+  pts2 = where(OutQC2 ne 1, count2)
+  if count1 gt 0 then OutQc2(pts1) = 0
+  if count2 gt 0 then OutQc2(pts2) = 1
+endif
+
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_seaice.pro	(revision 3294)
@@ -0,0 +1,178 @@
+PRO  read_seaice, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               Obs=Obs, modarr=modarr, qc=qcarr, $
+               Dates=Dates, rmdi=rmdi, iobs=outiobs, jobs=outjobs, $
+               nodates=nodates, quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of sea ice data.
+;
+;Author:   D. J. Lea       Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+; could read in from file
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+  ncdf_diminq, ncid, 0, name, NData
+  if Ndata gt 0 then begin
+
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)  
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobs = intarr(NData)
+  jobs = intarr(NData)
+
+; output attribute and variable info
+;  ncattinfo, id
+  
+  varid = ncdf_varid(ncid, 'lon')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LONGITUDE')
+  ncdf_varget, ncid, varid, lons
+  
+  varid = ncdf_varid(ncid, 'lat')
+;  if not keyword_set(quiet) then print,varid
+  if (varid eq -1) then varid = ncdf_varid(ncid, 'LATITUDE')
+  ncdf_varget, ncid, varid, lats
+
+  if (keyword_set(nodates) eq 0) then begin
+
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts = Dats+RefDate
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'SeaIce_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor    
+    if not keyword_set(quiet) then print,'dtime(0): ',dtime(0), scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+
+  endif
+
+  if not keyword_set(quiet) then print,'reading sea ice data'   
+  varid = ncdf_varid(ncid, 'sea_ice_concentration')
+    if not keyword_set(quiet) then print,varid
+    if (varid eq -1) then begin
+    	 varid2 = ncdf_varid(ncid, 'SEAICE')
+         if (varid2 ne -1) then ncdf_varget, ncid, varid2, obsval
+    endif
+    if (varid ne -1) then ncdf_varget, ncid, varid, obsval
+    if not keyword_set(quiet) then print,'scale_factor'
+  scale_factor=1.  
+  if (varid ne -1) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+
+  if not keyword_set(quiet) then print,'_FillValue'
+  FillValue=99999
+      
+;  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  if not keyword_set(quiet) then print,FillValue  
+
+  pts = where(obsval eq FillValue, count)
+
+  if not keyword_set(quiet) then print,'scale_factor ',scale_factor  
+  obsval=obsval*scale_factor
+  
+  if count gt 0 then obsval(pts) = rmdi
+
+
+  if not keyword_set(quiet) then print,'reading sea ice model values'
+  varid = ncdf_varid(ncid, 'SEAICE_Hx')
+  if (varid ne -1) then ncdf_varget, ncid, varid, modval
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobs
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobs
+  
+
+  scale_factor=1
+  pts = where(modval eq FillValue or modval eq -9999, count)
+  
+  modval=modval*scale_factor
+  
+  if count gt 0 then modval(pts) = rmdi
+
+  	if not keyword_set(quiet) then print,'sea ice qc'
+
+  varid = ncdf_varid(ncid, 'SEAICE_QC')	     
+  if (varid ne -1) then begin
+   if not keyword_set(quiet) then print,'bytQC' 
+   ncdf_varget, ncid, varid, bytQC
+   ncdf_attget, ncid, varid, '_FillValue', FillValue
+   QC(*) = 0.
+   pts = where(bytQC eq FillValue, count)
+   if count gt 0 then QC(pts) = rmdi
+   pts = where(bytQC ne 48, count)
+   if count gt 0 then QC(pts) = 1.  
+  endif else begin
+   varid = ncdf_varid(ncid, 'confidence_flag')
+   ncdf_varget, ncid, varid, QC
+  endelse
+  
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    Obs = [obsval]
+    Modarr = [modval]
+    QCarr = [QC]
+    Dates = [dts]
+    if (n_elements(iobs) gt 0) then outiobs = [iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [jobs]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    Obs = [Obs, obsval]
+    Modarr = [Modarr, modval]    
+    QCarr = [QCarr, QC]
+    Dates = [Dates, dts]
+    if (n_elements(iobs) gt 0) then outiobs = [outiobs, iobs]
+    if (n_elements(jobs) gt 0) then outjobs = [outjobs, jobs]
+  endelse      
+
+ifile2=ifile2+1
+endif
+
+  if not keyword_set(quiet) then print,'closing file'
+
+  ncdf_close, ncid
+
+endif
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+if (n_elements(Modarr) ne NumObs) then Modarr=replicate(rmdi,NumObs)
+
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sla.pro	(revision 3294)
@@ -0,0 +1,312 @@
+;+
+PRO  read_sla, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSLA=ObsSLA, ModSLA=ModSLA, SLAQC=SLAQC, $
+               MDT=MDT, Satellites=Satellites, Types=Types, Dates=Dates, rmdi=rmdi, $
+	       iobs=iobs, jobs=jobs, mstp=mstp, quiet=quiet, track=track
+;+-----------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea       - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)		; should be at 0 UTC
+
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+;  var = ncdf_varinq( ncid, "SLA" )
+  if not keyword_set(quiet) then print,'ncinfo.ndims ',ncinfo.ndims
+  ncdf_diminq, ncid, 0, name, NData
+  NData2=0
+  cycles=1
+  if (ncinfo.ndims gt 2) then ncdf_diminq, ncid, 2, name, NData2
+  if (ncinfo.ndims gt 1) then ncdf_diminq, ncid, 1, name, cycles
+
+
+  if not keyword_set(quiet) then print,NData, NData2
+
+ NData=max([NData*cycles, NData2*cycles])
+
+; print,NData, NData2
+
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  mdtval = fltarr(NData)  
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  Dats   = dblarr(NData)
+  trackval  = intarr(NData)
+  Sats   = intarr(NData)
+  strSats= strarr(NData)
+  StrVal = strarr(8)
+;  dts    = replicate(!dt_base, NData)
+  dts = dblarr(NData)
+  
+;  info,lons 
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin 
+  	varid = ncdf_varid(ncid, 'Longitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'longitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lons 
+  lons=lons*scale_factor
+;  info, lons
+  if (cycles gt 1) then begin
+    lonsn=lons
+    for i=1,cycles-1 do begin
+       lonsn=[lonsn,lons]
+    endfor
+    lons=lonsn
+  endif
+
+;  info, lons
+
+;  info,lats     
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  scale_factor=1.
+  if (varid eq -1) then begin
+  	varid = ncdf_varid(ncid, 'Latitudes')
+        if (varid eq -1) then begin
+             varid = ncdf_varid(ncid, 'latitude')
+        endif
+        ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  endif
+  ncdf_varget, ncid, varid, lats
+  lats=lats*scale_factor
+;  info, lats
+  if (cycles gt 1) then begin
+    latsn=lats
+    for i=1,cycles-1 do begin
+       latsn=[latsn,lats]
+    endfor
+    lats=latsn
+  endif
+  
+;  info, lats
+    
+  varid = ncdf_varid(ncid, 'JULD')
+  if (varid eq -1) then begin
+        varid = ncdf_varid(ncid, 'time')
+  endif
+  if (varid ne -1) then begin 
+  	ncdf_varget, ncid, varid, Dats
+  endif else begin
+        varid = ncdf_varid(ncid, 'BeginDates')
+        ncdf_varget, ncid, varid, Bds
+;        print,bds
+;        info, bds
+        if (cycles gt 1) then begin
+           bds=transpose(bds)
+        endif
+        varid = ncdf_varid(ncid, 'NbPoints')
+        ncdf_varget, ncid, varid, nbpoints
+
+; Read in dataindexes and deltat in cls format file 
+; These are used to adjust dates 
+        varid = ncdf_varid(ncid, 'DeltaT')
+        if (varid ne -1) then begin 
+  	  ncdf_varget, ncid, varid, deltat
+          ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+          deltat=deltat*scale_factor
+          varid = ncdf_varid(ncid, 'DataIndexes')
+          ncdf_varget, ncid, varid, dataindexes
+          
+        endif
+
+	print, 'deltat ',deltat
+;        print, 'dataindexes ',dataindexes
+
+;        info, nbpoints
+;        print,nbpoints
+;        info, cycles
+        cumbds=[0]
+        nbpointst=nbpoints
+        dataindexest=dataindexes
+        for i=1,cycles-1 do begin
+	 	nbpointst=[nbpointst,nbpoints]
+                dataindexest=[dataindexest,dataindexes]
+        endfor
+        cumbds=[0,total(nbpointst,/cumulative)]
+;       if not keyword_set(quiet) then print,'cumbds ',cumbds
+        nel=n_elements(Bds)
+;        info,nel
+;       if not keyword_set(quiet) then print,n_elements(dats)
+        for i=0,nel-1 do begin
+;        print,'*',i, cumbds(i+1)-cumbds(i) 
+;           print,i,cumbds(i),cumbds(i+1)-1
+           dats(cumbds(i):cumbds(i+1)-1)=bds(i)
+           trackval(cumbds(i):cumbds(i+1)-1)=i
+           dataindexest(cumbds(i):cumbds(i+1)-1)=dataindexest(cumbds(i):cumbds(i+1)-1)-dataindexest(cumbds(i))
+        endfor
+        
+; adjust dats based on dataindex
+	dats=dats+dataindexest*deltat/86400.
+        
+        
+;        print, dats
+  endelse
+
+
+          
+  dts=RefDate + Dats 
+    
+  varid = ncdf_varid(ncid, 'MISSION')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, Sats
+  ncdf_attget, ncid, varid, 'Value_0', StrVal0           
+  ncdf_attget, ncid, varid, 'Value_1', StrVal1  
+  ncdf_attget, ncid, varid, 'Value_2', StrVal2  
+  ncdf_attget, ncid, varid, 'Value_3', StrVal3      
+  ncdf_attget, ncid, varid, 'Value_4', StrVal4  
+  ncdf_attget, ncid, varid, 'Value_5', StrVal5 
+  ncdf_attget, ncid, varid, 'Value_6', StrVal6    
+  ncdf_attget, ncid, varid, 'Value_7', StrVal7
+  StrVal=[StrVal0, StrVal1, StrVal2, StrVal3, StrVal4, $
+  	StrVal5, StrVal6, StrVal7]    
+  for ival = 0, 7 do begin
+    pts = where(Sats eq ival, count)
+    if count gt 0 then strSats(pts) = StrVal(ival)
+  endfor
+  endif
+
+  varid = ncdf_varid(ncid, 'SLA')
+  ncdf_varget, ncid, varid, obsval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  scale_factor=1.
+  add_offset=0.
+  ;if (ncinfo.ndims gt 2) then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+  ncviq=ncdf_varinq(ncid, varid)
+  for iatt=0,ncviq.natts-1 do begin
+    ncaiq=ncdf_attname(ncid, varid, iatt)
+    if ( ncaiq eq 'scale_factor') then ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    if ( ncaiq eq 'add_factor') then ncdf_attget, ncid, varid, 'add_factor', add_factor
+  endfor
+
+  if not keyword_set(quiet) then print,'SLA scale factor: ',scale_factor
+  if not keyword_set(quiet) then print,'SLA add offset: ',add_offset
+  if not keyword_set(quiet) then print,'SLA FillValue: ',FillValue
+  pts = where(obsval eq FillValue, count)
+;  if not keyword_set(quiet) then print,count
+  obsval=obsval*scale_factor+add_offset
+  if count gt 0 then obsval(pts) = rmdi
+  
+  varid = ncdf_varid(ncid, 'SLA_Hx')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, modval
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+;  if not keyword_set(quiet) then print,'SLA_Hx FillValue ',FillValue
+  pts = where(modval eq FillValue or modval eq -9999.0, count)
+;  if not keyword_set(quiet) then print,count
+  if count gt 0 then modval(pts) = rmdi
+  endif
+    
+  varid = ncdf_varid(ncid, 'SLA_QC')
+  if (varid ne -1) then begin
+  ncdf_varget, ncid, varid, bytQC
+  ncdf_attget, ncid, varid, '_FillValue', FillValue
+  QC(*) = 0.
+  pts = where(bytQC eq FillValue, count)
+  if count gt 0 then QC(pts) = rmdi
+  pts = where(bytQC ne 48, count)
+  if count gt 0 then QC(pts) = 1.
+  endif
+  
+  varid = ncdf_varid(ncid, 'MDT')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mdtval
+
+  varid = ncdf_varid(ncid, 'data_source')
+  if varid ne -1 then begin
+     ncdf_varget, ncid, varid, obstyp
+  endif else begin
+     varid = ncdf_varid(ncid, 'MISSION')
+     if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+; reads in multi cycle data the wrong way round!
+  if (cycles gt 1) then begin
+      obsval=reform(obsval,[cycles,ndata/cycles])
+      obsval=transpose(obsval)
+      modval=reform(modval,[cycles,ndata/cycles])
+      modval=transpose(modval)
+      QC=reform(QC,[cycles,ndata/cycles])
+      QC=transpose(QC)
+  endif
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsval
+
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsval
+
+  varid = ncdf_varid(ncid, 'MSTP')
+  if (varid ne -1) then ncdf_varget, ncid, varid, mstpval
+
+;  info, obssla
+;  info, obsval
+;  info, modsla
+;  info, modval
+ 
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSLA = [obsval(*)]
+    ModSLA = [modval(*)]
+    MDT = [mdtval]
+    SLAQC = [QC]
+    Dates = [dts]
+    Satellites = [strSats]
+    if (n_elements(obstyp) gt 0) then Types = [obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobsval]
+   if (n_elements(mstpval) gt 0) then mstp = [mstpval]
+   if (n_elements(trackval) gt 0) then track = [trackval]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSLA = [ObsSLA, obsval(*)]
+    ModSLA = [ModSLA, modval(*)]
+    MDT = [MDT, mdtval]    
+    SLAQC = [SLAQC, QC]
+    Dates = [Dates, dts]    
+    Satellites = [Satellites, strSats]
+    if (n_elements(obstyp) gt 0) then Types = [Types, obstyp]
+    if (n_elements(iobsval) gt 0) then iobs = [iobs, iobsval]
+    if (n_elements(jobsval) gt 0) then jobs = [jobs, jobsval]
+    if (n_elements(mstpval) gt 0) then mstp = [mstp, mstpval]
+    if (n_elements(trackval) gt 0) then tracks = [track, trackval]
+  endelse      
+
+ifile2=ifile2+1
+endif
+  ncdf_close, ncid
+
+endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/dataplot/read_sst.pro	(revision 3294)
@@ -0,0 +1,193 @@
+PRO  read_sst, Files, NumObs=NumObs, $
+               Latitudes=Latitudes, Longitudes=Longitudes, $
+               ObsSST=ObsSST, ModSST=ModSST, SSTQC=SSTQC, $
+               Dates=Dates, rmdi=rmdi, Types=Types, iobs=iobs, jobs=jobs, $
+               quiet=quiet
+;------------------------------------------------------------
+;IDL program to read in netcdf files of altimeter data.
+;
+;Author:  D. J. Lea        - Feb 2008
+;
+;------------------------------------------------------------
+rmdi = -99999.
+NumFiles=n_elements(Files)
+;print,NumFiles
+;RefDate = '1950-01-01'
+;!DATE_SEPARATOR='-'
+RefDate=JULDAY(1,1,1950,0,0)    ; should be at 0 UTC
+ifile2=0
+for ifile = 0, NumFiles-1 do begin
+;------------------------------------------------------------
+;1. Open the file containing the data
+  ncid = ncdf_open(Files(ifile), /nowrite)
+  if ncid lt 0 and not keyword_set(quiet) then print, 'Error opening file '+Files(ifile)
+  if ncid ge 0 then begin
+  if not keyword_set(quiet) then print, 'Opened file '+Files(ifile)+' successfully'
+
+;------------------------------------------------------------
+;2. Read in the dimensions in the file
+  ncinfo = ncdf_inquire(ncid)
+
+  if ncinfo.Ndims eq 1 then begin
+    ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 2 then begin
+    ncdf_diminq, ncid, 1, name, NData
+    if (name eq "string8") then  ncdf_diminq, ncid, 0, name, NData
+  endif else if ncinfo.Ndims eq 3 then begin
+    ncdf_diminq, ncid, 1, name, NLats
+    ncdf_diminq, ncid, 2, name, NLons
+    NData = NLats * NLons
+  endif
+    
+  if not keyword_set(quiet) then print, 'Number of SST data points ',NData
+  
+  if (NData gt 0) then begin
+;------------------------------------------------------------
+;3. Allocate the data arrays and read in the data
+  lons   = dblarr(NData)
+  lats   = dblarr(NData)
+  obsval = fltarr(NData)
+  modval = fltarr(NData)
+  bytQC  = bytarr(NData)
+  QC     = fltarr(NData)
+  obstyp = intarr(NData)  
+  Dats   = dblarr(NData)
+  dts    = replicate(!dt_base, NData)
+  iobsa = intarr(NData)
+  jobsa = intarr(NData)
+  
+  varid = ncdf_varid(ncid, 'LONGITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lons $
+  else begin
+    varid = ncdf_varid(ncid, 'lon')
+    ncdf_varget, ncid, varid, lons
+  endelse
+  
+  varid = ncdf_varid(ncid, 'LATITUDE')
+  if varid ne -1 then ncdf_varget, ncid, varid, lats $
+  else begin
+    varid = ncdf_varid(ncid, 'lat')
+    ncdf_varget, ncid, varid, lats
+  endelse
+  
+  varid = ncdf_varid(ncid, 'JULD')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, Dats
+    dts=RefDate + Dats
+    
+  endif else begin
+    varid = ncdf_varid(ncid, 'time')
+    ncdf_varget, ncid, varid, secs_from_base
+    varid = ncdf_varid(ncid, 'sst_dtime')
+    ncdf_varget, ncid, varid, dtime
+    ncdf_attget, ncid, varid, 'scale_factor', scale_factor
+    dtime=dtime*scale_factor
+;    RefDate = '1981-01-01'
+    RefDate = JULDAY(1,1,1981,0,0)	; should be ref from 0 UTC
+    dtime = dtime + secs_from_base
+    dts = RefDate + dtime/86400.
+  endelse
+        
+  varid = ncdf_varid(ncid, 'SST')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)        ;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endif else begin
+    varid = ncdf_varid(ncid, 'sea_surface_temperature')
+    ncdf_varget, ncid, varid, obsval
+    obsval=float(obsval)	;ensure obsval is a floating point array
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    ncdf_attget, ncid, varid, 'add_offset', Offset
+    ncdf_attget, ncid, varid, 'scale_factor', Scale
+    pts = where(obsval ne FillValue, count)
+    if count gt 0 then obsval(pts) = Offset + (obsval(pts) *Scale)
+    pts = where(obsval eq FillValue, count)
+    if count gt 0 then obsval(pts) = rmdi
+  endelse
+
+  varid = ncdf_varid(ncid, 'SST_Hx')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, modval
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    pts = where(modval eq FillValue, count)
+    if count gt 0 then modval(pts) = rmdi
+  endif
+      
+  varid = ncdf_varid(ncid, 'SST_QC')
+  if varid ne -1 then begin
+    ncdf_varget, ncid, varid, bytQC
+    ncdf_attget, ncid, varid, '_FillValue', FillValue
+    QC(*) = 0.
+    pts = where(bytQC eq FillValue, count)
+    if count gt 0 then QC(pts) = rmdi
+    pts = where(bytQC ne 48, count)
+    if count gt 0 then QC(pts) = bytQC(pts)-48
+  endif else begin
+    varid = ncdf_varid(ncid, 'confidence_flag')
+    ncdf_varget, ncid, varid, bytQC
+    QC = float(bytQC)
+  endelse
+      
+  varid = ncdf_varid(ncid, 'SST_DATA_SOURCE')
+  if varid ne -1 then ncdf_varget, ncid, varid, obstyp $
+  else begin
+    varid = ncdf_varid(ncid, 'data_source')
+    if varid ne -1 then ncdf_varget, ncid, varid, obstyp
+  endelse
+
+  varid = ncdf_varid(ncid, 'callsign')
+  if varid ne -1 then begin 
+  	ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+  endif else begin
+   varid = ncdf_varid(ncid, 'SST_CALL_SIGN')
+   if varid ne -1 then begin 
+      ncdf_varget, ncid, varid, callsign
+        tmp=strtrim(string(obstyp),2)+' '+strtrim(string(callsign),2)
+        obstyp=tmp
+   endif
+  endelse
+
+  varid = ncdf_varid(ncid, 'IOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, iobsa
+  
+  varid = ncdf_varid(ncid, 'JOBS')
+  if (varid ne -1) then ncdf_varget, ncid, varid, jobsa
+      
+  if ifile2 eq 0 then begin
+    Latitudes = [float(lats)]
+    Longitudes = [float(lons)]
+    ObsSST = [obsval]
+    ModSST = [modval]
+    SSTQC = [QC]
+    Dates = [dts]
+    Types = [obstyp]
+    iobs = [iobsa]
+    jobs = [jobsa]
+  endif else begin
+    Latitudes = [Latitudes, float(lats)]
+    Longitudes = [Longitudes, float(lons)]
+    ObsSST = [ObsSST, obsval]
+    ModSST = [ModSST, modval]
+    SSTQC = [SSTQC, QC]
+    Dates = [Dates, dts]    
+    Types = [Types, obstyp]
+    iobs = [iobs, iobsa]
+    jobs = [jobs, jobsa]       
+  endelse      
+
+  ifile2=ifile2+1
+  endif
+  ncdf_close, ncid
+
+  endif
+
+endfor ; ifile  
+  
+NumObs = n_elements(Latitudes)
+
+END
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/convmerge.F90	(revision 3294)
@@ -0,0 +1,131 @@
+MODULE convmerge
+
+   USE toolspar_kind
+   USE obs_fbm
+   USE obs_utils
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE conv_fbmerge( cdoutfile, nfiles, fbdata )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE conv_fbmerg **
+      !!
+      !!  ** Purpose : Merge all fbfiles into a single fbfile
+      !!
+      !!  ** Method  : Use of utilities from obs_fbm.
+      !!
+      !!  ** Action  :
+      !!
+      !!   Optional :
+      !!     namelist = namobs.in    to select the observation range 
+      !!
+      !!   History :
+      !!        ! 2010 (K. Mogensen) Initial version
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(LEN=*) :: cdoutfile                ! Input file.
+      INTEGER :: nfiles                            ! Number of files
+      TYPE(obfbdata), dimension(nfiles) :: fbdata  ! Structure to merge
+      !! * Local variables
+      type(obfbdata) :: fbmerge
+      INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+      INTEGER :: nmaxlev
+      INTEGER :: ia,ij,ii
+      REAL(fbdp), DIMENSION(nfiles) :: djulini, djulend
+      CHARACTER(len=8) :: cl_refdate
+      INTEGER :: irefdate,iyea,imon,iday,ihou,imin,isec
+      ! Namelist variables
+      CHARACTER(len=9) :: cdnamefile='namobs.in'
+      LOGICAL :: lexists 
+      REAL(fbdp) :: dobsini,dobsend
+      NAMELIST/namobs/dobsini,dobsend
+      
+      dobsini = 0.0
+      dobsend = 99991231.235959
+
+      INQUIRE(file=cdnamefile, exist=lexists)
+      IF (lexists) THEN
+         OPEN(10,file=cdnamefile)
+         READ(10,namobs)
+         WRITE(*,namobs)
+         CLOSE(10)
+      ENDIF
+      !
+      ! Count number of data points
+      !
+      nmaxlev = 1
+      ii = 0
+      DO ia = 1,nfiles
+         IF (lexists) THEN
+            cl_refdate=fbdata(ia)%cdjuldref(1:8)
+            READ(cl_refdate,'(I8)') irefdate
+            CALL ddatetoymdhms( dobsini, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulini(ia), &
+               &           krefdate = irefdate )
+            CALL ddatetoymdhms( dobsend, iyea, imon, iday, ihou, imin, isec )
+            CALL greg2jul( isec, imin, ihou, iday, imon, iyea, djulend(ia), &
+            &           krefdate = irefdate )
+            DO ij = 1, fbdata(ia)%nobs
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+               ENDIF
+            ENDDO
+         ELSE
+            nmaxlev = MAX(nmaxlev,fbdata(ia)%nlev)
+            ii = ii + fbdata(ia)%nobs
+         ENDIF
+      ENDDO
+      !
+      ! Merge the input structures into the output structure
+      !
+      ALLOCATE( iset(ii), inum(ii), iindex(ii))
+      ii = 0
+      DO ia = 1,nfiles
+         DO ij = 1, fbdata(ia)%nobs
+            IF (lexists) THEN
+               IF ( ( fbdata(ia)%ptim(ij) >  djulini(ia) ) .AND. &
+                  & ( fbdata(ia)%ptim(ij) <= djulend(ia) ) ) THEN
+                  ii = ii + 1
+                  iset(ii)   = ia
+                  inum(ii)   = ij
+                  iindex(ii) = ii
+               ENDIF
+            ELSE
+               ii = ii + 1
+               iset(ii)   = ia
+               inum(ii)   = ij
+               iindex(ii) = ii
+            ENDIF
+         ENDDO
+      ENDDO
+      WRITE(*,*)'Output number of observations = ',ii
+      WRITE(*,*)'Output number of levels       = ',nmaxlev
+      !
+      ! Prepare fbmerge structure
+      !
+      CALL init_obfbdata( fbmerge )
+      CALL alloc_obfbdata( fbmerge, fbdata(1)%nvar, ii, nmaxlev, &
+         &                 fbdata(1)%nadd, fbdata(1)%next, fbdata(1)%lgrid )
+      CALL merge_obfbdata( nfiles, fbdata, fbmerge, iset, inum, iindex )
+      !
+      ! Write the file
+      !
+      CALL write_obfbdata( TRIM(cdoutfile), fbmerge )
+      !
+      ! Dellocate the data
+      !
+      CALL dealloc_obfbdata( fbmerge )
+
+   END SUBROUTINE conv_fbmerge
+
+#include "ctl_stop.h90"
+
+#include "greg2jul.h90"
+
+!#include "ddatetoymdhms.h90"
+
+END MODULE convmerge
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/coords.F90	(revision 3294)
@@ -0,0 +1,1025 @@
+MODULE coords
+
+   IMPLICIT NONE
+
+   INTEGER, PARAMETER     :: nsech = 167
+   CHARACTER(len=20), DIMENSION(nsech)  :: cl_sech = (/ &
+      & 'global              ',  &
+      & 'nstrpac             ',  &
+      & 'sstrpac             ',  &
+      & 'npac                ',  &
+      & 'spac                ',  &
+      & 'trpac               ',  &
+      & 'natl                ',  &
+      & 'satl                ',  &
+      & 'tratl               ',  &
+      & 'nstratl             ',  &
+      & 'sstratl             ',  &
+      & 'neatl               ',  &
+      & 'nwatl               ',  &
+      & 'equa                ',  &
+      & 'nino1               ',  &
+      & 'nino2               ',  &
+      & 'nino12              ',  &
+      & 'nino3               ',  &
+      & 'nino4               ',  &
+      & 'nino34              ',  &
+      & 'ind1                ',  &
+      & 'ind2                ',  &
+      & 'ind3                ',  &
+      & 'eq1                 ',  &
+      & 'eq2                 ',  &
+      & 'eq3                 ',  &
+      & 'eq4                 ',  &
+      & 'neq1                ',  &
+      & 'neq2                ',  &
+      & 'neq3                ',  &
+      & 'neq4                ',  &
+      & 'eqpac               ',  &
+      & 'eqind               ',  &
+      & 'atl1                ',  &
+      & 'atl2                ',  &
+      & 'atl3                ',  &
+      & 'eqatl               ',  &
+      & 'trop                ',  &
+      & 'nxtrp               ',  &
+      & 'sxtrp               ',  &
+      & 'trind               ',  &
+      & 'sind                ',  &
+      & 'nepac               ',  &
+      & 'nwpac               ',  &
+      & 'trepac              ',  &
+      & 'trwpac              ',  &
+      & 'p15n38w             ',  &
+      & 'p12n38w             ',  &
+      & 'p8n38w              ',  &
+      & 'p4n38w              ',  &
+      & 'p0n35w              ',  &
+      & 'p21n23w             ',  &
+      & 'p12n23w             ',  &
+      & 'p4n23w              ',  &
+      & 'p0n23w              ',  &
+      & 'p0n10w              ',  &
+      & 'p0n0w               ',  &
+      & 'p5s10w              ',  &
+      & 'p10s10w             ',  &
+      & 't0n156e             ',  &
+      & 't0n165e             ',  &
+      & 't0n180e             ',  &
+      & 't0n170w             ',  &
+      & 't0n155w             ',  &
+      & 't0n140w             ',  &
+      & 't0n125w             ',  &
+      & 't0n110w             ',  &
+      & 't0n95w              ',  &
+      & 't5n156e             ',  &
+      & 't5s156e             ',  &
+      & 't5n165e             ',  &
+      & 't5n180e             ',  &
+      & 't5n170w             ',  &
+      & 't5n155w             ',  &
+      & 't5n140w             ',  &
+      & 't5n125w             ',  &
+      & 't5n110w             ',  &
+      & 't5n95w              ',  &
+      & 't5s165e             ',  &
+      & 't5s180e             ',  &
+      & 't5s170w             ',  &
+      & 't5s155w             ',  &
+      & 't5s140w             ',  &
+      & 't5s125w             ',  &
+      & 't5s110w             ',  &
+      & 't5s95w              ',  &
+      & 'r8s55e              ',  &
+      & 'r12s55e             ',  &
+      & 'r4s67e              ',  &
+      & 'r8s67e              ',  &
+      & 'r12s67e             ',  &
+      & 'r0n80e              ',  &
+      & 'r4s80e              ',  &
+      & 'r12s80e             ',  &
+      & 'r12n90e             ',  &
+      & 'r8n90e              ',  &
+      & 'r4n90e              ',  &
+      & 'r0n90e              ',  &
+      & 'r5s95e              ',  &
+      & 'r8s95e              ',  &
+      & 'r8s100e             ',  &
+      & 'NE_subtrop_pac      ',  &
+      & 'NW_subtrop_pac      ',  &
+      & 'NE_extratrop_pac    ',  &
+      & 'NW_extratrop_pac    ',  &
+      & 'SE_subtrop_pac      ',  &
+      & 'SW_subtrop_pac      ',  &
+      & 'NE_subtrop_atl      ',  &
+      & 'NW_subtrop_atl      ',  &
+      & 'NE_extratrop_atl    ',  &
+      & 'NW_extratrop_atl    ',  &
+      & 'SE_subtrop_atl      ',  &
+      & 'SW_subtrop_atl      ',  &
+      & 'SE_subtrop_ind      ',  &
+      & 'SW_subtrop_ind      ',  &
+      & 'Southern_ocean_pac  ',  &
+      & 'Southern_ocean_atl  ',  &
+      & 'Southern_ocean_ind  ',  &
+      & 'GLOBAL05            ',  &
+      & 'GLOBAL10            ',  &
+      & 'GLOBAL15            ',  &
+      & 'GLOBAL20            ',  &
+      & 'GLOBAL25            ',  &
+      & 'GLOBAL30            ',  &
+      & 'GLOBAL40            ',  &
+      & 'GLOBAL50            ',  &
+      & 'GLOBAL60            ',  &
+      & 'ARCTIC              ',  &
+      & 'ATL60NA             ',  &
+      & 'ATL50NA             ',  &
+      & 'ATL40NA             ',  &
+      & 'ATL35NA             ',  &
+      & 'ATL30NA             ',  &
+      & 'ATL26NA             ',  &
+      & 'ATL10NA             ',  &
+      & 'ATLEQA              ',  &
+      & 'ATL10SA             ',  &
+      & 'ATL20SA             ',  &
+      & 'ATL30SA             ',  &
+      & 'PAC60NA             ',  &
+      & 'PAC50NA             ',  &
+      & 'PAC40NA             ',  &
+      & 'PAC35NA             ',  &
+      & 'PAC30NA             ',  &
+      & 'PAC20NA             ',  &
+      & 'PAC10NA             ',  &
+      & 'PACEQA              ',  &
+      & 'INP10SA             ',  &
+      & 'PAC20SA             ',  &
+      & 'PAC30SA             ',  &
+      & 'INDEQA              ',  &
+      & 'IND20SA             ',  &
+      & 'IND30SA             ',  &
+      & 'GLB60NA             ',  &
+      & 'GLB50NA             ',  &
+      & 'GLB40NA             ',  &
+      & 'GLB30NA             ',  &
+      & 'GLB20NA             ',  &
+      & 'GLB10NA             ',  &
+      & 'GLBEQA              ',  &
+      & 'GLB10SA             ',  &
+      & 'GLB20SA             ',  &
+      & 'GLB30SA             ',  &
+      & 'GLB40SA             ',  &
+      & 'GLB50SA             ',  &
+      & 'GLB60SA             ',  &
+      & 'npac25              '  &
+      & /)
+
+   ! User defined areas
+   INTEGER :: nboxuser
+   CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes_user
+   REAL, DIMENSION(:,:), ALLOCATABLE :: areas
+
+   ! zonal sections
+   INTEGER, PARAMETER     :: nsecz = 50
+   CHARACTER(len=20), DIMENSION(nsecz)  :: cl_secz = (/ &
+      & 'LOMBOK              ',  &
+      & 'BANDA               ',  &
+      & 'MAKASSAR            ',  &
+      & 'SAVU                ',  &
+      & 'MALACCAS            ',  &
+      & 'PHILIPINES          ',  &
+      & 'YUCATAN             ',  &
+      & 'GIN                 ',  &
+      & 'LABRADOR            ',  &
+      & 'ATL60N              ',  &
+      & 'ATL50N              ',  &
+      & 'ATL40N              ',  &
+      & 'ATL35N              ',  &
+      & 'ATL30N              ',  &
+      & 'ATL27N              ',  &
+      & 'ATL26N              ',  &
+      & 'ATL10N              ',  &
+      & 'ATLEQ               ',  &
+      & 'ATL10S              ',  &
+      & 'ATL20S              ',  &
+      & 'ATL30S              ',  &
+      & 'PAC60N              ',  &
+      & 'PAC50N              ',  &
+      & 'PAC40N              ',  &
+      & 'PAC35N              ',  &
+      & 'PAC30N              ',  &
+      & 'PAC25N              ',  &
+      & 'PAC20N              ',  &
+      & 'PAC10N              ',  &
+      & 'PACEQ               ',  &
+      & 'INP10S              ',  &
+      & 'PAC20S              ',  &
+      & 'PAC30S              ',  &
+      & 'INDEQ               ',  &
+      & 'IND20S              ',  &
+      & 'IND30S              ',  &
+      & 'GLB60N              ',  &
+      & 'GLB50N              ',  &
+      & 'GLB40N              ',  &
+      & 'GLB30N              ',  &
+      & 'GLB20N              ',  &
+      & 'GLB10N              ',  &
+      & 'GLBEQ               ',  &
+      & 'GLB10S              ',  &
+      & 'GLB20S              ',  &
+      & 'GLB30S              ',  &
+      & 'GLB40S              ',  &
+      & 'GLB50S              ',  &
+      & 'GLB60S              ',  &
+      & 'SUM-DARWIN          '   &
+      & /)
+
+   ! meridional sections
+   INTEGER, PARAMETER     :: nsecm = 10
+   CHARACTER(len=20), DIMENSION(nsecm)  :: cl_secm = (/ &
+      & 'IT                  ',  &
+      & 'ITA                 ',  &
+      & 'TIMOR               ',  &
+!      & 'OMBAI               ',  &
+!      & 'SUMBA               ',  &
+!      & 'LUZON               ',  &
+      & 'DRAKE               ',  &
+      & 'TORRES              ',  &
+      & 'MED                 ',  &
+      & 'FLORIDA             ',  &
+      & 'ANTILLAS            ',  &
+      & 'GOODHOPE            ', &
+      & 'SOUTHAUS            '   &
+      & /)
+
+CONTAINS
+
+   SUBROUTINE coord_area( reg, area )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    Define coordinates of different regions 
+      !
+      !   Modifications :
+      !   -------------
+      !
+      !      SEE: /home/rd/ocx/postp/NEWGRIB/regions.txt 
+      !      and  /home/rd/nep/sms/verify/automat/include/regions.h
+      !
+      !      modification     : 04-09 (N. Daget)
+      !      modification     : 04-09 (N. Daget) add new regions
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      !
+      reg=TRIM(reg)
+      ! 
+      SELECT CASE (reg)
+      CASE ('global')
+         area = (/0.,360.,-90.,90./)
+      CASE ('nstrpac')
+         area = (/105.,270.,10.,30./)
+      CASE ('sstrpac')
+         area = (/105.,270.,-30.,-10./)
+      CASE ('npac')    
+         area = (/100.,260.,30.,70./)
+      CASE ('spac')
+         area = (/150.,290.,-70.,-30./)
+      CASE ('trpac')   
+         area = (/125.,280.,-30.,30./)
+      CASE ('natl')
+         area = (/290.,15.,30.,70./)
+      CASE ('satl')
+         area = (/290.,20.,-70.,-30./)
+      CASE ('tratl')
+         area = (/280.,20.,-20.,30./)
+      CASE ('nstratl')
+         area = (/280.,20.,5.,28./)
+      CASE ('sstratl')
+         area = (/300.,20.,-20.,5./)
+      CASE ('neatl')
+         area = (/320.,15.,30.,70./)
+      CASE ('nwatl')
+         area = (/260.,320.,30.,70./)
+      CASE ('equa')
+         area = (/0.,360.,-2.,2./)
+      CASE ('nino1')
+         area = (/270.,280.,-10.,-5./)
+      CASE ('nino2')
+         area = (/270.,280.,-5.,0./)
+      CASE ('nino12')
+         area = (/270.,280.,-10.,0./)
+      CASE ('nino3')
+         area = (/210.,270.,-5.,5./)
+      CASE ('nino4')
+         area = (/160.,210.,-5.,5./)
+      CASE ('nino34')
+         area = (/190.,240.,-5.,5./)
+      CASE ('ind1')
+         area = (/50.,70.,-10.,10./)
+      CASE ('ind2')
+         area = (/90.,110.,-10.,0./)
+      CASE ('ind3')
+         area = (/50.,90.,-10.,0./)
+      CASE ('eq1')
+         area = (/230.,270.,-5.,5./)
+      CASE ('eq2')
+         area = (/190.,230.,-5.,5./)
+      CASE ('eq3')
+         area = (/150.,190.,-5.,5./)
+      CASE ('eq4')
+         area = (/120.,150.,-5.,5./)
+      CASE ('neq1')
+         area = (/230.,270.,5.,15./)
+      CASE ('neq2')
+         area = (/190.,230.,5.,15./)
+      CASE ('neq3')
+         area = (/150.,190.,5.,15./)
+      CASE ('neq4')
+         area = (/120.,150.,5.,15./)
+      CASE ('eqpac')
+         area = (/130.,280.,-5.,5./)
+      CASE ('eqind')
+         area = (/40.,120.,-5.,5./)
+      CASE ('atl1')
+         area = (/315.,340.,0.,10./)
+      CASE ('atl2')
+         area = (/0.,10.,-3.,3./)
+      CASE ('atl3')
+         area = (/340.,360.,-3.,3./)
+      CASE ('eqatl')
+         area = (/290.,30.,-5.,5./)
+      CASE ('trop')
+         area = (/0.,360.,-30.,30./)      ! Tropics (second definition)
+      CASE ('nxtrp')
+         area = (/0.,360.,30.,70./)     ! Northern Extratropics
+      CASE ('sxtrp')
+         area = (/0.,360.,-70.,-30./)   ! Southern Extratropics
+      CASE ('trind')
+         area = (/40.,120.,-30.,30./)
+      CASE ('sind')
+         area = (/20.,150.,-70.,-30./)
+      CASE ('nepac')
+         area = (/210.,260.,30.,70./)
+      CASE ('nwpac')
+         area = (/100.,210.,30.,70./)
+      CASE ('trepac')
+         area = (/210.,270.,-30.,30./)
+      CASE ('trwpac')
+         area = (/100.,210.,-30.,30./)
+     ! PIRATA
+      CASE ('p20n38w') 
+         area = (/321.,323.,19.,21./)
+      CASE ('p15n38w') 
+         area = (/321.,323.,14.,16./)
+      CASE ('p12n38w') 
+         area = (/321.,323.,11.,13./)
+      CASE ('p8n38w') 
+         area = (/321.,323.,7.,9./)
+      CASE ('p4n38w') 
+         area = (/321.,323.,3.,5./)
+      CASE ('p0n35w') 
+         area = (/324.,326.,-0.5,0.5/)
+      CASE ('p21n23w') 
+         area = (/336.,338.,20.,22./)
+      CASE ('p12n23w') 
+         area = (/336.,338.,11.,13./)
+      CASE ('p4n23w') 
+         area = (/336.,338.,3.,5./)
+      CASE ('p0n23w') 
+         area = (/336.,338.,-0.5,0.5/)
+      CASE ('p0n10w') 
+         area = (/349.,351.,-0.5,0.5/)
+      CASE ('p0n0w') 
+         area = (/359.,1.,-0.5,0.5/)
+      CASE ('p5s10w') 
+         area = (/349.,351.,-6.,-4./)
+      CASE ('p10s10w') 
+         area = (/349.,351.,-11.,-9./)
+
+      ! TAO
+      CASE ('t0n156e') 
+         area = (/155.,157.,-0.5,0.5/)
+      CASE ('t0n165e') 
+         area = (/164.,166.,-0.5,0.5/)
+      CASE ('t0n180e') 
+         area = (/179.,181.,-0.5,0.5/)
+      CASE ('t0n170w') 
+         area = (/189.,191.,-0.5,0.5/)
+      CASE ('t0n155w') 
+         area = (/204.,206.,-0.5,0.5/)
+      CASE ('t0n140w')
+         area = (/219.,221.,-0.5,0.5/)
+      CASE ('t0n125w')
+         area = (/234.,236.,-0.5,0.5/)
+      CASE ('t0n110w')
+         area = (/249.,251.,-0.5,0.5/)
+      CASE ('t0n95w')
+         area = (/264.,266.,-0.5,0.5/)
+      CASE ('t5n156e')
+         area = (/155.,157.,4.5,5.5/)
+      CASE ('t5n165e')
+         area = (/164.,166.,4.5,5.5/)
+      CASE ('t5n180e')
+         area = (/179.,181.,4.5,5.5/)
+      CASE ('t5n170w')
+         area = (/189.,191.,4.5,5.5/)
+      CASE ('t5n155w') 
+         area = (/204.,206.,4.5,5.5/)
+      CASE ('t5n140w')
+         area = (/219.,221.,4.5,5.5/)
+      CASE ('t5n125w')
+         area = (/234.,236.,4.5,5.5/)
+      CASE ('t5n110w')
+         area = (/249.,251.,4.5,5.5/)
+      CASE ('t5n95w')
+         area = (/264.,266.,4.5,5.5/)
+      CASE ('t5s156e')
+         area = (/155.,157.,-5.5,-5.5/)
+      CASE ('t5s165e')
+         area = (/164.,166.,-5.5,4.5/)
+      CASE ('t5s180e')
+         area = (/179.,181.,-5.5,-4.5/)
+      CASE ('t5s170w')
+         area = (/189.,191.,-5.5,-4.5/)
+      CASE ('t5s155w') 
+         area = (/204.,206.,-5.5,-4.5/)
+      CASE ('t5s140w')
+         area = (/219.,221.,-5.5,-4.5/)
+      CASE ('t5s125w')
+         area = (/234.,236.,-5.5,-4.5/)
+      CASE ('t5s110w')
+         area = (/249.,251.,-5.5,-4.5/)
+      CASE ('t5s95w')
+         area = (/264.,266.,-5.5,-4.5/)
+      !RAMA
+      CASE ('r8s55e')
+         area = (/54.,56.,-8.,-7./)
+      CASE ('r12s55e')
+         area = (/54.,56.,-13.,-11./)
+      CASE ('r4s67e')
+         area = (/66.,68.,-4.5,-3.5/)
+      CASE ('r8s67e')
+         area = (/66.,68.,-9.,-7./)
+      CASE ('r12s67e')
+         area = (/66.,68.,-13.,-11./)
+      CASE ('r0n80e')
+         area = (/79.,81.,-0.5,0.5/)
+      CASE ('r4s80e')
+         area = (/79.,81.,-4.5,-3.5/)
+      CASE ('r8s80e')
+         area = (/79.,81.,-9.,-7./)
+      CASE ('r12s80e')
+         area = (/79.,81.,-13.,-11./)
+      CASE ('r12n90e')
+         area = (/89.,91.,11.,13./)
+      CASE ('r8n90e')
+         area = (/89.,91.,7.,9./)
+      CASE ('r4n90e')
+         area = (/89.,91.,3.5,4.5/)
+      CASE ('r0n90e')
+         area = (/89.,91.,-0.5,0.5/)
+      CASE ('r5s95e')
+         area = (/94.,96.,-5.5,-4.5/)
+      CASE ('r8s95e')
+         area = (/94.,96.,-9.,-7./)
+      CASE ('r8s100e')
+         area = (/99.,101.,-9.,-7./)
+
+
+      ! ENACT
+      CASE ('NE_subtrop_pac')
+         area = (/190.,260.,10.,30./)
+      CASE ('NW_subtrop_pac')
+         area = (/120.,190.,10.,30./)
+      CASE ('NE_extratrop_pac')
+         area = (/190.,250.,30.,60./)
+      CASE ('NW_extratrop_pac')
+         area = (/120.,190.,30.,60./)
+      CASE ('SE_subtrop_pac')
+         area = (/200.,300.,-30.,-10./)
+      CASE ('SW_subtrop_pac')
+         area = (/143.,200.,-30.,-10./)
+      CASE ('NE_subtrop_atl')
+         area = (/320.,355.,10.,30./)
+      CASE ('NW_subtrop_atl')
+         area = (/283.,320.,10.,30./)
+      CASE ('NE_extratrop_atl')
+         area = (/320.,360.,30.,60./)
+      CASE ('NW_extratrop_atl')
+         area = (/285.,320.,30.,60./)
+      CASE ('SE_subtrop_atl')
+         area = (/350.,20.,-30.,-10./)
+      CASE ('SW_subtrop_atl')
+         area = (/300.,350.,-30.,-10./)
+      CASE ('SE_subtrop_ind')
+         area = (/80.,120.,-30.,-10./)
+      CASE ('SW_subtrop_ind')
+         area = (/30.,80.,-30.,-10./)
+      CASE ('Southern_ocean_pac')
+         area = (/130.,290.,-80.,-30./)
+      CASE ('Southern_ocean_atl')
+         area = (/290.,20.,-80.,-30./)
+      CASE ('Southern_ocean_ind')
+         area = (/20.,130.,-80.,-30./)
+      ! Global areas different latitudes
+      CASE ('GLOBAL05')
+         area = (/0.,360.,-5.,5./)
+      CASE ('GLOBAL10')
+         area = (/0.,360.,-10.,10./)
+      CASE ('GLOBAL15')
+         area = (/0.,360.,-15.,15./)
+      CASE ('GLOBAL20')
+         area = (/0.,360.,-20.,20./)
+      CASE ('GLOBAL25')
+         area = (/0.,360.,-25.,25./)
+      CASE ('GLOBAL30')
+         area = (/0.,360.,-30.,30./)
+      CASE ('GLOBAL40')
+         area = (/0.,360.,-40.,40./)
+      CASE ('GLOBAL50')
+         area = (/0.,360.,-50.,50./)
+      CASE ('GLOBAL60')
+         area = (/0.,360.,-60.,60./)
+      CASE ('ARCTIC')
+         area = (/0.,360.,65.,90./)
+      CASE  ('ATL60NA')
+         area=(/260.,9.13,59.,61./) 
+      CASE  ('ATL50NA')
+         area=(/260.,5.,49.,51./) 
+      CASE  ('ATL40NA')
+         area=(/260.,358.,39.,41./) 
+      CASE  ('ATL35NA')
+         area=(/260.,360.,34.,36./) 
+      CASE  ('ATL30NA')
+         area=(/260.,360.,29.,31./) 
+      CASE  ('ATL26NA')
+         area=(/260.,360.,25.,27./) 
+      CASE  ('ATL20NA')
+         area=(/260.,360.,19.,21./) 
+      CASE  ('ATL10NA')
+         area=(/290.,360.,9.,11./) 
+      CASE  ('ATLEQA')
+         area=(/289.,11.,-1.,1./) 
+      CASE  ('ATL10SA')
+         area=(/320.,15.,-11.,-9./) 
+      CASE  ('ATL20SA')
+         area=(/318.,15.,-21.,-19./) 
+      CASE  ('ATL30SA')
+         area=(/310.,20.,-31.,-29./) 
+      CASE  ('PAC60NA')
+         area=(/140.,250.,59.,61./) 
+      CASE  ('PAC50NA')
+         area=(/130.,240.,49.,51./) 
+      CASE  ('PAC40NA')
+         area=(/125.,240.,39.,41./) 
+      CASE  ('PAC35NA')
+         area=(/115.,242.,34.,36./) 
+      CASE  ('PAC30NA')
+         area=(/115.,250.,29.,31./) 
+      CASE  ('PAC20NA')
+         area=(/100.,260.,19.,21./) 
+      CASE  ('PAC10NA')
+         area=(/105.,275.,9.,11./) 
+      CASE  ('PACEQA')
+         area=(/115.,282.,-1.,1./) 
+      CASE  ('INP10SA')
+         area=(/35.,290.,-11.,-9./) 
+      CASE  ('PAC20SA')
+         area=(/140.,292.,-21.,-19./) 
+      CASE  ('PAC30SA')
+         area=(/150.,292.,-31.,-29./) 
+      CASE  ('INDEQA')
+         area=(/40.,115.,-1.,1./) 
+      CASE  ('IND20SA')
+         area=(/30.,130.,-21.,-19./) 
+      CASE  ('IND30SA')
+         area=(/30.,120.,-31.,-29./) 
+      CASE  ('GLB60NA')
+         area=(/166.,9.13,59.,61./) 
+      CASE  ('GLB50NA')
+         area=(/0.,360.,49.,51./) 
+      CASE  ('GLB40NA')
+         area=(/0.,360.,39.,41./) 
+      CASE  ('GLB30NA')
+         area=(/0.,360.,29.,31./) 
+      CASE  ('GLB20NA')
+         area=(/0.,360.,19.,21./) 
+      CASE  ('GLB10NA')
+         area=(/0.,360.,9.,11./) 
+      CASE  ('GLBEQA')
+         area=(/0.,360.,-1.,1./) 
+      CASE  ('GLB10SA')
+         area=(/0.,360.,-11.,-9./) 
+      CASE  ('GLB20SA')
+         area=(/0.,360.,-21.,-19./) 
+      CASE  ('GLB30SA')
+         area=(/0.,360.,-31.,-29./) 
+      CASE  ('GLB40SA')
+         area=(/0.,360.,-41.,-39./) 
+      CASE  ('GLB50SA')
+         area=(/0.,360.,-51.,-49./) 
+      CASE  ('GLB60SA')
+         area=(/0.,360.,-61.,-59./) 
+      CASE ('npac25')    
+         area = (/100.,260.,25.,70./)
+      !Zonal sections
+      ! Measurements of Indonesian Throughflow at 
+      ! http://www.ocean.washington.edu/people/faculty/susanh/spga/spga.htm
+      ! INSTANT obserational program
+
+      CASE ('LOMBOK')
+!         area=(/114.,118.,-8.,-8./)  
+         area=(/114.,120.,-8.,-9./) ! first/last point rather than min,max
+      CASE ('MAKASSAR')
+!         area=(/114.,120.,-3.,-3./) 
+         area=(/114.,121.,-3.,-3./) 
+      CASE ('MALACCAS')
+!         area=(/99.,102.,3.,3./) 
+         area=(/103.,112.,-2.8,-2.8/) 
+      CASE ('BANDA')
+         area=(/122.,140.,-4.,-4./)
+      CASE  ('SAVU')
+!         area=(/122.,124.,-8.8,-8.8/) 
+         area=(/120.,125.,-8.8,-9.4/) 
+      CASE  ('PHILIPINES')
+         area=(/106.,120.,10.985,10.985/) 
+      CASE  ('YUCATAN')
+!         area=(/273.,285.,20.,20./) 
+         area=(/271.,283.,20.,21./) 
+      CASE  ('GIN')
+!         area=(/315.,7.,63.,63./) 
+         area=(/315.,9.8,63.,63./) 
+      CASE  ('LABRADOR')
+!         area=(/290.,315.,61.,61./) 
+         area=(/289.,310.,60.6,63.5/) 
+      CASE  ('ATL60N')
+!         area=(/260.,10.,57.,57./) 
+!         area=(/260.,10.87,57.,57./) 
+!         area=(/260.,11.2,57.,57./) 
+         area=(/260.,9.13,60.,59.925/) 
+      CASE  ('ATL50N')
+         area=(/260.,5.,50.,50./) 
+      CASE  ('ATL40N')
+         area=(/260.,358.,40.,40./) 
+      CASE  ('ATL35N')
+         area=(/260.,360.,35.,35./) 
+      CASE  ('ATL30N')
+         area=(/260.,360.,30.,30./) 
+      CASE  ('ATL27N')
+         area=(/260.,360.,27.,27./) 
+      CASE  ('ATL26N')
+         area=(/260.,360.,26.,26./) 
+      CASE  ('ATL20N')
+         area=(/260.,360.,20.,20./) 
+      CASE  ('ATL10N')
+!         area=(/300.,360.,10.,10./) 
+         area=(/290.,360.,10.,10./) 
+      CASE  ('ATLEQ')
+!         area=(/300.,10.,0.,0./) 
+         area=(/289.,11.,0.,0./) 
+      CASE  ('ATL10S')
+         area=(/320.,15.,-10.,-10./) 
+      CASE  ('ATL20S')
+         area=(/318.,15.,-30.,-30./) 
+      CASE  ('ATL30S')
+         area=(/310.,20.,-30.,-30./) 
+      CASE  ('PAC60N')
+         area=(/140.,250.,60.,60./) 
+      CASE  ('PAC50N')
+         area=(/130.,240.,50.,50./) 
+      CASE  ('PAC40N')
+         area=(/125.,240.,40.,40./) 
+      CASE  ('PAC35N')
+!         area=(/115.,240.,35.,35./) 
+         area=(/115.,242.,35.,35./) 
+      CASE  ('PAC30N')
+         area=(/115.,250.,30.,30./) 
+      CASE  ('PAC25N')
+         area=(/100.,260.,25.,25./) 
+      CASE  ('PAC20N')
+         area=(/100.,260.,20.,20./) 
+      CASE  ('PAC10N')
+!         area=(/98.,275.,10.,10./) 
+         area=(/105.,275.,10.,10./) 
+      CASE  ('PACEQ')
+         area=(/115.,282.,0.,0./) 
+      CASE  ('INP10S')
+         area=(/35.,290.,-10.,-10./) 
+      CASE  ('PAC20S')
+         area=(/140.,292.,-20.,-20./) 
+      CASE  ('PAC30S')
+         area=(/150.,292.,-30.,-30./) 
+      CASE  ('INDEQ')
+         area=(/40.,115.,-0.,-0./) 
+      CASE  ('IND20S')
+         area=(/30.,130.,-20.,-20./) 
+      CASE  ('IND30S')
+         area=(/30.,120.,-30.,-30./) 
+      CASE  ('GLB60N')
+!         area=(/0.,360.,60.,60./) 
+!         area=(/166.,10.,60.5,60./) 
+!         area=(/166.,6.6,60.5,59.7/) 
+         area=(/166.,9.13,60.5,59.925/) 
+      CASE  ('GLB50N')
+         area=(/0.,360.,50.,50./) 
+      CASE  ('GLB40N')
+         area=(/0.,360.,40.,40./) 
+      CASE  ('GLB30N')
+         area=(/0.,360.,30.,30./) 
+      CASE  ('GLB20N')
+         area=(/0.,360.,20.,20./) 
+      CASE  ('GLB10N')
+         area=(/0.,360.,10.,10./) 
+      CASE  ('GLBEQ')
+         area=(/0.,360.,0.,0./) 
+      CASE  ('GLB10S')
+         area=(/0.,360.,-10.,-10./) 
+      CASE  ('GLB20S')
+         area=(/0.,360.,-20.,-20./) 
+      CASE  ('GLB30S')
+         area=(/0.,360.,-30.,-30./) 
+      CASE  ('GLB40S')
+         area=(/0.,360.,-40.,-40./) 
+      CASE  ('GLB50S')
+         area=(/0.,360.,-50.,-50./) 
+      CASE  ('GLB60S')
+         area=(/0.,360.,-60.,-60./) 
+      CASE  ('SUM-DARWIN')
+         area=(/104.,131.,-4.9,-15.3/) 
+
+      !Meridonal sections (for zonal transports)
+      CASE ('IT'   )                    !From Flores to Australia
+!         area=(/114.,114.,-22.,-8.5/)
+         area=(/126.,126.,-8.8,-16./)
+      CASE ('ITA'   )                   !From Sumatra to Australia
+!         area=(/115.,114.,-22.,-3./)
+         area=(/104.,115.,-4.9,-24.7/)
+      CASE ('TIMOR')
+         area=(/124.,124.,-17.,-9./) 
+!      CASE  ('OMBAI')
+!         area=(/124.5,124.5,-9.2,-8.2/) 
+!      CASE  ('SUMBA') 
+!         area=(/120.,120.,-9.3,-8.3/) 
+!      CASE ('LUZON')
+!         area=(/120.5,120.5,17.,23./) 
+      CASE ('DRAKE')
+!         area=(/290.,290.,-75.,-52./) 
+!         area=(/-69.,-64.,-55.2,-65.9/) 
+         area=(/291.,296.,-54.6,-65.9/) 
+      CASE ('TORRES')
+         area=(/143.,143.,-15.,-8./) 
+      CASE ('MED')
+         area=(/356.,356.,32.,40./) 
+      CASE ('FLORIDA')
+!         area=(/279.5,279.5,22.,28./) 
+!         area=(/-81.,-79,26.5,21.9/) 
+         area=(/-82.,-79.,28.2,22./) 
+      CASE ('ANTILLAS')
+!         area=(/290.,290.,10.,18./) 
+         area=(/-72.,-72.,19.1,8.2/) 
+      CASE ('GOODHOPE')
+!         area=(/340.,340.,-80.,-30./) 
+         area=(/23.,44.,-31.7,-68.2/) 
+      CASE ('SOUTHAUS')
+!         area=(/140.,140.,-80.,-30./) 
+         area=(/133.,133.,-30.,-67.5/) 
+      CASE default
+         PRINT*,'area: ', reg, 'is not defined'
+         CALL abort
+      END SELECT
+
+   END SUBROUTINE coord_area
+
+   SUBROUTINE coord_user_init (sec)
+      CHARACTER(len=1), INTENT(IN) :: sec
+      CHARACTER(len=20), DIMENSION(:), ALLOCATABLE  :: cl_boxes
+      INTEGER                            :: nbox
+      CHARACTER(len=32) :: cdnamelist = 'coords.nml'
+      LOGICAL :: lexists, lnodefaults
+      CHARACTER(len=20) :: carea
+      REAL :: lat1,lat2,lon1,lon2,dlat,dlon
+      LOGICAL :: lreg, lstd
+      INTEGER :: nlat,nlon
+      INTEGER :: i,j,k
+      NAMELIST/area/lstd,lreg,carea,lat1,lat2,lon1,lon2,dlat,dlon
+
+      lnodefaults=.TRUE.
+      nboxuser=0
+      SELECT CASE (sec)
+      CASE ('u')
+         nbox=nsecm
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secm(:)
+      CASE ('v')
+         nbox=nsecz
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_secz(:)
+      CASE default
+         nbox=nsech
+         ALLOCATE(cl_boxes(nbox))
+         cl_boxes(:)=cl_sech(:)
+      END SELECT
+      INQUIRE(file=cdnamelist,exist=lexists) 
+      IF (lexists) THEN
+         nboxuser=0
+         OPEN(20,file=cdnamelist)
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=100)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            WRITE(*,area)
+            IF (lreg.AND.(TRIM(carea)/='undefined')) THEN
+               WRITE(*,*)'coord_init: please specify either lreg=true '//&
+                  &      'or carea/=undefined'
+               CALL abort
+            ENDIF
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+            IF (lstd) THEN
+               IF (lnodefaults) THEN
+                  nboxuser=nboxuser+nbox
+                  lnodefaults=.FALSE.
+               ENDIF
+            ENDIF
+         END DO
+100      CONTINUE
+         WRITE(*,*)'Total areas = ',nboxuser
+         IF (nboxuser==0) THEN
+            CLOSE(20)
+            WRITE(*,*)'coord_init: no boxes defined!!'
+            CALL abort
+         ENDIF
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         nboxuser=0
+         IF (.NOT.lnodefaults) THEN
+            cl_boxes_user(1:nbox)=cl_boxes(1:nbox)
+            DO i=1,nbox
+               CALL coord_area( cl_boxes_user(i), areas(:,i) )
+            ENDDO
+            nboxuser=nboxuser+nbox
+         ENDIF
+         REWIND(20)
+         WRITE(*,*)'Reading areas'
+         DO
+            carea='undefined'
+            lat1=-90
+            lat2=90
+            lon1=0
+            lon2=360
+            dlat=10
+            dlon=10
+            lreg=.FALSE.
+            lstd=.FALSE.
+            READ(20,area,end=200)
+            DO
+               IF (lon1<0) lon1=lon1+360
+               IF (lon1>360) lon1=lon1-360
+               IF ((lon1>=0).AND.(lon1<=360)) EXIT
+            ENDDO
+            DO
+               IF (lon2<0) lon2=lon2+360
+               IF (lon2>360) lon2=lon2-360
+               IF ((lon2>=0).AND.(lon2<=360)) EXIT
+            ENDDO
+            IF (TRIM(carea)/='undefined') THEN
+               nboxuser=nboxuser+1
+               cl_boxes_user(nboxuser)=carea
+               areas(1,nboxuser)=MIN(lon1,lon2)
+               areas(2,nboxuser)=MAX(lon1,lon2)
+               areas(3,nboxuser)=MIN(lat1,lat2)
+               areas(4,nboxuser)=MAX(lat1,lat2)
+            ENDIF
+            IF (lreg) THEN
+               nlat=NINT((MAX(lat1,lat2)-MIN(lat1,lat2))/dlat)
+               nlon=NINT((MAX(lon1,lon2)-MIN(lon1,lon2))/dlon)
+               k=0
+               DO j=1,nlat
+                  DO i=1,nlon
+                     k=k+1
+                     areas(1,k+nboxuser)=MIN(lon1,lon2)+(i-1)*dlon
+                     areas(2,k+nboxuser)=MIN(lon1,lon2)+i*dlon
+                     areas(3,k+nboxuser)=MIN(lat1,lat2)+(j-1)*dlat
+                     areas(4,k+nboxuser)=MIN(lat1,lat2)+j*dlat
+                     WRITE(cl_boxes_user(k+nboxuser)(1:5),'(I4.4,A1)') &
+                        & NINT(areas(1,k+nboxuser)*10),'e'
+                     WRITE(cl_boxes_user(k+nboxuser)(6:10),'(I4.4,A1)') &
+                        & NINT(areas(2,k+nboxuser)*10),'e'
+                     IF (areas(3,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & -NINT(areas(3,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(11:15),'(I4.4,A1)') &
+                           & NINT(areas(3,k+nboxuser)*10),'n'
+                     ENDIF
+                     IF (areas(4,k+nboxuser)<0) THEN
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & -NINT(areas(4,k+nboxuser)*10),'s'
+                     ELSE
+                        WRITE(cl_boxes_user(k+nboxuser)(16:20),'(I4.4,A1)') &
+                           & NINT(areas(4,k+nboxuser)*10),'n'
+                     ENDIF
+                  ENDDO
+               ENDDO
+               nboxuser=nboxuser+nlat*nlon
+            ENDIF
+         END DO
+200      CONTINUE
+         CLOSE(20)
+      ELSE
+         nboxuser=nbox
+         ALLOCATE(cl_boxes_user(nboxuser))
+         ALLOCATE(areas(4,nboxuser))
+         cl_boxes_user(:)=cl_boxes(:)
+         DO i=1,nbox
+            CALL coord_area( cl_boxes_user(i), areas(:,i) )
+         ENDDO
+      ENDIF
+      DO i=1,nboxuser
+         WRITE(*,'(A,4F12.2)')cl_boxes_user(i),areas(:,i)
+         DO j=i+1,nboxuser
+            IF (TRIM(cl_boxes_user(i))==TRIM(cl_boxes_user(j))) THEN
+               WRITE(*,*)'coord_user_init: dublicate boxes'
+               CALL abort
+            ENDIF
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE coord_user_init
+
+   SUBROUTINE coord_area_user( reg, area, ldfail )
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE coord_area_user
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    Get coordinate of different regions
+      !
+      !   Modifications :
+      !   -------------
+      IMPLICIT NONE
+      !----------------------------------------------------------------------
+      ! local declarations
+      !----------------------------------------------------------------------
+      !
+      CHARACTER(len=20), INTENT(inout) :: reg
+      REAL, DIMENSION(4), INTENT(out) :: area
+      LOGICAL, OPTIONAL, INTENT(out) :: ldfail
+      INTEGER :: i
+      LOGICAL :: lnotfound
+      !
+      reg=TRIM(reg)
+
+      lnotfound=.TRUE.
+      DO i=1,nboxuser
+         IF (reg==TRIM(cl_boxes_user(i))) THEN
+            area(:)=areas(:,i)
+            lnotfound=.FALSE.
+            EXIT
+         ENDIF
+      ENDDO
+      IF (PRESENT(ldfail)) THEN
+         ldfail=lnotfound
+      ELSE
+         IF (lnotfound) THEN
+            WRITE(*,*)'coord_area_user: area not found'
+            CALL abort
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE coord_area_user
+
+END MODULE coords
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/corio2fb.F90	(revision 3294)
@@ -0,0 +1,90 @@
+PROGRAM corio2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert Coriolis format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     corio2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: coriof(:)
+   INTEGER :: ninfiles,ntotcorio,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'corio2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( coriof(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotcorio = 0
+   ninfiles  = nargs - 1
+   DO ia=1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_coriofile( TRIM(cdinfile(ia)), coriof(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',coriof(ia)%nobs,' profiles'
+      ntotcorio = ntotcorio + coriof(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, coriof(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( coriof(1) )
+      CALL alloc_obfbdata( coriof(1), 2, 0, 1, 0, 1, .FALSE. )
+      coriof(1)%cname(1) = 'POTM'
+      coriof(1)%cname(2) = 'PSAL'
+      coriof(1)%coblong(1) = 'Potential temperature'
+      coriof(1)%coblong(2) = 'Practical salinity'
+      coriof(1)%cobunit(1) = 'Degrees Celsius'
+      coriof(1)%cobunit(2) = 'PSU'
+      coriof(1)%cextname(1) = 'TEMP'
+      coriof(1)%cextlong(1) = 'Insitu temperature'
+      coriof(1)%cextunit(1) = 'Degrees Celsius'
+      coriof(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotcorio
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, coriof )
+   
+END PROGRAM corio2fb
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ctl_stop.h90	(revision 3294)
@@ -0,0 +1,21 @@
+   SUBROUTINE ctl_stop( cerr )
+      !!---------------------------------------------------------------------
+      !!
+      !!                     ** ROUTINE ctl_stop **
+      !!
+      !!  ** Purpose : Stop execution
+      !!
+      !!  ** Method  : 
+      !!
+      !!  ** Action  :
+      !!
+      !!   History :   (2008-12) K. Mogensen. NEMOVAR version
+      !!----------------------------------------------------------------------
+      CHARACTER(len=*) :: cerr
+
+      WRITE(*,*)'Error:'
+      WRITE(*,*)TRIM(cerr)
+      CALL abort
+
+   END SUBROUTINE ctl_stop
+
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/date_utils.F90	(revision 3294)
@@ -0,0 +1,382 @@
+MODULE date_utils
+
+   USE toolspar_kind
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE add_date(initial_date,hours,final_date)
+
+      ! Add a number of hours to initial_date and return it in final_date
+
+      IMPLICIT NONE
+
+
+      !! Arguments
+      INTEGER,INTENT(in) :: initial_date ! Initial date (YYYYMMDDHH)
+      INTEGER,INTENT(in) :: hours        ! Number of hours to add
+      INTEGER,INTENT(out) :: final_date  ! Final date (YYYYMMDDHH)
+
+      !! Local variables
+
+      INTEGER :: isec,imin,ihours,iyear,imon,iday ! temporary results
+      REAL(dp):: juld
+
+      CALL split_date(initial_date,iyear,imon,iday,ihours)
+
+      CALL greg2jul(0,0,ihours,iday,imon,iyear,juld)
+
+      juld=juld+REAL(hours)/24.0
+
+      CALL jul2greg(isec,imin,ihours,iday,imon,iyear,juld)
+
+      final_date=iyear*1000000+imon*10000+iday*100+ihours
+
+   END SUBROUTINE add_date
+
+   SUBROUTINE split_date(iyyyymmddhh,iyyyy,imm,idd,ihh)
+
+      ! Splits a date in YYYYMMDDHH format into iyyyy, imm, idd, ihh
+
+      IMPLICIT NONE
+      INTEGER,INTENT(in) :: iyyyymmddhh
+      INTEGER,INTENT(out) :: iyyyy,imm,idd,ihh
+
+      iyyyy=iyyyymmddhh/1000000
+      imm=iyyyymmddhh/10000-iyyyy*100
+      idd=iyyyymmddhh/100-(iyyyy*10000+imm*100)
+      ihh=MOD(iyyyymmddhh,100)
+
+   END SUBROUTINE split_date
+
+   SUBROUTINE jul2greg( ksec, kminut, khour, kday, kmonth, kyear, &
+      &                           prelday )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE jul2greg  ***
+      !!
+      !! ** Purpose : Take the relative time in days and re-express in terms of
+      !!              seconds, minutes, hours, days, month, year.
+      !!
+      !! ** Method  : Reference date : 19500101
+      !!
+      !! ** Action  :
+      !!
+      !! History
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-05  (A. Vidard) Reformatted and refdate      
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(OUT) :: &
+         & ksec,   &
+         & kminut, &
+         & khour,  &
+         & kday,   &
+         & kmonth, &
+         & kyear
+      REAL(KIND=dp), INTENT(IN) :: &
+         & prelday
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 2299161, &
+         & jporef = 2433283, &
+         & jparef = 2415021
+      INTEGER :: &
+         & ijulian, &
+         & ij1,     &
+         & ija,     &
+         & ijb,     &
+         & ijc,     &
+         & ijd,     &
+         & ije,     &
+         & isec,    &
+         & imin,    &
+         & ihou,    &
+         & iday,    &
+         & imon,    &
+         & iyea,    &
+         & iref
+      REAL(KIND=wp) :: &
+         & zday, &
+         & zref
+
+      ! Main computation
+      iref = jporef 
+
+      zday = prelday
+      ksec = NINT( 86400. * MOD( zday, 1.0_wp ) )
+
+      IF ( ksec < 0. ) ksec = 86400. + ksec
+
+      khour  = ksec / 3600
+      kminut = ( ksec - 3600 * khour ) / 60
+      ksec   = MOD( ksec , 60 )
+
+      ijulian = iref + INT( zday )
+      IF ( zday < 0. ) ijulian = ijulian - 1
+
+      ! If input date after 10/15/1582 :
+      IF ( ijulian >= jpgreg ) THEN
+         ij1 = INT( ( DBLE( ijulian - 1867216 ) - 0.25 ) / 36524.25 )
+         ija = ijulian + 1 + ij1 - INT( ( 0.25 * ij1 ) )
+      ELSE
+         ija = ijulian
+      ENDIF
+
+      ijb = ija + 1524
+      ijc = INT( 6680. + ( DBLE ( ijb - 2439870 ) - 122.1 ) / 365.25 )
+      ijd = 365 * ijc + INT( 0.25 * ijc )
+      ije = INT( ( ijb - ijd ) / 30.6001 )
+      kday = ijb - ijd - INT( 30.6001 * ije )
+      kmonth = ije - 1
+      IF ( kmonth > 12 ) kmonth = kmonth - 12
+      kyear = ijc - 4715
+      IF ( kmonth > 2 ) kyear = kyear - 1
+      IF ( kyear <= 0 ) kyear = kyear - 1
+
+   END SUBROUTINE jul2greg
+
+   SUBROUTINE greg2jul( ksec, kmin, khour, kday, kmonth, kyear, pjulian )
+
+      IMPLICIT NONE
+      !!-----------------------------------------------------------------------
+      !!
+      !!                     ***  ROUTINE greg2jul  ***
+      !!
+      !! ** Purpose : Produce the time relative to the current date and time.
+      !!
+      !! ** Method  : The units are days, so hours and minutes transform to
+      !!              fractions of a day. 
+      !!
+      !!              Reference date : 19500101
+      !! ** Action  :
+      !!
+      !! History :
+      !!      ! 06-04  (A. Vidard) Original
+      !!      ! 06-04  (A. Vidard) Reformatted
+      !!      ! 06-10  (A. Weaver) Cleanup
+      !!-----------------------------------------------------------------------
+
+      ! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & ksec,   &
+         & kmin,   &
+         & khour,  & 
+         & kday,   &
+         & kmonth, & 
+         & kyear
+      REAL(KIND=dp), INTENT(OUT) :: &
+         & pjulian
+
+      !! * Local declarations
+      INTEGER, PARAMETER :: &
+         & jpgreg = 15 + 31 * ( 10 + 12 * 1582 ), &  ! Gregorian calendar introduction date
+         & jpjref = 2433283                          ! Julian reference date: 19500101
+      INTEGER :: &
+         & ija,     &
+         & ijy,     &
+         & ijm,     &
+         & ijultmp, &
+         & ijyear
+
+      ! Main computation
+      ijyear = kyear
+      IF ( ijyear < 0 ) ijyear = ijyear + 1
+      IF ( kmonth > 2 ) THEN
+         ijy = ijyear
+         ijm = kmonth + 1
+      ELSE
+         ijy = ijyear  - 1
+         ijm = kmonth + 13
+      ENDIF
+      ijultmp = INT( 365.25 * ijy ) + INT( 30.6001 * ijm ) + kday + 1720995
+      IF ( kday + 31 * ( kmonth + 12 * ijyear ) >= jpgreg ) THEN
+         ija = INT( 0.01 * ijy )
+         ijultmp = ijultmp + 2 - ija + INT( 0.25 * ija )
+      ENDIF
+      pjulian = ( ijultmp - jpjref ) + ( ( 60 * khour + kmin ) * 60 + ksec ) / 86400.
+
+   END SUBROUTINE greg2jul
+
+
+   SUBROUTINE addseconds(iyear,imon,iday,ihour,imin,isec,iaddsec)
+
+      ! Add iaddsecs to the date and return the new date (in place)
+
+      !! Arguments
+
+      INTEGER,intent(inout) :: iyear,imon,iday,ihour,imin,isec,iaddsec
+
+      !! Local variables
+
+      INTEGER :: itotsec,idays,isecs
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/) 
+
+      itotsec=iaddsec+ihour*3600*imin*60+isec
+
+      IF (itotsec<0) THEN
+         WRITE(*,*)'Negative itotsec in addseconds'
+         WRITE(*,*)'This does not work'
+         RETURN
+      ENDIF
+
+      ihour=0
+      imin=0
+      isec=0
+
+      idays=itotsec/86400
+      isecs=itotsec-idays*86400
+      iday=iday+idays
+
+      ! Compute the date
+      DO
+         ! Leap year 
+         mday(2)=28
+         IF (MOD(iyear,4).EQ.0) mday(2)=29
+         IF (MOD(iyear,100).EQ.0) mday(2)=28
+         IF (MOD(iyear,400).EQ.0) mday(2)=29
+         IF (MOD(iyear,4000).EQ.0) mday(2)=28
+
+         IF (iday.GT.mday(imon))THEN
+            iday=iday-mday(imon)
+            imon=imon+1
+            IF(imon.GT.12)THEN
+               imon=1
+               iyear=iyear+1
+            ENDIF
+         ELSE
+            EXIT
+         ENDIF
+
+      ENDDO
+
+      ! Set the time
+      ihour=isecs/3600
+      imin=isecs/60-ihour*60
+      isec=isecs-ihour*3600-imin*60
+
+   END SUBROUTINE addseconds
+
+   INTEGER FUNCTION nextdate(idate)
+
+      ! Return next date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day+1
+      IF (day.GT.mday(mon))THEN
+         day=1
+         mon=mon+1
+         IF(mon.GT.12)THEN
+            mon=1
+            year=year+1
+         ENDIF
+      ENDIF
+      nextdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION nextdate
+
+   INTEGER FUNCTION prevdate(idate)
+
+      ! Return previous date.
+      ! Date format is assumed to be YYYYMMDD
+
+      IMPLICIT NONE
+
+      !! Arguments
+
+      INTEGER :: idate ! Initial date
+
+      !! Local variables
+
+      INTEGER :: year,day,mon
+      INTEGER :: mday(12) = (/31,28,31,30,31,30,31,31,30,31,30,31/)
+
+
+      day=MOD(idate,100)
+      mon=MOD((idate-day)/100,100)
+      year=idate/10000
+
+      mday(2)=28
+      IF (MOD(year,4).EQ.0) mday(2)=29
+      IF (MOD(year,100).EQ.0) mday(2)=28
+      IF (MOD(year,400).EQ.0) mday(2)= 29
+      IF (MOD(year,4000).EQ.0) mday(2) = 28
+
+      day=day-1
+      IF (day.LT.1)THEN
+         mon=mon-1
+         IF(mon.LT.1)THEN
+            mon=12
+            year=year-1
+         ENDIF
+         day=mday(mon)
+      ENDIF
+      prevdate=year*10000+mon*100+day
+      RETURN
+
+   END FUNCTION prevdate
+
+   INTEGER FUNCTION diffdate(idate1,idate2)
+
+      ! Compute difference in days between dates
+      ! Assumes YYYYMMDD format for dates
+
+      IMPLICIT NONE
+
+      !! Argument
+
+      INTEGER :: idate1,idate2    ! Dates to be diffed.
+
+      !! Local variables
+
+      INTEGER :: itdate1,itdate2
+      INTEGER :: it
+
+      itdate1=MIN(idate1,idate2)
+      itdate2=MAX(idate1,idate2)
+
+      IF (itdate1==itdate2) THEN
+         diffdate=0
+         RETURN
+      ENDIF
+      diffdate=0
+      it=itdate1
+      DO 
+         it=nextdate(it)
+         diffdate=diffdate+1
+         IF (it==itdate2) EXIT
+      ENDDO
+      RETURN
+
+   END FUNCTION diffdate
+
+
+END MODULE date_utils
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ddatetoymdhms.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/distance.h90	(revision 3294)
@@ -0,0 +1,33 @@
+   REAL FUNCTION distance( plon1, plat1, plon2, plat2 )
+      ! Arggumnts
+      REAL :: plon1,plat1,plat2,plon2
+      ! Local variables
+      REAL :: zplat1,zplon1,zplat2,zplon2
+      REAL :: za1,za2,zb1,zb2,zc1,zc2,zcos1,zcos2
+      REAL, PARAMETER :: zrad = 3.141592653589793/180.0
+      REAL, parameter :: rearth = 6371229
+
+      zplon1 = plon1
+      zplon2 = plon2
+      IF ( zplon1 <  -180 ) zplon1 = zplon1 + 360.0
+      IF ( zplon1 >=  180 ) zplon1 = zplon1 - 360.0
+      IF ( zplon2 <  -180 ) zplon2 = zplon2 + 360.0
+      IF ( zplon2 >=  180 ) zplon2 = zplon2 - 360.0
+
+      zplon1 = zplon1 * zrad
+      zplon2 = zplon2 * zrad
+      zplat1 = plat1  * zrad
+      zplat2 = plat2  * zrad
+      zcos1  = COS( zplat1 )
+      zcos2  = COS( zplat2 )
+      za1    = SIN( zplat1 )
+      za2    = SIN( zplat2 )
+      zb1    = zcos1 * COS( zplon1 )
+      zb2    = zcos2 * COS( zplon2 )
+      zc1    = zcos1 * SIN( zplon1 )
+      zc2    = zcos2 * SIN( zplon2 )
+
+      distance  =  rearth  *  &
+         &  ASIN( SQRT( ABS ( 1.0 - ( za1 * za2 + zb1 * zb2 + zc1 * zc2) ** 2) ) )
+      
+    END FUNCTION distance
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/dom_oce.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/DOM/dom_oce.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/enact2fb.F90	(revision 3294)
@@ -0,0 +1,90 @@
+PROGRAM enact2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM corio2fb **
+   !!
+   !!  ** Purpose : Convert ENACT format profiles to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     enact2fb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_prof_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: enactf(:)
+   INTEGER :: ninfiles,ntotenact,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'enact2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( enactf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotenact = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_enactfile( TRIM(cdinfile(ia)), enactf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',enactf(ia)%nobs,' profiles'
+      ntotenact = ntotenact + enactf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, enactf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( enactf(1) )
+      CALL alloc_obfbdata( enactf(1), 2, 0, 1, 0, 1, .FALSE. )
+      enactf(1)%cname(1) = 'POTM'
+      enactf(1)%cname(2) = 'PSAL'
+      enactf(1)%coblong(1) = 'Potential temperature'
+      enactf(1)%coblong(2) = 'Practical salinity'
+      enactf(1)%cobunit(1) = 'Degrees Celsius'
+      enactf(1)%cobunit(2) = 'PSU'
+      enactf(1)%cextname(1) = 'TEMP'
+      enactf(1)%cextlong(1) = 'Insitu temperature'
+      enactf(1)%cextunit(1) = 'Degrees Celsius'
+      enactf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotenact
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, enactf )
+
+END PROGRAM enact2fb
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbaccdata.F90	(revision 3294)
@@ -0,0 +1,16 @@
+MODULE fbaccdata
+   USE fbacctype
+   IMPLICIT NONE
+   INTEGER, DIMENSION(:,:,:,:,:), ALLOCATABLE :: inum,inumov,inumbv
+   INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: inuma
+   REAL, DIMENSION(:,:,:,:,:), ALLOCATABLE :: zbias,zrms,zsdev,zomean,zmmean,&
+      & zoemea,zovmea,zbemea,zbvmea
+   REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: zoamean
+   INTEGER, PARAMETER :: maxvars = 10
+   REAL, DIMENSION(maxvars) :: zcheck
+   REAL, DIMENSION(maxvars) :: zhistmax, zhistmin, zhiststep
+   TYPE(histtype), DIMENSION(maxvars) :: hist
+   REAL, DIMENSION(maxvars) :: zxymax, zxymin, zxystep
+   TYPE(xytype), DIMENSION(maxvars) :: xy
+END MODULE fbaccdata
+
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbacctype.F90	(revision 3294)
@@ -0,0 +1,11 @@
+MODULE fbacctype
+   IMPLICIT NONE
+   TYPE histtype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:) :: nhist
+   END TYPE histtype
+   TYPE xytype
+      INTEGER :: npoints
+      INTEGER, POINTER, DIMENSION(:,:,:,:,:,:) :: nxy
+   END TYPE xytype
+END MODULE fbacctype
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbcomb.F90	(revision 3294)
@@ -0,0 +1,182 @@
+PROGRAM fbcomb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbcomb **
+   !!
+   !!  ** Purpose : Combine MPI decomposed feedback files into one file
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  : 
+   !!
+   !!   Usage:
+   !!     fbcomb.exe outputfile inputfile1 inputfile2 ...
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   INTEGER :: iwmo
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,iv,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( nargs < 2 ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbcomb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Get input data
+   !
+   ALLOCATE( obsdata( nargs - 1 ) )
+   ALLOCATE( cdinfile( nargs - 1 ) )
+   ntotobs = 0
+   ninfiles = nargs - 1
+   DO ia=1, ninfiles
+      CALL getarg( ia+1, cdinfile(ia) )
+      CALL init_obfbdata( obsdata(ia) )
+      CALL read_obfbdata( TRIM(cdinfile(ia)), obsdata(ia) )
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ia)%nobs, ' observations'
+      ntotobs = ntotobs + obsdata(ia)%nobs
+   ENDDO
+   WRITE(*,'(A,I8)') 'Total obsfiles : ',ntotobs
+   !
+   ! Check that the data is confirming
+   !
+   DO ia=2, ninfiles
+      IF ( obsdata(ia)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+         WRITE(*,*)'Different julian date reference. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%nvar /= obsdata(1)%nvar ) THEN
+         WRITE(*,*)'Different number of variables. Aborting'
+         CALL abort
+      ENDIF
+      IF  (obsdata(ia)%nadd /= obsdata(1)%nadd ) THEN
+         WRITE(*,*)'Different number of additional entries. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%next /= obsdata(1)%next ) THEN
+         WRITE(*,*)'Different number of additional variables. Aborting'
+         CALL abort
+      ENDIF
+      IF ( obsdata(ia)%lgrid .NEQV. obsdata(1)%lgrid ) THEN
+         WRITE(*,*)'Inconsistent grid search info. Aborting'
+         CALL abort
+      ENDIF
+      DO iv=1, obsdata(ia)%nvar
+         IF ( obsdata(ia)%cname(iv) /= obsdata(1)%cname(iv) ) THEN
+            WRITE(*,*)'Variable name ', TRIM(obsdata(ia)%cname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+         IF ( obsdata(1)%lgrid ) THEN
+            IF ( obsdata(ia)%cgrid(iv) /= obsdata(1)%cgrid(iv) ) THEN
+               IF (obsdata(1)%nobs==0) THEN
+                  obsdata(1)%cgrid(iv) = obsdata(ia)%cgrid(iv)
+               ELSE
+                  IF (obsdata(ia)%nobs>0) THEN
+                     WRITE(*,*)'Grid name ', TRIM(obsdata(ia)%cgrid(iv)), &
+                        &      ' is different from ', &
+                        &      TRIM(obsdata(1)%cgrid(iv)), '. Aborting'
+                     CALL abort
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%nadd
+         IF ( obsdata(ia)%caddname(iv) /= obsdata(1)%caddname(iv) ) THEN
+            WRITE(*,*)'Additional name ', TRIM(obsdata(ia)%caddname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%caddname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+      DO iv=1,obsdata(ia)%next
+         IF ( obsdata(ia)%cextname(iv) /= obsdata(1)%cextname(iv) ) THEN
+            WRITE(*,*)'Extra name ', TRIM(obsdata(ia)%cextname(iv)), &
+               &      ' is different from ', TRIM(obsdata(1)%cextname(iv)), &
+               &      '. Aborting'
+            CALL abort
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Construct sorting arrays
+   !
+   ALLOCATE( zsort(5,ntotobs), iset(ntotobs), &
+      & inum(ntotobs), iindex(ntotobs))
+   ii = 0
+   DO ia = 1,ninfiles
+      DO ij = 1,obsdata(ia)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdata(ia)%ptim(ij)
+         zsort(2,ii) = obsdata(ia)%pphi(ij)
+         zsort(3,ii) = obsdata(ia)%plam(ij)
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata(ia)%cdwmo(ij)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+         iset(ii) = ia
+         inum(ii) = ij
+      ENDDO
+   ENDDO
+   !
+   ! Get indexes for time sorting.
+   !
+   CALL index_sort_dp_n(zsort,5,iindex,ntotobs)
+   !
+   ! Allocate output data
+   !   
+   nlev = -1
+   DO ia = 1,ninfiles
+      IF ( obsdata(ia)%nlev > nlev ) nlev = obsdata(ia)%nlev
+   ENDDO
+   CALL init_obfbdata( obsoutdata )
+   CALL alloc_obfbdata( obsoutdata, obsdata(1)%nvar, ntotobs, nlev, &
+      &                 obsdata(1)%nadd, obsdata(1)%next, obsdata(1)%lgrid )
+   !
+   ! Copy input data into output data
+   !
+   CALL merge_obfbdata( ninfiles, obsdata, obsoutdata, iset, inum, iindex )
+   !
+   ! Save output data 
+   !
+   CALL write_obfbdata ( TRIM(cdoutfile), obsoutdata )
+   
+END PROGRAM fbcomb
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbmatchup.F90	(revision 3294)
@@ -0,0 +1,477 @@
+PROGRAM fbmatchup
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbmatchup **
+   !!
+   !!  ** Purpose : Find matching obs in feedback files
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !! 
+   !!   Usage:
+   !!     fbmatchup.exe outputfile inputfile1 varname1 inputfile2 varname2 ...
+   !!
+   !!   Optional: 
+   !!     namelist = namfbmatchup.in       to set ldaily820
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind
+   USE obs_fbm
+   USE index_sort
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=ilenname),ALLOCATABLE :: cdnames(:)
+   CHARACTER(len=2*ilenname) :: cdtmp
+   LOGICAL :: ldaily820
+   NAMELIST/namfbmatchup/ldaily820
+   !
+   ! Input data
+   !
+   TYPE(obfbdata)         :: obsdatatmp(1)
+   TYPE(obfbdata),POINTER :: obsdata(:)
+   INTEGER :: ninfiles,ntotobs,nlev,nadd,next
+   !
+   ! Time sorting arrays
+   !
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Comparison arrays and scalars
+   !
+   REAL(KIND=fbsp), ALLOCATABLE :: zrtim(:),zrphi(:),zrlam(:)
+   INTEGER(KIND=SELECTED_INT_KIND(12)), ALLOCATABLE :: irwmo(:)
+   REAL(KIND=fbsp) :: ztim,zphi,zlam
+   INTEGER(KIND=SELECTED_INT_KIND(12)) :: iwmo
+   LOGICAL, ALLOCATABLE :: ltaken(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: obsoutdata
+   !
+   ! Storage for extra to search for unique.
+   !
+   CHARACTER(len=ilenname), ALLOCATABLE :: cexttmp(:)
+   TYPE extout
+      LOGICAL, POINTER, DIMENSION(:) :: luse
+      INTEGER, POINTER, DIMENSION(:) :: ipos
+   END TYPE extout
+   TYPE(extout), POINTER, DIMENSION(:) :: pextinf
+   !
+   ! Loop variables
+   !
+   INTEGER :: ifi,ia,ip,i1,ii,ij,ik1,ik2,iv,ist,iadd,ie,iext
+   LOGICAL :: llfound
+   LOGICAL :: lexists,lnotobs
+   INTEGER :: ityp
+   !
+   ! Get number of command line arguments
+   !
+   nargs = IARGC()
+   IF ( ( MOD(nargs,2) /= 1 ) .OR. ( nargs == 0 )  ) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbmatchup outputfile inputfile1 varname1 inputfile2 varname2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg( 1, cdoutfile )
+   !
+   ! Read namelist if present
+   !
+   ldaily820=.FALSE.
+   INQUIRE(file='namfbmatchup.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbmatchup.in')
+      READ(10,namfbmatchup)
+      CLOSE(10)
+      WRITE(*,namfbmatchup)
+   ENDIF
+   !
+   ! Get input data
+   !
+   ninfiles = ( nargs -1 ) / 2
+   ALLOCATE( obsdata( ninfiles ) )
+   ALLOCATE( cdinfile( ninfiles ) )
+   ALLOCATE( cdnames( ninfiles ) )
+   ip = 1
+   DO ifi = 1, ninfiles
+      !
+      ! Read the unsorted file
+      !
+      ip = ip + 1
+      CALL getarg( ip, cdinfile(ifi) )
+      ip = ip + 1
+      CALL getarg( ip, cdnames(ifi) )
+      CALL init_obfbdata( obsdatatmp(1) )
+      CALL read_obfbdata( TRIM(cdinfile(ifi)), obsdatatmp(1) )
+      !
+      ! Check if we have fewer levels than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nlev > obsdata(1)%nlev ) THEN
+            WRITE(*,*)'Warning. More levels in file than the first file'
+            WRITE(*,*)'Number of levels in current file = ', obsdatatmp(1)%nlev
+            WRITE(*,*)'Number of levels in first file   = ', obsdata(1)%nlev
+            WRITE(*,*)'Only the number of levels in the first'//&
+               &' file will be used'
+         ENDIF
+      ENDIF
+      !
+      ! Check if we have fewer observations than in the first file
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nobs > obsdata(1)%nobs ) THEN
+            WRITE(*,*)'Warning. More obs in file than the first file'
+            WRITE(*,*)'Number of obs in current file = ', obsdatatmp(1)%nobs
+            WRITE(*,*)'Number of obs in first file   = ', obsdata(1)%nobs
+            WRITE(*,*)'Only the observations in the first'//&
+               &' file will be stored'
+         ENDIF
+      ENDIF
+      !
+      ! Check that we have the same number of variables
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%nvar /= obsdata(1)%nvar ) THEN
+            WRITE(*,*)'Error. Different number of variables.'
+            WRITE(*,*)'Number of var in current file = ', obsdatatmp(1)%nvar
+            WRITE(*,*)'Number of var in first file   = ', obsdata(1)%nvar
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Check reference datas
+      !
+      IF ( ifi > 1 )  THEN
+         IF ( obsdatatmp(1)%cdjuldref /= obsdata(1)%cdjuldref ) THEN
+            WRITE(*,*)'Different reference dates'
+            CALL abort
+         ENDIF
+      ENDIF
+      !
+      ! Special fix for daily average MRB data (820) for the first file
+      !
+      IF (ldaily820.AND.(ifi==1)) THEN
+         DO ij = 1,obsdatatmp(1)%nobs
+            READ(obsdatatmp(1)%cdtyp(ij),'(I5)')ityp
+            IF (ityp==820) THEN
+               obsdatatmp(1)%ptim(ij)=INT(obsdatatmp(1)%ptim(ij))+1.0
+            ENDIF
+         ENDDO
+      ENDIF
+      !
+      ! Construct sorting arrays
+      !
+      ALLOCATE( zsort(3,obsdatatmp(1)%nobs), iset(obsdatatmp(1)%nobs), &
+         & inum(obsdatatmp(1)%nobs), iindex(obsdatatmp(1)%nobs))
+      ii = 0
+      DO ij = 1,obsdatatmp(1)%nobs
+         ii = ii+1
+         zsort(1,ii) = obsdatatmp(1)%ptim(ij)
+         zsort(2,ii) = obsdatatmp(1)%pphi(ij)
+         zsort(3,ii) = obsdatatmp(1)%plam(ij)
+         iset(ii) = 1
+         inum(ii) = ij
+      ENDDO
+      !
+      ! Get indexes for time sorting.
+      !
+      CALL index_sort_dp_n(zsort,3,iindex,obsdatatmp(1)%nobs)
+      CALL init_obfbdata( obsdata(ifi) )
+      CALL alloc_obfbdata( obsdata(ifi), &
+         &                 obsdatatmp(1)%nvar, obsdatatmp(1)%nobs, &
+         &                 obsdatatmp(1)%nlev, obsdatatmp(1)%nadd, &
+         &                 obsdatatmp(1)%next, obsdatatmp(1)%lgrid )
+      !
+      ! Copy input data into output data
+      !
+      CALL merge_obfbdata( 1, obsdatatmp, obsdata(ifi), iset, inum, iindex )
+      CALL dealloc_obfbdata( obsdatatmp(1) )
+      
+      WRITE(*,'(2A)')'File = ', TRIM(cdinfile(ifi))
+      WRITE(*,'(A,I9,A)')'has', obsdata(ifi)%nobs, ' observations'
+
+      DEALLOCATE( zsort, iset, inum, iindex )
+
+   ENDDO
+   !
+   ! Prepare output data
+   ! 
+   CALL init_obfbdata( obsoutdata )
+   !
+   ! Count number of additional fields
+   !
+   nadd = 0
+   DO ifi = 1, ninfiles
+      nadd = nadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Count number of unique extra fields
+   !
+   ! First the maximum to construct list
+   next = 0
+   DO ifi = 1, ninfiles
+      next = next + obsdata(ifi)%next
+   ENDDO
+   ALLOCATE( &
+      & cexttmp(next) &
+      & )
+   ! Setup pextinf structure and search for unique extra fields
+   ALLOCATE( &
+      & pextinf(ninfiles) &
+      & )
+   next = 0
+   DO ifi = 1, ninfiles
+      ALLOCATE( &
+         & pextinf(ifi)%luse(obsdata(ifi)%next), &
+         & pextinf(ifi)%ipos(obsdata(ifi)%next)  &
+         & )
+      DO ie = 1, obsdata(ifi)%next
+         llfound = .FALSE.
+         DO ii = 1, next
+            IF ( cexttmp(ii) == obsdata(ifi)%cextname(ie) ) THEN
+               llfound = .TRUE.
+            ENDIF
+         ENDDO
+         IF (llfound) THEN
+            pextinf(ifi)%luse(ie) = .FALSE.
+            pextinf(ifi)%ipos(ie) = -1
+         ELSE
+            next = next + 1
+            pextinf(ifi)%luse(ie) = .TRUE.
+            pextinf(ifi)%ipos(ie) = next
+            cexttmp(next) = obsdata(ifi)%cextname(ie)
+         ENDIF
+      ENDDO
+   ENDDO
+   !
+   ! Copy the first input data to output data
+   !
+   CALL copy_obfbdata( obsdata(1), obsoutdata, &
+      &                kadd = nadd, kext = next )
+   ALLOCATE( ltaken(obsoutdata%nlev) )
+   iadd = 0
+   DO ifi = 1, ninfiles
+      DO ia = 1, obsdata(ifi)%nadd
+         cdtmp = TRIM(obsdata(ifi)%caddname(ia))//TRIM(cdnames(ifi))
+         obsoutdata%caddname(iadd+ia) = cdtmp(1:ilenname)
+         DO iv = 1, obsdata(ifi)%nvar
+            obsoutdata%caddlong(iadd+ia,iv) = obsdata(ifi)%caddlong(ia,iv)
+            obsoutdata%caddunit(iadd+ia,iv) = obsdata(ifi)%caddunit(ia,iv)
+         ENDDO
+      ENDDO
+      DO ie = 1, obsdata(ifi)%next
+         IF ( pextinf(ifi)%luse(ie) ) THEN
+            obsoutdata%cextname(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextname(ie)
+            obsoutdata%cextlong(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextlong(ie)
+            obsoutdata%cextunit(pextinf(ifi)%ipos(ie)) = &
+               & obsdata(ifi)%cextunit(ie)
+         ENDIF
+      ENDDO
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Allocate comparison arrays and file them
+   ! 
+   IF (ilenwmo>8) THEN
+      WRITE(*,*)'Fix fbmatchup to allow string length > 8'
+      CALL abort
+   ENDIF
+   ALLOCATE(zrtim(obsoutdata%nobs),zrphi(obsoutdata%nobs), &
+      &     zrlam(obsoutdata%nobs),irwmo(obsoutdata%nobs))
+   DO i1 = 1, obsoutdata%nobs
+      irwmo(i1) = TRANSFER( obsoutdata%cdwmo(i1), irwmo(i1) )
+      zrtim(i1) = REAL( obsoutdata%ptim(i1), fbsp )
+      zrphi(i1) = REAL( obsoutdata%pphi(i1), fbsp )
+      zrlam(i1) = REAL( obsoutdata%plam(i1), fbsp ) 
+   ENDDO
+   !
+   ! Merge extra data into output data
+   !
+   iadd = obsdata(1)%nadd
+   DO ifi = 2, ninfiles
+      ist = 1
+      DO ii = 1, obsdata(ifi)%nobs
+         IF (MOD(ii,10000)==1) THEN
+            WRITE(*,*)'Handling observation no ',ii,' for file no ',ifi
+         ENDIF
+         llfound = .FALSE.
+         iwmo = TRANSFER( obsdata(ifi)%cdwmo(ii), iwmo )
+         ztim = REAL( obsdata(ifi)%ptim(ii), fbsp )
+         zphi = REAL( obsdata(ifi)%pphi(ii), fbsp )
+         zlam = REAL( obsdata(ifi)%plam(ii), fbsp ) 
+         ! Check if the the same index is the right one.
+         IF ( iwmo == irwmo(ii) ) THEN
+            IF ( ztim == zrtim(ii) ) THEN
+               IF (  zphi == zrphi(ii) ) THEN
+                  IF ( zlam == zrlam(ii) ) THEN
+                     llfound = .TRUE.
+                     i1 = ii
+                  ENDIF
+               ENDIF
+            ENDIF
+         ENDIF
+         ! Search for position in from previous found position
+         ! if not the same index
+         IF (.NOT.llfound) THEN
+            DO i1 = ist, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If not fount try agan from the beginnning
+         IF ( .NOT.llfound ) THEN
+            DO i1 = 1, obsoutdata%nobs
+               IF ( iwmo == irwmo(i1) ) THEN
+                  IF ( ztim == zrtim(i1) ) THEN
+                     IF (  zphi == zrphi(i1) ) THEN
+                        IF ( zlam == zrlam(i1) ) THEN
+                           llfound = .TRUE.
+                           EXIT
+                        ENDIF
+                     ENDIF
+                  ENDIF
+               ENDIF
+            ENDDO
+         ENDIF
+         ! If found put the data into the common structure
+         IF (llfound) THEN
+            obsoutdata%ioqc(i1) = & 
+               & MAX( obsoutdata%ioqc(i1), obsdata(ifi)%ioqc(ii) )
+            obsoutdata%ipqc(i1) = &
+               & MAX( obsoutdata%ipqc(i1), obsdata(ifi)%ipqc(ii) )
+            obsoutdata%itqc(i1) = &
+               & MAX( obsoutdata%itqc(i1), obsdata(ifi)%itqc(ii) )
+            obsoutdata%ivqc(i1,:) = &
+               & MAX( obsoutdata%ivqc(i1,:), obsdata(ifi)%ivqc(ii,:) )
+            obsoutdata%ioqcf(:,i1)   = IOR( obsdata(ifi)%ioqcf(:,ii), &
+               &                            obsoutdata%ioqcf(:,i1) )
+            obsoutdata%ipqcf(:,i1)   = IOR( obsdata(ifi)%ipqcf(:,ii), &
+               &                            obsoutdata%ipqcf(:,i1) )
+            obsoutdata%itqcf(:,i1)   = IOR( obsdata(ifi)%itqcf(:,ii), &
+               &                            obsoutdata%itqcf(:,i1) )
+            obsoutdata%ivqcf(:,i1,:) = IOR( obsdata(ifi)%ivqcf(:,ii,:), &
+               &                            obsoutdata%ivqcf(:,i1,:) )
+            llfound = .FALSE.
+            ! Search for levels 
+            ltaken(:) = .FALSE.
+            DO ik1 = 1, obsdata(ifi)%nlev
+               levloop : DO ik2 = 1, obsoutdata%nlev
+                  IF ( REAL( obsdata(ifi)%pdep(ik1,ii), fbsp ) ==  &
+                     & REAL( obsoutdata%pdep(ik2,i1),  fbsp ) ) THEN
+                     lnotobs=.TRUE.
+                     IF (ltaken(ik2)) CYCLE
+                     DO iv = 1, obsdata(ifi)%nvar
+                        IF ( REAL( obsdata(ifi)%pob(ik1,ii,iv), fbsp ) == &
+                           & REAL( obsoutdata%pob(ik2,i1,iv), fbsp ) ) THEN
+                           lnotobs=.FALSE.
+                        ENDIF
+                     ENDDO
+                     IF (lnotobs) CYCLE levloop
+                     ltaken(ik2)=.TRUE.
+                     DO ia = 1, obsdata(ifi)%nadd
+                        obsoutdata%padd(ik2,i1,iadd+ia,:) = &
+                           & obsdata(ifi)%padd(ik1,ii,ia,:)
+                     ENDDO
+                     DO ie = 1, obsdata(ifi)%next
+                        IF ( pextinf(ifi)%luse(ie) ) THEN
+                           obsoutdata%pext(ik2,i1,pextinf(ifi)%ipos(ie)) = &
+                              & obsdata(ifi)%pext(ik1,ii,ie)
+                        ENDIF
+                     ENDDO
+                     obsoutdata%idqc(ik2,i1) = &
+                        & MAX( obsoutdata%idqc(ik2,i1), obsdata(ifi)%idqc(ik1,ii) )
+                     obsoutdata%ivlqc(ik2,i1,:) = &
+                        & MAX( obsoutdata%ivlqc(ik2,i1,:), obsdata(ifi)%ivlqc(ik1,ii,:) )
+                     obsoutdata%idqcf(:,ik2,i1)    = &
+                        &                IOR( obsdata(ifi)%idqcf(:,ik1,ii), &
+                        &                     obsoutdata%idqcf(:,ik2,i1) )
+                     obsoutdata%ivlqcf(:,ik2,i1,:) = &
+                        &                IOR( obsdata(ifi)%ivlqcf(:,ik1,ii,:), &
+                        &                     obsoutdata%ivlqcf(:,ik2,i1,:) )
+                     llfound = .TRUE.
+                     EXIT
+                  ENDIF
+               ENDDO levloop
+               ! Write warning if level not found
+               IF (.NOT.llfound.AND.(obsdata(ifi)%pdep(ik1,ii)/=fbrmdi)) THEN
+                  WRITE(*,*)'Level not found in first file : ',&
+                     &      TRIM( cdinfile(1)  )
+                  WRITE(*,*)'Data file                     : ',&
+                     &      TRIM( cdinfile(ifi) )
+                  WRITE(*,*)'Identifier                    : ',&
+                     &      obsdata(ifi)%cdwmo(ii)
+                  WRITE(*,*)'Julifin date                   : ',&
+                     &      obsdata(ifi)%ptim(ii)
+                  WRITE(*,*)'Latitude                      : ',&
+                     &      obsdata(ifi)%pphi(ii)
+                  WRITE(*,*)'Longitude                     : ',&
+                     &      obsdata(ifi)%plam(ii)
+                  WRITE(*,*)'Depth                         : ',&
+                     &      obsdata(ifi)%pdep(ik1,ii)
+               ENDIF
+            ENDDO
+            ist = i1
+         ELSE
+            ! Write warning if observation not found
+            WRITE(*,*)'Observation not found in first data file : ',&
+               &      TRIM( cdinfile(1)  )
+            WRITE(*,*)'Data file                                : ',&
+               &      TRIM( cdinfile(ifi) )
+            WRITE(*,*)'Identifier                               : ',&
+               &      obsdata(ifi)%cdwmo(ii)
+            WRITE(*,*)'Julifin date                              : ',&
+               &      obsdata(ifi)%ptim(ii)
+            WRITE(*,*)'Latitude                                 : ',&
+               &      obsdata(ifi)%pphi(ii)
+            WRITE(*,*)'Longitude                                : ',&
+               &      obsdata(ifi)%plam(ii)
+            ist = 1
+         ENDIF
+      ENDDO
+      IF (obsdata(ifi)%nobs>0) THEN
+         WRITE(*,*)'Handled last obs. no    ',ii,' for file no ',ifi
+      ENDIF
+      iadd = iadd + obsdata(ifi)%nadd
+   ENDDO
+   !
+   ! Write output file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), obsoutdata )
+   !
+   ! Deallocate temporary data
+   ! 
+   DEALLOCATE(zrtim,zrphi,zrlam,irwmo )
+   DEALLOCATE( &
+      & cexttmp &
+      & )
+   DO ifi = 1, ninfiles
+      DEALLOCATE( &
+         & pextinf(ifi)%luse, &
+         & pextinf(ifi)%ipos  &
+         & )
+   ENDDO
+   DEALLOCATE( &
+      & pextinf &
+      & )
+
+END PROGRAM fbmatchup
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbprint.F90	(revision 3294)
@@ -0,0 +1,536 @@
+PROGRAM fbprint
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbprint **
+   !!
+   !!  ** Purpose : Print feedback file contents as text
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage :
+   !!     fbprint.exe [options] inputfile
+   !!   Options :
+   !!     -b            shorter output
+   !!     -q            QC flags (nqc=1) select observations based on QC flags
+   !!     -Q            QC flags (nqc=2) select observations based on QC flags
+   !!     -B            QC flags (nqc=3) select observations based on QC flags
+   !!     -u            unsorted
+   !!     -s ID         select station ID  
+   !!     -t TYPE       select observation type
+   !!     -v NUM1-NUM2  select variable range to print by number (default all)
+   !!     -a NUM1-NUM2  select additional variable range to print by number (default all)
+   !!     -e NUM1-NUM2  select extra variable range to print by number (default all)
+   !!     -d            output date range
+   !!     -D            print depths
+   !!     -z            use zipped files
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE toolspar_kind 
+   USE obs_fbm
+   USE index_sort
+   USE date_utils
+   USE proftools
+
+   IMPLICIT NONE
+   !
+   ! Command line arguments input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdinfile, cdbrief
+   LOGICAL :: lbrief, lqcflags, lstat, ltyp, lsort, ldaterange, lzinp, ldepths
+   CHARACTER(len=ilenwmo) :: cdstat
+   CHARACTER(len=ilentyp) :: cdtyp
+   INTEGER :: nqc
+   INTEGER :: nvar1, nvar2, nadd1, nadd2, next1, next2
+   !
+   ! Input data
+   !
+   TYPE(obfbdata) :: obsdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ii, iarg, ip
+   !
+   ! Sorting
+   !
+   INTEGER :: iwmo
+   REAL(KIND=dp),ALLOCATABLE :: zsort(:,:)
+   INTEGER,ALLOCATABLE  :: iindex(:)
+   !
+   ! Get number of command line arguments
+   !
+   nargs  = IARGC()
+   lbrief = .FALSE.
+   lstat = .FALSE.
+   ltyp = .FALSE.
+   ldaterange = .FALSE.
+   ldepths = .FALSE.
+   cdstat = 'XXXXXXX'
+   cdtyp = 'XXXX'
+   lsort = .TRUE.
+   nqc = 0
+   nvar1 = -1
+   nvar2 = -1
+   nadd1 = -1
+   nadd2 = -1
+   next1 = -1
+   next2 = -1
+   lzinp = .FALSE.
+   IF ( nargs < 1 ) THEN
+      CALL usage()
+   ENDIF
+   iarg = 1
+   DO
+      IF ( iarg == nargs ) EXIT
+      CALL getarg( iarg, cdbrief )
+      IF ( cdbrief == '-b' ) THEN
+         lbrief = .TRUE.
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-q' ) THEN
+         lqcflags = .TRUE.
+         nqc=1
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-Q' ) THEN
+         lqcflags = .TRUE.
+         nqc=2
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-B' ) THEN
+         lqcflags = .TRUE.
+         nqc=3
+         iarg = iarg + 1
+      ELSEIF( cdbrief == '-u' ) THEN
+         lsort = .FALSE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-s' ) THEN
+         lstat = .TRUE.
+         CALL getarg( iarg + 1, cdstat )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-t' ) THEN
+         ltyp = .TRUE.
+         CALL getarg( iarg + 1, cdtyp )
+         iarg = iarg + 2 
+      ELSEIF ( cdbrief == '-v' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nvar1
+            IF (nvar1==0) THEN
+               nvar2=-1
+            ELSE
+               nvar2 = nvar1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nvar1=1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nvar1
+            READ(cdbrief(ip+1:),'(I10)') nvar2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-a' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') nadd1
+            IF (nadd1==0) THEN
+               nadd2=-1
+            ELSE
+               nadd2 = nadd1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            nadd1=1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') nadd1
+            READ(cdbrief(ip+1:),'(I10)') nadd2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-e' ) THEN
+         CALL getarg( iarg + 1, cdbrief )
+         ip=INDEX(cdbrief,'-')
+         IF (ip==0) THEN
+            READ(cdbrief,'(I10)') next1
+            IF (next1==0) THEN
+               next2=-1
+            ELSE
+               next2 = next1
+            ENDIF
+         ELSEIF(ip==1) THEN
+            next1=1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ELSE
+            READ(cdbrief(1:ip-1),'(I10)') next1
+            READ(cdbrief(ip+1:),'(I10)') next2
+         ENDIF
+         iarg = iarg + 2
+      ELSEIF ( cdbrief == '-d' ) THEN
+         ldaterange=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-D' ) THEN
+         ldepths=.TRUE.
+         iarg = iarg + 1
+      ELSEIF ( cdbrief == '-z' ) THEN
+         lzinp=.TRUE.
+         iarg = iarg + 1
+      ELSE
+         CALL usage
+      ENDIF
+   ENDDO
+   CALL getarg( nargs, cdinfile )
+   !
+   ! Get input data
+   !
+   IF (lzinp) THEN
+#if defined NOSYSTEM
+      WRITE(*,*)'Compressed files need the system subroutine call'
+      CALL abort
+#else
+      CALL system( 'cp '//TRIM(cdinfile)//' fbprint_tmp.nc.gz' )
+      CALL system( 'gzip -df fbprint_tmp.nc.gz' )
+      CALL read_obfbdata( 'fbprint_tmp.nc', obsdata )
+      CALL system( 'rm -f fbprint_tmp.nc' )
+#endif
+   ELSE
+      CALL read_obfbdata( TRIM(cdinfile), obsdata )
+   ENDIF
+   CALL sealsfromargo( obsdata )
+   WRITE(*,'(2A,I9,A,I9,A)')TRIM(cdinfile), ' has ', obsdata%nobs ,&
+      & ' observations and a maximum of ', obsdata%nlev, ' levels'
+   IF (nvar1<0) THEN
+      nvar1 = 1
+      nvar2 = obsdata%nvar
+   ENDIF
+   IF (nadd1<0) THEN
+      nadd1 = 1
+      nadd2 = obsdata%nadd
+   ENDIF
+   IF (next1<0) THEN
+      next1 = 1
+      next2 = obsdata%next
+   ENDIF
+   !
+   ! Sort the data
+   !   
+   ALLOCATE(zsort(5,obsdata%nobs),iindex(obsdata%nobs))
+   IF (lsort) THEN
+      DO ii=1,obsdata%nobs
+         zsort(1,ii)=obsdata%ptim(ii)
+         zsort(2,ii)=obsdata%pphi(ii)
+         zsort(3,ii)=obsdata%plam(ii)
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(1:4), iwmo )
+         zsort(4,ii) = iwmo
+         iwmo = TRANSFER( obsdata%cdwmo(ii)(5:8), iwmo )
+         zsort(5,ii) = iwmo
+      ENDDO
+      CALL index_sort_dp_n(zsort,5,iindex,obsdata%nobs)
+   ELSE
+      DO ii=1,obsdata%nobs
+         iindex(ii)=ii
+      ENDDO
+   ENDIF
+   IF (ldaterange) THEN
+      IF (obsdata%nobs>0) THEN
+         WRITE(*,'(A)')'First observation'
+         CALL print_time(obsdata%ptim(1))
+         WRITE(*,'(A)')'Last observation'
+         CALL print_time(obsdata%ptim(obsdata%nobs))
+      ENDIF
+   ELSE
+      !
+      ! Print the sorted list
+      !   
+      DO ii=1,obsdata%nobs
+         IF (lstat) THEN
+            IF (TRIM(ADJUSTL(cdstat)) /= &
+               &TRIM(ADJUSTL(obsdata%cdwmo(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ltyp) THEN
+            IF (TRIM(ADJUSTL(cdtyp)) /= &
+               &TRIM(ADJUSTL(obsdata%cdtyp(iindex(ii))))) CYCLE
+         ENDIF
+         IF (ldepths) THEN
+            CALL print_depths(obsdata,iindex(ii))
+         ELSE
+            IF (lqcflags) THEN
+               CALL print_obs_qc(obsdata,iindex(ii),nqc,nvar1,nvar2)
+            ELSE
+               CALL print_obs(obsdata,iindex(ii),lbrief,&
+                  &           nvar1,nvar2,nadd1,nadd2,next1,next2)
+            ENDIF
+         ENDIF
+      ENDDO
+
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE usage
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbprint [options] inputfile'
+      CALL abort()
+   END SUBROUTINE usage
+   
+   SUBROUTINE print_depths(obsdata,iindex)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      INTEGER :: kj
+      REAL :: mindep,maxdep
+
+      mindep=10000
+      maxdep=0
+      DO kj=1,obsdata%nlev
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            IF (obsdata%pdep(kj,iindex)>maxdep) maxdep=obsdata%pdep(kj,iindex)
+            IF (obsdata%pdep(kj,iindex)<mindep) mindep=obsdata%pdep(kj,iindex)
+         ENDIF
+      ENDDO
+      
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Minimum obs. depth  = ',mindep
+      WRITE(*,*)'Maximum obs. depth  = ',maxdep
+      WRITE(*,*)
+
+   END SUBROUTINE print_depths
+
+   SUBROUTINE print_obs(obsdata,iindex,lshort,&
+      &                 kvar1,kvar2,kadd1,kadd2,kext1,kext2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lshort
+      INTEGER :: kvar1,kvar2,kadd1,kadd2,kext1,kext2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      IF (.NOT.lshort) THEN
+         DO jv = kvar1, kvar2
+            WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+            WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+            IF (obsdata%lgrid) THEN
+               WRITE(*,*)'Grid I              = ',obsdata%iobsi(iindex,jv)
+               WRITE(*,*)'Grid J              = ',obsdata%iobsj(iindex,jv)
+            ENDIF
+         ENDDO
+         cdfmt1='(1X,A8,1X,A8'
+         cdfmt2='(1X,F8.2,1X,I8'
+         DO jv = kvar1, kvar2
+            cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+            cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+            IF (kadd2-kadd1+1>0) THEN
+               WRITE(cdtmp,'(I10)')kadd2-kadd1+1
+               cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+               cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+            ENDIF
+            IF (obsdata%lgrid) THEN
+               cdfmt1 = TRIM(cdfmt1)//',1X,A10'
+               cdfmt2 = TRIM(cdfmt2)//',1X,I10'
+            ENDIF
+         ENDDO
+         IF (kext2-kext1+1>0) THEN
+            WRITE(cdtmp,'(I10)')kext2-kext1+1
+            cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+            cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+         ENDIF
+         cdfmt1=TRIM(cdfmt1)//')'
+         cdfmt2=TRIM(cdfmt2)//')'
+         IF (obsdata%lgrid) THEN
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//'_'//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & TRIM(obsdata%cname(jv))//'_K' , &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & obsdata%iobsk(kj,iindex,jv), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ELSE
+            cdfmt1=TRIM(cdfmt1)//')'
+            cdfmt2=TRIM(cdfmt2)//')'
+            WRITE(*,FMT=cdfmt1)&
+               & 'DEPTH', 'DEP_QC', &
+               & (TRIM(obsdata%cname(jv))//'_OBS', &
+               & TRIM(obsdata%cname(jv))//'_QC' , &
+               & (TRIM(obsdata%cname(jv))//TRIM(obsdata%caddname(ja)),&
+               & ja = kadd1, kadd2 ), &
+               & jv = kvar1, kvar2 ), &
+               & ( TRIM(obsdata%cextname(ja)),&
+               & ja = kext1, kext2 )
+            DO kj=1,obsdata%nlev
+               IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+                  WRITE (*,FMT=cdfmt2) &
+                     & obsdata%pdep(kj,iindex),   &
+                     & obsdata%idqc(kj,iindex),   &
+                     & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+                     & ( obsdata%padd(kj,iindex,ja,jv) , ja = kadd1, kadd2 ), &
+                     & jv = kvar1, kvar2 ), &
+                     & ( obsdata%pext(kj,iindex,ja), ja = kext1, kext2 )
+               ENDIF
+            ENDDO
+         ENDIF
+      ENDIF
+      WRITE(*,*)
+   END SUBROUTINE print_obs
+   
+   SUBROUTINE print_obs_qc(obsdata,iindex,kqc,kvar1,kvar2)
+      IMPLICIT NONE
+      TYPE(obfbdata) :: obsdata
+      INTEGER :: iindex
+      LOGICAL :: lqc
+      INTEGER :: kqc
+      INTEGER :: kvar1,kvar2
+      INTEGER :: jv,ja,je,jk
+      INTEGER :: kj
+      LOGICAL :: lskip
+      CHARACTER(len=1024) :: cdfmt1,cdfmt2
+      CHARACTER(len=16) :: cdtmp
+      INTEGER :: iqcf
+      
+      IF (kqc==2) THEN
+         lskip=.TRUE.
+         IF (obsdata%ipqc(iindex)>1) lskip=.FALSE.
+         IF (obsdata%ioqc(iindex)>1) lskip=.FALSE.
+         DO jv = kvar1, kvar2
+            IF (obsdata%ivqc(iindex,jv)>1) lskip=.FALSE.
+         ENDDO
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ELSEIF (kqc==3) THEN
+         lskip=.TRUE.
+         DO kj=1,obsdata%nlev
+            IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+               iqcf=0
+               DO jv = kvar1, kvar2
+                  IF (obsdata%ivlqc(kj,iindex,jv)>1) iqcf=iqcf+1
+                  IF (iqcf==obsdata%nvar) lskip=.FALSE.
+               ENDDO
+            ENDIF
+         ENDDO
+         IF (lskip) RETURN
+      ENDIF
+      WRITE(*,*)'Fileindex           = ',obsdata%kindex(iindex)
+      WRITE(*,*)'Station identifier  = ',obsdata%cdwmo(iindex)
+      WRITE(*,*)'Station type        = ',obsdata%cdtyp(iindex)
+      WRITE(*,*)'Latitude            = ',obsdata%pphi(iindex)
+      WRITE(*,*)'Longtude            = ',obsdata%plam(iindex)
+      CALL print_time( obsdata%ptim(iindex) )
+      WRITE(*,*)'Position QC         = ',obsdata%ipqc(iindex)
+      WRITE(*,*)'Position QC flags   = ',obsdata%ipqcf(:,iindex)
+      WRITE(*,*)'Observation QC      = ',obsdata%ioqc(iindex)
+      WRITE(*,*)'Observation QC flags= ',obsdata%ioqcf(:,iindex)
+      DO jv = kvar1, kvar2
+         WRITE(*,*)'Variable name       = ',obsdata%cname(jv)
+         WRITE(*,*)'Variable QC         = ',obsdata%ivqc(iindex,jv)
+         WRITE(*,*)'Variable QC flags   = ',obsdata%ivqcf(:,iindex,jv)
+      ENDDO
+      cdfmt1='(1X,A8,1X,A8'
+      cdfmt2='(1X,F8.2,1X,I8'
+      WRITE(cdtmp,'(I10)')obsdata%nqcf
+      cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+      cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      DO jv = kvar1, kvar2
+         cdfmt1 = TRIM(cdfmt1)//',1X,A15,1X,A8'
+         cdfmt2 = TRIM(cdfmt2)//',1X,E15.9,1X,I8'
+         WRITE(cdtmp,'(I10)')obsdata%nqcf
+         cdfmt1 = TRIM(cdfmt1)//',1X,A18'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(I9)'
+      ENDDO
+      IF (obsdata%next>0) THEN
+         WRITE(cdtmp,'(I10)')obsdata%next
+         cdfmt1 = TRIM(cdfmt1)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,A15)'
+         cdfmt2 = TRIM(cdfmt2)//',1X,'//TRIM(ADJUSTL(cdtmp))//'(1X,E15.9)'
+      ENDIF
+      cdfmt1=TRIM(cdfmt1)//')'
+      cdfmt2=TRIM(cdfmt2)//')'
+      WRITE(*,FMT=cdfmt1)&
+         & 'DEPTH', 'DEP_QC', 'DEP_QC_FLAGS', &
+         & (TRIM(obsdata%cname(jv))//'_OBS', &
+         & TRIM(obsdata%cname(jv))//'_QC' , &
+         & TRIM(obsdata%cname(jv))//'_QC_FLAGS',&
+         & jv = kvar1, kvar2 ), &
+         & ( TRIM(obsdata%cextname(ja)),&
+         & ja = 1, obsdata%next )
+      DO kj=1,obsdata%nlev
+         IF (kqc>=2)  THEN
+            lskip=.TRUE.
+            IF (obsdata%idqc(kj,iindex)>1) lskip=.FALSE.
+            DO jv = kvar1, kvar2
+               IF (obsdata%ivlqc(kj,iindex,jv)>1) lskip=.FALSE.
+            ENDDO
+            IF (lskip) CYCLE
+         ENDIF
+         IF (obsdata%pdep(kj,iindex)<99999.0) THEN
+            WRITE (*,FMT=cdfmt2) &
+               & obsdata%pdep(kj,iindex),   &
+               & obsdata%idqc(kj,iindex),   &
+               & ( obsdata%idqcf(ja,kj,iindex), ja = 1, obsdata%nqcf ), &
+               & ( obsdata%pob(kj,iindex,jv), obsdata%ivlqc(kj,iindex,jv), &
+               & ( obsdata%ivlqcf(ja,kj,iindex,jv) , ja=1, obsdata%nqcf ), &
+               & jv = kvar1, kvar2 ), &
+               & ( obsdata%pext(kj,iindex,ja), ja=1, obsdata%next )
+         ENDIF
+      ENDDO
+      WRITE(*,*)
+      
+   END SUBROUTINE print_obs_qc
+
+   SUBROUTINE print_time(ptim)
+      IMPLICIT NONE
+      REAL(fbdp) :: ptim
+      INTEGER:: iyr,imon,iday,ihou,imin,isec      
+      WRITE(*,*)'Julian date         = ',ptim
+      CALL jul2greg(isec,imin,ihou,iday,imon,iyr,ptim)
+      WRITE(*,'(1X,A,I4,2I2.2)') &
+         &      'Gregorian date      = ',iyr,imon,iday
+      WRITE(*,'(1X,A,I2.2,A1,I2.2,A1,I2.2)') &
+         &      'Time                = ',ihou,':',imin,':',isec
+   END  SUBROUTINE print_time
+
+END PROGRAM fbprint
+
+   
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbsel.F90	(revision 3294)
@@ -0,0 +1,260 @@
+PROGRAM fbsel
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbsel **
+   !!
+   !!  ** Purpose : Select or subsample observations
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbsel.exe <input filename> <output filename>
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE date_utils
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdatain,fbdataout
+   CHARACTER(len=256) :: filenamein,filenameout,filenametmp,cnameout
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER,PARAMETER :: maxtyp=1023
+   INTEGER,PARAMETER :: maxdates=20
+   INTEGER :: nqc,ntyp,ndates,ninidate(maxdates),nenddate(maxdates)
+   LOGICAL :: lsplitqc,lsplittyp,lsplitstat
+   INTEGER :: iqc,ityp,idate,istat
+   REAL :: maxlat,minlat,maxlon,minlon
+   CHARACTER(len=ilenwmo) :: cdwmo,cdwmobeg,cdwmoend
+   CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+   INTEGER :: nstat
+   NAMELIST/namsel/nqc,ntyp,ndates,ninidate,nenddate,lsplitqc,lsplittyp, &
+      &            lsplitstat,maxlat,minlat,maxlon,minlon,cdwmo,&
+      &            cdwmobeg,cdwmoend
+
+   IF (iargc()/=2) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbsel <input filename> <output filename>'
+      CALL abort
+   ENDIF
+
+   CALL getarg(1,filenamein)
+   CALL getarg(2,filenameout)
+   
+   nqc=-1
+   ntyp=-1
+   ndates=1
+   ninidate=19500101
+   nenddate=21000101
+
+   lsplitqc=.FALSE.
+   lsplittyp=.FALSE.
+   lsplitstat=.FALSE.
+   cdwmo=REPEAT('X',ilenwmo)
+   cdwmobeg=cdwmo
+   cdwmoend=cdwmo
+   maxlat=1e+38
+   minlat=-1e+38
+   maxlon=1e+38
+   minlon=-1e+38
+   OPEN(10,file='namsel.in')
+   READ(10,namsel)
+   CLOSE(10)
+   IF (cdwmobeg==REPEAT('X',ilenwmo)) cdwmobeg=cdwmo
+   IF (cdwmoend==REPEAT('X',ilenwmo)) cdwmoend=cdwmo
+   WRITE(*,namsel)
+
+   CALL init_obfbdata(fbdatain)
+   CALL init_obfbdata(fbdataout)
+
+   WRITE(*,*)'Reading file : ',TRIM(filenamein)
+   CALL read_obfbdata(TRIM(filenamein),fbdatain)
+   WRITE(*,*)'Number of observations before selection = ',fbdatain%nobs
+   DO idate=1,ndates
+      IF (ndates==1) THEN
+         cnameout=filenameout
+      ELSE
+         WRITE(cnameout,'(I2.2,2A)')idate,'_',TRIM(filenameout)
+      ENDIF
+      IF (lsplitqc) THEN
+         DO iqc=1,3
+            CALL fb_sel(fbdatain,fbdataout,iqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I2.2,A,A)')'qc_',iqc,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'QC selected = ',iqc
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplittyp) THEN
+         DO ityp=0,maxtyp
+            CALL fb_sel(fbdatain,fbdataout,nqc,ityp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+            WRITE(filenametmp,'(A,I4.4,A,A)')'typ_',ityp,'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Type = ',ityp
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSEIF (lsplitstat) THEN
+         CALL fb_sel_uniqueids(fbdatain,clstatids,nstat)
+         DO istat=1,nstat
+            CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, &
+               &        ninidate(idate),nenddate(idate), &
+               &        maxlat,minlat,maxlon,minlon,clstatids(istat),clstatids(istat))
+            WRITE(filenametmp,'(4A)')'statid_', &
+               & TRIM(clstatids(istat)),'_',TRIM(cnameout)
+            IF (fbdataout%nobs>0) THEN
+               WRITE(*,*)'Station = ',clstatids(istat)
+               WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+               WRITE(*,*)'Writing file : ',TRIM(filenametmp)
+               CALL write_obfbdata(TRIM(filenametmp),fbdataout)
+            ENDIF
+            CALL dealloc_obfbdata(fbdataout)
+         ENDDO
+      ELSE
+         CALL fb_sel(fbdatain,fbdataout,nqc,ntyp, & 
+            &        ninidate(idate),nenddate(idate), &
+            &        maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+         WRITE(*,*)'Number of observations selected = ',fbdataout%nobs
+         WRITE(*,*)'Writing file : ',TRIM(cnameout)
+         CALL write_obfbdata(TRIM(cnameout),fbdataout)
+         CALL dealloc_obfbdata(fbdataout)
+      ENDIF
+   ENDDO
+
+CONTAINS
+
+   SUBROUTINE fb_sel(fbdatain,fbdataout,nqc,ntyp,ninidate,nenddate,&
+      &              maxlat,minlat,maxlon,minlon,cdwmobeg,cdwmoend)
+      TYPE(obfbdata) :: fbdatain,fbdataout
+      INTEGER :: nqc,ntyp,ninidate,nenddate
+      REAL :: maxlat,minlat,maxlon,minlon
+      CHARACTER(len=ilenwmo) :: cdwmobeg,cdwmoend
+      INTEGER :: jobs
+      INTEGER :: iqc,ityp
+      LOGICAL :: llvalid(fbdatain%nobs)
+      INTEGER :: iyea,imon,iday
+      REAL(KIND=dp) :: zjini,zjend
+      LOGICAL :: lcheckwmo
+
+      lcheckwmo=(cdwmobeg/=REPEAT('X',ilenwmo)).OR.&
+         &      (cdwmoend/=REPEAT('X',ilenwmo))
+      iyea=ninidate/10000
+      imon=ninidate/100-iyea*100
+      iday=ninidate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjini)
+      iyea=nenddate/10000
+      imon=nenddate/100-iyea*100
+      iday=nenddate-iyea*10000-imon*100
+      CALL greg2jul(0,0,0,iday,imon,iyea,zjend)
+      DO jobs = 1, fbdatain%nobs
+         llvalid(jobs)=.TRUE.
+         IF (nqc/=-1) THEN
+            CALL check_prof(fbdatain,jobs,iqc)
+            llvalid(jobs)=(iqc==nqc).AND.llvalid(jobs)
+         ENDIF
+         IF (ntyp/=-1) THEN
+            READ(fbdatain%cdtyp(jobs),'(I4)')ityp
+            llvalid(jobs)=(ityp==ntyp).AND.llvalid(jobs)
+         ENDIF
+         IF (ninidate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)>zjini).AND.llvalid(jobs)
+         ENDIF
+         IF (nenddate/=-1) THEN
+            llvalid(jobs)=(fbdatain%ptim(jobs)<=zjend).AND.llvalid(jobs)
+         ENDIF
+         llvalid(jobs)=(fbdatain%pphi(jobs)<=maxlat).AND.       &
+            &          (fbdatain%pphi(jobs)>=minlat).AND.       &
+            &          (((fbdatain%plam(jobs)<=maxlon).AND.     &
+            &            (fbdatain%plam(jobs)>=minlon)).OR.     &
+            &           ((fbdatain%plam(jobs)+360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)+360>=minlon)).OR. &
+            &           ((fbdatain%plam(jobs)-360<=maxlon).AND. &
+            &            (fbdatain%plam(jobs)-360>=minlon))).AND.llvalid(jobs) 
+         IF (lcheckwmo) THEN
+            llvalid(jobs)=LGE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmobeg)) &
+               &    .AND. LLE(TRIM(fbdatain%cdwmo(jobs)),TRIM(cdwmoend)) &
+               &    .AND. llvalid(jobs)
+         ENDIF
+         ! Add more checks here...
+      ENDDO
+
+      CALL subsamp_obfbdata(fbdatain,fbdataout,llvalid)
+
+   END SUBROUTINE fb_sel
+
+   SUBROUTINE fb_sel_uniqueids(fbdatain,clstatids,nstat)
+      TYPE(obfbdata) :: fbdatain
+      CHARACTER(len=ilenwmo), DIMENSION(:), POINTER :: clstatids
+      INTEGER :: nstat
+      INTEGER :: jobs,kobs
+      LOGICAL, DIMENSION(fbdatain%nobs) :: lunique
+
+      lunique(:)=.TRUE.
+      DO jobs=1,fbdatain%nobs
+         IF (.NOT.lunique(jobs)) CYCLE
+         DO kobs=jobs+1,fbdatain%nobs
+            IF (.NOT.lunique(kobs)) CYCLE
+            IF (fbdatain%cdwmo(jobs)==fbdatain%cdwmo(kobs)) THEN
+               lunique(kobs)=.FALSE.
+            ENDIF
+         ENDDO
+      ENDDO
+      nstat=COUNT(lunique)
+      ALLOCATE(clstatids(nstat))
+      kobs=0
+      DO jobs=1,fbdatain%nobs
+         IF (lunique(jobs)) THEN
+            kobs=kobs+1
+            clstatids(kobs)=fbdatain%cdwmo(jobs)
+         ENDIF
+      ENDDO
+      WRITE(*,*)'Unique station ids'
+      DO jobs=1,nstat
+         WRITE(*,'(I5,1X,A)')jobs,clstatids(jobs)
+      ENDDO
+
+   END SUBROUTINE fb_sel_uniqueids
+   
+   SUBROUTINE check_prof(fbdata,iobs,iqc)
+      
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: iobs,iqc
+      INTEGER :: i,ivar
+      
+      LOGICAL :: lpart,lfull
+
+      lpart=.false.
+      lfull=.true.
+      DO ivar=1,fbdata%nvar
+         DO i=1,fbdata%nlev
+            IF ((fbdata%ivlqc(i,iobs,ivar)>2).AND.&
+               &(fbdata%ivlqc(i,iobs,ivar)<9)) lpart = .TRUE.
+            IF (fbdata%ivlqc(i,iobs,ivar)<=2) lfull = .FALSE.
+         ENDDO
+      ENDDO
+
+      IF(lfull) THEN
+         iqc=3
+      ELSEIF (lpart) then
+         iqc=2
+      ELSE
+         iqc=1
+      ENDIF
+
+   END SUBROUTINE check_prof
+
+END PROGRAM fbsel
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstat.F90	(revision 3294)
@@ -0,0 +1,1335 @@
+PROGRAM fbstat
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbstat **
+   !!
+   !!  ** Purpose : Output feedback file summary info/statistics
+   !!         into a number of .dat files for different areas
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbstat.exe [-nmlev] <filenames>
+   !!   Optional:
+   !!     namelist = namfbstat.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE fbaccdata
+   USE coords
+   USE omonainfo
+   USE fbstatncio
+   USE proftools
+   IMPLICIT NONE
+   TYPE(obfbdata) :: fbdata
+   CHARACTER(len=256) :: filename,outfilename
+   INTEGER :: jfile,jbox,jlev,jfirst,jvar,jadd,ji,ja,jt,jboxl
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   REAL,DIMENSION(:),ALLOCATABLE :: zlev
+   INTEGER :: nmlev, nfiles
+   LOGICAL :: lexists,lomona,ltext,lnetcdf,lzinp
+   REAL, ALLOCATABLE, DIMENSION(:,:,:) :: zdat3d
+   REAL, ALLOCATABLE, DIMENSION(:,:) :: zdat2d
+   INTEGER,DIMENSION(1) :: itime
+   INTEGER :: inidate,icurdate,loopno,ityp,iloopno
+   INTEGER :: nvar,nadd,noberr,nbgerr
+   CHARACTER(len=4) :: expver
+   CHARACTER(len=20) :: cltyp
+   CHARACTER(len=128) :: cdfmthead,cdfmtbody
+   LOGICAL :: lnear,linner,linnerp,linnerini,lpassive,lhistogram,lfound
+   LOGICAL :: lxyplot,lrmmean
+   INTEGER :: nqc,nqco
+   REAL :: rlspc,rlmax
+   CHARACTER(len=ilenname), DIMENSION(:), ALLOCATABLE :: cname,caddname,&
+      & cobename,cbgename
+   INTEGER, PARAMETER :: nmaxareas = 20
+   CHARACTER(len=20), DIMENSION(nmaxareas) :: carea
+   LOGICAL, DIMENSION(:), ALLOCATABLE :: lskipbox
+   INTEGER, parameter :: maxtyp = 10
+   CHARACTER(len=ilentyp), DIMENSION(maxtyp) :: ctyp
+   INTEGER :: ntyp,nboxuserl,ipdcst
+   REAL :: mindcst
+   NAMELIST/namfbstat/ltext,lomona,lnetcdf,nmlev,inidate,icurdate,loopno,&
+      &               expver,lnear,linner,lpassive,lhistogram,&
+      &               zhistmax,zhistmin,zhiststep,zcheck,carea,nmlev,&
+      &               nqc,nqco, &
+      &               rlspc,rlmax,ntyp,ctyp,&
+      &               lxyplot,zxymin,zxymax,zxystep,lzinp,lrmmean,mindcst
+
+   ltext=.TRUE.
+   lnetcdf=.TRUE.
+   lomona=.FALSE.
+   nmlev=31
+   inidate=19010101
+   icurdate=19010116
+   loopno=0
+   expver='test'
+   lnear=.TRUE.
+   linner=.FALSE.
+   lpassive=.FALSE.
+   lhistogram=.FALSE.
+   zhistmin(:)=-10.0
+   zhistmax(:)=10.0
+   zhiststep(:)=0.1
+   zcheck(:)=1000.0
+   nqc=2
+   nqco=2
+   carea(:)='all'
+   rlmax=5000.0
+   rlspc=-0.1
+   ntyp=1
+   ctyp(:)='all'
+   lxyplot=.FALSE.
+   zxymin(:)=-5.0
+   zxymax(:)=45.0
+   zxystep(:)=0.5
+   lzinp=.FALSE.
+   lrmmean=.FALSE.
+   mindcst=-1.0
+
+   INQUIRE(file='namfbstat.in',exist=lexists)
+   IF (lexists) THEN
+      OPEN(10,file='namfbstat.in')
+      READ(10,namfbstat)
+      CLOSE(10)
+      WRITE(*,namfbstat)
+   ENDIF
+   mindcst=mindcst*1000.0 !From km to m.
+   IF (iargc()==0) THEN
+      WRITE(*,*)'Usage:'
+      WRITE(*,*)'fbstat [-nmlev] <filenames>'
+      CALL abort
+   ENDIF
+   jfirst=1
+   DO ji=1,2
+      CALL getarg(jfirst,filename)
+      IF (filename=='-42') THEN
+         nmlev=42
+         jfirst=jfirst+1
+      ELSEIF(filename=='-31') THEN
+         nmlev=31
+         jfirst=jfirst+1
+      ELSEIF(filename=='-1') THEN
+         nmlev=1
+         lnear=.TRUE.
+         jfirst=jfirst+1
+      ELSEIF(filename=='-q') THEN
+         jfirst=jfirst+1
+         CALL getarg(jfirst,filename)
+         READ(filename,'(I4)')nqc
+         IF ((nqc<0).OR.(nqc>4)) THEN
+            WRITE(*,*)'Quality control option (-q) should be 1 to 4'
+            CALL abort
+         ENDIF
+         jfirst=jfirst+1
+      ENDIF
+   END DO
+   nfiles=iargc()
+
+   CALL coord_user_init('o')
+
+   ALLOCATE(lskipbox(nboxuser))
+   lskipbox(:)=.FALSE.
+
+   IF (carea(1)/='all') THEN
+      IF (lomona) THEN
+         WRITE(*,*)'For omona files carea(1) has to be all'
+         CALL abort
+      ENDIF
+      lskipbox(:)=.TRUE.
+      DO ji=1,nmaxareas
+         IF (carea(ji)/='all') THEN
+            lfound=.FALSE.
+            DO jbox=1,nboxuser
+               IF (TRIM(carea(ji))==TRIM(cl_boxes_user(jbox))) THEN
+                  lskipbox(jbox)=.FALSE.
+                  lfound=.TRUE.
+               ENDIF
+            ENDDO
+            IF (.NOT.lfound) THEN
+               WRITE(*,*)'Area ',TRIM(carea(ji)),' not found'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDDO
+      nboxuserl=0
+      DO ji=1,nboxuser
+         WRITE(*,*)'Area ',TRIM(cl_boxes_user(ji)),' is set to ',lskipbox(ji)
+         IF (.NOT.lskipbox(ji)) nboxuserl=nboxuserl+1
+      ENDDO
+      WRITE(*,*)'Total areas for statistics = ',nboxuserl
+      IF (lomona.AND.(nboxuserl/=nboxuser)) THEN
+         WRITE(*,*)'Omona files only possible if all areas'
+         CALL abort
+      ENDIF
+   ELSE
+      nboxuserl=nboxuser
+   ENDIF
+
+   IF (rlspc>0.0) THEN
+      lnear=.TRUE.
+      nmlev=rlmax/rlspc+1
+      ALLOCATE(zlev(nmlev))
+      DO ji=1,nmlev
+         zlev(ji)=(ji-1)*rlspc
+      ENDDO
+   ELSE
+      IF (.NOT.lnear) nmlev=nmlev-1
+      ALLOCATE(&
+         & zlev(nmlev) &
+         & )
+      IF(lnear) THEN
+         CALL getlevs(nmlev,zlev)
+      ELSE
+         CALL getlevsmean(nmlev,zlev)
+      ENDIF
+   ENDIF
+
+   DO jfile=jfirst, nfiles
+      CALL getarg(jfile,filename)
+      WRITE(*,*)'Handling file : ',TRIM(filename)
+      CALL flush(6)
+      IF (lzinp) THEN
+#if defined NOSYSTEM
+         WRITE(*,*)'Compressed files need the system subroutine call'
+         CALL abort
+#else
+         CALL system('cp '//TRIM(filename)//' fbstat_tmp.nc.gz')
+         CALL system('gzip -df fbstat_tmp.nc.gz')
+         CALL read_obfbdata('fbstat_tmp.nc',fbdata)
+         CALL system('rm -f fbstat_tmp.nc')
+#endif
+      ELSE
+         CALL read_obfbdata(TRIM(filename),fbdata)
+      ENDIF
+      CALL sealsfromargo( fbdata )
+      IF (jfile==jfirst) THEN
+         nvar=fbdata%nvar
+         nadd=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') nadd=nadd+1
+         ENDDO
+         noberr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') noberr=noberr+1
+         ENDDO
+         nbgerr=0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') nbgerr=nbgerr+1
+         ENDDO
+         IF (lhistogram) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want histograms'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               hist(jvar)%npoints=(zhistmax(jvar)-zhistmin(jvar))&
+                  &              /zhiststep(jvar)+1
+               WRITE(*,*)'Number of points in histogram      = ',&
+                  &  hist(jvar)%npoints
+               WRITE(*,*)'Size of histogram array (elements) = ',&
+                  &  hist(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & hist(jvar)%nhist(hist(jvar)%npoints,nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               hist(jvar)%nhist(:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ipdcst=0
+         IF (mindcst>0) THEN
+            DO ja= 1, fbdata%next
+               IF (TRIM(fbdata%cextname(ja))=='DCST') THEN
+                  ipdcst=ja
+                  EXIT 
+               ENDIF
+            ENDDO
+            IF (ipdcst==0) THEN
+               WRITE(*,*)'Distance to coast not found in file, but mindcst>0'
+               WRITE(*,*)'Extra variables:'
+               DO ja= 1, fbdata%next
+                  WRITE(*,*)ja,TRIM(fbdata%cextname(ja))
+               ENDDO
+               CALL abort
+            ENDIF
+         ENDIF
+         IF (lxyplot) THEN
+            IF (nvar>maxvars) THEN
+               WRITE(*,*)'fbstat.F90: Increase maxvars to ',nvar
+               WRITE(*,*)'if you want xyplots'
+               CALL abort
+            ENDIF
+            DO jvar = 1, nvar
+               xy(jvar)%npoints=(zxymax(jvar)-zxymin(jvar))&
+                  &              /zxystep(jvar)+1
+               WRITE(*,*)'Number of points in x and y for xyplots = ',&
+                  &  xy(jvar)%npoints
+               WRITE(*,*)'Size of xyplot array (elements)         = ',&
+                  &  xy(jvar)%npoints*xy(jvar)%npoints*nmlev*nboxuserl*nadd
+               ALLOCATE(&
+                  & xy(jvar)%nxy(xy(jvar)%npoints,xy(jvar)%npoints,&
+                  &              nmlev,nboxuserl,nadd,ntyp) &
+                  & )
+               xy(jvar)%nxy(:,:,:,:,:,:)=0
+            ENDDO
+         ENDIF
+         ALLOCATE(&
+            & inum(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & inumov(nmlev,nboxuserl,noberr,nvar,ntyp),  &
+            & inumbv(nmlev,nboxuserl,nbgerr,nvar,ntyp),  &
+            & inuma(nmlev,nboxuserl,nvar,ntyp),      &
+            & zbias(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zrms(nmlev,nboxuserl,nadd,nvar,ntyp),  &
+            & zsdev(nmlev,nboxuserl,nadd,nvar,ntyp), &
+            & zomean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zmmean(nmlev,nboxuserl,nadd,nvar,ntyp),&
+            & zoemea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zovmea(nmlev,nboxuserl,noberr,nvar,ntyp),&
+            & zbemea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zbvmea(nmlev,nboxuserl,nbgerr,nvar,ntyp),&
+            & zoamean(nmlev,nboxuserl,nvar,ntyp),    &
+            & cname(nvar),                           &
+            & caddname(nadd),                        &
+            & cobename(noberr),                      &
+            & cbgename(nbgerr)                       &
+            & )
+         DO jvar = 1, nvar
+            cname(jvar) = fbdata%cname(jvar)
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+               caddname(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+               cobename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+               cbgename(jadd) = fbdata%caddname(ja)
+            ENDIF
+         END DO
+         IF (nadd>0) THEN
+            inum(:,:,:,:,:)=0
+            zbias(:,:,:,:,:)=0.0
+            zrms(:,:,:,:,:)=0.0
+            zsdev(:,:,:,:,:)=0.0
+            zomean(:,:,:,:,:)=0.0 
+            zmmean(:,:,:,:,:)=0.0
+         ENDIF
+         IF (noberr>0) THEN
+            inumov(:,:,:,:,:)=0
+            zoemea(:,:,:,:,:)=0
+            zovmea(:,:,:,:,:)=0
+         ENDIF
+         IF (nbgerr>0) THEN
+            inumbv(:,:,:,:,:)=0
+            zbemea(:,:,:,:,:)=0
+            zbvmea(:,:,:,:,:)=0
+         ENDIF
+         inuma(:,:,:,:)=0
+         zoamean(:,:,:,:)=0.0
+      ELSE
+         IF (fbdata%nvar/=nvar) THEN
+            WRITE(*,*)'Different number of nvar ',fbdata%nvar,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:2)=='Hx') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nadd) THEN
+            WRITE(*,*)'Different number of nadd ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='OBE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=noberr) THEN
+            WRITE(*,*)'Different number of noberr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         jadd = 0
+         DO ja= 1, fbdata%nadd
+            IF (fbdata%caddname(ja)(1:3)=='BGE') THEN
+               jadd=jadd+1
+            ENDIF
+         END DO
+         IF (jadd/=nbgerr) THEN
+            WRITE(*,*)'Different number of nbgerr ',jadd,' in ',&
+               & TRIM(filename)
+            CALL abort
+         ENDIF
+         IF (ipdcst>0) THEN
+            IF (ipdcst>fbdata%next) THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+            IF (TRIM(fbdata%cextname(ipdcst))/='DCST') THEN
+               WRITE(*,*)'Distrance to coast in file not compatible with first file'
+               CALL abort
+            ENDIF
+         ENDIF
+      ENDIF
+      IF (lrmmean) THEN
+         CALL fb_rmmean(fbdata)
+      ENDIF
+      CALL fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,nqc,nqco,&
+         &         lhistogram,lxyplot,ntyp,ctyp,ipdcst,mindcst)
+      CALL dealloc_obfbdata(fbdata)
+   ENDDO
+
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inum(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbias(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbias(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zrms(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(zrms(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt))
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = &
+                        & SQRT(MAX(zrms(jlev,jboxl,jadd,jvar,jt)**2-zbias(jlev,jboxl,jadd,jvar,jt)**2,0.0))
+                     zomean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zomean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)/inum(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbias(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zrms(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zsdev(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zomean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zmmean(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,noberr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumov(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)/inumov(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zoemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zovmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+         DO jadd=1,nbgerr
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               DO jlev = 1, nmlev
+                  IF ( inumbv(jlev,jboxl,jadd,jvar,jt) > 0 ) THEN
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)/inumbv(jlev,jboxl,jadd,jvar,jt)
+                  ELSE
+                     zbemea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                     zbvmea(jlev,jboxl,jadd,jvar,jt) = fbrmdi
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+   DO jt=1,ntyp
+      DO jvar=1,nvar
+         jboxl=0
+         DO jbox=1,nboxuser
+            IF (lskipbox(jbox)) CYCLE
+            jboxl=jboxl+1
+            DO jlev = 1, nmlev
+               IF ( inuma(jlev,jboxl,jvar,jt) > 0 ) THEN
+                  zoamean(jlev,jboxl,jvar,jt) = &
+                     & zoamean(jlev,jboxl,jvar,jt)/inuma(jlev,jboxl,jvar,jt)
+               ELSE
+                  zoamean(jlev,jboxl,jvar,jt) = fbrmdi
+               ENDIF
+            ENDDO
+         ENDDO
+      ENDDO
+   ENDDO
+
+   IF (ltext) THEN
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            DO jadd=1,nadd
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(caddname(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inum(jlev,jboxl,jadd,jvar,jt), &
+                        & zbias(jlev,jboxl,jadd,jvar,jt), &
+                        & zrms(jlev,jboxl,jadd,jvar,jt), &
+                        & zsdev(jlev,jboxl,jadd,jvar,jt), &
+                        & zomean(jlev,jboxl,jadd,jvar,jt), &
+                        & zmmean(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,noberr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cobename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumov(jlev,jboxl,jadd,jvar,jt), &
+                        & zoemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zovmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+            DO jadd=1,nbgerr
+               jboxl=0
+               DO jbox=1,nboxuser
+                  IF (lskipbox(jbox)) CYCLE
+                  jboxl=jboxl+1
+                  WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                     &                  TRIM(cbgename(jadd)),'_',&
+                     &                  TRIM(cl_boxes_user(jbox)),'_',&
+                     &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+                  OPEN(10,file=TRIM(filename))
+                  DO jlev = 1, nmlev
+                     WRITE(10,'(F16.7,2I12,5F17.10)') zlev(jlev), &
+                        & jlev, inumbv(jlev,jboxl,jadd,jvar,jt), &
+                        & zbemea(jlev,jboxl,jadd,jvar,jt), &
+                        & zbvmea(jlev,jboxl,jadd,jvar,jt)
+                  ENDDO
+                  CLOSE(10)
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDDO
+
+      DO jt=1,ntyp
+         DO jvar=1,nvar
+            jboxl=0
+            DO jbox=1,nboxuser
+               IF (lskipbox(jbox)) CYCLE
+               jboxl=jboxl+1
+               WRITE(filename,'(7A)')TRIM(cname(jvar)),'_',&
+                  &                  TRIM(cl_boxes_user(jbox)),'_',&
+                  &                  TRIM(ADJUSTL(ctyp(jt))),'.dat'
+               OPEN(10,file=TRIM(filename))
+               DO jlev = 1, nmlev
+                  WRITE(10,'(F16.7,2I12,F17.10)') zlev(jlev), &
+                     & jlev, inuma(jlev,jboxl,jvar,jt), &
+                     & zoamean(jlev,jboxl,jvar,jt)
+               ENDDO
+               CLOSE(10)
+            ENDDO
+         ENDDO
+      ENDDO
+
+      IF (lhistogram) THEN
+         DO jt=1,ntyp
+            DO jvar=1,nvar
+               DO jadd=1,nadd
+                  jboxl=0
+                  DO jbox=1,nboxuser
+                     IF (lskipbox(jbox)) CYCLE
+                     jboxl=jboxl+1
+                     WRITE(filename,'(7A)')TRIM(cname(jvar)),&
+                        &                  TRIM(caddname(jadd)),'_',&
+                        &                  TRIM(cl_boxes_user(jbox)),'_',&
+                        &                  TRIM(ADJUSTL(ctyp(jt))),&
+                        &                  '_histogram.dat'
+                     OPEN(10,file=TRIM(filename))
+                     WRITE(10,'(A10,1000F10.2)')'#',(zlev(jlev),jlev=1,nmlev)
+                     DO ji=1,hist(jvar)%npoints
+                        WRITE(10,'(F10.2,1000I10)') &
+                           & zhistmin(jvar)+(ji-1)*zhiststep(jvar), &
+                           & (hist(jvar)%nhist(ji,jlev,jboxl,jadd,jt),jlev=1,nmlev)
+                     ENDDO
+                     CLOSE(10)
+                  ENDDO
+               ENDDO
+            ENDDO
+         ENDDO
+      ENDIF
+      
+   ENDIF
+
+   IF (lnetcdf) THEN
+
+      IF (nadd>0) THEN
+         DO jt=1,ntyp
+            WRITE(outfilename,'(3A)')'fbstat_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+            CALL fbstat_ncwrite(TRIM(outfilename),&
+               & nvar,cname,nadd,caddname,noberr,cobename,nbgerr,cbgename,&
+               & nboxuser,nboxuserl,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+               & inum(:,:,:,:,jt),zbias(:,:,:,:,jt),zrms(:,:,:,:,jt), &
+               & zsdev(:,:,:,:,jt),zomean(:,:,:,:,jt),zmmean(:,:,:,:,jt),&
+               & inuma(:,:,:,jt),zoamean(:,:,:,jt), &
+               & inumov(:,:,:,:,jt),zoemea(:,:,:,:,jt),zovmea(:,:,:,:,jt), &
+               & inumbv(:,:,:,:,jt),zbemea(:,:,:,:,jt),zbvmea(:,:,:,:,jt) )
+            IF (lhistogram) THEN
+               WRITE(outfilename,'(3A)')'fbstat_hist_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_hist(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & hist,zhistmin,zhiststep,jt)
+            ENDIF
+            IF (lxyplot) THEN
+               WRITE(outfilename,'(3A)')'fbstat_xyplot_',TRIM(ADJUSTL(ctyp(jt))),'.nc'
+               CALL fbstat_ncwrite_xy(TRIM(outfilename),&
+                  & nvar,cname,nadd,caddname,&
+                  & nboxuser,20,cl_boxes_user,lskipbox,nmlev,zlev,&
+                  & xy,zxymin,zxystep,jt)
+            ENDIF
+         ENDDO
+      ENDIF
+   ENDIF
+
+   IF (lomona) THEN
+
+      IF (ntyp>1) THEN
+         WRITE(*,*)'Omona file only supported for the first type which is : ',TRIM(ctyp(1))
+      ENDIF
+      IF (nmlev>1) THEN
+         ALLOCATE(zdat3d(nmlev,nboxuser,1))
+      ELSE
+         ALLOCATE(zdat2d(nboxuser,1))
+      ENDIF
+
+      cl_expnam=expver
+      WRITE(cl_date,'(I8.8)')inidate
+      i_dp = nmlev
+      itime=icurdate
+      linnerp=.TRUE.
+      iloopno = loopno
+      linnerini = linner
+      i_fill=0
+
+      DO jt=1,ntyp
+         DO jvar = 1, nvar
+            linner = linnerini
+            loopno = iloopno
+            SELECT CASE (TRIM(cname(jvar)))
+            CASE('POTM')
+               cl_var = 'votemper'
+            CASE('PSAL')
+               cl_var='vosaline'
+            CASE('SLA')
+               cl_var='sossheig'
+            CASE('SST')
+               cl_var='sosstsst'
+            CASE('UVEL')
+               cl_var='vozocrtx'
+            CASE('VVEL')
+               cl_var='vomecrty'
+            END SELECT
+            DO jadd = 1, nadd
+               linner = (caddname(jadd)(1:3)=='Hxa').OR.linner
+               IF (lpassive) THEN
+                  ityp=145
+               ELSE
+                  IF (linner) THEN
+                     linnerp=.TRUE.
+                     ityp=144
+                     IF (jadd>1) loopno=loopno+1
+                  ELSE
+                     ityp=142
+                     IF (.NOT.linnerp) THEN
+                        IF (jadd>1) loopno=loopno+1
+                     ENDIF
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbias(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbias(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=245
+               ELSE
+                  IF (linner) THEN
+                     ityp=244
+                  ELSE
+                     ityp=242
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zrms(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zrms(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=345
+               ELSE
+                  IF (linner) THEN
+                     ityp=344
+                  ELSE
+                     ityp=342
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zsdev(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zsdev(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=445
+               ELSE
+                  IF (linner) THEN
+                     ityp=444
+                  ELSE
+                     ityp=442
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = inum(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = inum(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=545
+               ELSE
+                  IF (linner) THEN
+                     ityp=544
+                  ELSE
+                     ityp=542
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zomean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zomean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               IF (lpassive) THEN
+                  ityp=645
+               ELSE
+                  IF (linner) THEN
+                     ityp=644
+                  ELSE
+                     ityp=642
+                  ENDIF
+               ENDIF
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zmmean(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zmmean(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               linner=.FALSE.
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, noberr
+               linner = .TRUE.
+               ityp = 139
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zoemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zoemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 239
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zovmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zovmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            loopno = iloopno
+            DO jadd = 1, nbgerr
+               linner = .TRUE.
+               ityp = 141
+               IF (jadd>1) loopno=loopno+1
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbemea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbemea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+               ityp = 241
+               WRITE(cltyp,'(I3.3,A1,I2.2,A1,A)')ityp,'_',loopno,'_',&
+                  & TRIM(ADJUSTL(ctyp(jt)))
+               CALL obs_variable_att(cltyp)
+               IF (nmlev>1) THEN
+                  zdat3d(:,:,1) = zbvmea(:,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+                  CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+               ELSE
+                  zdat2d(:,1) = zbvmea(1,:,jadd,jvar,jt)
+                  i_fill=0
+                  CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                     &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               ENDIF
+            ENDDO
+            IF (lpassive) THEN
+               ityp=745
+            ELSE
+               ityp=742
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = inuma(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = inuma(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+            IF (lpassive) THEN
+               ityp=845
+            ELSE
+               ityp=842
+            ENDIF
+            WRITE(cltyp,'(I3.3,A1,A)')ityp,'_',&
+               & TRIM(ADJUSTL(ctyp(jt)))
+            CALL obs_variable_att(cltyp)
+            IF (nmlev>1) THEN
+               zdat3d(:,:,1) = zoamean(:,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat3d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+               CALL write_dep_netcdf(cl_filename_out,cl_boxes_user,zlev)
+            ELSE
+               zdat2d(:,1) = zoamean(1,:,jvar,jt)
+               i_fill=0
+               CALL write_omona_netcdf(cl_filename_out,zdat2d,itime, &
+                  &                    cl_boxes_user,REAL(fbrmdi),i_fill)
+            ENDIF
+         ENDDO
+      ENDDO
+
+      IF (nmlev>1) THEN
+         DEALLOCATE(zdat3d)
+      ELSE
+         DEALLOCATE(zdat2d)
+      ENDIF
+      
+   ENDIF
+
+CONTAINS
+
+   SUBROUTINE fb_stat(fbdata,lskipbox,nmlev,zlev,lnear,kqc,kqco,lhist,lxyplot,&
+      &               ntyp,ctyp,ipdcst,mindcst)
+      USE fbaccdata
+      USE coords
+      TYPE(obfbdata) :: fbdata
+      LOGICAL, DIMENSION(nboxuser) :: lskipbox
+      INTEGER :: nmlev
+      REAL :: zlev(nmlev)
+      LOGICAL :: lnear
+      INTEGER :: kqc,kqco
+      LOGICAL :: lhist,lxyplot
+      INTEGER :: ntyp
+      CHARACTER(len=ilentyp), DIMENSION(ntyp) :: ctyp
+      INTEGER :: ipdcst
+      REAL :: mindcst
+      INTEGER, DIMENSION(nboxuser) :: jlboxnum
+      INTEGER :: jlev, jobs, jvar, klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl
+      REAL :: zarea(4),zlat,zlon,zdiff,zdiff2,zvar
+      
+      jboxl=0
+      jlboxnum=-1
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jboxl+1
+         jlboxnum(jbox)=jboxl
+      ENDDO
+
+      !$omp parallel do default(shared) private(jlev,jobs,jvar,klev,jlev2,ih,ja,jadd,jbox,jt,ix,iy,jboxl,zarea,zlat,zlon,zdiff,zdiff2)
+      DO jbox = 1, nboxuser
+         IF (lskipbox(jbox)) CYCLE
+         jboxl=jlboxnum(jbox)
+         CALL coord_area_user(cl_boxes_user(jbox),zarea)
+         DO jobs = 1, fbdata%nobs
+            ! Reject observations with observation, position or time flag rejections
+            IF (fbdata%ioqc(jobs)>kqco) CYCLE
+            IF (fbdata%ipqc(jobs)>kqco) CYCLE
+            IF (fbdata%itqc(jobs)>kqco) CYCLE
+            zlat = fbdata%pphi(jobs)
+            zlon = fbdata%plam(jobs)
+            IF (zlon<0) zlon=zlon+360
+            IF (zlon>360) zlon=zlon-360
+            IF ( ( zlat .GE. zarea(3) ) .AND. &
+               & ( zlat .LE. zarea(4) ) .AND. &
+               & ( ( ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) .OR. &
+               &   ( ( zarea(2) .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. zarea(1) ) .AND. &
+               &     ( zlon .LE. 360        ) ) .OR. &
+               &   ( ( zarea(2)   .LE. zarea(1) ) .AND. &
+               &     ( zlon .GE. 0          ) .AND. &
+               &     ( zlon .LE. zarea(2) ) ) ) ) THEN
+            
+               DO jlev = 1, fbdata%nlev
+                  IF (ipdcst>0) THEN
+                     IF (fbdata%pext(jlev,jobs,ipdcst)==fbrmdi) CYCLE
+                     IF (fbdata%pext(jlev,jobs,ipdcst)<mindcst) CYCLE
+                  ENDIF
+                  DO jvar = 1, fbdata%nvar
+                     IF (nmlev==1) THEN
+                        klev=1
+                     ELSE
+                        IF (lnear) THEN
+                           zdiff=ABS(fbdata%pdep(jlev,jobs)-zlev(1))
+                           klev=1
+                           DO jlev2=2,nmlev
+                              zdiff2=ABS(fbdata%pdep(jlev,jobs)-zlev(jlev2))
+                              IF (zdiff2<zdiff) THEN
+                                 klev=jlev2
+                                 zdiff=zdiff2
+                              ENDIF
+                           ENDDO
+                        ELSE
+                           klev = fbdata%iobsk(jlev,jobs,jvar)-1
+                        ENDIF
+                        IF ( klev > nmlev ) THEN
+                           DO ja = 1, fbdata%nadd
+                              IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                              IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar))<9000 ) THEN
+                                 WRITE(*,*)'Error in fb_stat'
+                                 WRITE(*,*)'Increase nmlev to at least ',klev
+                                 klev=nmlev
+                                 CALL abort
+                              ENDIF
+                           ENDDO
+                        ENDIF
+                     ENDIF
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        DO jt=1,ntyp
+                           IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                              IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                           ENDIF
+                           inuma(klev,jboxl,jvar,jt) = inuma(klev,jboxl,jvar,jt) + 1
+                           zoamean(klev,jboxl,jvar,jt) = zoamean(klev,jboxl,jvar,jt) + &
+                              & fbdata%pob(jlev,jobs,jvar)
+                        ENDDO
+                     ENDIF
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) < 0 ) CYCLE 
+                     IF ( fbdata%ivlqc(jlev,jobs,jvar) > kqc ) CYCLE 
+                     IF (( klev > 0 ).AND. &
+                        &(ABS(fbdata%pob(jlev,jobs,jvar)) < 9000 )) THEN
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:2) /= 'Hx' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zdiff = ( fbdata%padd(jlev,jobs,ja,jvar) - &
+                                 &      fbdata%pob(jlev,jobs,jvar) )
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inum(klev,jboxl,jadd,jvar,jt) = inum(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbias(klev,jboxl,jadd,jvar,jt) = zbias(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff
+                                 zrms(klev,jboxl,jadd,jvar,jt) = zrms(klev,jboxl,jadd,jvar,jt) + &
+                                    & zdiff * zdiff
+                                 zomean(klev,jboxl,jadd,jvar,jt) = zomean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%pob(jlev,jobs,jvar)
+                                 zmmean(klev,jboxl,jadd,jvar,jt) = zmmean(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                              ENDDO
+                              IF (ABS(zdiff)>zcheck(jvar)) THEN
+                                 WRITE(*,*)'Departure outside check range ',&
+                                    & TRIM(fbdata%cname(jvar)),' entry ',&
+                                    & fbdata%caddname(jadd)
+                                 WRITE(*,*)'Depar = ',zdiff
+                                 WRITE(*,*)'Check = ',zcheck(jvar)
+                                 WRITE(*,*)'Id    = ',fbdata%cdwmo(jobs)
+                                 WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                 WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                 WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                 WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                 WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                 WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                 WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                 WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                              ENDIF
+                              IF (lhist) THEN
+                                 ih=NINT((zdiff-zhistmin(jvar))/zhiststep(jvar))+1
+                                 IF ((ih>=1).AND.(ih<=hist(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) = &
+                                          hist(jvar)%nhist(ih,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'Histogram value outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Value = ',zdiff
+                                    WRITE(*,*)'Range = ',zhistmin(jvar),zhistmax(jvar)
+                                    WRITE(*,*)'Step  = ',zhiststep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                              IF (lxyplot) THEN
+                                 ix=NINT((fbdata%pob(jlev,jobs,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 iy=NINT((fbdata%padd(jlev,jobs,ja,jvar)-zxymin(jvar))/&
+                                    &    zxystep(jvar))+1
+                                 IF ((ix>=1).AND.(ix<=xy(jvar)%npoints).AND. &
+                                    &(iy>=1).AND.(iy<=xy(jvar)%npoints)) THEN
+                                    DO jt=1,ntyp
+                                       IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                          IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                       ENDIF
+                                       xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) = &
+                                          xy(jvar)%nxy(ix,iy,klev,jboxl,jadd,jt) +1
+                                    ENDDO
+                                 ELSE
+                                    WRITE(*,*)'xy plot values outside range for ',&
+                                       & TRIM(fbdata%cname(jvar)),' entry ',&
+                                       & fbdata%caddname(jadd)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Model = ',fbdata%padd(jlev,jobs,ja,jvar)
+                                    WRITE(*,*)'Range = ',zxymin(jvar),zxymax(jvar)
+                                    WRITE(*,*)'Step  = ',zxystep(jvar)
+                                    WRITE(*,*)'Index = ',ih
+                                    WRITE(*,*)'Id    = ',TRIM(fbdata%cdwmo(jobs))
+                                    WRITE(*,*)'Typ   = ',TRIM(fbdata%cdtyp(jobs))
+                                    WRITE(*,*)'Lat   = ',fbdata%pphi(jobs)
+                                    WRITE(*,*)'Lon   = ',fbdata%plam(jobs)
+                                    WRITE(*,*)'Tim   = ',fbdata%ptim(jobs)
+                                    WRITE(*,*)'Depth = ',fbdata%pdep(jlev,jobs)
+                                    WRITE(*,*)'Obs   = ',fbdata%pob(jlev,jobs,jvar)
+                                    WRITE(*,*)'Var   = ',fbdata%padd(jlev,jobs,jadd,jvar)
+                                    WRITE(*,*)'QC    = ',fbdata%ivlqc(jlev,jobs,jvar)
+                                    WRITE(*,*)'QCflag= ',fbdata%ivlqcf(:,jlev,jobs,jvar)
+                                 ENDIF
+                              ENDIF
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'OBE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumov(klev,jboxl,jadd,jvar,jt) = inumov(klev,jboxl,jadd,jvar,jt) + 1
+                                 zoemea(klev,jboxl,jadd,jvar,jt) = zoemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)                                 
+                                 zovmea(klev,jboxl,jadd,jvar,jt) = zovmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                        jadd = 0
+                        DO ja = 1, fbdata%nadd
+                           IF ( fbdata%caddname(ja)(1:3) /= 'BGE' ) CYCLE
+                           jadd = jadd + 1
+                           IF ( ABS(fbdata%padd(jlev,jobs,ja,jvar)) < 9000 ) THEN
+                              zvar = fbdata%padd(jlev,jobs,ja,jvar)*fbdata%padd(jlev,jobs,ja,jvar)
+                              DO jt=1,ntyp
+                                 IF (TRIM(ADJUSTL(ctyp(jt)))/='all') THEN
+                                    IF (TRIM(ADJUSTL(ctyp(jt)))/=TRIM(ADJUSTL(fbdata%cdtyp(jobs)))) CYCLE
+                                 ENDIF
+                                 inumbv(klev,jboxl,jadd,jvar,jt) = inumbv(klev,jboxl,jadd,jvar,jt) + 1
+                                 zbemea(klev,jboxl,jadd,jvar,jt) = zbemea(klev,jboxl,jadd,jvar,jt) + &
+                                    & fbdata%padd(jlev,jobs,ja,jvar)
+                                 zbvmea(klev,jboxl,jadd,jvar,jt) = zbvmea(klev,jboxl,jadd,jvar,jt) + zvar
+                              ENDDO
+                           ENDIF
+                        ENDDO
+                     ENDIF
+                  ENDDO
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDDO
+      !$omp end parallel do
+      
+   END SUBROUTINE fb_stat
+
+   SUBROUTINE fb_rmmean(fbdata)
+      TYPE(obfbdata) :: fbdata
+      INTEGER :: jadd,jmean
+
+      jmean=0
+      DO jadd=1,fbdata%nadd
+         IF (fbdata%caddname(jadd)(1:4)=='MEAN') THEN
+            jmean=jadd
+            EXIT
+         ENDIF
+      ENDDO
+      IF (jmean==0) THEN
+         WRITE(*,*)'Warning: MEAN additional variable not found'
+         RETURN
+      ENDIF
+      IF (fbdata%nobs>0) THEN
+         DO jadd=1,fbdata%nadd 
+            IF (fbdata%caddname(jadd)(1:2)=='Hx') THEN
+               fbdata%padd(:,:,jadd,:)=fbdata%padd(:,:,jadd,:)&
+                  &                   +fbdata%padd(:,:,jmean,:)
+            ENDIF
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE fb_rmmean
+
+   SUBROUTINE getlevsmean(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      REAL,DIMENSION(nmlev+1) :: ztmp
+      INTEGER :: i
+
+      zlev(:)=9999.9
+      CALL getlevs(nmlev+1,ztmp)
+      DO i=1,nmlev
+         zlev(i)=0.5*(ztmp(i)+ztmp(i+1))
+      ENDDO
+
+   END SUBROUTINE getlevsmean
+
+   SUBROUTINE getlevs(nmlev,zlev)
+      IMPLICIT NONE
+      INTEGER :: nmlev
+      REAL,DIMENSION(nmlev) :: zlev
+      
+      zlev(:)=9999.9
+
+      IF (nmlev==42) THEN
+         zlev(1)=5.02159
+         zlev(2)=15.07854
+         zlev(3)=25.16046
+         zlev(4)=35.27829
+         zlev(5)=45.44776
+         zlev(6)=55.69149
+         zlev(7)=66.04198
+         zlev(8)=76.54591
+         zlev(9)=87.27029
+         zlev(10)=98.31118
+         zlev(11)=109.8062
+         zlev(12)=121.9519
+         zlev(13)=135.0285
+         zlev(14)=149.4337
+         zlev(15)=165.7285
+         zlev(16)=184.6975
+         zlev(17)=207.4254
+         zlev(18)=235.3862
+         zlev(19)=270.5341
+         zlev(20)=315.3741
+         zlev(21)=372.9655
+         zlev(22)=446.8009
+         zlev(23)=540.5022
+         zlev(24)=657.3229
+         zlev(25)=799.5496
+         zlev(26)=967.9958
+         zlev(27)=1161.806
+         zlev(28)=1378.661
+         zlev(29)=1615.291
+         zlev(30)=1868.071
+         zlev(31)=2133.517
+         zlev(32)=2408.583
+         zlev(33)=2690.780
+         zlev(34)=2978.166
+         zlev(35)=3269.278
+         zlev(36)=3563.041
+         zlev(37)=3858.676
+         zlev(38)=4155.628
+         zlev(39)=4453.502
+         zlev(40)=4752.021
+         zlev(41)=5050.990
+         zlev(42)=5350.272
+      ELSEIF (nmlev==31) THEN
+         zlev(1)=4.999938
+         zlev(2)=15.00029
+         zlev(3)=25.00176
+         zlev(4)=35.00541
+         zlev(5)=45.01332
+         zlev(6)=55.0295
+         zlev(7)=65.06181
+         zlev(8)=75.12551
+         zlev(9)=85.25037
+         zlev(10)=95.49429
+         zlev(11)=105.9699
+         zlev(12)=116.8962
+         zlev(13)=128.6979
+         zlev(14)=142.1953
+         zlev(15)=158.9606
+         zlev(16)=181.9628
+         zlev(17)=216.6479
+         zlev(18)=272.4767
+         zlev(19)=364.303
+         zlev(20)=511.5348
+         zlev(21)=732.2009
+         zlev(22)=1033.217
+         zlev(23)=1405.698
+         zlev(24)=1830.885
+         zlev(25)=2289.768
+         zlev(26)=2768.242
+         zlev(27)=3257.479
+         zlev(28)=3752.442
+         zlev(29)=4250.401
+         zlev(30)=4749.913
+         zlev(31)=5250.227
+      ELSEIF (nmlev==1) THEN
+         zlev(1)=0.0
+      ELSE
+         WRITE(*,*) 'Unknown number of levels'
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE getlevs
+
+END PROGRAM fbstat
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbstatncio.F90	(revision 3294)
@@ -0,0 +1,995 @@
+#define MYFILE 'fbstatncio.F90'
+MODULE fbstatncio
+
+   USE fbacctype
+   USE nctools
+   IMPLICIT NONE
+
+   REAL, PARAMETER :: fbstncmiss = 99999.
+
+   TYPE fbstatnctype
+      INTEGER :: nlev,nbox,nadd
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      CHARACTER(len=32), POINTER, DIMENSION(:) :: name
+      REAL, POINTER, DIMENSION(:) :: dep
+      REAL, POINTER, DIMENSION(:,:,:) :: val
+      INTEGER, POINTER, DIMENSION(:,:) :: cnt
+   END TYPE fbstatnctype
+
+   TYPE fbstathistnctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:) :: nhist
+   END TYPE fbstathistnctype
+
+   TYPE fbstatxynctype
+      INTEGER :: nlev,nbox,npoints
+      CHARACTER(len=20), POINTER, DIMENSION(:) :: area
+      REAL, POINTER, DIMENSION(:) :: dep,val
+      INTEGER, POINTER, DIMENSION(:,:,:,:) :: nxy
+   END TYPE fbstatxynctype
+
+CONTAINS
+
+   SUBROUTINE fbstat_ncwrite(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nobe,cdobe,nbge,cdbge,&
+      & nbox,nboxl,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & knum,pbias,prms,pstd,pomean,pmmean,knuma,poamean, &
+      & knumo,poerr,povar,knumb,pberr,pbvar)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of additional data
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nobe                               ! Number of obs errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdobe    ! Name of obs erors
+      INTEGER :: nbge                               ! Number of bg errors
+      CHARACTER(len=*), DIMENSION(nadd) :: cdbge    ! Name of bg erors
+      INTEGER :: nbox                               ! Total number of boxes
+      INTEGER :: nboxl                              ! Actual number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), DIMENSION(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      INTEGER, DIMENSION(nlev,nboxl,nadd,nvar) :: & ! Output data
+         & knum
+      REAL, DIMENSION(nlev,nboxl,nadd,nvar) :: &    ! Output data
+         & pbias, prms, pstd, pomean, pmmean
+      INTEGER, DIMENSION(nlev,nboxl,nvar) :: &      ! Output data
+         & knuma
+      REAL, DIMENSION(nlev,nboxl,nvar) :: &         ! Output data
+         & poamean
+      INTEGER, DIMENSION(nlev,nboxl,nobe,nvar) :: & ! Output data
+         & knumo
+      REAL, DIMENSION(nlev,nboxl,nobe,nvar) :: &    ! Output data
+         & poerr,povar
+      INTEGER, DIMENSION(nlev,nboxl,nbge,nvar) :: & ! Output data
+         & knumb
+      REAL, DIMENSION(nlev,nboxl,nbge,nvar) :: &    ! Output data
+         & pberr,pbvar
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,iv,jbox,ip
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimdep(1),idimbox(2),idimids(2)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      INTEGER :: inoboxes
+      REAL, ALLOCATABLE, DIMENSION(:,:) :: ztmp
+      INTEGER, ALLOCATABLE, DIMENSION(:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox)
+      ALLOCATE(ztmp(nlev,inoboxes),itmp(nlev,inoboxes),clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Setup variables names
+
+      idimids(1)=idlev
+      idimids(2)=idbox
+      incvar=(nadd*6+nobe*3+nbge*3+2)*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdadd(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_bias'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_rms'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_std'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_omean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_mmean'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdobe(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            WRITE(cncvarbase,'(3A)')TRIM(cdvar(jvar)),'_',TRIM(cdbge(jadd))
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanerr'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_meanvar'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            cncvar(iv)=TRIM(cncvarbase)//'_count'
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+               &                       idimids,idvar(iv)),__LINE__,MYFILE)
+            CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         WRITE(cncvarbase,'(A)')TRIM(cdvar(jvar))
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_omean'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_float,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         cncvar(iv)=TRIM(cncvarbase)//'_count'
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),nf90_int,&
+            &                       idimids,idvar(iv)),__LINE__,MYFILE)
+         CALL nchdlerr(nf90_put_att(ncid,idvar(iv),"missing_value",fbstncmiss),&
+            &          __LINE__,MYFILE)
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+      
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      ! Write the output data
+
+      iv=0
+      DO jvar=1,nvar
+         DO jadd=1,nadd
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbias(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=prms(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pstd(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pomean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pmmean(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knum(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nobe
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=poerr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=povar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumo(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         DO jadd=1,nbge
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pberr(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  ztmp(:,ip)=pbvar(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+               &          __LINE__,MYFILE)
+            iv=iv+1
+            ip=0
+            DO jbox=1,nbox
+               IF (.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,ip)=knumb(:,ip,jadd,jvar)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+         ENDDO
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               ztmp(:,ip)=poamean(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),ztmp),&
+            &          __LINE__,MYFILE)
+         iv=iv+1
+         ip=0
+         DO jbox=1,nbox
+            IF (.NOT.lskipbox(jbox)) THEN
+               ip=ip+1
+               itmp(:,ip)=knuma(:,ip,jvar)
+            ENDIF
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+      ENDDO
+      
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+      DEALLOCATE(cncvar,idvar,ztmp,itmp,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite
+
+   SUBROUTINE fbstat_ncwrite_hist(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zhist,zhistmin,zhiststep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(histtype), DIMENSION(nvar) :: zhist      ! Histogram data
+      REAL, DIMENSION(nvar) :: &
+         & zhistmin,zhiststep                       ! Histogram info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimhist(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(3)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'hist',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zhist(jvar)%npoints,idimhist(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimhist(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimhist(jvar)
+            idimcnt(2)=idlev
+            idimcnt(3)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zhist(jvar)%npoints))
+         DO ji=1,zhist(jvar)%npoints
+            zhval(ji)=(ji-1)*zhiststep(jvar)+zhistmin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zhist(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,ip)=zhist(jvar)%nhist(:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_hist
+
+   SUBROUTINE fbstat_ncwrite_xy(cdfilename,nvar,cdvar,nadd,cdadd,&
+      & nbox,lenboxname,cdboxnam,lskipbox,nlev,pdep,&
+      & zxy,zxymin,zxystep,ntyp)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      INTEGER :: nvar                               ! Number of variables 
+      CHARACTER(len=*), DIMENSION(nvar) :: cdvar    ! Name of variables 
+      INTEGER :: nadd                               ! Number of addiables 
+      CHARACTER(len=*), DIMENSION(nadd) :: cdadd    ! Name of entries
+      INTEGER :: nbox                               ! Number of boxes
+      INTEGER :: lenboxname                         ! Length of box names
+      CHARACTER(len=lenboxname), dimension(nbox) :: &
+         & cdboxnam                                 ! Name of boxes
+      LOGICAL, DIMENSION(nbox) :: lskipbox          ! Boxes to skip
+      INTEGER :: nlev                               ! Number of levels
+      REAL,DIMENSION(nlev) :: pdep                  ! Depth of levels
+      TYPE(xytype), DIMENSION(nvar) :: zxy          ! xyplot data
+      REAL, DIMENSION(nvar) :: &
+         & zxymin,zxystep                           ! xyplot info
+      integer :: ntyp                               ! Type to write
+      ! Local variables
+      INTEGER :: jadd,jvar,incvar,ji,iv,ip,jbox
+      CHARACTER(len=50) :: cncvarbase
+      CHARACTER(len=60), ALLOCATABLE, DIMENSION(:) :: cncvar
+      ! netcdf stuff
+      INTEGER :: ncid,idlev,idbox,idlbox,idimxy(nvar),&
+         & idimdep(1),idimbox(2),idimids(2),idimval(1),idimcnt(4)
+      INTEGER :: idvbox,idvlev
+      INTEGER, ALLOCATABLE, DIMENSION(:) :: idvar
+      CHARACTER(len=40) :: cdhdimname
+      REAL, ALLOCATABLE, DIMENSION(:) :: zhval
+      INTEGER :: inoboxes
+      INTEGER, ALLOCATABLE, DIMENSION(:,:,:,:) :: itmp
+      CHARACTER(len=lenboxname), DIMENSION(:), ALLOCATABLE :: &
+         & clboxnam                                 ! Name of boxes
+
+      ! Open netCDF files.
+
+      CALL nchdlerr(nf90_create(TRIM(cdfilename),nf90_clobber,ncid),&
+         &          __LINE__,MYFILE)
+
+      ! Create dimensions
+
+      inoboxes=nbox-COUNT(lskipbox) 
+      ALLOCATE(clboxnam(inoboxes))
+
+      CALL nchdlerr(nf90_def_dim(ncid,"depth",nlev,idlev),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"box",inoboxes,idbox),&
+         &          __LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_def_dim(ncid,"len",lenboxname,idlbox),__LINE__,MYFILE)
+      
+      DO jvar=1,nvar
+         WRITE(cdhdimname,'(A,A)')'xy',TRIM(cdvar(jvar))
+         CALL nchdlerr(nf90_def_dim(ncid,TRIM(cdhdimname),&
+            &                       zxy(jvar)%npoints,idimxy(jvar)),&
+            & __LINE__,MYFILE)
+      ENDDO
+
+      ! Box variable name
+
+      idimbox(1)=idlbox
+      idimbox(2)=idbox
+      CALL nchdlerr(nf90_def_var(ncid,'box',nf90_char,idimbox,idvbox),&
+         &          __LINE__,MYFILE)
+
+      ! Depths
+
+      idimdep(1)=idlev
+      CALL nchdlerr(nf90_def_var(ncid,'depth',nf90_float,idimdep,idvlev),&
+         &          __LINE__,MYFILE)
+
+      ! Histogram values and depths
+
+      incvar=nvar+nadd*nvar
+      ALLOCATE(cncvar(incvar),idvar(incvar))
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         WRITE(cncvar(iv),'(A,A)')TRIM(cdvar(jvar)),'_val'
+         idimval(1)=idimxy(jvar)
+         CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+            &                       nf90_float,idimval,idvar(iv)),&
+            &          __LINE__,MYFILE)
+         DO jadd=1,nadd
+            iv=iv+1
+            WRITE(cncvar(iv),'(A,A,A)')TRIM(cdvar(jvar)),&
+               &                       TRIM(cdadd(jadd)),'_count'
+            idimcnt(1)=idimxy(jvar)
+            idimcnt(2)=idimxy(jvar)
+            idimcnt(3)=idlev
+            idimcnt(4)=idbox
+            CALL nchdlerr(nf90_def_var(ncid,TRIM(cncvar(iv)),&
+               &                       nf90_int,idimcnt,idvar(iv)),&
+               &          __LINE__,MYFILE)
+         ENDDO
+      ENDDO
+      CALL nchdlerr(nf90_enddef(ncid),__LINE__,MYFILE)
+      
+      ! Write box names
+
+      ip=0
+      DO jbox=1,nbox
+         IF (.NOT.lskipbox(jbox)) THEN
+            ip=ip+1
+            clboxnam(ip)=cdboxnam(jbox)
+         ENDIF
+      ENDDO
+      CALL nchdlerr(nf90_put_var(ncid,idvbox,clboxnam),&
+         &          __LINE__,MYFILE)
+
+      ! Write levels
+
+      CALL nchdlerr(nf90_put_var(ncid,idvlev,pdep),&
+         &          __LINE__,MYFILE)
+
+      iv=0
+      DO jvar=1,nvar
+         iv=iv+1
+         ALLOCATE(zhval(zxy(jvar)%npoints))
+         DO ji=1,zxy(jvar)%npoints
+            zhval(ji)=(ji-1)*zxystep(jvar)+zxymin(jvar)
+         ENDDO
+         CALL nchdlerr(nf90_put_var(ncid,idvar(iv),zhval),&
+            &          __LINE__,MYFILE)
+         DEALLOCATE(zhval)
+         DO jadd=1,nadd
+            iv=iv+1
+            ALLOCATE(itmp(zxy(jvar)%npoints,zxy(jvar)%npoints,nlev,inoboxes))
+            ip=0
+            DO jbox=1,nbox
+               IF(.NOT.lskipbox(jbox)) THEN
+                  ip=ip+1
+                  itmp(:,:,:,ip)=zxy(jvar)%nxy(:,:,:,ip,jadd,ntyp)
+               ENDIF
+            ENDDO
+            CALL nchdlerr(nf90_put_var(ncid,idvar(iv),itmp),&
+               &          __LINE__,MYFILE)
+            DEALLOCATE(itmp)
+         ENDDO
+      ENDDO
+
+      ! Close the file
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+      
+      DEALLOCATE(cncvar,idvar,clboxnam)
+
+   END SUBROUTINE fbstat_ncwrite_xy
+
+   SUBROUTINE fbstat_ncread(cdfilename,cdvar,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      TYPE(fbstatnctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,nadd,nvar
+      INTEGER :: ncid,dimid,varid,i,icntpos
+      CHARACTER(len=128) :: cdname,tmpname
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire(ncid,nVariables=nvar),__LINE__,MYFILE)
+
+      ! Count the number of variables and find the "count" position
+
+      nadd=0
+      icntpos=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (TRIM(cdvar)//'_count'==TRIM(cdname)) THEN
+            icntpos=i
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      nadd=0
+      DO i=1,nvar
+         CALL nchdlerr(nf90_inquire_variable(ncid,i,name=cdname),&
+            &          __LINE__,MYFILE)
+         IF (i==icntpos) THEN
+            CALL nchdlerr(nf90_get_var(ncid,i,sdata%cnt),__LINE__,MYFILE)
+         ELSE
+            IF (TRIM(cdvar)==cdname(1:LEN_TRIM(cdvar))) THEN
+               tmpname=cdname(LEN_TRIM(cdvar)+2:)
+               IF (INDEX(tmpname,'_')==0) THEN
+                  nadd=nadd+1
+                  sdata%name(nadd)=tmpname(1:MAX(LEN_TRIM(tmpname),32))
+                  CALL nchdlerr(nf90_get_var(ncid,i,sdata%val(:,:,nadd)),&
+                     &                       __LINE__,MYFILE)
+               ENDIF
+            ENDIF
+         ENDIF
+      ENDDO
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread
+
+   SUBROUTINE fbstat_ncread_alloc(sdata,nlev,nbox,nadd)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be allocated
+      INTEGER :: nlev,nbox,nadd
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%nadd=nadd
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%name(nadd), &
+         & sdata%val(nlev,nbox,nadd), &
+         & sdata%cnt(nlev,nbox) &
+         )
+      
+   END SUBROUTINE fbstat_ncread_alloc
+
+   SUBROUTINE fbstat_ncread_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%nadd=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%name, &
+         & sdata%val, &
+         & sdata%cnt &
+         )
+      
+   END SUBROUTINE fbstat_ncread_dealloc
+
+   SUBROUTINE fbstat_ncread_hist(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstathistnctype) :: sdata               ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'hist'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get histograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nhist),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_hist
+
+   SUBROUTINE fbstat_ncread_hist_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nhist(npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_alloc
+
+   SUBROUTINE fbstat_ncread_hist_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstathistnctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nhist &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_hist_dealloc
+
+   SUBROUTINE fbstat_ncread_xy(cdfilename,cdvar,cdext,sdata)
+      ! Arguments
+      CHARACTER(len=*) :: cdfilename                ! Netcdf filename
+      CHARACTER(len=*) :: cdvar                     ! Name of variables 
+      CHARACTER(len=*) :: cdext                     ! Name of extras
+      TYPE(fbstatxynctype) :: sdata                 ! Data to be filled
+      ! Local variables
+      INTEGER :: nbox,nlev,npoints
+      INTEGER :: ncid,dimid,varid
+
+      ! Open the file and get the dimensions
+
+      CALL nchdlerr(nf90_open(cdfilename,nf90_nowrite,ncid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'box',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nbox),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'depth',dimid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=nlev),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_inq_dimid(ncid,'xy'//TRIM(cdvar),dimid),&
+         &                                __LINE__,MYFILE)
+      CALL nchdlerr(nf90_inquire_dimension(ncid,dimid,&
+         &                      len=npoints),__LINE__,MYFILE)
+
+      ! Allocate the data structure
+
+      CALL fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+
+      ! Get the box names in files
+
+      CALL nchdlerr(nf90_inq_varid(ncid,'box',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%area),__LINE__,MYFILE)
+      
+      ! Get the depths
+      
+      CALL nchdlerr(nf90_inq_varid(ncid,'depth',varid),__LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%dep),__LINE__,MYFILE)
+
+      ! Get values
+
+      CALL nchdlerr(nf90_inq_varid(ncid,TRIM(cdvar)//'_val',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%val),__LINE__,MYFILE)
+
+      ! Get xyograms
+
+      CALL nchdlerr(nf90_inq_varid(ncid,&
+         &                         TRIM(cdvar)//TRIM(cdext)//'_count',varid),&
+         &          __LINE__,MYFILE)
+      CALL nchdlerr(nf90_get_var(ncid,varid,sdata%nxy),__LINE__,MYFILE)
+
+      CALL nchdlerr(nf90_close(ncid),__LINE__,MYFILE)
+
+   END SUBROUTINE fbstat_ncread_xy
+
+   SUBROUTINE fbstat_ncread_xy_alloc(sdata,npoints,nlev,nbox)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be allocated
+      INTEGER :: npoints,nlev,nbox
+      ! Local variables
+
+      sdata%nlev=nlev
+      sdata%nbox=nbox
+      sdata%npoints=npoints
+      ALLOCATE( &
+         & sdata%area(nbox), &
+         & sdata%dep(nlev), &
+         & sdata%val(npoints), &
+         & sdata%nxy(npoints,npoints,nlev,nbox) &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_alloc
+
+   SUBROUTINE fbstat_ncread_xy_dealloc(sdata)
+      ! Arguments
+      TYPE(fbstatxynctype) :: sdata    ! Data to be deallocated
+      ! Local variables
+
+      sdata%nlev=0
+      sdata%nbox=0
+      sdata%npoints=0
+      DEALLOCATE( &
+         & sdata%area, &
+         & sdata%dep, &
+         & sdata%val, &
+         & sdata%nxy &
+         & )
+      
+   END SUBROUTINE fbstat_ncread_xy_dealloc
+
+END MODULE fbstatncio
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/fbthin.F90	(revision 3294)
@@ -0,0 +1,164 @@
+PROGRAM fbthin
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM fbthin **
+   !!
+   !!  ** Purpose : Thin the data to 1 degree resolution
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     fbthin.exe inputfile outputfile
+   !!
+   !!   Required:
+   !!     namelist = namthin.in
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input file
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256) :: cdinfile
+   CHARACTER(len=256) :: cdtmp
+   INTEGER :: nout,ninn,nadd,next,i,j,k
+   LOGICAL :: lgrid
+   !
+   ! Feedback data
+   !
+   TYPE(obfbdata) :: fbdatain
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF ((nargs /= 2)) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'fbthin inputfile outputfile'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdinfile)
+   CALL getarg(2,cdoutfile)
+   !
+   ! Initialize feedback data
+   !
+   CALL init_obfbdata( fbdatain )
+   !
+   ! Read the file
+   !
+   CALL read_obfbdata( TRIM(cdinfile), fbdatain )
+   !
+   ! Do the thining
+   !
+   CALL fb_thin( fbdatain )
+   !
+   ! Write the file
+   !
+   CALL write_obfbdata( TRIM(cdoutfile), fbdatain )
+
+CONTAINS
+   
+   SUBROUTINE fb_thin( fbdata )
+      !
+      ! Observation thinning 
+      !
+      IMPLICIT NONE
+      TYPE(obfbdata) :: fbdata
+      ! Namelist parameters
+      INTEGER, PARAMETER :: nmaxtypes = 10
+      CHARACTER(len=ilentyp), DIMENSION(nmaxtypes) :: thintypes
+      REAL, DIMENSION(nmaxtypes) :: thindists, thindtime
+      ! Local variables
+      NAMELIST/namthin/thintypes, thindists, thindtime
+      INTEGER :: it,ii,ij,iv,iobs,irej
+      REAL :: zdist
+
+      ! Get namelist
+      thintypes(:) = 'XXXX'
+      ! Distance in km
+      thindists(:) = 100.0
+      ! Time difference in days
+      thindtime(:) = 0.99999999
+      OPEN(10,file='namthin.in')
+      READ(10,namthin)
+      CLOSE(10)
+      WRITE(*,namthin)
+      
+      ! Convert to meters
+      thindists(:) = thindists(:) * 1000.0
+
+      DO it = 1, nmaxtypes
+
+         IF ( TRIM(thintypes(it)) == 'XXXX' ) CYCLE
+
+         iobs = 0 
+         irej = 0
+
+         master_loop: DO ii= 1, fbdata%nobs 
+            
+            IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+               IF ( TRIM(ADJUSTL(fbdata%cdtyp(ii))) /= &
+                  & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+            ENDIF
+            
+            iobs = iobs + 1
+
+            ! Skip data with missing lon and lat and observation flag rejected.
+
+            IF (fbdata%plam(ii)==fbrmdi) CYCLE
+            IF (fbdata%pphi(ii)==fbrmdi) CYCLE
+            IF (fbdata%ioqc(ii)>2) CYCLE
+            
+            DO ij=ii+1, fbdata%nobs
+
+               ! Skip data with missing lon and lat and observation flag rejected.
+               
+               IF (fbdata%plam(ij)==fbrmdi) CYCLE
+               IF (fbdata%pphi(ij)==fbrmdi) CYCLE
+               IF (fbdata%ioqc(ij)>2) CYCLE
+               
+               ! Skip different type unless thintypes is 'all'
+
+               IF ( TRIM(ADJUSTL(thintypes(it))) /= 'all' ) THEN
+                  IF ( TRIM(ADJUSTL(fbdata%cdtyp(ij))) /= &
+                     & TRIM(ADJUSTL(thintypes(it))) ) CYCLE
+               ENDIF
+
+               IF ( ABS( fbdata%ptim(ij) - fbdata%ptim(ii) ) &
+                  & >= thindtime(it) ) CYCLE
+
+               zdist = distance( fbdata%plam(ii), fbdata%pphi(ii), &
+                  &              fbdata%plam(ij), fbdata%pphi(ij) )
+
+               IF ( zdist < thindists(it) ) THEN
+
+                  irej = irej + 1
+                  fbdata%ioqc(ij)    = 4
+                  fbdata%ioqcf(2,ij) = fbdata%ioqcf(2,ij) + 32
+
+               ENDIF
+            ENDDO
+            
+         ENDDO master_loop
+
+         WRITE(*,*)'For type                = ',TRIM(thintypes(it))
+         WRITE(*,*)'Observations considered = ',iobs
+         WRITE(*,*)'Observations rejected   = ',irej
+
+      ENDDO
+
+
+     
+   END SUBROUTINE fb_thin
+
+#include "distance.h90"
+
+END PROGRAM fbthin
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/greg2jul.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/greg2jul.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/grt_cir_dis_saa.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/grt_cir_dis_saa.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/in_out_manager.F90	(revision 3294)
@@ -0,0 +1,133 @@
+MODULE in_out_manager   
+   !!======================================================================
+   !!                       ***  MODULE  in_out_manager  ***
+   !! Ocean physics:  vertical mixing coefficient compute from the tke 
+   !!                 turbulent closure parameterization
+   !!=====================================================================
+   !! History :   1.0  !  2002-06  (G. Madec)   original code
+   !!             2.0  !  2006-07  (S. Masson)  iom, add ctl_stop, ctl_warn
+   !!             3.0  !  2008-06  (G. Madec)   add ctmp4 to ctmp10
+   !!             3.2  !  2009-08  (S. MAsson)  add new ctl_opn
+   !!             3.3  !  2010-10  (A. Coward)  add NetCDF4 usage
+   !!----------------------------------------------------------------------
+
+   !!----------------------------------------------------------------------
+   USE par_oce       ! ocean parameter
+!   USE lib_print     ! formated print library
+!   USE nc4interface  ! NetCDF4 interface
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!                   namrun namelist parameters
+   !!----------------------------------------------------------------------
+   CHARACTER(lc) ::   cn_exp        = "exp0"      !: experiment name used for output filename
+   CHARACTER(lc) ::   cn_ocerst_in  = "restart"   !: suffix of ocean restart name (input)
+   CHARACTER(lc) ::   cn_ocerst_out = "restart"   !: suffix of ocean restart name (output)
+   LOGICAL       ::   ln_rstart     = .FALSE.     !: start from (F) rest or (T) a restart file
+   INTEGER       ::   nn_no         = 0           !: job number
+   INTEGER       ::   nn_rstctl     = 0           !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nn_rstssh     = 0           !: hand made initilization of ssh or not (1/0)
+   INTEGER       ::   nn_it000      = 1           !: index of the first time step
+   INTEGER       ::   nn_itend      = 10          !: index of the last time step
+   INTEGER       ::   nn_date0      = 961115      !: initial calendar date aammjj
+   INTEGER       ::   nn_leapy      = 0           !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   nn_istate     = 0           !: initial state output flag (0/1)
+   INTEGER       ::   nn_write      =   10        !: model standard output frequency
+   INTEGER       ::   nn_stock      =   10        !: restart file frequency
+   LOGICAL       ::   ln_dimgnnn    = .FALSE.     !: type of dimgout. (F): 1 file for all proc
+                                                       !:                  (T): 1 file per proc
+   LOGICAL       ::   ln_mskland    = .FALSE.     !: mask land points in NetCDF outputs (costly: + ~15%)
+   LOGICAL       ::   ln_clobber    = .FALSE.     !: clobber (overwrite) an existing file
+   INTEGER       ::   nn_chunksz    = 0           !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines)
+#if defined key_netcdf4
+   !!----------------------------------------------------------------------
+   !!                   namnc4 namelist parameters                         (key_netcdf4)
+   !!----------------------------------------------------------------------
+   ! The following four values determine the partitioning of the output fields
+   ! into netcdf4 chunks. They are unrelated to the nn_chunk_sz setting which is
+   ! for runtime optimisation. The individual netcdf4 chunks can be optionally 
+   ! gzipped (recommended) leading to significant reductions in I/O volumes 
+   !                                   !!!**  variables only used with iom_nf90 routines and key_netcdf4 **
+   INTEGER ::   nn_nchunks_i = 1        !: number of chunks required in the i-dimension 
+   INTEGER ::   nn_nchunks_j = 1        !: number of chunks required in the j-dimension 
+   INTEGER ::   nn_nchunks_k = 1        !: number of chunks required in the k-dimension 
+   INTEGER ::   nn_nchunks_t = 1        !: number of chunks required in the t-dimension 
+   LOGICAL ::   ln_nc4zip    = .TRUE.   !: netcdf4 usage: (T) chunk and compress output using the HDF5 sublayers of netcdf4
+   !                                    !                 (F) ignore chunking request and use the netcdf4 library 
+   !                                    !                     to produce netcdf3-compatible files 
+#endif
+!$AGRIF_DO_NOT_TREAT
+!   TYPE(snc4_ctl)     :: snc4set        !: netcdf4 chunking control structure (always needed for decision making)
+!$AGRIF_END_DO_NOT_TREAT
+
+
+   !! conversion of DOCTOR norm namelist name into model name
+   !! (this should disappear in a near futur)
+
+   CHARACTER(lc) ::   cexper                      !: experiment name used for output filename
+   INTEGER       ::   no                          !: job number
+   INTEGER       ::   nrstdt                      !: control of the time step (0, 1 or 2)
+   INTEGER       ::   nit000                      !: index of the first time step
+   INTEGER       ::   nitend                      !: index of the last time step
+   INTEGER       ::   ndate0                      !: initial calendar date aammjj
+   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30)
+   INTEGER       ::   ninist                      !: initial state output flag (0/1)
+   INTEGER       ::   nwrite                      !: model standard output frequency
+   INTEGER       ::   nstock                      !: restart file frequency
+
+   !!----------------------------------------------------------------------
+   !! was in restart but moved here because of the OFF line... better solution should be found...
+   !!----------------------------------------------------------------------
+   INTEGER ::   nitrst   !: time step at which restart file should be written
+
+   !!----------------------------------------------------------------------
+   !!                    output monitoring
+   !!----------------------------------------------------------------------
+   LOGICAL ::   ln_ctl     = .FALSE.   !: run control for debugging
+   INTEGER ::   nn_print     =    0    !: level of print (0 no print)
+   INTEGER ::   nn_ictls     =    0    !: Start i indice for the SUM control
+   INTEGER ::   nn_ictle     =    0    !: End   i indice for the SUM control
+   INTEGER ::   nn_jctls     =    0    !: Start j indice for the SUM control
+   INTEGER ::   nn_jctle     =    0    !: End   j indice for the SUM control
+   INTEGER ::   nn_isplt     =    1    !: number of processors following i
+   INTEGER ::   nn_jsplt     =    1    !: number of processors following j
+   INTEGER ::   nn_bench     =    0    !: benchmark parameter (0/1)
+   INTEGER ::   nn_bit_cmp   =    0    !: bit reproducibility  (0/1)
+
+   !                                          
+   INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt, nbench    !: OLD namelist names
+
+   INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors
+
+   !!----------------------------------------------------------------------
+   !!                        logical units
+   !!----------------------------------------------------------------------
+   INTEGER ::   numstp     =   -1      !: logical unit for time step
+   INTEGER ::   numout     =    6      !: logical unit for output print
+   INTEGER ::   numnam     =   -1      !: logical unit for namelist
+   INTEGER ::   numnam_ice =   -1      !: logical unit for ice namelist
+   INTEGER ::   numevo_ice =   -1      !: logical unit for ice variables (temp. evolution)
+   INTEGER ::   numsol     =   -1      !: logical unit for solver statistics
+
+   !!----------------------------------------------------------------------
+   !!                          Run control  
+   !!----------------------------------------------------------------------
+   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run)
+   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run)
+   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3
+   CHARACTER(lc) ::   ctmp4, ctmp5, ctmp6   !: temporary characters 4 to 6
+   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9
+   CHARACTER(lc) ::   ctmp10                !: temporary character 10
+   CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !:
+   CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !:
+   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only
+   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: in_out_manager.F90 2715 2011-03-30 15:58:35Z rblod $
+   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
+   !!=====================================================================
+END MODULE in_out_manager
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/index_sort.F90	(revision 3294)
@@ -0,0 +1,361 @@
+MODULE index_sort
+
+CONTAINS
+
+   LOGICAL FUNCTION lessn(a,b,n)
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE lessn  ***
+      !!          
+      !! ** Purpose : Compare two array and return true if the first
+      !!              element of array "a" different from the corresponding 
+      !!              array "b" element is less than the this element
+      !!
+      !! ** Method  : 
+      !!
+      !! ** Action  : 
+      !!
+      !! References : 
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      USE toolspar_kind
+      IMPLICIT NONE
+      INTEGER :: n
+      REAL(KIND=dp), DIMENSION(n) :: a,b
+      INTEGER :: i,j
+
+      DO i=1,n
+         IF (a(i)/=b(i)) THEN
+            IF (a(i)<b(i)) THEN
+               lessn=.TRUE.
+            ELSE
+               lessn=.FALSE.
+            ENDIF
+            EXIT
+         ENDIF
+      ENDDO
+
+   END FUNCTION lessn
+
+   SUBROUTINE  index_sort_dp_n(pval, n, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a
+      !!              double precision array 2D
+      !!
+      !! ** Method  : Heapsort with call to lessn for comparision
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  08-02  (K. Mogensen)  Original code based on index_sort_dp
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER, INTENT(IN) :: &
+         & n                               ! Number of keys
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+      REAL(KIND=dp),DIMENSION(n,kvals),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(kvals),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( lessn(pval(:,kindx(jchild)),pval(:,kindx(jchild+1)),n) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( lessn(pval(:,jt),pval(:,kindx(jchild)),n) ) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+      ENDIF
+
+   END SUBROUTINE index_sort_dp_n
+
+   SUBROUTINE  index_sort_dp(pval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for a
+      !!              double precision array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      REAL(KIND=dp),DIMENSION(*),INTENT(IN) :: &
+         & pval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( pval(kindx(jchild)) <  pval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( pval(jt) < pval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+   END SUBROUTINE index_sort_dp
+
+   SUBROUTINE  index_sort_int(kval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      INTEGER,DIMENSION(*),INTENT(IN) :: &
+         & kval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( kval(kindx(jchild)) <  kval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( kval(jt) < kval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_int
+
+   SUBROUTINE  index_sort_string(cdval, kindx, kvals)
+      USE toolspar_kind
+      IMPLICIT NONE
+      !!----------------------------------------------------------------------
+      !!                    ***  ROUTINE index_sort  ***
+      !!          
+      !! ** Purpose : Get indicies for ascending order for an
+      !!              integer array
+      !!
+      !! ** Method  : Heapsort
+      !!
+      !! ** Action  : 
+      !!
+      !! References : http://en.wikipedia.org/wiki/Heapsort
+      !!
+      !! History :
+      !!        !  06-05  (K. Mogensen)  Original code
+      !!----------------------------------------------------------------------
+      !! * Arguments
+      CHARACTER(len=*),DIMENSION(*),INTENT(IN) :: &
+         & cdval                            ! Array to be sorted
+      INTEGER,DIMENSION(*),INTENT(INOUT) :: &
+         & kindx                           ! Indicies for ordering
+      INTEGER, INTENT(IN) :: &
+         & kvals                           ! Number of values
+
+      !! * Local variables
+      INTEGER :: ji, jj, jt, jn, jparent, jchild
+
+      DO ji = 1, kvals
+         kindx(ji) = ji
+      END DO
+
+      IF (kvals > 1 ) THEN
+
+         ji = kvals/2 + 1
+         jn = kvals
+
+         main_loop : DO
+
+            IF ( ji > 1 ) THEN
+               ji = ji-1
+               jt = kindx(ji)
+            ELSE
+               jt = kindx(jn)
+               kindx(jn) = kindx(1)
+               jn = jn-1
+               IF ( jn == 1 ) THEN
+                  kindx(1) = jt
+                  EXIT main_loop
+               ENDIF
+            ENDIF
+
+            jparent = ji
+            jchild =  2*ji
+
+            inner_loop : DO
+               IF ( jchild > jn ) EXIT inner_loop
+               IF ( jchild < jn ) THEN
+                  IF ( cdval(kindx(jchild)) <  cdval(kindx(jchild+1)) ) THEN
+                     jchild = jchild+1
+                  ENDIF
+               ENDIF
+               IF  ( cdval(jt) < cdval(kindx(jchild))) THEN
+                  kindx(jparent) = kindx(jchild)
+                  jparent = jchild
+                  jchild = jchild*2
+               ELSE 
+                  jchild = jn + 1 
+               ENDIF
+            ENDDO inner_loop
+
+            kindx(jparent) = jt
+
+         END DO  main_loop
+
+      ENDIF
+
+   END SUBROUTINE index_sort_string
+
+END MODULE index_sort
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/ioncdf.F90	(revision 3294)
@@ -0,0 +1,4315 @@
+#define __MYFILE__ 'ioncdf.F90'
+MODULE ioncdf
+   !!======================================================================
+   !!                       ***  MODULE  ioncdf  ***
+   !! Input/Output: manage netcdf inputs/outputs
+   !!=====================================================================
+
+   !!----------------------------------------------------------------------
+   !!   ioncdf     : manage netcdf inputs/outputs
+   !!       put_map      : write a 2d/3d map 
+   !!       put_scalar   : write a scalar
+   !!       test_var     : test if variable exists
+   !!       get_nb_dim   : get dimension number of a variable
+   !!       get_dim_val  : get dimensions values of a variable
+   !!       get_var      : read a 1d/2d/3d/4d array 
+   !!       put_coord    : write coordinates
+   !!       create_map   : create map netcdf file
+   !!       put_att      : write CF attributes
+   !!       get_var_info : get CF attributes
+   !!  Original    : Nicolas Daget
+   !!  Modified      : MAB (nf90)
+   !!---------------------------------------------------------------------
+   !! * Modules used
+   USE toolspar_kind
+   USE netcdf
+   USE nctools
+
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC :: put_coord, put_map, get_var, test_var, put_scalar, get_nb_dim, &
+             get_dim_val, get_scalar
+
+   !! * Substitutions
+
+   !! * Interface
+   INTERFACE put_coord
+     MODULE PROCEDURE put_coord_r, put_coord_d
+   END INTERFACE
+
+   INTERFACE put_map
+     MODULE PROCEDURE put_map_2d_r, put_map_3d_r, put_map_2d_d, put_map_3d_d
+   END INTERFACE
+
+   INTERFACE put_scalar
+     MODULE PROCEDURE put_scalar_i,  put_scalar_r,  put_scalar_d
+   END INTERFACE
+
+   INTERFACE get_var
+     MODULE PROCEDURE get_var_1d_r, get_var_2d_r, get_var_3d_r, get_var_4d_r, &
+                      get_var_1d_d, get_var_2d_d, get_var_3d_d, get_var_4d_d, &
+                      get_var_1d_i, get_var_2d_i, get_var_3d_i, get_var_4d_i
+   END INTERFACE
+
+   INTERFACE get_scalar
+     MODULE PROCEDURE get_scalar_i,  get_scalar_r,  get_scalar_d
+   END INTERFACE
+
+CONTAINS
+
+   SUBROUTINE test_var ( cd_filename, cd_var, k_test )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE test_var  ***
+      !!
+      !! ** Purpose :  test if cd_var exists
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_test                                        ! test if variable exists
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      k_test = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__)
+
+      IF ( k_test .EQ. nf90_noerr  ) THEN
+         k_test = 1
+      ELSE
+         k_test = 0
+      ENDIF
+
+   END SUBROUTINE test_var
+   SUBROUTINE get_nb_dim ( cd_filename, cd_var, k_nb_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_nb_dim  ***
+      !!
+      !! ** Purpose :  Get dimension number of variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimension number of variables
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                        :: &
+         k_nb_dim                                      ! c$dimension number of variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id                           ! file and variable identifier
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, ndims=k_nb_dim ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_close( i_file_id ),&
+         & __LINE__,__MYFILE__) 
+   END SUBROUTINE get_nb_dim
+
+   SUBROUTINE get_dim_val ( cd_filename, cd_var, k_dim )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_dim_val  ***
+      !!
+      !! ** Purpose :  Get dimensions values of a variable
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get dimensions values of a variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-06  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)          :: &
+         k_dim                                         ! dimensions values of a variable
+
+      !! * local declarations
+      INTEGER, DIMENSION(1) :: i_nbdim                 ! dimensions of the variable
+      INTEGER               ::                       &
+         i_file_id, i_var_id,                        & ! file and variable identifier
+         ii                                     ! counter
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id, dimids=k_dim ) ,&
+         & __LINE__,__MYFILE__)
+      i_nbdim = SHAPE( k_dim )
+      DO ii =  1, i_nbdim(1)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, k_dim(ii), len=k_dim(ii) ),__LINE__,__MYFILE__ )
+      ENDDO
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_dim_val
+
+   !!======================================================================
+
+   SUBROUTINE get_scalar_i ( cd_filename, cd_var, k_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_i  ***
+      !!
+      !! ** Purpose :  read integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      INTEGER, INTENT(out)                     :: &
+         k_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr(nf90_open( cd_filename, nf90_nowrite, i_file_id ),&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr(nf90_inquire_variable( i_file_id, i_var_id,xtype=i_type,ndims=i_ndims),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ),&
+         & __LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE get_scalar_i
+
+   SUBROUTINE get_scalar_r ( cd_filename, cd_var, p_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_r  ***
+      !!
+      !! ** Purpose :  read real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), INTENT(out)                        :: &
+         p_var                                         ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims ),&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__  )
+
+   END SUBROUTINE get_scalar_r
+
+   SUBROUTINE get_scalar_d ( cd_filename, cd_var, dd_var )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_scalar_d  ***
+      !!
+      !! ** Purpose :  read double scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library
+      !!
+      !! ** Action : - get variable informations
+      !!             - read variable
+      !!
+      !! Reference :
+      !!
+      !! History :
+      !!    06-09  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), INTENT(out)            :: &
+         dd_var                                        ! variable to read in netcdf file
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type                                        ! external data type for this variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type,ndims=i_ndims),__LINE__,__MYFILE__ )
+      IF ( i_type .NE. 6 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ),__LINE__,__MYFILE__ )
+
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE get_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_scalar_i ( cd_filename, k_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_i  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      INTEGER, INTENT(in)                      :: &
+        k_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_int, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_i
+
+   SUBROUTINE put_scalar_r ( cd_filename, p_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_r  ***
+      !!
+      !! ** Purpose :  write an real scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=sp), INTENT(in)                         :: &
+        p_var                                          ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'scalar', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_r
+
+   SUBROUTINE put_scalar_d ( cd_filename, dd_var, cd_var, cd_longname )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_scalar_d  ***
+      !!
+      !! ** Purpose :  write an integer scalar in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename,                             &    ! filename
+         cd_var                                        ! variable name
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_longname                                   ! variable longname
+      REAL(KIND=dp), INTENT(in)             :: &
+        dd_var                                         ! variable to write in netcdf file
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_id,                                 &   ! dimension identifier
+         i_var_exist, i_dim_exist                      ! tests 
+      INTEGER, DIMENSION(1) ::                     &
+         i_dim                                          ! netcdf information 
+      !!----------------------------------------------------------------------
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim_exist =  nf90_inq_dimid( i_file_id, 'scalar', i_dim_id ) 
+      IF ( i_dim_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'double', 1, i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      i_dim(1) = i_dim_id
+
+      !
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cd_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cd_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', TRIM(cd_var) ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(cd_longname) ) THEN
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', TRIM(cd_longname) ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_scalar_d
+
+   !!======================================================================
+
+   SUBROUTINE put_map_2d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_r  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  &         'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_time) ) THEN
+            DO ii =  1, i_pos 
+               IF ( k_time .EQ. i_time(ii) ) THEN
+                  i_pos = ii - 1
+                  EXIT
+               ENDIF
+            ENDDO
+         ENDIF
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+                                    start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+                                    & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_r
+
+   SUBROUTINE put_map_2d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_2d_d  ***
+      !!
+      !! ** Purpose :  write 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id, i_time_id,        &   ! dimension identifier
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(2) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(3) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_count(3) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL( dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL( dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL( dd_var )
+         dl_max = MAXVAL( dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+            & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(3), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(3), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(3), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(3)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(3) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(3) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(3)/), count=(/i_time_bnd(1),i_tab_count(3)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_2d_d
+
+   SUBROUTINE put_map_3d_r ( cd_filename, p_var, p_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_r  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=sp), OPTIONAL, INTENT(in)               :: &
+        p_missing,                                &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(in)       :: &
+        p_var                                          ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL                  ::                     &
+         z_min, z_max, z_min_old, z_max_old            ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(p_missing) ) THEN
+         z_min = MINVAL(p_var, mask = p_var .NE. p_missing )
+         z_max = MAXVAL(p_var, mask = p_var .NE. p_missing )
+      ELSE
+         z_min = MINVAL(p_var )
+         z_max = MAXVAL(p_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_real, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(p_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', p_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_real, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ),__LINE__,__MYFILE__ )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_r
+
+   SUBROUTINE put_map_3d_d ( cd_filename, dd_var, dd_missing, cd_var, k_code, k_time, reftime, leadtime, time_bnd, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_map_3d_d  ***
+      !!
+      !! ** Purpose :  write 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, OPTIONAL, INTENT(in)            :: &
+        k_code,                                   &    ! CF code
+        k_time,                                   &    ! time of the variable
+        leadtime                                       ! leadtime of the variable
+      INTEGER, DIMENSION(:), OPTIONAL, INTENT(in) :: &
+        time_bnd                                       ! time_bnd
+      REAL(KIND=dp), OPTIONAL, INTENT(in)      :: &
+        dd_missing,                               &    ! missing value of the variable
+        reftime                                        ! reftime of the variable
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(in)  :: &
+        dd_var                                         ! variable to write in netcdf file
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                 ! test
+      CHARACTER(len=80)     :: cl_var                  ! new variable name
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_dim_x_id, i_dim_y_id,                   &   ! dimension identifiers
+         i_dim_z_id, i_time_id,                    &   ! dimension identifiers
+         i_reftime_id, i_leadtime_id,              &   ! dimension identifier
+         i_time_bnd_id, i_dim_id,                  &   ! dimension identifier
+         i_var_exist, i_pos, ii                        ! test and temporary variable
+      INTEGER, DIMENSION(1) :: i_time_bnd              ! dimensions of the variable
+      INTEGER, DIMENSION(3) :: i_dimxy, i_len          ! dimensions of the variable
+      INTEGER, DIMENSION(4) ::                     &
+         i_tab_start, i_tab_count, i_dim               ! netcdf information 
+      INTEGER, DIMENSION(:), ALLOCATABLE        :: &
+         i_time                                        ! time
+      REAL(KIND=dp)      ::                     &
+         dl_min, dl_max, dl_min_old, dl_max_old        ! Minima and maxima of variable
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_var)
+      i_tab_start(1) = 1
+      i_tab_count(1) = i_dimxy(1)
+      i_tab_start(2) = 1
+      i_tab_count(2) = i_dimxy(2)
+      i_tab_start(3) = 1
+      i_tab_count(3) = i_dimxy(3)
+      i_tab_count(4) = 1
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dl_min = MINVAL(dd_var, mask = dd_var .NE. dd_missing )
+         dl_max = MAXVAL(dd_var, mask = dd_var .NE. dd_missing )
+      ELSE
+         dl_min = MINVAL(dd_var )
+         dl_max = MAXVAL(dd_var )
+      ENDIF
+
+      ! Define the name of the variable
+      ! -------------------------------
+      cl_var = "var"
+      IF ( PRESENT(cd_var) ) cl_var = cd_var
+      IF ( PRESENT(k_code) ) CALL get_var_info( k_code, cl_var )
+
+      !
+      ! Open or create file
+      ! -------------------
+      INQUIRE( FILE=cd_filename, EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( cd_descr ) ) THEN
+            CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+         ELSE
+            CALL create_map ( cd_filename, i_dimxy )
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_time_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      i_dim(3) = i_dim_z_id
+      i_dim(4) = i_time_id
+
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( (i_len(1) .NE. i_dimxy(1)) .OR. (i_len(2) .NE. i_dimxy(2)) .OR.  &
+           (i_len(3) .NE. i_dimxy(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cl_var
+         WRITE(*,*)'shape of array = ',i_dimxy
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      ! Define variable or find it
+      ! --------------------------
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var, i_var_id )
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, cl_var, nf90_double, i_dim, i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(k_code) ) CALL put_att( i_file_id, i_var_id, k_code )
+         IF ( PRESENT(dd_missing) )   &
+           & CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dd_missing ) ,&
+           & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         i_var_exist = nf90_inq_varid( i_file_id, 'time', i_time_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, i_dim(4), i_time_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         IF ( PRESENT(reftime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'reftime', i_reftime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'reftime', nf90_double, i_dim(4), i_reftime_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'units', 'days since 1950-01-01 00:00:00' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'standard_name', 'forecast_reference_time' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_reftime_id, 'long_name', 'forecast reference time' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id )
+            IF ( i_var_exist .NE. 0 ) THEN
+               CALL nchdlerr( nf90_def_var( i_file_id, 'leadtime', nf90_int, i_dim(4), i_leadtime_id ),__LINE__,__MYFILE__ )
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'standard_name', 'forecast_period' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'long_name', &
+                  & 'Time elapsed since the start of the forecast' ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_leadtime_id, 'bounds', 'time_bnd' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_var_exist = nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id )
+            IF ( i_var_exist .NE. 0 ) THEN 
+               i_time_bnd=SHAPE(time_bnd)
+               CALL nchdlerr( nf90_def_dim( i_file_id, 'time_bnd', i_time_bnd(1) , i_dim_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_def_var( i_file_id, 'time_bnd', nf90_int, (/i_dim_id, i_dim(4)/), i_time_bnd_id ) ,&
+                  & __LINE__,__MYFILE__)
+               CALL nchdlerr( nf90_put_att( i_file_id, i_time_bnd_id, 'units', 'days' ) ,&
+                  & __LINE__,__MYFILE__)
+            ENDIF
+         ENDIF
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_tab_start(4) = 1
+         i_pos = 1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', dl_min_old ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', dl_max_old ) ,&
+            & __LINE__,__MYFILE__)
+         dl_min = MIN( dl_min, dl_min_old )
+         dl_max = MAX( dl_max, dl_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_min ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_max ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_time_id, len=i_pos ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( PRESENT(reftime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'reftime', i_reftime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(leadtime) ) THEN
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'leadtime', i_leadtime_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         IF ( PRESENT(time_bnd) ) THEN
+            i_time_bnd=SHAPE(time_bnd)
+            CALL nchdlerr( nf90_inq_varid( i_file_id, 'time_bnd', i_time_bnd_id ) ,&
+               & __LINE__,__MYFILE__) 
+         ENDIF
+         ALLOCATE( i_time(i_pos) )
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_id, i_time ) ,&
+            & __LINE__,__MYFILE__)
+         DO ii =  1, i_pos 
+            IF ( k_time .EQ. i_time(ii) ) THEN
+               i_pos = ii - 1
+               EXIT
+            ENDIF
+         ENDDO
+         DEALLOCATE( i_time )
+         i_pos = i_pos + 1
+         i_tab_start(4) = i_pos 
+      ENDIF
+
+      ! Put variable(s)
+      ! --------------
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_var, &
+         & start=i_tab_start, count=i_tab_count ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_time) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/k_time/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ELSE
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_id, (/i_pos/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(reftime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_reftime_id, (/reftime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(leadtime) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_leadtime_id, (/leadtime/), &
+            & start=(/i_tab_start(4)/), count=(/i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( PRESENT(time_bnd) ) THEN
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_bnd_id, time_bnd, &
+            & start=(/1,i_tab_start(4)/), count=(/i_time_bnd(1),i_tab_count(4)/) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_map_3d_d
+
+   !!======================================================================
+
+   SUBROUTINE get_var_1d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_i  ***
+      !!
+      !! ** Purpose :  read 1d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:), INTENT(out)       :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)           :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER               :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_i
+
+   SUBROUTINE get_var_2d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_i  ***
+      !!
+      !! ** Purpose :  read 2d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:), INTENT(out)        :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_i
+
+   SUBROUTINE get_var_3d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_i  ***
+      !!
+      !! ** Purpose :  read 3d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:), INTENT(out)      :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_i
+
+   SUBROUTINE get_var_4d_i ( cd_filename, cd_var, k_var, k_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_i  ***
+      !!
+      !! ** Purpose :  read 4d map of integers in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      INTEGER, DIMENSION(:,:,:,:), INTENT(out)    :: &
+        k_var                                          ! variable to read in netcdf file
+      INTEGER, OPTIONAL, INTENT(out)              :: &
+        k_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      INTEGER                  :: i_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_INT : 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(k_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(k_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, k_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', i_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', i_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_missing2 = MAXVAL(k_var)
+      ENDIF
+
+      IF ( PRESENT(k_missing) ) THEN
+         k_missing = i_missing2
+      ELSE
+         WHERE(k_var .EQ. i_missing2) k_var = 0.0
+         WHERE((k_var .GT. 0.) .EQV. (k_var .LE. 0.)) k_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_i
+
+   SUBROUTINE get_var_1d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_r  ***
+      !!
+      !! ** Purpose :  read 1d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:), INTENT(out)          :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ),__LINE__,__MYFILE__ )
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_r
+
+   SUBROUTINE get_var_2d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_r  ***
+      !!
+      !! ** Purpose :  read 2d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(out)        :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_r
+
+   SUBROUTINE get_var_3d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_r  ***
+      !!
+      !! ** Purpose :  read 3d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:), INTENT(out)      :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_r
+
+   SUBROUTINE get_var_4d_r ( cd_filename, cd_var, p_var, p_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_r  ***
+      !!
+      !! ** Purpose :  read 4d map of reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)  :: &
+         cd_var                                        ! variable name
+      REAL(KIND=sp), DIMENSION(:,:,:,:), INTENT(out)    :: &
+        p_var                                          ! variable to read in netcdf file
+      REAL(KIND=sp), OPTIONAL, INTENT(out)              :: &
+        p_missing                                      ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL                  :: z_missing2              ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. 5 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF_FLOAT : 5'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(p_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(p_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, p_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', z_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', z_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         z_missing2 = MAXVAL(p_var)
+      ENDIF
+
+      IF ( PRESENT(p_missing) ) THEN
+         p_missing = z_missing2
+      ELSE
+         WHERE(p_var .EQ. z_missing2) p_var = 0.0
+         WHERE((p_var .GT. 0.) .EQV. (p_var .LE. 0.)) p_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_r
+
+   SUBROUTINE get_var_1d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_1d_d  ***
+      !!
+      !! ** Purpose :  read 1d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(1) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 1 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 1'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( i_len(1) .NE. i_shape(1) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_1d_d
+
+   SUBROUTINE get_var_2d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_2d_d  ***
+      !!
+      !! ** Purpose :  read 2d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(2) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 2 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 2'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_2d_d
+
+   SUBROUTINE get_var_3d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_3d_d  ***
+      !!
+      !! ** Purpose :  read 3d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(3) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 3 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 3'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+            dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_3d_d
+
+   SUBROUTINE get_var_4d_d ( cd_filename, cd_var, dd_var, dd_missing )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE get_var_4d_d  ***
+      !!
+      !! ** Purpose :  read 4d map of real(kind=dp) reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - read variable 
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)               :: &
+         cd_filename                                   ! filename
+      CHARACTER(len=80), OPTIONAL, INTENT(in)     :: &
+         cd_var                                        ! variable name
+      REAL(KIND=dp), DIMENSION(:,:,:,:), INTENT(out) :: &
+         dd_var                                        ! variable to read in netcdf file
+      REAL(KIND=dp), OPTIONAL, INTENT(out)     :: &
+         dd_missing                                    ! missing value of the variable
+
+      !! * local declarations
+      INTEGER               ::                     &
+         i_file_id, i_var_id,                      &   ! file and variable identifier
+         i_ndims,                                  &   ! Number of dimensions for this variable
+         i_type,                                   &   ! external data type for this variable
+         i_exist                                       ! test
+      INTEGER, DIMENSION(4) :: i_dimid, i_len, i_shape ! dimensions of the variable
+      REAL(KIND=dp)      :: dl_missing2             ! missing value of the variable
+      !!----------------------------------------------------------------------
+
+      ! Open and test netcdf file
+      ! -------------------------
+      CALL nchdlerr( nf90_open( cd_filename, nf90_nowrite, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_varid( i_file_id, cd_var, i_var_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, xtype=i_type ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_type .NE. NF90_DOUBLE ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'External type for this variable = ',i_type
+         WRITE(*,*)'The valid external data type is NF90_DOUBLE : 6'
+!         WRITE(*,*)'CALL abort'
+!         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, ndims=i_ndims ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_ndims .NE. 4 ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'Number of dimensions for this variable = ',i_ndims
+         WRITE(*,*)'The valid number of dimension is 4'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+      CALL nchdlerr( nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dimid ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(1), len=i_len(1) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(2), len=i_len(2) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(3), len=i_len(3) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dimid(4), len=i_len(4) ) ,&
+         & __LINE__,__MYFILE__)
+      i_shape=SHAPE(dd_var)
+      IF ( (i_len(1) .NE. i_shape(1)) .OR. (i_len(2) .NE. i_shape(2)) &
+          .OR. (i_len(3) .NE. i_shape(3)) .OR. (i_len(4) .NE. i_shape(4)) ) THEN
+         WRITE(*,*)'filename = ',cd_filename
+         WRITE(*,*)'variable = ',cd_var
+         WRITE(*,*)'shape of array = ',SHAPE(dd_var)
+         WRITE(*,*)'Dimension length of variable = ',i_len
+         WRITE(*,*)'Dimensions are different'
+         WRITE(*,*)'CALL abort'
+         CALL abort
+      ENDIF
+
+      ! Read variable
+      ! -------------
+      CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, dd_var ) ,&
+         & __LINE__,__MYFILE__)
+
+      i_exist = nf90_get_att( i_file_id, i_var_id, '_FillValue', dl_missing2 )
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         i_exist = nf90_get_att( i_file_id, i_var_id, 'missing_value', dl_missing2 )
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( i_exist .NE. nf90_noerr  ) THEN
+         dl_missing2 = MAXVAL(dd_var)
+      ENDIF
+
+      IF ( PRESENT(dd_missing) ) THEN
+         dd_missing = dl_missing2
+      ELSE
+         WHERE(dd_var .EQ. dl_missing2) dd_var = 0.0
+         WHERE((dd_var .GT. 0.) .EQV. (dd_var .LE. 0.)) dd_var = 0.0
+      ENDIF
+
+   END SUBROUTINE get_var_4d_d
+
+   !!======================================================================
+
+   SUBROUTINE put_coord_r ( cd_filename, p_lon, p_lat, p_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_r  ***
+      !!
+      !! ** Purpose :  write coordinates as reals in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)            :: &
+         cd_filename                                    ! filename
+      REAL(KIND=sp), DIMENSION(:,:), INTENT(in)         :: &
+         p_lon, p_lat                                   ! longitude and latitude
+      REAL(KIND=sp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         p_dep                                          ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL                  ::                     &
+         z_minx, z_maxx, z_miny, z_maxy, z_minz, z_maxz ! minima and maxima
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( p_lon ) 
+      z_minx = MINVAL( p_lon )
+      z_maxx = MAXVAL( p_lon )
+      z_miny = MINVAL( p_lat )
+      z_maxy = MAXVAL( p_lat )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_dimz = SHAPE(  p_dep )
+         z_minz = MINVAL( p_dep )
+         z_maxz = MAXVAL( p_dep )
+      ENDIF
+   
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( p_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) 
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'z', i_dim_z_id ) ,&
+            & __LINE__,__MYFILE__)
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_real, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( p_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real, i_dim(3), i_var_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', 9.e+19 ),__LINE__,__MYFILE__ )
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, p_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE put_coord_r
+ 
+   SUBROUTINE put_coord_d ( cd_filename, dd_lon, dd_lat, dd_dep, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_coord_d  ***
+      !!
+      !! ** Purpose :  write coordinates as real(kind=dp) in a netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - get variable informations
+      !!             - (re)define variable
+      !!             - put variable in netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                        :: &
+         cd_filename                                            ! filename
+      REAL(KIND=dp), DIMENSION(:,:), INTENT(in)         :: &
+         dd_lon, dd_lat                                         ! longitude and latitude
+      REAL(KIND=dp), DIMENSION(:), OPTIONAL, INTENT(in) :: &
+         dd_dep                                                 ! depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      LOGICAL               :: llexist                  ! test
+      INTEGER               ::                    &
+         i_file_id, i_var_id,                     &     ! file and variable identifiers
+         i_dim_x_id, i_dim_y_id, i_dim_z_id,      &     ! dimension identifiers
+         i_var_exist                                    ! test
+      INTEGER, DIMENSION(2) :: i_dimxy                  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1) :: i_dimz                   ! dimension of depth
+      INTEGER, DIMENSION(3) :: i_dim                    ! dimensions for netcdf file
+      REAL(KIND=dp)      ::                     &
+         dl_minx, dl_maxx, dl_miny, dl_maxy,       &
+         dl_minz, dl_maxz,                         &    ! minima and maxima
+         dl_missing                                     ! missing value
+      !!----------------------------------------------------------------------
+
+      ! Read dimensions and compute min and max
+      ! ---------------------------------------
+      i_dimxy = SHAPE( dd_lon ) 
+      dl_minx = MINVAL( dd_lon )
+      dl_maxx = MAXVAL( dd_lon )
+      dl_miny = MINVAL( dd_lat )
+      dl_maxy = MAXVAL( dd_lat )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_dimz = SHAPE( dd_dep )
+         dl_minz = MINVAL(dd_dep)
+         dl_maxz = MAXVAL(dd_dep)
+      ENDIF
+
+      ! Open or create netcdf file
+      ! --------------------------
+      INQUIRE( FILE=TRIM(cd_filename), EXIST=llexist )
+      IF ( .NOT. llexist ) THEN
+         IF ( PRESENT( dd_dep ) ) THEN
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, i_dimz, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy, i_dimz )
+            ENDIF
+         ELSE
+            IF ( PRESENT( cd_descr ) ) THEN
+               CALL create_map ( cd_filename, i_dimxy, cd_descr=cd_descr )
+            ELSE
+               CALL create_map ( cd_filename, i_dimxy )
+            ENDIF
+         ENDIF
+      ENDIF
+
+      CALL nchdlerr( nf90_open( cd_filename, nf90_write, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Add longitude, latitude and depth
+      ! --------------------------------- 
+      dl_missing = 9.e+19_8
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'x', i_dim_x_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'y', i_dim_y_id ) ,&
+         & __LINE__,__MYFILE__)
+      i_dim(1) = i_dim_x_id
+      i_dim(2) = i_dim_y_id
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_dimid( i_file_id, 'z', i_dim_z_id )
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_redef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_def_dim( i_file_id, 'z', i_dimz(1), i_dim_z_id ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         i_dim(3) = i_dim_z_id
+      ENDIF
+
+      i_var_exist = nf90_inq_varid( i_file_id, "longitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "longitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'longitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_east' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Y' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'east' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxx ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lon) ,&
+         & __LINE__,__MYFILE__)
+
+      i_var_exist = nf90_inq_varid( i_file_id, "latitude", i_var_id )
+      CALL nchdlerr( nf90_redef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_def_var( i_file_id, "latitude", nf90_double, (/i_dim(1),i_dim(2)/), i_var_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'latitude' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'degrees_north' ),__LINE__,__MYFILE__ )
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'X' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'north' ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_miny ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxy ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_lat),__LINE__,__MYFILE__ )
+
+      IF ( PRESENT( dd_dep ) ) THEN
+         i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         IF ( i_var_exist .NE. 0 ) THEN
+            CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_double, i_dim(3), i_var_id ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'data_type', 'float' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', 'depth' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface'),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', 'meter' ),__LINE__,__MYFILE__ )
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'axis', 'Z' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'positive', 'down' ) ,&
+               & __LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, '_FillValue', dl_missing ) ,&
+               & __LINE__,__MYFILE__)
+         ENDIF
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', dl_minz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', dl_maxz ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, dd_dep) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+!
+   END SUBROUTINE put_coord_d
+
+   !!======================================================================
+
+   SUBROUTINE create_map ( cd_filename, k_dimxy, k_dimz, cd_descr )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE create_map  ***
+      !!
+      !! ** Purpose :  create netcdf file
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - define dimension of the netcdf file
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(in)                 :: &
+         cd_filename                                            ! filename
+      INTEGER, DIMENSION(:), INTENT(in)             :: k_dimxy  ! dimensions of longitude and latitude
+      INTEGER, DIMENSION(1), OPTIONAL, INTENT(in)   :: k_dimz   ! dimension of depth
+      CHARACTER(len=80), DIMENSION(6), OPTIONAL, INTENT(in)   :: &
+         cd_descr                                               ! description of file contents
+
+      !! * local declarations
+      INTEGER               ::                    &
+         i_file_id, i_dim_id                            ! file and dimension identifiers
+      INTEGER, DIMENSION(1) :: i_dim                    ! dimension of k_dimxy
+      !!----------------------------------------------------------------------
+
+      i_dim = SHAPE(k_dimxy)
+
+      ! Create file
+      ! -----------
+      CALL nchdlerr( nf90_create( cd_filename, nf90_clobber, i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      ! Define dimensions
+      ! -----------------
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'x', k_dimxy(1), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'y', k_dimxy(2), i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+      IF ( PRESENT(k_dimz) ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimz(1), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      IF ( i_dim(1) .EQ. 3 ) THEN
+         CALL nchdlerr( nf90_def_dim( i_file_id, 'z', k_dimxy(3), i_dim_id ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_id ) ,&
+         & __LINE__,__MYFILE__)
+
+      IF ( PRESENT( cd_descr ) ) THEN
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "title", cd_descr(1) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "institution", cd_descr(2) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "source", cd_descr(3) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "history", cd_descr(4) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "references", cd_descr(5) ) ,&
+            & __LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, nf90_global, "comment", cd_descr(6) ) ,&
+            & __LINE__,__MYFILE__)
+      ENDIF
+
+      CALL nchdlerr( nf90_close( i_file_id ) ,&
+         & __LINE__,__MYFILE__)
+
+   END SUBROUTINE create_map
+
+   !!======================================================================
+
+   SUBROUTINE put_att( k_file_id, k_var_id, k_code )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  write CF attributes
+      !!
+      !! ** Method  : use netcdf fortran library 
+      !!       
+      !! ** Action : - write CF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      INTEGER, INTENT(in)      :: k_file_id, k_var_id,  &       ! file and variable identifiers
+                                  k_code                        ! CF identifier
+
+      !! * local declarations
+      CHARACTER(len=80)        ::                       &
+         cl_name, cl_longname,                          &       ! names of variable
+         cl_unit, cl_longunit                                   ! units of variable
+      !!----------------------------------------------------------------------
+
+      ! Get variable attributes and write them
+      ! --------------------------------------
+      CALL get_var_info( k_code, cl_name, cl_longname, cl_unit, cl_longunit )
+
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'standard_name', TRIM(cl_name) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'long_name', TRIM(cl_longname) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'units', TRIM(cl_unit) ) ,&
+         & __LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( k_file_id, k_var_id, 'unit_long', TRIM(cl_longunit) ),__LINE__,__MYFILE__ )
+
+   END SUBROUTINE put_att
+
+   !!======================================================================
+
+   SUBROUTINE get_var_info( k_code, cd_name, cd_longname, cd_unit, cd_longunit )
+      !!----------------------------------------------------------------------
+      !!                ***  ROUTINE put_att  ***
+      !!
+      !! ** Purpose :  get CF attributes
+      !!
+      !! ** Method  : outofcore database
+      !!       
+      !! ** Action : - find iCF attributes
+      !!
+      !! Reference :
+      !!      
+      !! History :
+      !!    06-05  (N. Daget)  original code
+      !!----------------------------------------------------------------------
+      !! * Modules used
+
+      !! * Library used
+
+      !! * arguments
+      CHARACTER(len=80), INTENT(out)           :: cd_name       ! name of variable
+      CHARACTER(len=80), OPTIONAL, INTENT(out) ::       &
+         cd_longname, cd_unit, cd_longunit                      ! name and units of variable
+      INTEGER, INTENT(in)                      :: k_code        ! CF identifier
+
+      !! * local declarations
+      !!----------------------------------------------------------------------
+
+      ! Get CF attributes
+      ! -----------------
+      SELECT CASE ( k_code )
+         CASE (129)
+            cd_name="sea_water_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature ref to surface K"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (130)
+            cd_name="sea_water_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (131)
+            cd_name="sea_water_x_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="U zonal current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (132)
+            cd_name="sea_water_y_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="V meridional current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (133)
+            cd_name="upward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="W vertical current m/s"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (134)
+            cd_name="mst"
+            IF ( PRESENT(cd_longname) ) cd_longname="Modulus of strain rate tensor"
+            IF ( PRESENT(cd_unit) ) cd_unit="s-1"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="per_second"
+         CASE (135)
+            cd_name="vvs"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical viscosity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (136)
+            cd_name="vdf"
+            IF ( PRESENT(cd_longname) ) cd_longname="Vertical diffusivity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_second"
+         CASE (137)
+            cd_name="depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (138)
+            cd_name="sea_water_sigma_theta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sigma theta"
+            IF ( PRESENT(cd_unit) ) cd_unit="kgm3"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="kilogramme cubicmeter"
+         CASE (139)
+            cd_name="richardson_number"
+            IF ( PRESENT(cd_longname) ) cd_longname="Richardson number"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (140)
+            cd_name="UV"
+            IF ( PRESENT(cd_longname) ) cd_longname="UV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (141)
+            cd_name="UT"
+            IF ( PRESENT(cd_longname) ) cd_longname="UT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (142)
+            cd_name="VT"
+            IF ( PRESENT(cd_longname) ) cd_longname="VT product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m s**-1 degC"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m s**-1 degC"
+         CASE (143)
+            cd_name="UU"
+            IF ( PRESENT(cd_longname) ) cd_longname="UU product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (144)
+            cd_name="VV"
+            IF ( PRESENT(cd_longname) ) cd_longname="VV product"
+            IF ( PRESENT(cd_unit) ) cd_unit="m**2 s**-2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="m**2 s**-2"
+         CASE (145)
+            cd_name="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_surface_height_above_geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (146)
+            cd_name="sea_floor_topography"
+            IF ( PRESENT(cd_longname) ) cd_longname="Sea floor topography"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (147)
+            cd_name="ocean_barotropic_streamfunction"
+            IF ( PRESENT(cd_longname) ) cd_longname="Barotropic Stream Function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (148)
+            cd_name="ocean_mixed_layer_thickness"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (149)
+            cd_name="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea_water_bottom_pressure"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (153)
+            cd_name="surface_downward_eastward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (154)
+            cd_name="surface_downward_northward_stress"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-Stress"
+            IF ( PRESENT(cd_unit) ) cd_unit="Pa"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Pascal"
+         CASE (156)
+            cd_name="turbulent_kinetic_energy_input"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbulent kinetic energy input"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (157)
+            cd_name="absorbed_solar_radiation"
+            IF ( PRESENT(cd_longname) ) cd_longname="Absorbed solar radiation"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (158)
+            cd_name="surface_downward_water_flux"
+            IF ( PRESENT(cd_longname) ) cd_longname="Precipitation minus Evaporation"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (159)
+            cd_name="sea_surface_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="specified sea surface temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_Celcius"
+         CASE (160)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Specified Surface Heat flux"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (161)
+            cd_name="diagnosed_sst_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="diagnosed sea surface temperature error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (162)
+            cd_name="surface_downward_heat_flux_in_sea_water"
+            IF ( PRESENT(cd_longname) ) cd_longname="Heat flux Correction"
+            IF ( PRESENT(cd_unit) ) cd_unit="W.m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="watt_per_square_meter"
+         CASE (163)
+            cd_name="d20_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D20 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (164)
+            cd_name="ocean_integral_of_sea_water_temperature_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged temperature over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (167)
+            cd_name="barotropic_eastward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of U dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (168)
+            cd_name="barotropic_northward_sea_water_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of V dz"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (169)
+            cd_name="product_of_eastward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tudz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (170)
+            cd_name="product_of_northward_sea_water_velocity_and_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="integral of Tvdz"
+            IF ( PRESENT(cd_unit) ) cd_unit="Km/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="Kelvin_meter_per_second"
+         CASE (171)
+            cd_name="velocity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="velocity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (172)
+            cd_name="depth_of_maximum_velocity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (173)
+            cd_name="salinity_maximum"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity maximum"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (174)
+            cd_name="depth_of_maximum_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of maximum salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (175)
+            cd_name="ocean_integral_of_sea_water_salinity_wrt_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="averaged salinity over the fisrt 300m"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (179)
+            cd_name="potential_temperature_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (180)
+            cd_name="background_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="background potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (181)
+            cd_name="analysed_potential_temperature"
+            IF ( PRESENT(cd_longname) ) cd_longname="Analysed potential temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (182)
+            cd_name="potential_temperature_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="Potential temperature background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (183)
+            cd_name="analysed_salinity_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="analysed salinity from S(T) balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (184)
+            cd_name="sea_water_salinity_increment"
+            IF ( PRESENT(cd_longname) ) cd_longname="salinity increment"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (185)
+            cd_name="temperature_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (186)
+            cd_name="salinity_bias"
+            IF ( PRESENT(cd_longname) ) cd_longname="bias in salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (187)
+            cd_name="eastward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="eastward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (188)
+            cd_name="northward_sea_water_velocity_increment_from_balance"
+            IF ( PRESENT(cd_longname) ) cd_longname="northward sea water velocity increment from balance operator"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (190)
+            cd_name="sea_water_salinity_increment_from_soft"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity increment from soft"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (191)
+            cd_name="sea_water_salinity_analysis_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity analysis error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (192)
+            cd_name="sea_water_background_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (193)
+            cd_name="sea_water_analysed_salinity"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water analysed salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (194)
+            cd_name="sea_water_salinity_background_error"
+            IF ( PRESENT(cd_longname) ) cd_longname="sea water salinity background error"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (500)
+            cd_name="bcksta_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (501)
+            cd_name="bcksta_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (502)
+            cd_name="bcksta_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (503)
+            cd_name="bcksta_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (504)
+            cd_name="bcksta_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (505)
+            cd_name="bcksta_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of v"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (506)
+            cd_name="bcksta_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (507)
+            cd_name="bcksta_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (510)
+            cd_name="increm_tot_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (511)
+            cd_name="increm_tot_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (512)
+            cd_name="increm_bal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (513)
+            cd_name="increm_unbal_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (514)
+            cd_name="increm_tot_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (515)
+            cd_name="increm_bal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (516)
+            cd_name="increm_unbal_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of U"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (517)
+            cd_name="increm_tot_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (518)
+            cd_name="increm_bal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (519)
+            cd_name="increm_unbal_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (520)
+            cd_name="increm_tot_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for total part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (521)
+            cd_name="increm_bal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for balanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (522)
+            cd_name="increm_unbal_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (530)
+            cd_name="pbudct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (531)
+            cd_name="pbvdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (532)
+            cd_name="pbtdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model t-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (533)
+            cd_name="pbfdct"
+            IF ( PRESENT(cd_longname) ) cd_longname="distance between coastline and model f-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (540)
+            cd_name="bckenw_wetjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy T weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/C^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_degre_celcius"
+         CASE (541)
+            cd_name="bckenw_wesjc"
+            IF ( PRESENT(cd_longname) ) cd_longname="energy S weighting coefficient for Jc term"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^2/s^2/PSU^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_meter_per_square_second_per_square_practical_salinity_scale"
+         CASE (550)
+            cd_name="bckesd_ana_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for total part of T"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (551)
+            cd_name="bckesd_ana_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of S"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (552)
+            cd_name="bckesd_ana_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of u"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (553)
+            cd_name="bckesd_ana_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of V"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (554)
+            cd_name="bckesd_ana_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="standard deviations for unbalanced part of SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (560)
+            cd_name="bckesd_mod_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (561)
+            cd_name="bckesd_mod_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (562)
+            cd_name="bckesd_mod_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (563)
+            cd_name="bckesd_mod_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (564)
+            cd_name="bckesd_mod_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (565)
+            cd_name="bckesd_modf_t"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for temperature at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (566)
+            cd_name="bckesd_modf_s"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for salinity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (567)
+            cd_name="bckesd_modf_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for u-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (568)
+            cd_name="bckesd_modf_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for v-velocity at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (569)
+            cd_name="bckesd_modf_e"
+            IF ( PRESENT(cd_longname) ) cd_longname="background error standard deviations for SSH at final time"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (570)
+            cd_name="bcksal_dSdT"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dT coefficient for the salinity balance"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_degree_celcius"
+         CASE (571)
+            cd_name="bcksal_dTdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dT/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="C/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius_per_meter"
+         CASE (572)
+            cd_name="bcksal_dSdz"
+            IF ( PRESENT(cd_longname) ) cd_longname="dS/dz for the background"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU/m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale_per_meter"
+         CASE (575)
+            cd_name="bckssh_alpha"
+            IF ( PRESENT(cd_longname) ) cd_longname="Thermal expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (576)
+            cd_name="bckssh_beta"
+            IF ( PRESENT(cd_longname) ) cd_longname="Saline expansion coefficient for the SSH balance"
+            IF ( PRESENT(cd_unit) ) cd_unit=""
+            IF ( PRESENT(cd_longunit) ) cd_longunit=""
+         CASE (580)
+            cd_name="filnot"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at T-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (581)
+            cd_name="filnou"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at u-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (582)
+            cd_name="filnov"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at v-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (583)
+            cd_name="filnoe"
+            IF ( PRESENT(cd_longname) ) cd_longname="filter normalization factor at eta-points"
+            IF ( PRESENT(cd_unit) ) cd_unit="m^(3/2)"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="square_root_of_cube_meter"
+         CASE (590)
+            cd_name="bckint"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background temperature"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (591)
+            cd_name="bckins"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background salinity"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity"
+         CASE (592)
+            cd_name="bckinu"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background u-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (593)
+            cd_name="bckinv"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background v-velocity"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (594)
+            cd_name="bckineta"
+            IF ( PRESENT(cd_longname) ) cd_longname="increment to background SSH"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (610)
+            cd_name="tangent_T"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent potential temperature field"
+            IF ( PRESENT(cd_unit) ) cd_unit="C"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="degree_celcius"
+         CASE (611)
+            cd_name="tangent_S"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent salinity field"
+            IF ( PRESENT(cd_unit) ) cd_unit="PSU"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="practical_salinity_scale"
+         CASE (612)
+            cd_name="tangent_u"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent U zonal current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (613)
+            cd_name="tangent_v"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent V meridional current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (614)
+            cd_name="tangent_w"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent W vertical current"
+            IF ( PRESENT(cd_unit) ) cd_unit="m/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter_per_second"
+         CASE (615)
+            cd_name="tangent_SSH"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent sea surface height above geoid"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (616)
+            cd_name="tangent BSF"
+            IF ( PRESENT(cd_longname) ) cd_longname="tangent barotropic stream function"
+            IF ( PRESENT(cd_unit) ) cd_unit="m3/s"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="cubic_meter_per_second"
+         CASE (620)
+            cd_name="d28_isotherm_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the D28 isotherm"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (621)
+            cd_name="ocean_mixed_layer_thickness_bn2_criterion"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the ocean mixed layer from the surface with bn2 citerion"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (622)
+            cd_name="thermocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="depth of the strongest vertical temperature gradient"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (623)
+            cd_name="heat_content_of_first_300m"
+            IF ( PRESENT(cd_longname) ) cd_longname="heat content of first 300 m"
+            IF ( PRESENT(cd_unit) ) cd_unit="J"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules"
+         CASE (624)
+            cd_name="turbocline_depth"
+            IF ( PRESENT(cd_longname) ) cd_longname="turbocline depth"
+            IF ( PRESENT(cd_unit) ) cd_unit="m"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="meter"
+         CASE (625)
+            cd_name="U-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="U-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE (626)
+            cd_name="V-energy_transport"
+            IF ( PRESENT(cd_longname) ) cd_longname="V-energy transport"
+            IF ( PRESENT(cd_unit) ) cd_unit="J/s/m^2"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="joules_per_second_per_square_meter"
+         CASE default
+            cd_name="varname"
+            IF ( PRESENT(cd_longname) ) cd_longname="long_varname"
+            IF ( PRESENT(cd_unit) ) cd_unit="varunit"
+            IF ( PRESENT(cd_longunit) ) cd_longunit="long_varunit"
+      END SELECT
+
+   END SUBROUTINE get_var_info
+
+END MODULE ioncdf
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lbcnfd.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lbcnfd.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/lib_mpp.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/LBC/lib_mpp.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/nctools.F90	(revision 3294)
@@ -0,0 +1,40 @@
+#define __MYFILE__ 'nctools.F90'
+MODULE nctools
+
+   ! Utility subroutines for netCDF access
+   ! Modified    : MAB (nf90, handle_error, LINE&FILE)
+   ! Modifled    : KSM (new shorter name)
+
+   USE netcdf
+
+   PUBLIC ldebug_netcdf, nchdlerr
+   LOGICAL :: ldebug_netcdf = .FALSE.  ! Debug switch for netcdf
+
+CONTAINS
+
+   SUBROUTINE nchdlerr(status,lineno,filename)
+      
+      ! Error handler for netCDF access
+      IMPLICIT NONE
+
+
+      INTEGER :: status ! netCDF return status
+      INTEGER :: lineno ! Line number (usually obtained from 
+                        !  preprocessing __LINE__,__MYFILE__)
+      CHARACTER(len=*),OPTIONAL :: filename
+
+      IF (status/=nf90_noerr) THEN
+         WRITE(*,*)'Netcdf error, code ',status
+         IF (PRESENT(filename)) THEN
+            WRITE(*,*)'In file ',filename,' in line ',lineno
+         ELSE
+            WRITE(*,*)'In line ',lineno
+         END IF
+         WRITE(*,'(2A)')' Error message : ',nf90_strerror(status)
+         CALL abort
+      ENDIF
+
+   END SUBROUTINE nchdlerr
+
+!----------------------------------------------------------------------
+END MODULE nctools
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_conv_functions.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_conv_functions.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_fbm.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_fbm.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_prof_io.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_prof_io.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_io.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_sla_io.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_sla_types.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_sla_types.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_utils.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_utils.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obs_vel_io.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obs_vel_io.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsprof_io.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obsprof_io.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_io.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obssla_io.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obssla_types.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obssla_types.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/obsvel_io.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/obsvel_io.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/omonainfo.F90	(revision 3294)
@@ -0,0 +1,1283 @@
+#define __MYFILE__ 'omonainfo.F90'
+MODULE omonainfo
+   
+   ! Specific utilities for omona files
+   ! 
+   ! History
+   ! Original: Magdalena A. Balmaseda
+   !           2010: Split as to remove "scale factor information", 
+   !           which is now in auxgrid
+   !
+   
+   
+   USE netcdf
+   USE nctools
+   USE ioncdf
+   USE coords
+!   USE orcagrid
+
+   CHARACTER(len=4)    :: cl_expnam  
+   CHARACTER(len=8)    :: cl_date
+   CHARACTER(len=80)   :: cl_filename_out
+   CHARACTER(len=80)   :: cl_filename2_out 
+   CHARACTER(len=3)    :: cl_code
+   CHARACTER(len=1)    :: cl_grid
+   CHARACTER(len=80)   :: cl_var,cl_var_out
+   CHARACTER(len=80)   :: cl_varname1, cl_varname2, cl_varunit1, cl_varunit2
+   CHARACTER(len=1)    :: sec !o =box average omona
+                              !x =zonal section. Integral along x
+                              !y =meridional section. Integral along y
+
+   CHARACTER(len=1)    :: grid0='?'
+   
+   INTEGER ::  i_nb_dims,i_dp
+   INTEGER ::  i_fill
+   REAL, DIMENSION(:,:),     ALLOCATABLE :: z_var_2d
+   REAL, DIMENSION(:,:,:),   ALLOCATABLE :: z_var_3d
+   REAL, DIMENSION(:),       ALLOCATABLE :: z_dep2
+
+   PUBLIC  :: variable_att, write_omona_netcdf, &
+      &       write_dep_netcdf, create_time_series_netcdf_file
+
+   
+   INTERFACE write_omona_netcdf
+      MODULE PROCEDURE write_omona_netcdf_2d_r, write_omona_netcdf_3d_r
+   END INTERFACE
+   
+CONTAINS
+
+   !
+   !----------------------------------------------------------------------
+   !
+   ! W R I T E _ O M O N A _ N E T C D F
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_2d_r (cl_filename, z_field,i_time, &
+      cl_boxes, z_missing,i_fill)
+      !
+      ! write a 2d array (time_serie) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)                :: cl_filename
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:), INTENT(in)             :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z, i_b
+      INTEGER               :: i_tim_id,i_box_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(2) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:), ALLOCATABLE :: z_old_2d
+      !
+      i_tab_start(1) = 1
+      i_z=1
+      i_b=SIZE(z_field,1)
+      i_nb_files = SIZE(z_field,2)
+      i_tab_count(1) = i_b
+      i_tab_count(2) = i_nb_files
+      i_rest_start = 0
+      i_rest_end   = 0
+      i_time0      = 0
+      i_time1      = 0
+      
+      WRITE(6,*)' Input time dimensions ',i_nb_files
+      WRITE(6,*)' file for output       ',cl_filename
+      !
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+      !
+      
+      INQUIRE( FILE=cl_filename_out, EXIST=clbon )
+      WRITE(*,*)' Inquiring clbon ',clbon
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      
+      WRITE(*,*)' Inquiring var ',cl_var_out
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id ) 
+      WRITE(*,*)' i_var_exist ',i_var_exist, i_var_id
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+         i_dim(1) = i_box_id
+         i_dim(2) = i_tim_id
+         !         write(*,*)' i_dim ',i_dim
+         !
+         CALL nchdlerr( nf90_redef(i_file_id) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var(i_file_id, cl_var_out, nf90_real, i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units',cl_varunit1 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long',cl_varunit2 ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_min ',z_min
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         WRITE(*,*)'nf_put valid_max ',z_max
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         i_pos = 1 
+         i_tab_start(2)=1
+      ELSE
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+         z_min = MIN( z_min, z_min_old )
+         z_max = MAX( z_max, z_max_old )
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+ 
+         CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id,len=i_pos ) ,__LINE__,__MYFILE__)
+         ALLOCATE(i_time_old(i_pos))
+         
+         CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+         
+         CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+         i_tab_start(2)=i_pos+1
+         DO i_t=i_pos,1,-1
+            IF(i_time_old(i_t).GE.i_time(1)) THEN
+               i_tab_start(2)=i_t
+            ELSE
+               EXIT
+            ENDIF
+         ENDDO
+         WRITE(*,*)' i_tab_start(2)',i_tab_start(2)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(2),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+          ENDDO
+          WRITE(*,*)' i_tab_start(2), i_time0',i_tab_start(2),i_time0
+          i_time0=min(i_time0,i_tab_start(2))
+          i_tab_start(2)=i_time0
+          i_time1=i_tab_start(2)+i_tab_count(2)-1
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+          i_rest_start=i_time1+1
+          i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_2d(i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_2d ) ,__LINE__,__MYFILE__)
+            z_old_2d(:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(2)=1
+            i_tab_count(2)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_2d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_2d)
+          ENDIF
+         ELSE
+         WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(2)-1),i_time(1)
+         DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output start ',i_tab_start
+	 WRITE(*,*)' writing output count ',i_tab_count
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+         & z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time,start=(/i_tab_start(2)/), count=(/i_tab_count(2)/)),__LINE__,__MYFILE__)
+      ENDIF
+
+      !
+      
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_2d_r
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE write_omona_netcdf_3d_r (cl_filename, z_field,i_time, &
+                                       cl_boxes, z_missing, i_fill)
+!
+! write a 3d array (time_serie) of reals
+!
+      IMPLICIT NONE
+!
+      CHARACTER(len=80), INTENT(in)                :: cl_filename 
+      INTEGER, DIMENSION(:), INTENT(in)            :: i_time
+      INTEGER, INTENT(inout)                       :: i_fill
+      REAL, DIMENSION(:,:,:), INTENT(in)           :: z_field
+      REAL, INTENT(in)                             :: z_missing
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+
+!
+      LOGICAL               :: clbon
+      INTEGER               :: i_var_exist, i_pos
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_nb_files,i_z,i_b
+      INTEGER               :: i_tim_id,i_box_id,i_z_id
+      INTEGER               :: i_time_var
+      INTEGER               :: i_file
+      INTEGER, DIMENSION(3) :: i_dim, i_tab_start, i_tab_count
+      INTEGER               :: i_rest_start, i_rest_end
+      INTEGER               :: i_time0, i_time1
+      REAL                  :: z_min, z_max
+      REAL                  :: z_min_old, z_max_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_old
+      INTEGER, DIMENSION(:), ALLOCATABLE :: i_time_rest
+      INTEGER               :: i_t
+      REAL, DIMENSION(:,:,:), ALLOCATABLE :: z_old_3d
+!
+      i_tab_start(1) = 1
+      i_tab_start(2) = 1
+      i_tab_start(3) = 1
+      i_z=SIZE(z_field,1)   !depth
+      i_b=SIZE(z_field,2)   !nbox
+      i_nb_files = SIZE(z_field,3)
+      i_tab_count(1) = i_z
+      i_tab_count(2) = i_b
+      i_tab_count(3) = i_nb_files
+      i_time0        = 0
+      i_time1        = 0
+      i_rest_start   = 0
+      i_rest_end     = 0
+
+!      write(6,*)' in write_3d ,shape(z_field) ',shape(z_field)
+!      write(6,*)' i_z =',i_z
+!      write(6,*)' i_b =',i_b
+!      write(6,*)' i_nb_files =',i_nb_files
+
+
+!
+      z_min = MINVAL(z_field, mask = z_field .NE. z_missing )
+      z_max = MAXVAL(z_field, mask = z_field .NE. z_missing )
+!
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes)
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+!     
+      WRITE(*,*)' opening file ',cl_filename
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+!
+      WRITE(*,*)'Inquiring var ',cl_var_out, i_var_id
+      i_var_exist = nf90_inq_varid( i_file_id, cl_var_out, i_var_id)
+      WRITE(*,*)'i_var_exist ',i_var_exist
+
+      IF ( i_var_exist .NE. 0 ) THEN
+!       write(*,*)' Inquiring dimensions'
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+
+       i_dim(1) = i_z_id
+       i_dim(2) = i_box_id
+       i_dim(3) = i_tim_id
+!       write(*,*)' In write_omona_ncdf_3d: Dimensions: i_dim ',i_dim
+
+
+       CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+       CALL nchdlerr( nf90_def_var( i_file_id, cl_var_out,  nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name', cl_varname1 ),__LINE__,__MYFILE__ )
+       CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', cl_varname2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', cl_varunit1 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long', cl_varunit2 ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'missing_value', z_missing ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+!
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+!       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+        WRITE(*,*) 'inq_varid i_tim_id for var time ',i_time_var
+        i_pos = 1 
+        i_tab_start(3)=1
+      ELSE
+        !new addition
+!        CALL nchdlerr (nf90_inquire_variable( i_file_id, i_var_id, dimids=i_dim ) ,__LINE__,__MYFILE__)
+!        write(6,*)' after inquire variable i_dim = ',i_dim
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(1), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(1), len(1) ',i_dim(1),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(2), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(2), len(2) ',i_dim(2),i_pos
+!      CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_dim(3), len=i_pos )  ,__LINE__,__MYFILE__)
+!        write(6,*)' i_dim(3), len(3) ',i_dim(3),i_pos
+        !!!!
+
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_min', z_min_old ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_get_att( i_file_id, i_var_id, 'valid_max', z_max_old ) ,__LINE__,__MYFILE__)
+        z_min = MIN( z_min, z_min_old )
+        z_max = MAX( z_max, z_max_old )
+        CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+        CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+
+ 
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'depth', i_z_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_z_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_z_id, dim ',i_z_id,i_pos
+
+!        CALL nchdlerr( nf90_inq_varid( i_file_id, 'box', i_box_id ) ,__LINE__,__MYFILE__)
+!        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_box_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!        write(*,*)' i_box_id, dim ',i_box_id,i_pos
+
+
+ 
+       CALL nchdlerr( nf90_inq_dimid( i_file_id, 'time', i_tim_id ) ,__LINE__,__MYFILE__)
+!        write(6,*)' inq_dimid ',i_tim_id
+        CALL nchdlerr( nf90_inquire_dimension( i_file_id, i_tim_id, len=i_pos ) ,__LINE__,__MYFILE__)
+!       write(*,*) 'inq_var_id i_tim_id,dim ',i_tim_id,i_pos
+        ALLOCATE(i_time_old(i_pos))
+        CALL nchdlerr( nf90_inq_varid( i_file_id, 'time', i_time_var ) ,__LINE__,__MYFILE__)
+!        write(*,*) 'inq_var_id time',i_time_var
+        CALL nchdlerr( nf90_get_var( i_file_id, i_time_var, i_time_old ) ,__LINE__,__MYFILE__)
+        i_tab_start(3)=i_pos+1
+        DO i_t=i_pos,1,-1
+          IF(i_time_old(i_t).GE.i_time(1)) THEN
+            i_tab_start(3)=i_t
+          ELSE
+            EXIT
+         ENDIF
+        ENDDO
+
+         WRITE(*,*)'i_tab_start(3)',i_tab_start(3)
+         WRITE(*,*)'i_tab_count(3)',i_tab_count(3)
+
+         IF (I_FILL == 1 ) THEN
+           DO i_t=1,i_tab_start(3),1
+             IF(i_time_old(i_t).LT.i_time(1)) THEN
+                i_time0=i_t+1
+             ELSE
+                EXIT
+             ENDIF
+           ENDDO
+
+           i_time0=min(i_time0,i_tab_start(3))
+           i_tab_start(3)=i_time0
+           i_time1=i_time0+i_tab_count(3)-1
+           WRITE(*,*)'i_time0,i_tab_count(3),i_time1',i_Time0,i_tab_count(3),i_time1
+           WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+           i_rest_start=i_time1+1
+           i_rest_end = i_pos
+          IF ( i_rest_end .gt. i_rest_start ) THEN
+            ALLOCATE( z_old_3d(i_z,i_b, i_pos))
+            CALL nchdlerr( nf90_get_var( i_file_id, i_var_id, z_old_3d ) ,__LINE__,__MYFILE__)
+            z_old_3d(:,:,i_time0:i_time1)=z_field
+            i_time_old(i_time0:i_time1)=i_time
+            i_tab_start(3)=1
+            i_tab_count(3)=i_pos
+            WRITE(*,*)' writing output I_FILL i_time0 ',i_time0
+            WRITE(*,*)' writing output I_FILL i_time1 ',i_time1
+            CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+            & z_old_3d, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+            CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+         & i_time_old,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/)),__LINE__,__MYFILE__)
+          ELSE
+            I_FILL = 0
+            DEALLOCATE(i_time_old)
+            DEALLOCATE(i_time_rest)
+            DEALLOCATE(z_old_3d)
+          ENDIF
+         ELSE
+          WRITE(*,*)' Starting at time ',i_time_old(i_tab_start(3)-1),i_time(1)
+          DEALLOCATE(i_time_old)
+         ENDIF
+      ENDIF
+      !
+      IF ( I_FILL == 0 ) THEN
+         WRITE(*,*)' writing output count ',i_tab_count
+         WRITE(*,*)' writing output start ',i_tab_start
+         CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, &
+           z_field, start=i_tab_start, count=i_tab_count),__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_var( i_file_id, i_time_var, &
+           i_time,start=(/i_tab_start(3)/), count=(/i_tab_count(3)/) ),__LINE__,__MYFILE__)
+      ENDIF
+!
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+!
+      RETURN
+      !
+   END SUBROUTINE write_omona_netcdf_3d_r
+   !!----------------------------------------------------------------------
+   !
+   SUBROUTINE write_dep_netcdf ( cl_filename, cl_boxes, z_dep )
+      !
+      ! write a 2d array (map) of reals
+      !
+      IMPLICIT NONE
+      !
+      CHARACTER(len=80), INTENT(in)    :: cl_filename
+      CHARACTER(len=20), DIMENSION(:), INTENT(in)  :: cl_boxes
+      REAL, DIMENSION(:),   INTENT(in) :: z_dep
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_var_id
+      INTEGER               :: i_dim_z_id
+      INTEGER               :: i_dimz, i_var_exist
+      INTEGER, DIMENSION(1) :: i_dim
+      REAL                  :: z_min, z_max
+      !
+      i_dimz = i_dp
+      !
+      z_min = MINVAL(z_dep)
+      z_max = MAXVAL(z_dep)
+      !
+      INQUIRE( FILE=cl_filename, EXIST=clbon )
+      IF ( .NOT. clbon ) THEN
+         CALL create_time_series_netcdf_file ( cl_filename, cl_boxes )
+      ELSE
+         WRITE(*,*)' Time series file already exists'
+      ENDIF
+      !     
+      CALL nchdlerr( nf90_open( cl_filename, nf90_write, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_inq_dimid( i_file_id, 'depth', i_dim_z_id ) ,__LINE__,__MYFILE__)
+      i_dim(1) = i_dim_z_id
+      !      write(6,*)' defining depth axis : i_dim(1)= ',i_dim(1)
+      !
+      i_var_exist = nf90_inq_varid( i_file_id, "depth", i_var_id ) 
+      IF ( i_var_exist .NE. 0 ) THEN
+         CALL nchdlerr( nf90_redef( i_file_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_def_var( i_file_id, "depth", nf90_real,i_dim, i_var_id ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'standard_name','depth') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'long_name', 'depth below the surface') ,__LINE__,__MYFILE__) 
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'units', 'm' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'unit_long','meter' ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_min', z_min ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_put_att( i_file_id, i_var_id, 'valid_max', z_max ) ,__LINE__,__MYFILE__)
+         CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+      ENDIF
+      !
+      CALL nchdlerr( nf90_put_var( i_file_id, i_var_id, z_dep) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_close( i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      RETURN
+      !
+   END SUBROUTINE write_dep_netcdf
+   !
+   !
+   !----------------------------------------------------------------------
+   !
+   ! C R E A T E _ T I M E _ S E R I E S _ N E T C D F _ F I L E
+   !
+   !----------------------------------------------------------------------
+   !
+   SUBROUTINE create_time_series_netcdf_file ( cl_filename,cl_boxes)
+      !
+      ! create time_series netcdf file
+      !
+      IMPLICIT NONE
+      !
+
+      CHARACTER(len=80), INTENT(in)         :: cl_filename
+      CHARACTER(len=20), DIMENSION(:)       :: cl_boxes
+      !
+      LOGICAL               :: clbon
+      INTEGER               :: i_file_id, i_dim_z_id, i_dim_box_id, &
+         i_dim_len_id, i_dim_t_id
+      INTEGER               :: i_box_id, i_tim_id
+      INTEGER               :: i_nbox
+      !
+      i_nbox = SIZE(cl_boxes,1)
+      !
+      
+      WRITE(*,*)' create_time_series',cl_filename
+      CALL nchdlerr( nf90_create( cl_filename, nf90_clobber, i_file_id ) ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'len', 20, i_dim_len_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'depth',i_dp, i_dim_z_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'box', i_nbox, i_dim_box_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_def_dim( i_file_id, 'time', nf90_unlimited, i_dim_t_id ) ,__LINE__,__MYFILE__)
+
+
+      WRITE(*,*)' In create_time_series_ntcdf'
+      WRITE(*,*)' z,box,time:       ',i_dim_z_id,i_dim_box_id, i_dim_t_id
+
+      WRITE(*,*)' Definining box var '
+      CALL nchdlerr( nf90_def_var( i_file_id, 'box', nf90_char, &
+         (/i_dim_len_id,i_dim_box_id/), i_box_id ),__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_box_id, &
+         'long_name', 'Name of the box' ) ,__LINE__,__MYFILE__)
+
+      WRITE(*,*)' Definining time var'
+      CALL nchdlerr( nf90_def_var( i_file_id, 'time', nf90_int, &
+         (/i_dim_t_id/),i_tim_id ) ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'standard_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'long_name','time') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      CALL nchdlerr( nf90_put_att( i_file_id, i_tim_id, 'unit_long','days as %Y%m%d') ,__LINE__,__MYFILE__)
+      !
+      CALL nchdlerr( nf90_enddef( i_file_id ) ,__LINE__,__MYFILE__)
+
+      CALL nchdlerr( nf90_put_var( i_file_id, i_box_id, cl_boxes &
+         ),__LINE__,__MYFILE__ )
+      !
+      CALL nchdlerr( nf90_close( i_file_id ),__LINE__,__MYFILE__ )
+      !
+      RETURN
+      !
+   END SUBROUTINE create_time_series_netcdf_file
+
+
+   !-----------------------------------------------------------------------
+   SUBROUTINE variable_att
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE variable_att
+      !                     **********************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name 
+      !
+      !  Original :  M. Balmaseda
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      !
+      INTEGER:: ji,jj,jk
+      REAL   :: dx0    !nominal longitudinal resolution in deg
+      REAL   :: alat, alon,aux
+      INTEGER,DIMENSION(:,:), ALLOCATABLE:: iaux
+
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='specified_sea_surface_temperature'
+         cl_varname1='Sea_Surface_Temperature'
+         cl_varname2='Sea Surface Temperature'
+         cl_varunit1='C'
+         cl_varunit2='degrees C'
+         cl_code='159'
+         cl_grid='t'
+      CASE ('somxl010')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_thickness'
+         cl_varname1='ocean_mixed_layer_thickness'
+         cl_varname2='depth of the ocean mixed layer from the surface'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='148'
+         cl_grid='t'
+      CASE ('somixhgt')
+         i_nb_dims=2
+         cl_var_out='turbocline_depth'
+         cl_varname1='turbocline_depth'
+         cl_varname2='turbocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='248'
+         cl_grid='t'
+      CASE ('somxlt05')
+         i_nb_dims=2
+         cl_var_out='ocean_mixed_layer_depth'
+         cl_varname1='ocean_mixed_layer_depth'
+         cl_varname2='depth of the ocean mixed layer T 0.5 criteria'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='348'
+         cl_grid='t'
+      CASE ('sohtc300')
+         i_nb_dims=2
+         cl_var_out='hc300'
+         cl_varname1='300m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 300m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='164'
+         cl_grid='t'
+      CASE ('sohtc700')
+         i_nb_dims=2
+         cl_var_out='hc700'
+         cl_varname1='700m_ocean_heat_content'
+         cl_varname2='ocean heat content over the first 700m'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='264'
+         cl_grid='t'
+      CASE ('sohtcbtm')
+         i_nb_dims=2
+         cl_var_out='hcbtm'
+         cl_varname1='Column_ocean_heat_content'
+         cl_varname2='ocean heat content over the whole column'
+         cl_varunit1='J/m2'
+         cl_varunit2='J/m2'
+         cl_code='364'
+         cl_grid='t'
+      CASE ('sosal300')
+         i_nb_dims=2
+         cl_var_out='sal300'
+         cl_varname1='300m_integrated salinity'
+         cl_varname2='salinity integrated over the first 300m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='175'
+         cl_grid='t'
+      CASE ('sosal700')
+         i_nb_dims=2
+         cl_var_out='sal700'
+         cl_varname1='700m_integrated salinity'
+         cl_varname2='salinity integrated over the first 700m'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='275'
+         cl_grid='t'
+      CASE ('sosalbtm')
+         i_nb_dims=2
+         cl_var_out='salbtm'
+         cl_varname1='Column_integrate_salinity'
+         cl_varname2='Integrated Salinity over the whole column'
+         cl_varunit1='psu*m'
+         cl_varunit2='psu*m'
+         cl_code='375'
+         cl_grid='t'
+      CASE ('so20chgt')
+         i_nb_dims=2
+         cl_var_out='d20_isotherm_depth'
+         cl_varname1='depth'
+         cl_varname2='depth of the D20 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='163'
+         cl_grid='t'
+      CASE ('so28chgt')
+         i_nb_dims=2
+         cl_var_out='d28_isotherm_depth'
+         cl_varname1='28I_depth'
+         cl_varname2='depth of the D28 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='263'
+         cl_grid='t'
+      CASE ('so26chgt')
+         i_nb_dims=2
+         cl_var_out='d26_isotherm_depth'
+         cl_varname1='26I_depth'
+         cl_varname2='depth of the D26 isotherm'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='463'
+         cl_grid='t'
+      CASE ('sothedep')
+         i_nb_dims=2
+         cl_var_out='thermocline_depth'
+         cl_varname1='thermocline_depth'
+         cl_varname2='thermocline depth'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='363'
+         cl_grid='t'
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145'      
+         cl_grid='t'
+      CASE ('sostheig')
+         i_nb_dims=2
+         cl_var_out='steric_height'
+         cl_varname1='steric_height'
+         cl_varname2='steric_height'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='150'      
+         cl_grid='t'
+      CASE ('sobpheig')
+         i_nb_dims=2
+         cl_var_out='bottom_pressure_equivalent_height'
+         cl_varname1='Bottom Pressure'
+         cl_varname2='Bottom Pressure'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='149'      
+         cl_grid='t'
+      CASE ('sohefldo')
+         i_nb_dims=2
+         cl_var_out='specified_surface_heat_flux'
+         cl_varname1='Net Downward Heat Flux'
+         cl_varname2='Net Downward Heat Flux'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='160'      
+         cl_grid='t'
+      CASE ('sohefldp')
+         i_nb_dims=2
+         cl_var_out='heat_flux_correction'
+         cl_varname1='Surface_Heat_Flux_Damping'
+         cl_varname2='Surface Heat Flux: Damping'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='162'      
+         cl_grid='t'
+      CASE ('soshfldo')
+         i_nb_dims=2
+         cl_var_out='absorbed_solar_radiation'
+         cl_varname1='Shortwave_Radiation'
+         cl_varname2='Shortwave Radiation'
+         cl_varunit1='W/m2'
+         cl_varunit2='Watt_per_square_meter'
+         cl_code='157'      
+         cl_grid='t'
+      CASE ('sosalflx')
+         i_nb_dims=2
+         cl_var_out='Surface_Salt_Flux'
+         cl_varname1='Surface_Salt_Flux'
+         cl_varname2='Surface Salt Flux'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='260'      
+         cl_grid='t'
+      CASE ('sosafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_salt_flux_damping'
+         cl_varname1=cl_var_out
+         cl_varname2='Surface salt flux: damping'
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='261'      
+         cl_grid='t'
+      CASE ('sowaflup')
+         i_nb_dims=2
+         cl_var_out='Net_Upward_Water_Flux'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='258'      
+         cl_grid='t'
+      CASE ('sowafldp')
+         i_nb_dims=2
+         cl_var_out='Surface_Water_Flux_Damping'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='Kg/m2/s'
+         cl_varunit2='Kg/m2/s'
+         cl_code='262'      
+         cl_grid='t'
+      CASE ('soicetem')
+         i_nb_dims=2
+         cl_var_out='Ice_Surface_Temperature'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='429'      
+         cl_grid='t'
+      CASE ('soicealb')
+         i_nb_dims=2
+         cl_var_out='Ice_Albedo'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='430'      
+         cl_grid='t'
+      CASE ('soicecov')
+         i_nb_dims=2
+         cl_var_out='Ice_Fraction'
+         cl_varname1=cl_var_out
+         cl_varname2=cl_var_out
+         cl_varunit1='dl'
+         cl_varunit2='dimensionless'
+         cl_code='431'      
+         cl_grid='t'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+         cl_grid='t'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+         cl_grid='t'
+      CASE ('vosigmat')
+         i_nb_dims=3
+         cl_var_out='sigmat'
+         cl_varname1='sigmat'
+         cl_varname2='sigmat'
+         cl_varunit1='C'
+         cl_varunit2='NA'
+         cl_code='138'
+         cl_grid='t'
+      CASE ('vottrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_T_3D'
+         cl_varname1='Damping_T_3D'
+         cl_varname2='Damping T 3D'
+         cl_varunit1='C/s'
+         cl_varunit2='degree_Celsius/second'
+         cl_code='201'
+         cl_grid='t'
+      CASE ('vostrdmp')
+         i_nb_dims=3
+         cl_var_out='Damping_S_3D'
+         cl_varname1='Damping_S_3D'
+         cl_varname2='Damping S_3D'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu/second'
+         cl_code='202'
+         cl_grid='t'
+      CASE ('votbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_T_direct'
+         cl_varname1='Bias_T_direct'
+         cl_varname2='Bias_T_direct'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='203'
+         cl_grid='t'
+      CASE ('vosbiasd')
+         i_nb_dims=3
+         cl_var_out='Bias_S_direct'
+         cl_varname1='Bias_S_direct'
+         cl_varname2='Bias_S_direct'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='204'
+         cl_grid='t'
+      CASE ('votbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_T_pressure'
+         cl_varname1='Bias_T_pressure'
+         cl_varname2='Bias_T_pressure'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celsius'
+         cl_code='205'
+         cl_grid='t'
+      CASE ('vosbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_S_pressure'
+         cl_varname1='Bias_S_pressure'
+         cl_varname2='Bias_S_pressure'
+         cl_varunit1='psu'
+         cl_varunit2='psu'
+         cl_code='206'
+         cl_grid='t'
+      CASE ('vorbiasp')
+         i_nb_dims=3
+         cl_var_out='Bias_rho_pressure'
+         cl_varname1='Bias_rho_pressure'
+         cl_varname2='Bias_rho_pressure'
+         cl_varunit1='kg/m3/s'
+         cl_varunit2='kg/m3/s'
+         cl_code='207'
+         cl_grid='t'
+      CASE ('sozotaux')
+         i_nb_dims=2
+         cl_var_out='surface_downward_eastward_stress'
+         cl_varname1='Wind_Stress_along_i-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='153'      
+         cl_grid='u'
+         if (sec .eq. 'v') then
+            cl_varname2='taux*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='taux*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+         cl_grid='u'
+         if (sec .eq. 'u') then
+            cl_var_out='zonal_transport'
+            cl_varname1='zonal_transport'
+            cl_varname2='zonal_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vozout')
+         i_nb_dims=3
+         cl_var_out='UT'
+         cl_varname1='UT'
+         cl_varname2='UT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='169'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_H_transport'
+          cl_varname1='zonal_H_transport'
+          cl_varname2='zonal_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vozous')
+         i_nb_dims=3
+         cl_var_out='US'
+         cl_varname1='US'
+         cl_varname2='US'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='171'
+         cl_grid='t'
+         if (sec .eq. 'u') then
+          cl_var_out='zonal_S_transport'
+          cl_varname1='zonal_S_transport'
+          cl_varname2='zonal_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_var_out='meridional_transport'
+            cl_varname1='meridional_transport'
+            cl_varname2='meridional_transport'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('sometauy')
+         i_nb_dims=2
+         cl_var_out='surface_downward_northward_stress'
+         cl_varname1='Wind_Stress_along_j-axis'
+         cl_varname2=cl_var_out
+         cl_varunit1='N/m2'
+         cl_varunit2='N/m2'
+         cl_code='154'      
+         cl_grid='v'
+         if (sec .eq. 'v') then
+            cl_varname2='tauy*x*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+         if (sec .eq. 'u') then
+            cl_varname2='tauy*y*z'
+            cl_varunit1='Sv'
+            cl_varunit2='Sv'
+         endif
+      CASE ('vomevt')
+         i_nb_dims=3
+         cl_var_out='VT'
+         cl_varname1='VT'
+         cl_varname2='VT'
+         cl_varunit1='K*m/s'
+         cl_varunit2='K*m/s'
+         cl_code='170'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_H_transport'
+          cl_varname1='meridional_H_transport'
+          cl_varname2='meridional_H_transport'
+          cl_varunit1='PW'
+          cl_varunit2='PW'
+         endif
+      CASE ('vomevs')
+         i_nb_dims=3
+         cl_var_out='VS'
+         cl_varname1='VS'
+         cl_varname2='VS'
+         cl_varunit1='psu*m/s'
+         cl_varunit2='psu*m/s'
+         cl_code='172'
+         cl_grid='t'
+         if (sec .eq. 'v') then
+          cl_var_out='meridional_S_transport'
+          cl_varname1='meridional_S_transport'
+          cl_varname2='meridional_S_transport'
+          cl_varunit1='kT/s'
+          cl_varunit2='kT/s'
+         endif
+      CASE ('vovecrtz')
+         i_nb_dims=3
+         cl_var_out='upward_sea_water_velocity'
+         cl_varname1='upward_sea_water_velocity'
+         cl_varname2='W vertical current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='133'
+         cl_grid='f'
+      CASE ('votkeavm')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_viscosity'
+         cl_varname1='vertical_eddy_viscosity'
+         cl_varname2='vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='135'
+         cl_grid='f'
+      CASE ('votkeavt')
+         i_nb_dims=3
+         cl_var_out='vertical_eddy_diffusivity'
+         cl_varname1='vertical_eddy_diffusivity'
+         cl_varname2='vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='136'
+         cl_grid='f'
+      CASE ('votkeevm')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_viscosity'
+         cl_varname1='enhanced_vertical_eddy_viscosity'
+         cl_varname2='enhanced vertical eddy viscosity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='235'
+         cl_grid='f'
+      CASE ('votkeevd')
+         i_nb_dims=3
+         cl_var_out='enhanced_vertical_eddy_diffusivity'
+         cl_varname1='enhanced_vertical_eddy_diffusivity'
+         cl_varname2='enhanced vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='236'
+         cl_grid='f'
+      CASE ('voddmavs')
+         i_nb_dims=3
+         cl_var_out='salt_vertical_eddy_diffusivity'
+         cl_varname1='salt_vertical_eddy_diffusivity'
+         cl_varname2='salt vertical eddy diffusivity'
+         cl_varunit1='m2/s'
+         cl_varunit2='square_meter_per_second'
+         cl_code='237'
+         cl_grid='f'
+      CASE ('bckint')
+         i_nb_dims=3
+         cl_var_out='assim_incr_temperature'
+         cl_varname1='assim_incr_temperature'
+         cl_varname2='assim_incr_temperature'
+         cl_varunit1='K/s'
+         cl_varunit2='Kelvin_per_second'
+         cl_code='178'
+         cl_grid='t'
+      CASE ('bckins')
+         i_nb_dims=3
+         cl_var_out='assim_incr_salinity'
+         cl_varname1='assim_incr_salinity'
+         cl_varname2='assim_incr_salinity'
+         cl_varunit1='psu/s'
+         cl_varunit2='psu_per_second'
+         cl_code='184'
+         cl_grid='t'
+      CASE ('bckinu')
+         i_nb_dims=3
+         cl_var_out='assim_incr_uvel'
+         cl_varname1='assim_incr_uvel'
+         cl_varname2='assim_incr_uvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='179'
+         cl_grid='u'
+      CASE ('bckinv')
+         i_nb_dims=3
+         cl_var_out='assim_incr_vvel'
+         cl_varname1='assim_incr_vvel'
+         cl_varname2='assim_incr_vvel'
+         cl_varunit1='m/s2'
+         cl_varunit2='meter_per_square_second'
+         cl_code='180'
+         cl_grid='v'
+      CASE ('bckineta')
+         i_nb_dims=2
+         cl_var_out='assim_incr_eta'
+         cl_varname1='assim_incr_eta'
+         cl_varname2='assim_incr_eta'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='181'
+         cl_grid='t'
+      CASE ('vozoeivu')
+         i_nb_dims=3
+         cl_var_out='vozoeivu'
+         cl_varname1='vozoeivu'
+         cl_varname2='eddy U velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='231'
+      CASE ('vomeeivv')
+         i_nb_dims=3
+         cl_var_out='vomeeivv'
+         cl_varname1='vomeeivv'
+         cl_varname2='eddy V velocity m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='232'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_grid     = TRIM(cl_grid) 
+
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) //sec//'mona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // TRIM(cl_code) // 'xy' //sec//'mona.nc'
+!      IF ( i_nb_dims .EQ. 2 ) THEN
+!         i_dp=1
+!      ELSE
+!         i_dp=jpk
+!      ENDIF
+      WRITE(*,*)'Variable Attributes: '
+      WRITE(*,*)'   cl_var_out = ',cl_var_out
+!      WRITE(*,*)'   i_dp       = ',i_dp
+      WRITE(*,*)'   cl_grid    = ',cl_grid
+      WRITE(*,*)'   cl_code    = ',cl_code
+      WRITE(*,*)'   i_nb_dims  = ',i_nb_dims
+      WRITE(*,*)'------------------------------------ '
+
+      RETURN
+   END SUBROUTINE variable_att
+   !-----------------------------------------------------------------------
+   SUBROUTINE obs_variable_att(cl_type)
+      !-----------------------------------------------------------------------
+      !
+      !                       ROUTINE obs_variable_att
+      !                     ****************************
+      !
+      !  Purpose :
+      !  -------
+      !    set attributes for a given variable name (feedback version)
+      !
+      !  Original :  K. Mogensen
+      IMPLICIT NONE
+      !-----------------------------------------------------------------------
+      !   Different variables
+      !-----------------------------------------------------------------------
+      CHARACTER(len=*) :: cl_type
+      !
+      SELECT CASE ( TRIM(cl_var) )
+      CASE ('sossheig')
+         i_nb_dims=2
+         cl_var_out='sea_surface_height_above_geoid'
+         cl_varname1='sea_surface_height_above_geoid'
+         cl_varname2='sea_surface_height_above_geoid'
+         cl_varunit1='m'
+         cl_varunit2='meter'
+         cl_code='145' 
+      CASE ('sosstsst')
+         i_nb_dims=2
+         cl_var_out='sea_surface_temperature'
+         cl_varname1='sea_surface_temperature'
+         cl_varname2='sea_surface_temperature'
+         cl_varunit1='K'
+         cl_varunit2='Kelvin'
+         cl_code='159'
+      CASE ('votemper')
+         i_nb_dims=3
+         cl_var_out='sea_water_potential_temperature'
+         cl_varname1='sea_water_potential_temperature'
+         cl_varname2='Potential temperature ref to surface C'
+         cl_varunit1='C'
+         cl_varunit2='degree_Celcius'
+         cl_code='129'
+      CASE ('vosaline')
+         i_nb_dims=3
+         cl_var_out='sea_water_salinity'
+         cl_varname1='sea_water_salinity'
+         cl_varname2='sea water salinity'
+         cl_varunit1='PSU'
+         cl_varunit2='practical_salinity_scale'
+         cl_code='130'
+      CASE ('vozocrtx')
+         i_nb_dims=3
+         cl_var_out='sea_water_x_velocity'
+         cl_varname1='sea_water_x_velocity'
+         cl_varname2='U zonal current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='131'
+      CASE ('vomecrty')
+         i_nb_dims=3
+         cl_var_out='sea_water_y_velocity'
+         cl_varname1='sea_water_y_velocity'
+         cl_varname2='V meridional current m/s'
+         cl_varunit1='m/s'
+         cl_varunit2='meter_per_second'
+         cl_code='132'
+      CASE default
+         WRITE(*,*)'Variables not defined' 
+         CALL ABORT
+      END SELECT
+      cl_var_out  = TRIM(cl_var_out) 
+      cl_varname1 = TRIM(cl_varname1) 
+      cl_varname2 = TRIM(cl_varname2) 
+      cl_varunit1 = TRIM(cl_varunit1) 
+      cl_varunit2 = TRIM(cl_varunit2)
+      cl_code     = TRIM(cl_code)
+      cl_filename_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'//'fbmona.nc'
+      cl_filename2_out = TRIM(cl_expnam) // TRIM(cl_date) // '_' // &
+         & TRIM(cl_code) // '_'//TRIM(cl_type)//'_'// 'xy' //'_'//'fbmona.nc'
+     
+      RETURN
+   END SUBROUTINE obs_variable_att
+
+
+END MODULE omonainfo
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_kind.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/par_kind.F90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/par_oce.F90	(revision 3294)
@@ -0,0 +1,199 @@
+MODULE par_oce
+   !!======================================================================
+   !!                        ***  par_oce  ***
+   !! Ocean :   set the ocean parameters
+   !!======================================================================
+   !! History :  OPA  !  1991     (Imbard, Levy, Madec)  Original code
+   !!   NEMO     1.0  !  2004-01  (G. Madec, J.-M. Molines)  Free form and module
+   !!            3.3  !  2010-09  (C. Ethe) TRA-TRC merge: add jpts, jp_tem & jp_sal
+   !!----------------------------------------------------------------------
+   USE par_kind          ! kind parameters
+
+   IMPLICIT NONE
+   PUBLIC
+
+   !!----------------------------------------------------------------------
+   !!   Domain decomposition
+   !!----------------------------------------------------------------------
+   !! if we dont use massively parallel computer (parameters jpni=jpnj=1) so jpiglo=jpi and jpjglo=jpj
+   INTEGER, PUBLIC            ::   jpni         !: number of processors following i 
+   INTEGER, PUBLIC            ::   jpnj         !: number of processors following j
+   INTEGER, PUBLIC            ::   jpnij        !: nb of local domain = nb of processors ( <= jpni x jpnj )
+   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo 
+   INTEGER, PUBLIC, PARAMETER ::   jpreci = 1   !: number of columns for overlap 
+   INTEGER, PUBLIC, PARAMETER ::   jprecj = 1   !: number of rows    for overlap 
+
+   !! Ocean Domain sizes
+   !! ------------------
+   !!   data           domain   (jpidta,jpjdta)
+   !!   global or zoom domain   (jpiglo,jpjglo)
+   !!   local          domain   ( jpi  , jpj  )
+   
+!#if   defined key_orca_r4
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r4'   :                           global ocean : ORCA R4
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R4.h90"
+!#elif defined key_orca_r2
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r2'   :                           global ocean : ORCA R4
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R2.h90"
+!#elif defined key_orca_r1
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r1'   :                           global ocean : ORCA R1
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R1.h90"
+!#elif defined key_orca_r05
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r05'  :                          global ocean : ORCA R05
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R05.h90"
+!#elif defined key_orca_r025
+!   !!---------------------------------------------------------------------
+!   !!   'key_orca_r025' :                         global ocean : ORCA R025
+!   !!---------------------------------------------------------------------
+!#             include "par_ORCA_R025.h90"
+!#elif defined key_eel_r2
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r2'    :                                 channel : EEL R2
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R2.h90"
+!#elif defined key_eel_r5
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r5'    :                                 channel : EEL R5
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R5.h90"
+!#elif defined key_eel_r6
+!   !!---------------------------------------------------------------------
+!   !!   'key_eel_r6'    :                                 channel : EEL R6
+!   !!---------------------------------------------------------------------
+!#             include "par_EEL_R6.h90"
+!#elif defined key_gyre
+!   !!---------------------------------------------------------------------
+!   !!   'key_gyre'      :                        mid-latitude basin : GYRE
+!   !!---------------------------------------------------------------------
+!#             include "par_GYRE.h90"
+!#elif defined key_pomme_r025
+!   !!---------------------------------------------------------------------
+!   !!   'key_pomme_r025':                        regional basin : POMME025
+!   !!---------------------------------------------------------------------
+!#             include "par_POMME_R025.h90"
+!#else
+   !!---------------------------------------------------------------------
+   !!   default option  :                               small closed basin
+   !!---------------------------------------------------------------------
+   CHARACTER(len=16), PUBLIC, PARAMETER ::   cp_cfg = "default"   !: name of the configuration
+   INTEGER          , PUBLIC, PARAMETER ::   jp_cfg = 0           !: resolution of the configuration
+
+   ! data size                                       !!! * size of all input files *
+   INTEGER, PUBLIC, PARAMETER ::   jpidta  = 10       !: 1st lateral dimension ( >= jpi )
+   INTEGER, PUBLIC, PARAMETER ::   jpjdta  = 12       !: 2nd    "         "    ( >= jpj )
+   INTEGER, PUBLIC, PARAMETER ::   jpkdta  = 31       !: number of levels      ( >= jpk )
+
+   ! global or zoom domain size                      !!! * computational domain *
+   INTEGER, PUBLIC, PARAMETER ::   jpiglo  = jpidta   !: 1st dimension of global domain --> i
+   INTEGER, PUBLIC, PARAMETER ::   jpjglo  = jpjdta   !: 2nd    -                  -    --> j
+   INTEGER, PUBLIC            ::   jpk     = jpkdta   !: number of vertical levels
+   ! zoom starting position 
+   INTEGER, PUBLIC, PARAMETER ::   jpizoom =   1      !: left bottom (i,j) indices of the zoom
+   INTEGER, PUBLIC, PARAMETER ::   jpjzoom =   1      !: in data domain indices
+
+   ! Domain characteristics
+   INTEGER, PUBLIC, PARAMETER ::   jperio  =  0       !: lateral cond. type (between 0 and 6)
+   !                                                  !  = 0 closed                 ;   = 1 cyclic East-West
+   !                                                  !  = 2 equatorial symmetric   ;   = 3 North fold T-point pivot
+   !                                                  !  = 4 cyclic East-West AND North fold T-point pivot
+   !                                                  !  = 5 North fold F-point pivot
+   !                                                  !  = 6 cyclic East-West AND North fold F-point pivot
+
+   !!  Values set to pp_not_used indicates that this parameter is not used in THIS config.
+   !!  Values set to pp_to_be_computed  indicates that variables will be computed in domzgr
+   REAL(wp), PUBLIC, PARAMETER ::   pp_not_used       = 999999._wp   !: vertical grid parameter
+   REAL(wp), PUBLIC, PARAMETER ::   pp_to_be_computed = 999999._wp   !:    -      -       -
+
+
+   !! Horizontal grid parameters for domhgr
+   !! =====================================
+   INTEGER, PUBLIC, PARAMETER  ::   jphgr_msh = 0   !: type of horizontal mesh
+   !                                                !  = 0 curvilinear coordinate on the sphere read in coordinate.nc
+   !                                                !  = 1 geographical mesh on the sphere with regular grid-spacing
+   !                                                !  = 2 f-plane with regular grid-spacing
+   !                                                !  = 3 beta-plane with regular grid-spacing
+   !                                                !  = 4 Mercator grid with T/U point at the equator
+
+   REAL(wp) , PUBLIC, PARAMETER ::   ppglam0  =    0.0_wp   !: longitude of first raw and column T-point (jphgr_msh = 1)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppgphi0  =  -35.0_wp   !: latitude  of first raw and column T-point (jphgr_msh = 1)
+   !                                                        !  used for Coriolis & Beta parameters (jphgr_msh = 2 or 3)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_deg =    1.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_deg =    0.5_wp   !: meridional grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe1_m   = 5000.0_wp   !: zonal      grid-spacing (degrees)
+   REAL(wp) , PUBLIC, PARAMETER ::   ppe2_m   = 5000.0_wp   !: meridional grid-spacing (degrees)
+
+   !! Vertical grid parameter for domzgr
+   !! ==================================
+   REAL(wp), PUBLIC, PARAMETER ::   ppsur = -4762.96143546300_wp   !: ORCA r4, r2 and r05 coefficients
+   REAL(wp), PUBLIC, PARAMETER ::   ppa0  =   255.58049070440_wp   !: (default coefficients)
+   REAL(wp), PUBLIC, PARAMETER ::   ppa1  =   245.58132232490_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth =    21.43336197938_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr =     3.00000000000_wp   !:
+   !
+   !  If both ppa0 ppa1 and ppsur are specified to 0, then
+   !  they are computed from ppdzmin, pphmax , ppkth, ppacr in dom_zgr
+   REAL(wp), PUBLIC, PARAMETER ::   ppdzmin = 10._wp     !: Minimum vertical spacing
+   REAL(wp), PUBLIC, PARAMETER ::   pphmax  = 5000._wp   !: Maximum depth
+   !
+   LOGICAL , PUBLIC, PARAMETER ::   ldbletanh = .TRUE.   !: Use/do not use double tanf function for vertical coordinates
+   REAL(wp), PUBLIC, PARAMETER ::   ppa2  =   100.760928500000_wp   !: Double tanh function parameters
+   REAL(wp), PUBLIC, PARAMETER ::   ppkth2=    48.029893720000_wp   !:
+   REAL(wp), PUBLIC, PARAMETER ::   ppacr2=    13.000000000000_wp   !:
+   !
+!#endif
+
+
+   !!---------------------------------------------------------------------
+   !! Active tracer parameters
+   !!---------------------------------------------------------------------
+   INTEGER, PUBLIC, PARAMETER ::   jpts   = 2    !: Number of active tracers (=2, i.e. T & S )
+   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature
+   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity
+
+   !!---------------------------------------------------------------------
+   !! Domain Matrix size  (if AGRIF, they are not all parameters)
+   !!---------------------------------------------------------------------
+#if defined key_agrif
+   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 1                             !: number of ghost cells
+   INTEGER, PUBLIC            ::   nbcellsx     = jpiglo - 2 - 2*nbghostcells   !: number of cells in i-direction
+   INTEGER, PUBLIC            ::   nbcellsy     = jpjglo - 2 - 2*nbghostcells   !: number of cells in j-direction
+   !
+#endif
+   INTEGER, PUBLIC  ::   jpi   ! = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   !: first  dimension
+   INTEGER, PUBLIC  ::   jpj   ! = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   !: second dimension
+   INTEGER, PUBLIC  ::   jpk   ! = jpkdta                                             !: third dimension
+   INTEGER, PUBLIC  ::   jpim1 ! = jpi-1                                            !: inner domain indices
+   INTEGER, PUBLIC  ::   jpjm1 ! = jpj-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpkm1 ! = jpk-1                                            !:   -     -      -
+   INTEGER, PUBLIC  ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj
+
+   !!---------------------------------------------------------------------
+   !! Optimization/control flags
+   !!---------------------------------------------------------------------
+#if defined key_esopa
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .TRUE.   !: flag to activate the all options
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_esopa     = .FALSE.  !: flag to activate the all options
+#endif
+
+#if defined key_vectopt_loop
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .TRUE.   !: vector optimization flag
+#else
+   LOGICAL, PUBLIC, PARAMETER ::   lk_vopt_loop = .FALSE.  !: vector optimization flag
+#endif
+
+   !!----------------------------------------------------------------------
+   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
+   !! $Id: par_oce.F90 2715 2011-03-30 15:58:35Z rblod $ 
+   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
+   !!======================================================================
+END MODULE par_oce
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/proftools.F90	(revision 3294)
@@ -0,0 +1,34 @@
+MODULE proftools
+
+   ! Various tools to manipulate fb profiles data.
+
+   USE obs_fbm
+   IMPLICIT NONE
+
+CONTAINS
+
+   SUBROUTINE sealsfromargo( fbdata )
+
+      ! Separate seals  from argo
+
+      ! Notes:
+      ! Argo is type 831
+      ! Seals have station ids from Q9900000 to Q9900328
+      ! according to
+      ! http://www.nodc.noaa.gov/GTSPP/document/codetbls/shipcode/name_1-C.html
+      ! on 2010-04-28 but we assume that all Q990???? are seals
+      
+      TYPE(obfbdata) :: fbdata
+      CHARACTER(len=ilentyp) :: cdtyp
+      INTEGER :: i
+
+      DO i=1,fbdata%nobs
+         
+         cdtyp=ADJUSTL(fbdata%cdtyp(i))
+         IF ((cdtyp(1:3)=='831') .AND. &
+            &(fbdata%cdwmo(i)(1:4)=='Q990')) fbdata%cdtyp(i)='Seal'
+      ENDDO
+
+   END SUBROUTINE sealsfromargo
+
+END MODULE proftools
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/sla2fb.F90	(revision 3294)
@@ -0,0 +1,102 @@
+PROGRAM sla2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM sla2fb **
+   !!
+   !!  ** Purpose : Convert AVISO SLA format to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     sla2fb.exe [-s type] outputfile inputfile1 inputfile2 ...
+   !!   Option:
+   !!     -s            Select altimeter data_source
+   !!
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_sla_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   CHARACTER(len=256) :: cdtmp
+   CHARACTER(len=5) :: cdsource
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: slaf(:)
+   INTEGER :: ninfiles,ntotobs
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ip,ia,ji,jk,noff
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'sla2fb [-s type] outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   cdsource=''
+   !
+   ! Get input data
+   !
+   noff=1
+   IF ( nargs > 1 ) THEN
+      CALL getarg(1,cdtmp)
+      IF (TRIM(cdtmp)=='-s') THEN
+         IF ( nargs < 3 ) THEN
+            WRITE(*,*)'Missing arguments to -s <datasource>'
+            CALL abort
+         ENDIF
+         CALL getarg(2,cdsource)
+         noff=3
+      ENDIF
+   ENDIF
+   CALL getarg(noff,cdoutfile)
+   ninfiles = nargs - noff
+   ALLOCATE( slaf(MAX(nargs-noff,1)) )
+   ALLOCATE( cdinfile(nargs-noff) )
+   ntotobs = 0
+   DO ia=1,ninfiles
+      CALL getarg( ia + noff, cdinfile(ia) )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      CALL read_avisofile( TRIM(cdinfile(ia)), slaf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(A,I9,A)')'has',slaf(ia)%nobs,' observations'
+      IF (LEN_TRIM(cdsource)>0) THEN
+         DO ji=1,slaf(ia)%nobs
+            slaf(ia)%cdwmo(ji)=TRIM(slaf(ia)%cdwmo(ji))//'_'//TRIM(cdsource)
+         ENDDO
+      ENDIF
+      ntotobs = ntotobs + slaf(ia)%nobs
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( slaf(1) )
+      CALL alloc_obfbdata( slaf(1), 1, 0, 1, 0, 0, .FALSE. )
+      slaf(1)%cname(1) = 'SLA'
+      slaf(1)%cdjuldref = '19500101000000'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total observations : ',ntotobs
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, slaf )
+
+END PROGRAM sla2fb
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/str_c_to_for.h90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/OBS/str_c_to_for.h90
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/toolspar_kind.F90	(revision 3294)
@@ -0,0 +1,8 @@
+MODULE toolspar_kind
+  IMPLICIT NONE
+  INTEGER, PUBLIC, PARAMETER ::          &  !: Floating point section
+       sp = SELECTED_REAL_KIND( 6, 37),  &  !: single precision (real 4)
+       dp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+       wp = SELECTED_REAL_KIND(12,307),  &  !: double precision (real 8)
+       ik = SELECTED_INT_KIND(6)            !: integer precision 
+END MODULE toolspar_kind
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/vel2fb.F90	(revision 3294)
@@ -0,0 +1,86 @@
+PROGRAM vel2fb
+   !!---------------------------------------------------------------------
+   !!
+   !!                     ** PROGRAM vel2fb **
+   !!
+   !!  ** Purpose : Convert TAO/PIRATA/RAMA currents to feedback format
+   !!
+   !!  ** Method  : Use of utilities from obs_fbm.
+   !!
+   !!  ** Action  :
+   !!
+   !!   Usage:
+   !!     vel2fb.exe outputfile inputfile1 inputfile2 ...
+   !! 
+   !!   History :
+   !!        ! 2010 (K. Mogensen) Initial version
+   !!----------------------------------------------------------------------
+   USE obs_fbm
+   USE obs_vel_io
+   USE convmerge
+   IMPLICIT NONE
+   !
+   ! Command line arguments for output file and input files
+   !
+#ifndef NOIARGCPROTO
+   INTEGER,EXTERNAL :: iargc
+#endif
+   INTEGER :: nargs
+   CHARACTER(len=256) :: cdoutfile
+   CHARACTER(len=256),ALLOCATABLE :: cdinfile(:)
+   !
+   ! Input data
+   !
+   TYPE(obfbdata), POINTER :: velf(:)
+   INTEGER :: ninfiles,ntotvel,nmaxlev
+   INTEGER,ALLOCATABLE  :: iset(:),inum(:),iindex(:)
+   !
+   ! Output data
+   !
+   TYPE(obfbdata) :: fbdata
+   !
+   ! Loop variables
+   !
+   INTEGER :: ia,ii,ij
+   !
+   ! Get number of command line arguments
+   !
+   nargs=IARGC()
+   IF (nargs < 1) THEN
+      WRITE(*,'(A)')'Usage:'
+      WRITE(*,'(A)')'vel2fb outputfile inputfile1 inputfile2 ...'
+      CALL abort()
+   ENDIF
+   CALL getarg(1,cdoutfile)
+   !
+   ! Get input data
+   !
+   ALLOCATE( velf(MAX(nargs-1,1)) )
+   ALLOCATE( cdinfile(nargs-1) )
+   ntotvel = 0
+   ninfiles  = nargs - 1
+   DO ia = 1,ninfiles
+      CALL getarg( ia + 1, cdinfile(ia) )
+      CALL read_taondbc( TRIM(cdinfile(ia)), velf(ia), 6, .TRUE., .FALSE. )
+      WRITE(*,'(2A)')'File = ',TRIM(cdinfile(ia))
+      WRITE(*,'(A,I9,A)')'has',velf(ia)%nobs,' profiles'
+      ntotvel = ntotvel + velf(ia)%nobs
+      nmaxlev   = MAX( nmaxlev, velf(ia)%nlev )
+   ENDDO
+   IF (ninfiles==0) THEN
+      CALL init_obfbdata( velf(1) )
+      CALL alloc_obfbdata( velf(1), 2, 0, 1, 0, 1, .FALSE. )
+      velf(1)%cname(1) = 'UVEL'
+      velf(1)%cname(2) = 'VVEL'
+      velf(1)%coblong(1) = 'Zonal current'
+      velf(1)%coblong(2) = 'Meridional current'
+      velf(1)%cobunit(1) = 'Meters per second'
+      velf(1)%cobunit(2) = 'Meters per second'
+   ENDIF
+   WRITE(*,'(A,I8)') 'Total profiles : ',ntotvel
+   !
+   ! Merge and output the data.
+   !
+   CALL conv_fbmerge( TRIM(cdoutfile), ninfiles, velf )
+
+END PROGRAM vel2fb
Index: trunk/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90
===================================================================
--- trunk/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/OBSTOOLS/src/wrk_nemo.F90	(revision 3294)
@@ -0,0 +1,1 @@
+link ../../../NEMO/OPA_SRC/wrk_nemo.F90
Index: trunk/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/REBUILD_NEMO/rebuild_nemo	(revision 3294)
@@ -0,0 +1,75 @@
+#!/bin/ksh
+#
+#  Script to run the NEMO rebuild tool to rebuild NEMO
+#  diagnostic or restart files.
+#
+#  The scripts creates the nam_rebuild namelist based upon
+#  the command line options you give it (see usage below)
+#
+#  Ed Blockley, September 2011
+#
+#
+
+#set -ax
+usage ()
+{
+   echo
+   echo "  NEMO Rebuild"
+   echo "  ************"
+   echo
+   echo "  usage: ${0##*/} [-t -c] filebase ndomain [rebuild dimensions]"
+   echo
+   echo "  flags:  -t num      use num threads"
+   echo "          -c num      split 4D vars into time chuncks of size num"
+   echo
+   exit 1
+}
+
+while getopts c:t: opt
+do
+  case ${opt} in
+      t)
+         OMP_NUM_THREADS=${OPTARG}
+      ;;
+      c)
+         NCHUNKSIZE=${OPTARG}
+      ;;
+  esac
+done
+shift $(expr ${OPTIND} - 1)
+
+if [[ $# < 2 ]] ; then
+   usage
+fi
+
+script_dir=$(dirname $0)
+
+file=$1
+ndomain=$2
+DIM1=$3
+DIM2=$4
+export OMP_NUM_THREADS=${OMP_NUM_THREADS:-16}
+
+if [[ -n ${DIM1} && -n ${DIM2} ]] ; then
+   dim_str=" dims '${DIM1}','${DIM2}'"
+   dims="dims='${DIM1}','${DIM2}'"
+   echo ${dim_str} >> nam_rebuild
+fi
+
+echo "file ${file},  num_domains ${ndomain}, num_threads ${OMP_NUM_THREADS}${dim_str}"
+
+cat > nam_rebuild << EOC
+&nam_rebuild
+filebase='${file}'
+ndomain=${ndomain}
+EOC
+if [[ -n ${dims} ]] ; then
+   echo ${dims} >> nam_rebuild
+fi
+if [[ -n ${NCHUNKSIZE} ]] ; then
+   echo " nchunksize=${NCHUNKSIZE}" >> nam_rebuild
+fi
+echo "/" >> nam_rebuild
+
+# run the rebuild code
+${script_dir}/rebuild_nemo.exe 
Index: trunk/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/REBUILD_NEMO/src/rebuild_nemo.f90	(revision 3294)
@@ -0,0 +1,1155 @@
+PROGRAM rebuild_nemo
+
+   !!=========================================================================
+   !!                        ***  rebuild_nemo  ***
+   !!=========================================================================
+   !!
+   !!  A routine to rebuild NEMO files from multiple processors into one file.
+   !!  This routine is designed to be much quicker than the old IOIPSL rebuild
+   !!  but at the cost of an increased memory usage.
+   !!
+   !!  NEMO rebuild has the following features:
+   !!     * dynamically works out what variables require rebuilding
+   !!     * does not copy subdomain halo regions
+   !!     * works for 1,2,3 and 4d arrays or types for all valid NetCDF types
+   !!     * utilises OMP shared memory parallelisation where applicable
+   !!     * time 'chunking' for lower memory use 
+   !!       (only for 4D vars with unlimited dimension)
+   !!
+   !!  Ed Blockley - August 2011
+   !!  (based on original code by Matt Martin)
+   !!
+   !!-------------------------------------------------------------------------
+   !!
+   !!  The code reads the filestem and number of subdomains from the namelist file nam_rebuild.
+   !! 
+   !!  The 1st subdomain file is used to determine the dimensions and variables in all the input files. 
+   !!  It is also used to find which dimensions (and hence which variables) require rebuilding 
+   !!  as well as information about the global domain.
+   !!
+   !!  It then opens all the input files (unbuffered) and creates an array of netcdf identifiers
+   !!  before looping through all the variables and updating the rebuilt output file (either by direct 
+   !!  copying or looping over the number of domains and rebuilding as appropriate).
+   !!  
+   !!  The code looks more complicated than it is because it has lots of case statements to deal with all 
+   !!  the various NetCDF data types and with various data dimensions (up to 4d).
+   !!
+   !!  Diagnostic output is written to numout (default 6 - stdout)
+   !!  and errors are written to numerr (default 0 - stderr).
+   !!
+   !!  If time chunking is specified the code will use less memory but take a little longer.
+   !!  It does this by breaking down the 4D input variables over their 4th dimension 
+   !!  (generally time) by way of a while loop.
+   !!
+   !!-------------------------------------------------------------------------------
+  
+   USE netcdf
+
+!$ USE omp_lib           ! Note OpenMP sentinel
+
+   IMPLICIT NONE
+
+   ! kind specifications
+   INTEGER,PARAMETER :: i1=SELECTED_INT_KIND(2)          ! NF90_BYTE 
+   INTEGER,PARAMETER :: i2=SELECTED_INT_KIND(4)          ! NF90_SHORT
+   INTEGER,PARAMETER :: i4=SELECTED_INT_KIND(9)          ! NF90_INT
+   INTEGER,PARAMETER :: sp=SELECTED_REAL_KIND(6,37)      ! NF90_FLOAT
+   INTEGER,PARAMETER :: dp=SELECTED_REAL_KIND(12,307)    ! NF90_DOUBLE
+
+   INTEGER,PARAMETER :: numnam = 11
+   INTEGER,PARAMETER :: numout = 6
+   INTEGER,PARAMETER :: numerr = 0
+
+   LOGICAL, PARAMETER :: l_verbose = .true. 
+    
+   CHARACTER(LEN=nf90_max_name) :: filebase, suffix, attname, dimname, varname, time, date, zone, timestamp
+   CHARACTER(LEN=nf90_max_name), ALLOCATABLE :: filenames(:), indimnames(:)
+   CHARACTER(LEN=nf90_max_name), DIMENSION(2) :: dims
+
+   INTEGER :: ndomain, ifile, ndomain_file, nchunksize
+   INTEGER :: ncid, outid, idim, istop
+   INTEGER :: natts, attid, xtype, varid, rbdims 
+   INTEGER :: jv, ndims, nvars, dimlen, dimids(4)
+   INTEGER :: dimid, unlimitedDimId, di, dj, dr
+   INTEGER :: nmax_unlimited, nt, ntchunk 
+   INTEGER :: chunksize = 32000000
+   INTEGER :: nthreads = 1
+   INTEGER, ALLOCATABLE  :: outdimids(:), outdimlens(:), indimlens(:), inncids(:)
+   INTEGER, ALLOCATABLE  :: global_sizes(:), rebuild_dims(:)
+   INTEGER, DIMENSION(2) :: halo_start, halo_end, local_sizes
+   INTEGER, DIMENSION(2) :: idomain, jdomain, rdomain, start_pos
+   INTEGER :: ji, jj, jk, jl, jr
+ 
+   REAL(sp) :: ValMin, ValMax, InMin, InMax
+
+   ! NF90_BYTE local data arrays
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i1
+   INTEGER(i1), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i1
+
+   ! NF90_SHORT local data arrays
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i2
+   INTEGER(i2), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i2
+
+   ! NF90_INT local data arrays
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_i4
+   INTEGER(i4), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_i4
+
+   ! NF90_FLOAT local data arrays
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_sp
+   REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_sp
+
+   ! NF90_DOUBLE local data arrays
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:) :: localdata_1d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: localdata_2d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: localdata_3d_dp
+   REAL(dp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: localdata_4d_dp
+
+   ! NF90_BYTE global data arrays
+   INTEGER(i1) :: globaldata_0d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i1
+   INTEGER(i1), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i1
+
+   ! NF90_SHORT global data arrays
+   INTEGER(i2) :: globaldata_0d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i2
+   INTEGER(i2), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i2
+
+   ! NF90_INT global data arrays
+   INTEGER(i4) :: globaldata_0d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_i4
+   INTEGER(i4), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_i4
+ 
+   ! NF90_FLOAT global data arrays
+   REAL(sp) :: globaldata_0d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_sp
+   REAL(sp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_sp
+
+   ! NF90_DOUBLE global data arrays
+   REAL(dp) :: globaldata_0d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:) :: globaldata_1d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:) :: globaldata_2d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:) :: globaldata_3d_dp
+   REAL(dp), ALLOCATABLE, DIMENSION(:,:,:,:) :: globaldata_4d_dp
+
+   LOGICAL :: l_valid = .false.
+   LOGICAL :: l_noRebuild = .false.
+   LOGICAL :: l_findDims = .true.
+
+   NAMELIST/nam_rebuild/ filebase, ndomain, dims, nchunksize
+
+   !End of definitions 
+
+!--------------------------------------------------------------------------------
+!0. OMP setup
+
+!$OMP PARALLEL DEFAULT(NONE) SHARED(nthreads)
+!$OMP MASTER
+!$      nthreads = omp_get_num_threads()
+!$      WRITE(numout,*) 'Running OMP with ',nthreads,' thread(s).'
+!$OMP END MASTER
+!$OMP END PARALLEL
+ 
+!--------------------------------------------------------------------------------
+!1. Read in the namelist 
+
+   dims(:) = ""
+   nchunksize = 0
+   OPEN( UNIT=numnam, FILE='nam_rebuild', FORM='FORMATTED', STATUS='OLD' )
+   READ( numnam, nam_rebuild )
+   CLOSE( numnam )
+   IF( .NOT. ALL(dims(:) == "") ) l_findDims = .false.
+ 
+!1.1 Set up the filenames and fileids
+
+   ALLOCATE(filenames(ndomain))
+   IF (l_verbose) WRITE(numout,*) 'Rebuilding the following files:'
+   DO ifile = 1, ndomain
+      WRITE(suffix,'(i4.4)') ifile-1
+      filenames(ifile) = TRIM(filebase)//'_'//TRIM(suffix)//'.nc'
+      IF (l_verbose) WRITE(numout,*) TRIM(filenames(ifile))
+   END DO
+   ALLOCATE(inncids(ndomain))
+  
+!---------------------------------------------------------------------------
+!2. Read in the global dimensions from the first input file and set up the output file
+ 
+   CALL check_nf90( nf90_open( TRIM(filenames(1)), nf90_share, ncid ) )
+   CALL check_nf90( nf90_inquire( ncid, ndims, nvars, natts ) )
+    
+!2.0 Read in the total number of processors the file is expecting and check its correct  
+  
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_number_total', ndomain_file ) )
+   IF( ndomain /= ndomain_file ) THEN
+      WRITE(numerr,*) 'ERROR! : number of files to rebuild in file does not agree with namelist'
+      WRITE(numerr,*) 'Attribute DOMAIN_number_total is : ', ndomain_file
+      WRITE(numerr,*) 'Number of files specified in namelist is: ', ndomain
+      STOP
+   ENDIF
+  
+!2.1 Set up the output file
+
+   CALL check_nf90( nf90_create( TRIM(filebase)//'.nc', nf90_64bit_offset, outid, chunksize=chunksize ) )
+
+!2.2 Set up dimensions in output file
+
+!2.2.0 Find out  how many dimensions are required to be rebuilt and which ones they are
+   CALL check_nf90( nf90_inquire_attribute( ncid, nf90_global, 'DOMAIN_dimensions_ids', xtype, rbdims, attid ) )
+
+   ALLOCATE(rebuild_dims(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_dimensions_ids', rebuild_dims ) )
+
+   ALLOCATE(global_sizes(rbdims))
+   CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_global', global_sizes ) )
+   IF (l_verbose) WRITE(numout,*) 'Size of global arrays: ', global_sizes
+
+
+!2.2.1 Copy the dimensions into the output file apart from rebuild_dims() which are dimensioned globally 
+   ALLOCATE(indimlens(ndims), indimnames(ndims), outdimlens(ndims))
+   CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ) )
+   istop = 0
+   DO idim = 1, ndims
+      CALL check_nf90( nf90_inquire_dimension( ncid, idim, dimname, dimlen ) )
+      CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ) )
+      indimlens(idim) = dimlen    
+      indimnames(idim) = dimname
+      IF (l_findDims) THEN
+         IF( idim == rebuild_dims(1) ) THEN
+            IF( dimlen == local_sizes(1) ) THEN 
+               dimlen = global_sizes(1)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+         IF( rbdims > 1 .AND. idim == rebuild_dims(2) ) THEN
+            IF( dimlen == local_sizes(2) ) THEN
+               dimlen = global_sizes(2)
+            ELSE
+               istop = 1
+            ENDIF
+         ENDIF
+      ELSE ! l_findDims = false
+         IF( TRIM(dimname) == TRIM(dims(1))) THEN
+            dimlen = global_sizes(1)
+            rebuild_dims(1) = idim
+         ENDIF
+         IF( rbdims > 1 .AND. TRIM(dimname) == TRIM(dims(2))) THEN
+            dimlen = global_sizes(2)
+            rebuild_dims(2) = idim
+         ENDIF
+      ENDIF
+
+      IF( idim == unlimitedDimId ) THEN
+         CALL check_nf90( nf90_def_dim( outid, dimname, nf90_unlimited, dimid) )
+         nmax_unlimited = dimlen
+      ELSE
+         CALL check_nf90( nf90_def_dim( outid, dimname, dimlen, dimid) )
+      ENDIF
+      outdimlens(idim) = dimlen
+   END DO
+
+   IF( istop == 1 ) THEN
+      WRITE(numerr,*) 'ERROR! : DOMAIN_local_sizes attribute does not match rebuild dimension lengths in the first file'
+      WRITE(numerr,*) 'Attribute DOMAIN_local_sizes is : ', local_sizes
+      WRITE(numerr,*) 'Dimensions to be rebuilt are of size : ', outdimlens(rebuild_dims(1)), outdimlens(rebuild_dims(2)) 
+      STOP
+   ENDIF
+
+   IF (l_findDims) THEN
+      IF (l_verbose) WRITE(numout,*) 'Finding rebuild dimensions from the first file...'
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Using rebuild dimensions given in namelist...'
+   ENDIF
+
+   IF( rbdims > 1 ) THEN
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimensions '//TRIM(indimnames(rebuild_dims(1)))//  &
+         &                      ' and '//TRIM(indimnames(rebuild_dims(2)))
+   ELSE
+      IF (l_verbose) WRITE(numout,*) 'Rebuilding across dimension '//TRIM(indimnames(rebuild_dims(1)))
+   ENDIF
+      
+!2.2.2 Copy the global attributes into the output file, apart from those beginning with DOMAIN_  
+!      Also need to change the file_name attribute and the TimeStamp attribute.
+   DO attid = 1, natts
+      CALL check_nf90( nf90_inq_attname( ncid, nf90_global, attid, attname ) )
+      IF( INDEX( attname, "DOMAIN_" ) == 1 ) CYCLE
+      IF( INDEX( attname, "file_name") == 1 ) CYCLE
+      IF( INDEX( attname, "associate_file") == 1 ) CYCLE
+      IF (l_verbose) WRITE(numout,*) 'Copying attribute '//TRIM(attname)//' into destination file...'
+      CALL check_nf90( nf90_copy_att( ncid, nf90_global, attname, outid, nf90_global ) )
+   END DO
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "file_name", TRIM(filebase)//'.nc') )
+   IF (l_verbose) WRITE(numout,*) 'Writing new file_name attribute'  
+   CALL DATE_AND_TIME ( date=date, time=time, zone=zone )
+   timestamp = date(7:8) // "/" // date(5:6) // "/" // date(1:4) // " " // &
+               time(1:2) // ":" // time(3:4) // ":" // time(5:6) // " " // &
+               zone  
+   CALL check_nf90( nf90_put_att( outid, nf90_global, "TimeStamp", timestamp ) )
+   IF (l_verbose) WRITE(numout,*) 'Writing new TimeStamp attribute'
+  
+!2.2.3 Copy the variable definitions and attributes into the output file.
+   DO jv = 1, nvars
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+      ALLOCATE(outdimids(ndims))
+      DO idim = 1, ndims
+         outdimids(idim) = dimids(idim)
+      END DO
+      CALL check_nf90( nf90_def_var( outid, varname, xtype, outdimids, varid ) )
+      DEALLOCATE(outdimids)
+      IF (l_verbose) WRITE(numout,*) 'Defining variable '//TRIM(varname)//'...' 
+      IF( natts > 0 ) THEN
+         DO attid = 1, natts
+            CALL check_nf90( nf90_inq_attname( ncid, varid, attid, attname ) )
+            CALL check_nf90( nf90_copy_att( ncid, varid, attname, outid, varid ) )
+         END DO
+      ENDIF
+   END DO
+ 
+!2.3 End definitions in output file and copy 1st file ncid to the inncids array
+
+   CALL check_nf90( nf90_enddef( outid ) )
+   inncids(1) = ncid
+   IF (l_verbose) WRITE(numout,*) 'Finished defining output file.'
+  
+!---------------------------------------------------------------------------
+!3. Read in data from each file for each variable 
+
+!3.1 Open each file and store the ncid in inncids array
+
+   IF (l_verbose) WRITE(numout,*) 'Opening input files...'
+   DO ifile = 2, ndomain
+      CALL check_nf90( nf90_open( TRIM(filenames(ifile)), nf90_share, ncid, chunksize=chunksize ) )
+      inncids(ifile) = ncid
+   END DO
+   IF (l_verbose) WRITE(numout,*) 'All input files open.'
+
+   DO jv = 1, nvars
+
+      ValMin = 1.e10
+      ValMax = -1.e10
+      l_valid = .false.
+      istop = nf90_noerr
+      nt = 1
+      ntchunk = nmax_unlimited
+      IF( nchunksize == 0 ) nchunksize = nmax_unlimited
+
+!3.2 Inquire variable to find out name and how many dimensions it has
+!    and importantly whether it contains the dimensions in rebuild_dims()
+
+      ncid = inncids(1)
+      CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ) )
+
+      l_noRebuild = .true.
+      IF( ANY( dimids(1:ndims) == rebuild_dims(1) )) l_noRebuild = .false.
+      IF( rbdims > 1 ) THEN
+         IF( ANY( dimids(1:ndims) == rebuild_dims(2) )) l_noRebuild = .false.
+      ENDIF
+
+!3.2.0 start while loop for time chunking
+
+      DO WHILE( nt <= nmax_unlimited )
+
+         IF( ndims > 3 ) THEN
+            ntchunk = MIN( nchunksize, nmax_unlimited + 1 - nt )
+         ENDIF
+
+      IF (l_noRebuild) THEN
+
+         IF( nchunksize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Copying data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Copying data from variable '  &
+            &                 //TRIM(varname)//' for chunks ',nt,' to ',nt+ntchunk-1,' ...'
+         ENDIF
+
+!3.2.1 If rebuilding not required then just need to read in variable
+!      for copying direct into output file after the OMP (files) loop.
+         IF( ndims == 0 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i1 ) )
+               CASE( NF90_SHORT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i2 ) )
+               CASE( NF90_INT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_i4 ) )
+               CASE( NF90_FLOAT )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_sp ) )
+               CASE( NF90_DOUBLE )
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_0d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(indimlens(dimids(1))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_1d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(indimlens(dimids(1)),indimlens(dimids(2))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_2d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i1 ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i2 ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_i4 ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_sp ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3))))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_3d_dp ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(indimlens(dimids(1)),indimlens(dimids(2)),       &
+                     &                      indimlens(dimids(3)),ntchunk))
+                  CALL check_nf90( nf90_get_var( ncid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ENDIF
+
+      ELSE  ! l_noRebuild = .false.
+
+!3.2.2 For variables that require rebuilding we need to read in from all ndomain files
+!      Here we allocate global variables ahead of looping over files
+         IF( nchunksize == nmax_unlimited .OR. ndims <= 3 ) THEN
+            IF (l_verbose) WRITE(numout,*) 'Rebuilding data from variable '//TRIM(varname)//'...'
+         ELSE
+            IF (l_verbose) WRITE(numout,'(A,I3,A,I3,A)') ' Rebuilding data from variable '  &
+            &                 //TRIM(varname)//' for chunks ',nt,' to ',nt+ntchunk-1,' ...'
+         ENDIF
+         IF( ndims == 1 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_1d_i1(outdimlens(dimids(1))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_1d_i2(outdimlens(dimids(1))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_1d_i4(outdimlens(dimids(1))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_1d_sp(outdimlens(dimids(1))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_1d_dp(outdimlens(dimids(1))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 2 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_2d_i1(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_2d_i2(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_2d_i4(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_2d_sp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_2d_dp(outdimlens(dimids(1)),outdimlens(dimids(2))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 3 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_3d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_3d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_3d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_3d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_3d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3))))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+
+         ELSEIF( ndims == 4 ) THEN
+
+            SELECT CASE( xtype )
+               CASE( NF90_BYTE )
+                  ALLOCATE(globaldata_4d_i1(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_SHORT )
+                  ALLOCATE(globaldata_4d_i2(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_INT )
+                  ALLOCATE(globaldata_4d_i4(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_FLOAT )
+                  ALLOCATE(globaldata_4d_sp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE( NF90_DOUBLE )
+                  ALLOCATE(globaldata_4d_dp(outdimlens(dimids(1)),outdimlens(dimids(2)),     &
+                     &                      outdimlens(dimids(3)),ntchunk))
+               CASE DEFAULT
+                  WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                  STOP
+            END SELECT
+         ELSE
+            WRITE(numerr,*) 'ERROR! : A netcdf variable has more than 4 dimensions which is not taken into account'
+            STOP
+         ENDIF
+
+!$OMP  PARALLEL DO DEFAULT(NONE)                                                          &
+!$OMP& PRIVATE(ifile,ncid,xtype,start_pos,local_sizes,InMin,InMax,natts,                  &
+!$OMP&         ndims,attid,attname,dimids,idim,dimname,dimlen,unlimitedDimId,             &
+!$OMP&         halo_start,halo_end,idomain,jdomain,rdomain,di,dj,dr,                      &
+!$OMP&         localdata_1d_i2,localdata_1d_i4,localdata_1d_sp,localdata_1d_dp,           &
+!$OMP&         localdata_2d_i2,localdata_2d_i4,localdata_2d_sp,localdata_2d_dp,           &
+!$OMP&         localdata_3d_i2,localdata_3d_i4,localdata_3d_sp,localdata_3d_dp,           &
+!$OMP&         localdata_4d_i2,localdata_4d_i4,localdata_4d_sp,localdata_4d_dp,           &
+!$OMP&         localdata_1d_i1,localdata_2d_i1,localdata_3d_i1,localdata_4d_i1)           &
+!$OMP& SHARED(jv,nvars,varname,filenames,ValMin,ValMax,indimlens,outdimlens,rbdims,       &
+!$OMP&        ndomain,outid,chunksize,istop,l_valid,nthreads,inncids,rebuild_dims,        &
+!$OMP&        globaldata_1d_i2,globaldata_1d_i4,globaldata_1d_sp,globaldata_1d_dp,        &
+!$OMP&        globaldata_2d_i2,globaldata_2d_i4,globaldata_2d_sp,globaldata_2d_dp,        &
+!$OMP&        globaldata_3d_i2,globaldata_3d_i4,globaldata_3d_sp,globaldata_3d_dp,        &
+!$OMP&        globaldata_4d_i2,globaldata_4d_i4,globaldata_4d_sp,globaldata_4d_dp,        &
+!$OMP&        globaldata_1d_i1,globaldata_2d_i1,globaldata_3d_i1,globaldata_4d_i1,        &
+!$OMP&        ntchunk,nt,nmax_unlimited)
+
+         DO ifile = 1, ndomain
+
+            ncid = inncids(ifile)
+!$OMP CRITICAL
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_size_local', local_sizes ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_position_first', start_pos ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_start', halo_start ), istop )
+            CALL check_nf90( nf90_get_att( ncid, nf90_global, 'DOMAIN_halo_size_end', halo_end ), istop )
+            CALL check_nf90( nf90_inquire_variable( ncid, jv, varname, xtype, ndims, dimids, natts ), istop )
+            CALL check_nf90( nf90_inquire( ncid, unlimitedDimId = unlimitedDimId ), istop )
+!$OMP END CRITICAL
+
+            ! set defaults for rebuilding so that i is 1st, j 2nd
+            di=1
+            dj=2
+
+            IF( rbdims == 1 ) THEN
+               ! override defaults above and set other variables
+               start_pos(2) = 1
+               local_sizes(2) = outdimlens(3-dimids(2))
+               halo_end(2) = 0
+               halo_start(2) = 0
+               di=rebuild_dims(1)
+               dj=3-di
+            ENDIF
+
+!3.3.1 Generate local domain interior sizes from local_sizes and halo sizes
+!      idomain defines the 1st and last interior points in the i direction and
+!      jdomain defines the 1st and last interior points in the j direction
+
+            idomain(1) = 1 + halo_start(di)
+            idomain(2) = local_sizes(di) - halo_end(di)
+            jdomain(1) = 1 + halo_start(dj)
+            jdomain(2) = local_sizes(dj) - halo_end(dj)
+
+!3.3.2 For rbdims or more dimensions put the data array from this input file into the correct
+!      part of the output data array. Assume the first dimensions are those to be rebuilt.
+
+            IF( ndims == 1 ) THEN
+
+               IF( rebuild_dims(1) == 1 ) THEN
+                  dr = di
+                  rdomain = idomain
+               ELSE
+                  dr = dj
+                  rdomain = jdomain
+               ENDIF
+
+              SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_1d_i1(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i1 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i1(start_pos(dr) + jr - 1) = localdata_1d_i1(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_1d_i2(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i2 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i2(start_pos(dr) + jr - 1) = localdata_1d_i2(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_1d_i4(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_i4 ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_i4(start_pos(dr) + jr - 1) = localdata_1d_i4(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_1d_sp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_sp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_sp(start_pos(dr) + jr - 1) = localdata_1d_sp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_1d_dp(local_sizes(dr)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_1d_dp ), istop )
+                     DO jr = rdomain(1), rdomain(2)
+                        globaldata_1d_dp(start_pos(dr) + jr - 1) = localdata_1d_dp(jr)
+                     END DO
+                     DEALLOCATE(localdata_1d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 2 ) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_2d_i1(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i1 ), istop )
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_2d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i1(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_2d_i2(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i2 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i2(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_2d_i4(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_i4 ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_i4(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_2d_sp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_sp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_sp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_2d_dp(local_sizes(di),local_sizes(dj)))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_2d_dp ), istop )
+                     DO jj = jdomain(1), jdomain(2)
+                        DO ji = idomain(1), idomain(2)
+                           globaldata_2d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1) = localdata_2d_dp(ji,jj)
+                        END DO
+                     END DO
+                     DEALLOCATE(localdata_2d_dp) 
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ELSEIF( ndims == 3 ) THEN
+
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_3d_i1(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i1 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i1,localdata_3d_i1,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i1(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_3d_i2(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i2 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i2,localdata_3d_i2,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i2(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_3d_i4(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_i4 ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_i4,localdata_3d_i4,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_i4(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_3d_sp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_sp ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_sp,localdata_3d_sp,di,dj) 
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_sp(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_3d_dp(local_sizes(di),local_sizes(dj),indimlens(dimids(3))))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_3d_dp ), istop )
+!$OMP  PARALLEL DO DEFAULT(NONE) PRIVATE(ji,jj,jk)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_3d_dp,localdata_3d_dp,di,dj)
+                     DO jk = 1, indimlens(dimids(3))
+                        DO jj = jdomain(1), jdomain(2)
+                           DO ji = idomain(1), idomain(2)
+                              globaldata_3d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk) = localdata_3d_dp(ji,jj,jk)
+                           END DO
+                        END DO
+                     END DO
+!$OMP END PARALLEL DO
+                     DEALLOCATE(localdata_3d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+      
+            ELSEIF (ndims == 4) THEN
+        
+               SELECT CASE( xtype )
+                  CASE( NF90_BYTE )
+                     ALLOCATE(localdata_4d_i1(local_sizes(di),local_sizes(dj),               &
+                         &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i1, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i1,localdata_4d_i1,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2)
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i1(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i1(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i1)
+                  CASE( NF90_SHORT )
+                     ALLOCATE(localdata_4d_i2(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i2, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i2,localdata_4d_i2,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO 
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i2(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i2(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i2)
+                  CASE( NF90_INT )
+                     ALLOCATE(localdata_4d_i4(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_i4, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_i4,localdata_4d_i4,di,dj,nt,ntchunk)
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_i4(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_i4(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_i4)
+                  CASE( NF90_FLOAT )
+                     ALLOCATE(localdata_4d_sp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_sp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_sp,localdata_4d_sp,di,dj,nt,ntchunk) 
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_sp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_sp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_sp)
+                  CASE( NF90_DOUBLE )
+                     ALLOCATE(localdata_4d_dp(local_sizes(di),local_sizes(dj),               &
+                        &                     indimlens(dimids(3)),ntchunk))
+                     CALL check_nf90( nf90_get_var( ncid, jv, localdata_4d_dp, start=(/1,1,1,nt/) ), istop )
+!$OMP  PARALLEL DEFAULT(NONE) PRIVATE(ji,jj,jk,jl)   &
+!$OMP& SHARED(idomain,jdomain,indimlens,dimids,start_pos,globaldata_4d_dp,localdata_4d_dp,di,dj,nt,ntchunk) 
+                     DO jl = 1, ntchunk
+!$OMP DO
+                        DO jk = 1, indimlens(dimids(3))
+                           DO jj = jdomain(1), jdomain(2) 
+                              DO ji = idomain(1), idomain(2)
+                                 globaldata_4d_dp(start_pos(di) + ji - 1, start_pos(dj) + jj - 1, jk, jl) = localdata_4d_dp(ji,jj,jk,jl)
+                              END DO
+                           END DO
+                        END DO
+!$OMP END DO nowait
+                     END DO
+!$OMP END PARALLEL
+                     DEALLOCATE(localdata_4d_dp)
+                  CASE DEFAULT
+                     WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+                     istop = istop + 1
+               END SELECT
+
+            ENDIF ! l_noRebuild false
+
+!3.4 Work out if the valid_min and valid_max attributes exist for this variable.
+!    If they do then calculate the extrema over all input files.
+
+            DO attid = 1, natts
+               CALL check_nf90( nf90_inq_attname( ncid, jv, attid, attname ), istop )
+               IF( INDEX( attname, "valid_min" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMin), istop )
+                  l_valid = .true.
+               ENDIF
+               IF( INDEX( attname, "valid_max" ) == 1 ) THEN
+                  CALL check_nf90( nf90_get_att( ncid, jv, attname, InMax ), istop )
+                  l_valid = .true.
+               ENDIF
+            END DO
+
+            IF (l_valid) THEN
+!$OMP CRITICAL
+               IF( InMin < ValMin ) ValMin = InMin
+               IF( InMax > ValMax ) ValMax = InMax
+!$OMP END CRITICAL
+            ENDIF
+
+!3.5 Abort if failure and only 1 thread 
+
+            IF( nthreads == 1 .AND. istop /= nf90_noerr )  THEN
+               WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+               STOP
+            ENDIF
+        
+         END DO  ! loop over files
+!$OMP END PARALLEL DO
+
+!3.6 Abort if any of the OMP threads failed
+         IF( istop /= nf90_noerr )  THEN
+            WRITE(numerr,*) '*** NEMO rebuild failed! ***'
+            STOP
+         ENDIF
+
+      ENDIF ! ndims > 2
+
+!---------------------------------------------------------------------------
+!4. Write data to output file
+
+      IF (l_verbose) WRITE(numout,*) 'Writing variable '//TRIM(varname)//'...'
+
+!4.1 If the valid min and max attributes exist then update them in the file
+
+      IF( l_valid ) THEN
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_min", ValMin ) )
+         CALL check_nf90( nf90_put_att( outid, jv, "valid_max", ValMax ) )
+      ENDIF
+
+!4.2 Write the data to the output file depending on how many dimensions it has
+
+      IF( ndims == 0 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i1 ) )
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i2 ) )
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_i4 ) )
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_sp ) )
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_0d_dp ) )
+         END SELECT
+
+      ELSEIF( ndims == 1 ) THEN
+
+         SELECT CASE( xtype )
+            CASE( NF90_BYTE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i1 ) )
+               DEALLOCATE(globaldata_1d_i1)
+            CASE( NF90_SHORT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i2 ) )
+               DEALLOCATE(globaldata_1d_i2)
+            CASE( NF90_INT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_i4 ) )
+               DEALLOCATE(globaldata_1d_i4)
+            CASE( NF90_FLOAT )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_sp ) )
+               DEALLOCATE(globaldata_1d_sp)
+            CASE( NF90_DOUBLE )
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_1d_dp ) )
+               DEALLOCATE(globaldata_1d_dp)
+         END SELECT
+
+      ELSEIF( ndims == 2 ) THEN  
+     
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i1 ) )
+               DEALLOCATE(globaldata_2d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i2 ) )
+               DEALLOCATE(globaldata_2d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_i4 ) )
+               DEALLOCATE(globaldata_2d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_sp ) )
+               DEALLOCATE(globaldata_2d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_2d_dp ) )
+               DEALLOCATE(globaldata_2d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP
+         END SELECT     
+                      
+      ELSEIF( ndims == 3 ) THEN
+      
+         SELECT CASE( xtype ) 
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i1 ) )
+               DEALLOCATE(globaldata_3d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i2 ) )
+               DEALLOCATE(globaldata_3d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_i4 ) )
+               DEALLOCATE(globaldata_3d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_sp ) )
+               DEALLOCATE(globaldata_3d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_3d_dp ) )
+               DEALLOCATE(globaldata_3d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP
+         END SELECT     
+    
+      ELSEIF( ndims == 4 ) THEN
+
+         SELECT CASE( xtype )   
+            CASE( NF90_BYTE )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i1, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i1)
+            CASE( NF90_SHORT )                   
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i2, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i2)
+            CASE( NF90_INT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_i4, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_i4)
+            CASE( NF90_FLOAT )                              
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_sp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_sp)
+            CASE( NF90_DOUBLE )                                         
+               CALL check_nf90( nf90_put_var( outid, jv, globaldata_4d_dp, start=(/1,1,1,nt/) ) )
+               DEALLOCATE(globaldata_4d_dp)
+            CASE DEFAULT   
+               WRITE(numerr,*) 'Unknown nf90 type: ', xtype
+               STOP
+         END SELECT     
+    
+      ENDIF
+
+         nt = nt + ntchunk
+
+      END DO ! WHILE loop
+    
+   END DO  ! loop over variables
+
+!---------------------------------------------------------------------------
+!5. Close files
+
+!5.1 Close input files
+
+   IF (l_verbose) WRITE(numout,*) 'Closing input files...'
+   DO ifile = 1, ndomain
+      ncid = inncids(ifile)
+      CALL check_nf90( nf90_close( ncid ) )
+   END DO
+
+!5.2 Close output file
+
+   IF (l_verbose) WRITE(numout,*) 'Closing output file...'
+   CALL check_nf90( nf90_close( outid ) )
+
+   IF (l_verbose) WRITE(numout,*) 'NEMO rebuild completed successfully'
+   IF (l_verbose) WRITE(numout,*)
+
+CONTAINS
+
+
+   SUBROUTINE check_nf90(status, errorFlag)
+   !---------------------------------------------------------------------
+   !  Checks return code from nf90 library calls and warns if needed
+   !  If errorFlag is present then it just increments this flag (OMP use)
+   !
+   !---------------------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: status
+      INTEGER, INTENT(INOUT), OPTIONAL :: errorFlag
+   !---------------------------------------------------------------------
+
+      IF( status /= nf90_noerr ) THEN
+         WRITE(numerr,*) 'ERROR! : '//TRIM(nf90_strerror(status))
+         IF( PRESENT( errorFlag ) ) THEN
+            errorFlag = errorFlag + status
+         ELSE
+            WRITE(numerr,*) "*** NEMO rebuild failed ***"
+            WRITE(numerr,*)
+            STOP
+         ENDIF
+      ENDIF
+
+   END SUBROUTINE check_nf90
+
+
+END PROGRAM rebuild_nemo
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/job.ksh	(revision 3294)
@@ -0,0 +1,46 @@
+#!/bin/ksh
+set -x
+#####################################################
+#     CONFIGURATION CHOICE                          #
+#####################################################
+#CONFIG=ORCA2_LIM GYRE
+CONFIG=ORCA2_LIM
+
+#####################################################
+#     CONFIGURATION DESCRIPTION                     #
+#####################################################
+# each configuration is defined by:
+#   - INSPACE: directory the coordinate netcdf file is
+#   - COOR_FIL: configuration's coordinate netcdf file
+#   - LIST:     configuration's list of sections
+#
+#####################################################
+case $CONFIG in
+#
+ORCA2_LIM)
+INSPACE=/dataref/rd/INITIALISATION/ORCA2
+COOR_FIL=coordinates.nc
+LIST=list_sections.ascii_global
+;;
+#
+GYRE)
+INSPACE=/perm/ms/fr/ar5
+COOR_FIL=mesh_mask.nc
+LIST=list_sections.ascii_GYRE
+;;
+#
+esac
+
+#####################################################
+#     RUN                                           #
+#####################################################
+BIN=diadct_sections.exe
+
+export CTLDIR=`pwd`
+cd ${CTLDIR}
+rm -f coordinates.nc ${BIN} list_sections.ascii
+cp ../${BIN} .
+ln -sf ${LIST} list_sections.ascii
+ln -s $INSPACE/$COOR_FIL ./coordinates.nc
+./${BIN}
+mv section_ijglobal.diadct section_ijglobal.diadct_$CONFIG 
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_GYRE	(revision 3294)
@@ -0,0 +1,3 @@
+ -80.     14.    -80.     30.   00 okstrpond noice  SEC1
+ -70.     14.    -70.     30.   00 okstrpond noice  SEC2
+ -90.     20.    -60.     20.   00 okstrpond noice  SEC3
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_exp	(revision 3294)
@@ -0,0 +1,27 @@
+(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)
+
+long1   lat1    long2   lat2    nbclasse S/T transp? ice transp? section name
+
+-xxx.xx_-xxx.xx_-xxx.xx_-xxx.xx_ii_aaaaaaaaa_aaaaa_aaaaa....
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/list_sections.ascii_global	(revision 3294)
@@ -0,0 +1,357 @@
+ -68.    -54.5   -60.    -64.7  00 okstrpond noice ACC_Drake_Passage
+  27.    -73.     27.    -30.   00 nostrpond noice ACC_LeCap
+ 116.    -70.    116.    -33.8  00 nostrpond noice ACC_WAUS
+ 147.3   -70.    147.3   -41.   00 okstrpond noice ACC_TAS
+ 167.4   -73.    167.4   -45.5  00 nostrpond noice ACC_NZ
+ -82.     73.4   -82.     74.9  00 nostrpond   ice ARC_Lancaster_sound
+ -81.     75.1   -81.     76.6  00 nostrpond   ice ARC_Jones_Strait
+ -76.     78.4   -72.     78.3  00 nostrpond   ice ARC_Robeson_Channel
+ -64.6    60.3   -65.     61.5  00 nostrpond   ice ARC_Hudson_Strait
+  20.9    71.5    16.     77.   03 nostrpond   ice ARC_Bear_Island
+zsal
+ 0.00
+34.9
+50.0
+  33.5    68.     33.5    74.   03 nostrpond   ice ARC_Kola_Section
+zsal
+ 0.00
+34.9
+50.0
+  25.     80.     48.2    80.2  00 nostrpond   ice ARC_Spitzberg_FJLand
+  57.     80.3    65.9    76.4  03 nostrpond   ice ARC_FJLand_NovZemlija
+zsigi
+ 0.
+27.8
+30.0
+  57.     70.7    59.     70.2  00 nostrpond   ice ARC_Kara_Gate
+  25.     70.     22.6    77.8  05 nostrpond   ice ARC_Barents_Sea
+zsigi
+ 0.0
+25.0
+27.8
+29.0
+30.0
+ -21.5    79.5    15.     79.   05 nostrpond   ice ARC_Fram_Strait
+zsigi
+0.0
+25.0
+27.8
+29.0
+30.0
+ -81.     27.1   -73.     27.   04 nostrpond noice ATL_West_Atlantic_27N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ -35.     15.1   -35.     -8.   00 nostrpond noice ATL_Tropical_Atlantic_35W
+ -63.      9.    -55.     20.   03 nostrpond noice ATL_South_West_Atlantic
+ztem
+-2.0
+ 4.5
+40.0
+ -35.     54.    -30.5    52.   03 nostrpond noice ATL_Gibbs
+zlay
+    0.
+ 3000.
+20000.
+ -40.     -4.    -40.     10.   03 nostrpond noice ATL_North_Brazil_Current_40W
+zsigi
+ 0.0
+27.45
+30.0
+ -55.     -1.    -50.     10.   05 nostrpond noice ATL_North_Brazil_Current_10N
+zsigi
+ 0.0
+24.5
+27.125
+27.45
+30.0 
+ -53.    -30.1   -40.    -30.   00 nostrpond noice ATL_Brazil_Current_30S
+ -63     -40.1   -53.    -40.   00 nostrpond noice ATL_Falklands_Current_40S
+ -23.    -15.    -23.     15.   05 nostrpond noice ATL_Atlantic_Equatorial
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+   5.    -15.1    13.    -15.   00 nostrpond noice ATL_Benguela_Current_15S
+  10.    -40.     22.    -31.   00 nostrpond noice ATL_Agulhas_zone_30S
+  19.    -30.1   -54.0   -30.0  00 nostrpond noice ATL_Trans_Atlantic_30S
+  -7.     62.2    -4.5    58.   05 nostrpond noice ATL_England_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -15.     65.     -7.     62.2  05 nostrpond noice ATL_Iceland_Faroe
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -37.     66.1   -22.5    66.   05 nostrpond   ice ATL_Denmark_Strait
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -44.     63.    -35.     61.   05 nostrpond   ice ATL_East_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -45.     60.9   -45.     57.   05 nostrpond   ice ATL_South_Greenland
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+ -50.1    55.1   -61.     55.   05 nostrpond   ice ATL_Labrador_55N 
+zsigi
+ 0.0
+25.
+27.8
+29.
+30.0
+   8.     58.5    -2.5    57.   00 nostrpond noice ATL_England_Norway 
+  -5.7    35.5    -5.7    36.5  00 nostrpond noice ATL_Gibraltar 
+  -8.5    32.     -8.5    38.2  00 nostrpond noice ATL_Gulf_Cadiz
+ -44.     60.     -27.    56.   00 nostrpond noice ATL_Ovide1
+ -27.     56.     -16.    40.   00 nostrpond noice ATL_Ovide2
+ -16.     40.1     -8.1   40.   00 nostrpond noice ATL_Portugal
+  -4.     48.2     -8.1   43.1  05 nostrpond noice ATL_Biscay
+zsal
+ 0.0
+35.6
+36.0
+36.0
+50.0
+ -14.     26.1    -22.    26.   00 nostrpond noice ATL_South_Canaries
+ -24.     32.     -24.    37.9  03 nostrpond noice ATL_Acores_24W
+zlay
+   0.
+  800.
+20000.
+ -66.4    18.1    -63.    10.   05 nostrpond noice ATL_Antilles
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -60.1    18.1    -66.5   18.2  05 nostrpond noice ATL_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -66.5    18.1    -68.9   18.5  05 nostrpond noice ATL_Hispagnola_Porto_Rico
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -75.     20.2    -72.6   19.7  05 nostrpond noice ATL_Windward_Passage
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.2    -84.    14.   05 nostrpond noice ATL_Jamaica_Ridge
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -77.5    18.     -76.5   20.3  05 nostrpond noice ATL_Cuba_Jamaica
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -87.3    21.     -84.    22.2  05 nostrpond noice ATL_Yucatan_Strait_KANEC
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -80.5    22.5    -80.5   25.5  05 nostrpond noice ATL_Cuba_Florida
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -78.5    26.7    -80.5   27.   05 okstrpond noice ATL_Florida_Bahamas
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     30.1    -82.    30.   05 nostrpond noice ATL_West_Atlantic_30N
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -70.     45.     -70.    30.1  05 nostrpond noice ATL_Gulf_Stream
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     30.     -55.    47.9  05 nostrpond noice ATL_Gulf_Stream_2
+ztem
+-2.0
+ 4.5
+ 7.0
+12.0
+40.0
+ -55.     48.1     -3.9   48.   00 okstrpond noice ATL_Atlantic_48N
+ -85.     24.1    -10.8   24.   00 okstrpond noice ATL_Atlantic_24N
+ -75.6    24.     -10.8   24.   00 okstrpond noice ATL_Atlantic_24N1
+ -85.     26.1    -10.8   26.   04 okstrpond noice ATL_Atlantic_26N
+zlay
+    0.
+ 1000.
+ 6000.
+20000.
+ 100.    -23.9   115.    -23.9  00 nostrpond noice IND_W1
+ 100.    -33.8   117.    -33.8  00 nostrpond noice IND_W2
+ 100.    -33.8   100.      2.   00 nostrpond noice IND_W3
+ 122.    -45.    122.    -30.   00 nostrpond noice IND_S1
+ 139.5   -45.    139.5   -32.   00 nostrpond noice IND_S2
+ 122.    -45.    139.5   -45.   00 nostrpond noice IND_S3
+ 150.    -28.5   165.    -28.5  00 nostrpond noice IND_E1
+ 148.    -34.    165.    -34.   00 nostrpond noice IND_E2
+ 146.    -41.7   165.    -41.7  00 nostrpond noice IND_E3
+ 165.    -41.7   165.    -28.5  00 nostrpond noice IND_E4
+ 165.    -10.    165.    -28.5  00 nostrpond noice IND_E5
+ 149.    -10.    165.    -10.   00 nostrpond noice IND_E6
+ 165.    -41.7   173.    -41.7  00 nostrpond noice IND_E7
+ 115.     24.    122.     17.   00 nostrpond noice IND_N1
+ 125.      8.    134.     -2.   00 nostrpond noice IND_N2
+ 114.1    -8.45  118.9    -8.45 00 nostrpond noice IND_N3
+ 121.8    -8.7   124.1    -9.7  00 nostrpond noice IND_N4
+ 124.1    -9.7   127.    -15.   00 nostrpond noice IND_N5
+ 115.    -25.    104.     -4.   00 nostrpond noice IND_N6
+ 116.      2.3   134.     -2.   00 nostrpond noice IND_N8
+  33.   -22.2     45.    -22.2  00 nostrpond noice IND_AG1
+  25.   -33.65    44.    -33.65 00 nostrpond noice IND_AG2
+  44.   -22.2     44.    -33.65 00 nostrpond noice IND_AG3
+ 114.    -8.5    120.    -21.   05 nostrpond noice IND_Australia_Bali
+zlay
+    0.
+  200.
+  500.
+ 2000.
+20000.
+  45.     6.1     53.      6.   00 nostrpond noice IND_Somali_Current
+  39.   -16.      45.    -18.   00 nostrpond noice IND_Mozambique_Current
+  27.   -32.1     40.    -32.   06 nostrpond noice IND_Agulhas_Current_32S
+zsigi
+ 0.
+26.5
+26.75
+27.
+27.4
+50.0 
+  43.25   12.65   43.75   12.9  00 nostrpond noice IND_Bab_El_Manded
+  41.      0.1    50.      0.   00 nostrpond noice IND_Indian_Equatorial
+  81.    -20.     81.      8.   00 nostrpond noice IND_Indian_80E
+ 115.    -30.1   109.    -30.   00 nostrpond noice IND_West_Australia
+  52.    -24.     47.    -22.   00 nostrpond noice IND_Madagascar
+  25.    -30.1   120.    -30.   00 nostrpond noice IND_Indian_30S
+-171.5    66.2  -166.0    65.7  00 okstrpond   ice ARC_Bering_Strait
+-120.     47.1   142.5    47.   00 nostrpond noice PAC_Subarctic_Gyre_47N
+-130.     43.   -122.     47.   00 nostrpond noice PAC_OffCalif1
+-122.     40.   -130.     36.   00 nostrpond noice PAC_OffCalif2
+-118.     35.   -126.     31.   00 nostrpond noice PAC_OffCalif3
+ 121.     24.   -110.6    24.   03 okstrpond noice PAC_North_Pacific_24N
+zsigi
+20.
+27.
+30.
+-137.      7.   -137.     25.   00 nostrpond noice PAC_North_Pacific_137W_NEC
+-137.     25.   -137.     37.   00 nostrpond noice PAC_North_Pacific_137W_Kuroshio
+ 132.8    33.    137.     26.   00 nostrpond noice PAC_Kuroshio
+ 175.    -20.    175.     10.   00 nostrpond noice PAC_Pacific_Equatorial_175E
+-125.    -10.   -125.     10.   00 nostrpond noice PAC_Pacific_Equatorial_125W
+ -70.    -17.1   -76.    -17.   00 nostrpond noice PAC_Peru_Current
+ 152.    -30.1   175.    -30.   00 nostrpond noice PAC_East_Australia
+ 142.5    -8.    142.5   -13.   00 nostrpond noice PAC_Torres_Strait
+ 147.     10.    147.     50.   06 nostrpond noice PAC_Pacific_147E_10N_50N
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 165.      0.    165.     50.   06 nostrpond noice PAC_Pacific_165E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+ 179.9     0.    179.9    50.   06 nostrpond noice PAC_Pacific_180E
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-140.      0.   -140.     30.   06 nostrpond noice PAC_Pacific_140W
+zsigi
+20.
+26.6
+26.7
+26.8
+27.2
+30.0
+-150.     40.   -150.     60.5  00 nostrpond noice PAC_Alaskan_Gyre
+ 161.     55.   -162.     55.5  00 nostrpond noice PAC_Bering_Sea
+ 137.      0.    137.     36.   00 nostrpond noice PAC_JMA_137E_0N_35N
+ 150.    -30.    -70.    -30.   00 nostrpond noice PAC_Pacific_30S
+   0.     38.75    0.     35.36 00 nostrpond noice MED_0E
+   0.     38.75    1.37   39.   00 nostrpond noice MED_Ibiza_Channel
+   9.     36.8     9.     39.37 00 nostrpond noice MED_Sardinia_Channel
+   9.3    42.5    11.68   42.5  00 nostrpond noice MED_Corsica_Channel
+  10.5    36.6    12.9    37.85 00 nostrpond noice MED_Sicily_Strait
+  18.3    40.1    20.07   40.   00 nostrpond noice MED_Otranto_Strait
+  25.     31.5    25.     35.05 00 nostrpond noice MED_Cretan_Passage
+  28.     30.8    28.     37.32 00 nostrpond noice MED_Rhodes_Gyre
+  25.5    35.1    28.6    37.07 00 nostrpond noice MED_Kassos_Strait
+  33.4    35.     33.4    36.36 00 nostrpond noice MED_Cilician_Channel
+  22.9    36.8    23.85   35.42 00 nostrpond noice MED_Kytheron_Strait
+  10.08   60.     10.08,  56.   00 nostrpond noice BAL_WesternBaltic
+  10.     57.     13.     57.   00 nostrpond noice BAL_Kattegat
+  14.     57.     14.     53.   00 nostrpond noice BAL_Skagerrak
+ -53.5    47.     -43.    47.   00 nostrpond noice ATL_FlemishCap
+ -40.    -11.     20.    -11.1  03 okstrpond noice ATL_11S
+zsigi
+0.0
+28.12
+60.0
+  25.    -32.    120.    -32.   00 okstrpond noice IND_Indian_32S
+ 150.    -32.    -70.    -32.   00 okstrpond noice PAC_Pacific_32S
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/run/namelist	(revision 3294)
@@ -0,0 +1,8 @@
+&namdct
+!----------------------------------------!
+!nsecdebug =-1 (debug all section        !
+!          = 0 (no section to debug)     !
+!          = n (debug section # n        !
+!----------------------------------------!
+nsecdebug= 1
+/
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/compute_sections.f90	(revision 3294)
@@ -0,0 +1,692 @@
+MODULE compute_sections
+   !!=====================================================================
+   !!                       ***  MODULE  diadct  ***
+   !! Ocean diagnostics: Compute the transport through a section
+   !!
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !!
+   !!===============================================================
+   !! * Modules used
+   USE declarations 
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC compsec
+   
+   !! * Module variables
+ 
+CONTAINS
+
+  SUBROUTINE compsec(jsec,sec,lkdebug)         
+     !!---------------------------------------------------------------------
+     !!                     ***  ROUTINE compsec  ***
+     !!
+     !!  ** Purpose : Compute the series of mesh points that represent the section
+     !!               defined by its extremities.
+     !!
+     !!  ** Method  : 
+     !!          I.   Find which cells of the mesh the section is crossing
+     !!          II.  Classification of the intersections mesh/section
+     !!                  -first  classification west to east          
+     !!                  -second classification south to north 
+     !!          III. Find extremities of section in the mesh
+     !!          IV.  Find the series of mesh points that form the section
+     !!  ** Input: sec : the section to compute
+     !!
+     !!  ** Output:
+     !!---------------------------------------------------------------------
+     !! * Arguments
+     INTEGER,INTENT(IN)           :: jsec    ! number of the section
+     TYPE(SECTION), INTENT(INOUT) :: sec     ! information about the section
+     LOGICAL ,INTENT(IN)          :: lkdebug ! debug or not debug this section
+
+     !! * Local variables
+     INTEGER :: &
+        ji,jj            ,     & ! dummy loop argument
+        jseg             ,     & ! loop on segments that form the section    
+        nb_inmesh        ,     & ! number of intersections between the section and the mesh
+        nmesh                    ! number of cells in processor domain
+     INTEGER :: itest , jtest    ! dummy integer
+     REAL(wp)      :: &
+        zdistEst   , zdistNorth , zdistWest , zdistSouth ,  &! temporary scalars
+        zdistEst2  , zdistNorth2, zdistWest2, zdistSouth2,  &! temporary scalars
+        zdistEst3  , zdistNorth3, zdistWest3, zdistSouth3,  &! temporary scalars
+        zdistFirst , zdistLast  , zdistref  ,               &! temporary scalars
+        zdistante  , zdistante2 , zdistnew  , zdistnew2  ,  &! temporary scalars
+        zdeltai    , zdeltaj                                 ! temporary scalars
+     LOGICAL :: & 
+        ll_overlap_sec_left = .FALSE. , ll_overlap_sec_right = .FALSE. ,&! temporary logical
+        ll_date_domain_left = .FALSE. , ll_date_domain_right = .FALSE. ,&! temporary logical
+        ll_overlap_sec      = .FALSE. , ll_date_domain       = .FALSE. ,&! temporary logical
+        ll_test             = .FALSE.                                    ! temporary logical
+     LOGICAL :: lest, lwest, lnorth, lsouth
+     LOGICAL :: l_oldmethod
+     CHARACTER(len=120) :: cltmp
+     TYPE(COORD_SECTION) :: &
+        coord_a   , coord_b  , coord_d ,  coord_t ,               &!temporary point (long/lat)
+        coordFirst, coordLast, coordTemp                           !        "
+     TYPE(COORD_SECTION), DIMENSION(nb_point_max) :: coordSec      !intersections mesh/section    
+     TYPE(POINT_SECTION) :: &
+        endingPoint, prevPoint , nextPoint,           &!temporary point (I/J)
+        SouthPoint , NorthPoint, EstPoint , WestPoint  !        "
+     !!---------------------------------------------------------------------
+     IF( jsec==1 )THEN
+          PRINT*,'                '
+          PRINT*,'COMPUTE SECTIONS'
+          PRINT*,'----------------'
+     ENDIF
+
+     !debug
+     CALL write_debug(jsec,'compute section:')
+     CALL write_debug(jsec,'================')
+
+
+     !==================!
+     !0. Initializations!
+     !==================! 
+     
+     nmesh       = jpi*jpj          ! number of cells in processor domain
+     nb_inmesh   = 0                ! initialize number of intersections between section and the mesh
+     zdistEst  =0. ; zdistNorth=0. ; zdistWest=0. ; zdistSouth=0.   ! temporary scalars
+     zdistFirst=0. ; zdistLast =0.                                  ! temporary scalars
+     zdistante =0. ; zdistante2=0. ; zdistnew=0.  ; zdistnew2=0.    ! temporary scalars
+     zdeltai=0.    ; zdeltaj=0. 
+     coord_a     = COORD_SECTION( 0., 0. ) ; coord_b    = COORD_SECTION( 0., 0. )
+     coord_d     = COORD_SECTION( 0., 0. ) ; coord_t    = COORD_SECTION( 0., 0. ) 
+     coordFirst  = COORD_SECTION( 0., 0. ) ; coordLast  = COORD_SECTION( 0., 0. )
+     coordTemp   = COORD_SECTION( 0., 0. ) ; coordSec   = COORD_SECTION( 0., 0. )
+     endingPoint = POINT_SECTION( -1, -1 ) 
+     prevPoint   = POINT_SECTION( -1, -1 ) ; nextPoint   = POINT_SECTION( -1, -1 )
+     SouthPoint  = POINT_SECTION( -1, -1 ) ; NorthPoint  = POINT_SECTION( -1, -1 )
+     EstPoint    = POINT_SECTION( -1, -1 ) ; WestPoint   = POINT_SECTION( -1, -1 )
+
+     !===========================================================!    
+     !I. Find which cells of the mesh the section is  crossing  !
+     !===========================================================!
+
+     !loop on the mesh 
+     DO jj=2,jpj
+        DO ji=2,jpi
+           !-----------------------------------------------------------
+           !For each cell of the mesh, we find the intersection between 
+           !the section and the cell as described below:
+           !The cell is defined by 4 points A B C D 
+           !and the section by S1 and S2 
+           !
+           !Section\    ________
+           !        \ B|        |
+           !         \ |        |
+           !          \|one cell|
+           !      .....\        |
+           !           |\       |
+           !           | \      | 
+           !          A|__\_____|D
+           !       ........\
+           !----------------\-------------------------------------------
+
+           !definition of points A,B,D (we don't need C) 
+           coord_a = COORD_SECTION( glamf(ji-1,jj-1) ,gphif(ji-1,jj-1) )
+           coord_b = COORD_SECTION( glamf(ji-1,jj)   ,gphif(ji-1,jj)   )
+           coord_d = COORD_SECTION( glamf(ji,jj-1)   ,gphif(ji,jj-1)   )
+ 
+           !size of the cell 
+           zdeltai= glamf(ji-1,jj) - glamf(ji-1,jj-1) !zdeltai=[AB]
+           zdeltaj= gphif(ji,jj-1) - gphif(ji-1,jj-1) !zdeltaj=[AD]
+           
+           !intersection section/[AB]=?
+           coordTemp     = intersec(sec,coord_a,coord_b)     !compute intersection 
+ 
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*,"WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE    
+                 nb_inmesh=nb_inmesh+1              
+                 coordSec(nb_inmesh) = coordTemp    !store the intersection's coordinates
+
+                 !We need to know if the section crosses the overlapping band.
+
+                 !Fist we look if there is an intersection mesh/section 
+                 !just on the left of the overlapping band: 
+                 IF( coordTemp%lon .GT. glamf(1,1)-5  .AND. coordTemp%lon .LT. glamf(1,1) ) & 
+                    & ll_overlap_sec_left  = .TRUE.
+                 !And we look if there is an intersection mesh/section 
+                 !just on the right of the overlapping band:
+                 IF( coordTemp%lon .GT. glamf(jpi,1) .AND. coordTemp%lon .LT. glamf(1,1)+5 ) &
+                    & ll_overlap_sec_right = .TRUE.
+              ENDIF
+           ENDIF
+              
+           !intersection section/[AD]=?
+           coordTemp=intersec(sec,coord_a,coord_d)       !compute intersection
+           coordTemp%lon = coordTemp%lon !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+           coordTemp%lat = coordTemp%lat !* zmask(ji,jj)-9999.*(1-zmask(ji,jj))
+
+           IF( coordTemp%lon .NE. -9999 )THEN
+              IF( nb_inmesh+1 .GT. nb_point_max )THEN
+                 PRINT*, "WARNING diadct: nb_point_max needs to be greater than ", nb_inmesh
+              ELSE  
+                 nb_inmesh=nb_inmesh+1
+                 coordSec(nb_inmesh)=coordTemp
+                   
+                 !We need to know if the section crosses the overlapping band:
+                 !same test as above 
+                 IF( coordTemp%lon .GE. glamf(1,1)-3  .AND. coordTemp%lon .LE. glamf(1,1) ) &
+                      & ll_overlap_sec_left  = .TRUE.
+                 IF( coordTemp%lon .GE. glamf(jpi,1) .AND. coordTemp%lon .LE. glamf(jpi,1)+3) & 
+                      & ll_overlap_sec_right = .TRUE. 
+              ENDIF
+           ENDIF
+         
+           !We need to know if the domain crosses the date line:
+           !Fist, we search a mesh point that is just one the left of date line:
+           IF( glamf(ji-1,jj-1) .GT.  175 .AND. glamf(ji-1,jj-1) .LT.  180 ) &
+              & ll_date_domain_left = .TRUE.
+           !And we search a mesh point that is just one the right of date line:
+           IF( glamf(ji-1,jj-1) .GT. -180 .AND. glamf(ji-1,jj-1) .LT. -175 ) &  
+              & ll_date_domain_right = .TRUE.
+ 
+        ENDDO
+     ENDDO !End of the loop on the mesh
+
+ 
+     !Crossing section/overlapping band (we need to know it for later):
+     !----------------------------------------------------------------- 
+     !If there is one intersection mesh/section just on the left of
+     !the overlapping band (ll_overlap_sec_left  = .TRUE.)
+     !AND there is one just the right of the overlapping band 
+     !(ll_overlap_sec_right  = .TRUE.),
+     !so the section crosses the overlapping band.
+     ll_overlap_sec = ll_overlap_sec_left .AND. ll_overlap_sec_right 
+
+     !Crossing of the domain and the date line (we need to know it for later): 
+     !------------------------------------------------------------------------
+     !If there is one point of the domain that is just on the left of the date line
+     !(ll_date_domain_left = .TRUE.) AND one point that is just on the right of the
+     !date line (ll_date_domain_right = .TRUE. ) 
+     !So the domain crosses the date line:
+     ll_date_domain = ll_date_domain_left .AND. ll_date_domain_right
+
+     !=====================================================!
+     ! II. Classification of the intersections mesh/section!
+     !=====================================================!
+
+     !   -first classification  west to east          
+     !   -second classification south to north        
+     !CAUTION: routine qcksrt doesn't work in the same way if the section
+     !and the domain crosse the date line (sec%ll_date_line=T and ll_date_domain=T)
+
+     IF( sec%ll_date_line .AND. ll_date_domain )THEN
+
+        !we add 360° to negative longitudes to have a good classification
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .LT. 0 ) coordSec(jseg)%lon=coordSec(jseg)%lon+360.
+        ENDDO
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon ) THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+        DO jseg=1,nb_inmesh
+           IF( coordSec(jseg)%lon .GT. 180 ) coordSec(jseg)%lon=coordSec(jseg)%lon-360.
+        ENDDO
+
+     ELSE     
+
+        IF( sec%coordSec(1)%lon .NE. sec%coordSec(2)%lon )THEN
+           CALL qcksrt(coordSec(:)%lon,coordSec(:)%lat,nb_inmesh)
+        ELSE
+           CALL qcksrt(coordSec(:)%lat,coordSec(:)%lon,nb_inmesh)
+        ENDIF
+
+     ENDIF
+
+     !debug
+     WRITE(cltmp,'(A20,i3.3)')'number intersections = ',nb_inmesh ; CALL write_debug(jsec,cltmp)
+     CALL write_debug(jsec,'List of intersections between grid and section: ')
+     DO jseg=1,nb_inmesh
+        WRITE(cltmp,'(i4.4,1X,2(f8.3,1X) )')jseg,coordSec(jseg) ;  CALL write_debug(jsec,cltmp)
+     ENDDO
+ 
+     !=====================================================!
+     ! III. Find extremities of section in the mesh        !
+     !=====================================================!
+     !we can find section's extremities in the mesh only if
+     !there is intersection between section and mesh (nb_inmesh .ne. 0)
+
+     IF( nb_inmesh .ne. 0 )THEN
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(nb_inmesh) 
+        sec%nb_point     = nb_inmesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        zdistante        = 1000.
+        zdistante2       = 1000.
+
+        !First, we find the point of the mesh that is the closest 
+        !to the first intersection section/mesh (=coordFirst=coordSec(1)):
+        !this point will be called sec%listPoint(1).
+        !Then, we find the point of the mesh that is the closest
+        !to the last intersection section/mesh (coordLast=coordSec(nb_inmesh))
+        !this point will be called endingPoint.
+
+        DO jj=1,jpj
+           DO ji=1,jpi  
+              coord_t=COORD_SECTION(glamf(ji,jj),gphif(ji,jj))
+              zdistFirst = distance2(coord_t,coordFirst)
+              zdistLast = distance2(coord_t,coordLast)
+              IF( zdistFirst .LT. zdistante )THEN
+                 sec%listPoint(1) = POINT_SECTION(ji,jj)
+                 zdistante=zdistFirst
+              ENDIF
+              IF( zdistLast .LT. zdistante2 )THEN
+                 endingPoint = POINT_SECTION(ji,jj)
+                 zdistante2=zdistLast
+              ENDIF
+           ENDDO
+        ENDDO
+
+        IF( sec%listPoint(1)%I == endingPoint%I .AND. sec%listPoint(1)%J == endingPoint%J )THEN
+           sec%listPoint(1) = POINT_SECTION(-1,-1)
+           endingPoint      = POINT_SECTION(-1,-1)
+           coordFirst       = coordSec(1)
+           coordLast        = coordSec(2)
+           sec%nb_point     = 0
+        ENDIF
+
+     ELSE
+        !If there is no intersection section/mesh
+        sec%listPoint(1) = POINT_SECTION(-1,-1)
+        endingPoint      = POINT_SECTION(-1,-1)
+        coordFirst       = coordSec(1)
+        coordLast        = coordSec(2)
+        sec%nb_point     = 0
+     ENDIF 
+
+     !debug
+     CALL write_debug(jsec,"extremities of section in the grid : ")
+     ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+     IF( sec%nb_point .ne. 0 )THEN
+        ji=sec%listPoint(1)%I ; jj=sec%listPoint(1)%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'First point: ',sec%listPoint(1),glamf(ji,jj),gphif(ji,jj) 
+        CALL write_debug(jsec,cltmp)
+        ji=endingPoint%I ; jj=endingPoint%J
+        WRITE(cltmp,'(A15,X,i4.4,X,i4.4,X,f8.3,X,f8.3)')'Last  point: ',endingPoint,glamf(ji,jj),gphif(ji,jj)
+        CALL write_debug(jsec,cltmp)
+        !
+        coord_a=pointToCoordF(sec%listPoint(1)) ; coord_b=pointToCoordF(endingPoint)
+        ll_test = .FALSE.
+        IF ( ll_date_domain .AND. ABS( coord_a%lon - coord_b%lon ).GT. 180) ll_test= .TRUE.
+        zdistante=distance2(coord_a,coord_b ,ll_test )
+        WRITE(cltmp,'(A20,f10.3)' )'distance between IJ-extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        !
+        CALL write_debug(jsec,"Initial extremities : ") 
+        WRITE(cltmp,'( 2(f9.3),A3,2(f9.3) )')coordFirst,'---',coordLast
+        CALL write_debug(jsec,cltmp)
+        ll_test = .FALSE.
+        IF( ll_date_domain .AND. ABS(coordFirst%lon - coordLast%lon).GT. 180)ll_test= .TRUE.
+        zdistante=distance2(coordFirst,coordLast,ll_test)
+        WRITE(cltmp,'(A30,f10.3)')' distance between initial extremities : ',zdistante
+        CALL write_debug(jsec,cltmp)
+        CALL write_debug(jsec,"                  ")
+     ELSE
+        WRITE(cltmp,'(A50)' )"no intersection between section and mesh"
+     ENDIF
+
+     !==========================================================!
+     ! IV. Find the series of mesh points that form the section !
+     !==========================================================!
+     CALL write_debug(jsec,"Find the serie of mesh's points that form the section")
+
+     IF( sec%nb_point .ne. 0 )THEN
+
+        !The series of mesh points that form the section will 'link' 
+        !sec%listPoint(1) to endingPoint: it will be stored in 
+        !sec%listPoint(jseg)
+        !
+        !We take place on the first point (sec%listPoint(1)) 
+        ! a.  We find the 4 adjacent points (North, South, East, West)
+        ! b.  Compute distance between current point and endingPoint
+        ! c.  Compute distance between the 4 adjacent points and endingPoint
+        ! d.  Select the points which are closer to end-point than current point
+        ! e.1 If at least one point is selected, select the point which is closest to original section among selected points 
+        ! e.2 If no point is selected, select the point which is the closest to end-point 
+        ! f. save next point and direction of velocity.
+        ! g. Save nextPoint and go to nextPoint
+        !
+        !We get out of this loop if:
+        !    - we are on endingPoint
+        !    - the number of points (jseg) that link sec%listPoint(1) to endingPoint is 
+        !      twice greater than number of section/mesh intersection (nb_inmesh):
+        !      it could be possible if thr algorithm can't link endingPoint (bug).
+
+        !initialize distnew value (with distance between section's extremities) 
+        zdistnew  = distance2(coordFirst,coordLast,sec%ll_date_line) 
+        prevPoint  = POINT_SECTION(0,0)
+        jseg       = 1
+
+        DO WHILE ( (  sec%listPoint(jseg)%I .NE.  endingPoint%I    &
+                 .OR. sec%listPoint(jseg)%J .NE. endingPoint%J   ) &
+                 .AND. jseg .LT. nb_inmesh + 1 .AND. sec%listPoint(jseg)%I .GT. 0  )         
+   
+           ! a. find the 4 adjacent points (North, South, East, West)
+           !---------------------------------------------------------
+           SouthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J-1)
+           NorthPoint = POINT_SECTION(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J+1)
+           WestPoint  = POINT_SECTION(sec%listPoint(jseg)%I-1,sec%listPoint(jseg)%J)
+           EstPoint   = POINT_SECTION(sec%listPoint(jseg)%I+1,sec%listPoint(jseg)%J)
+
+           !debug
+           CALL write_debug(jsec,"---------------")
+           WRITE(cltmp,100)'Current points: ',sec%listPoint(jseg), & 
+                         glamf(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J), &
+                         gphif(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)
+           CALL write_debug(jsec,cltmp)
+           CALL write_debug(jsec,"E/W/N/S points")
+           WRITE(cltmp,102)EstPoint,WestPoint,NorthPoint,SouthPoint
+           CALL write_debug(jsec,cltmp)
+           itest=MIN(MAX(EstPoint%I,0),jpi+1) ; jtest=MIN(MAX(EstPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'Est',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"Est point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(WestPoint%I,0),jpi+1) ; jtest=MIN(MAX(WestPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'West',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"West point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(NorthPoint%I,0),jpi+1) ; jtest=MIN(MAX(NorthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'North',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"North point out of domain")
+           ENDIF
+           !
+           itest=MIN(MAX(SouthPoint%I,0),jpi+1) ; jtest=MIN(MAX(SouthPoint%J,0),jpj+1)
+           IF( itest .NE. 0 .AND. itest .NE. jpi+1 .AND. jtest .NE. 0 .AND. jtest .NE. jpj+1 )THEN 
+              WRITE(cltmp,101)'South',glamf(itest,jtest),gphif(itest,jtest)
+              CALL write_debug(jsec,cltmp)
+           ELSE
+              CALL write_debug(jsec,"South point out of domain")
+           ENDIF
+           !
+           !
+100 FORMAT ( A15,2(i4.4," "),2(f8.3," ") )
+101 FORMAT ( A6,2(f7.3," "))
+102 FORMAT ( "E ",i4.4,' ',i4.4,"//W ",i4.4,' ',i4.4,"//N ",i4.4,' ',i4.4,"//S ",i4.4,' ',i4.4 )
+
+               
+           !Either we are at an end-point
+           !--------------------
+           IF(      SouthPoint%I==endingPoint%I .AND. SouthPoint%J==endingPoint%J )THEN 
+               jseg = jseg+1 ; sec%listPoint(jseg) = SouthPoint
+           ELSE IF( NorthPoint%I==endingPoint%I .AND. NorthPoint%J==endingPoint%J )THEN
+               jseg = jseg+1 ; sec%listPoint(jseg) = NorthPoint
+           ELSE IF(  WestPoint%I==endingPoint%I .AND.  WestPoint%J==endingPoint%J )THEN
+               jseg = jseg+1 ; sec%listPoint(jseg) = WestPoint
+           ELSE IF(   EstPoint%I==endingPoint%I .AND.   EstPoint%J==endingPoint%J )THEN
+               jseg = jseg+1 ; sec%listPoint(jseg) = EstPoint
+
+           ELSE
+           !Else we are NOT on end-point
+           !------------------------
+
+              ! b. distance between current point and endingPoint
+              !--------------------------------------------------
+              zdistante = zdistnew
+
+              ! c. compute distance between the 4 adjacent points and endingPoint
+              !------------------------------------------------------------------
+              ! BE CAREFUL! When the domain crosses the date line (ll_date_domain):
+              !
+              ! When we will compute distances between W/E/S/N points and endingPoint,
+              ! we have to check if theses 4 lines crosses the date line
+              ! (test: ABS(coordTemp%lon - coordLast%lon).GT. 180)
+              !
+              ! If one of these lines crosses the date line, we have to add 360° 
+              ! to the longitudes of the extremities to compute the distance through
+              ! the date line and not around the Earth.
+       
+              ! c.1 compute distWest: distance between west point and endingPoint
+              !----------------------
+              zdistWest2 = 99999999.9 ;  zdistWest3 = 99999999.9 
+              IF( sec%listPoint(jseg)%I .NE. 1 )THEN
+                 !When we are on the west side of the mesh (i=1),we can't go to the west.
+                 coordTemp = pointToCoordF(WestPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test = .TRUE.
+                 zdistWest2  = distance2(pointToCoordF(WestPoint) ,coordLast ,ll_test)
+              ENDIF
+
+              ! c.2 compute distEst: distance between east point and endingPoint
+              !---------------------
+              zdistEst2 = 99999999.9 ;  zdistEst3 = 99999999.9
+              IF( sec%listPoint(jseg)%I .EQ. jpi )THEN
+                 !We test if the current point is on the east side of the mesh
+                 ! The method is done such that we go toward east to link
+                 ! sec%listPoint(1) to endingPoint.
+                 ! So, if the section crosses the overlapping band (ll_overlap_sec=T),
+                 ! we won't have to stop if the current point is on the EAST side of the mesh:
+                 ! we have to follow the construction of the section on the
+                 ! WEST side of the mesh
+                 IF( ll_overlap_sec  )THEN
+                    !section crosses the overlapping band 
+                    !So EastPoint is on the west side of the mesh
+                    EstPoint = POINT_SECTION(3,sec%listPoint(jseg)%J)
+                    zdistEst2= distance2(pointToCoordF(EstPoint)  ,coordLast ,.FALSE.)
+                 ENDIF 
+              ELSE
+                 coordTemp = pointToCoordF(EstPoint) 
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistEst2 = distance2(pointToCoordF(EstPoint)  ,coordLast ,ll_test )
+              ENDIF
+
+              ! c.3 compute distSouth: distance between south point and endingPoint
+              !-----------------------
+              zdistSouth2 = 99999999.9 ; zdistSouth3 = 99999999.9
+              IF( sec%listPoint(jseg)%J .NE. 1 )THEN
+                 !When we are on the south side of the mesh (j=1),we can't go to the south. 
+                 coordTemp=pointToCoordF(SouthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                    zdistSouth2 = distance2(pointToCoordF(SouthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! c.4 compute distNorth: distance between north and endingPoint
+              !-----------------------
+              zdistNorth2 = 99999999.9 ; zdistNorth3 = 99999999.9 
+              IF( sec%listPoint(jseg)%J .NE. jpj )THEN
+                 !When we are on the north side of the mesh (j=jpj),we can't go to the south. 
+                 coordTemp=pointToCoordF(NorthPoint)
+                 ll_test = .FALSE.
+                 IF( ll_date_domain .AND. ABS(coordTemp%lon - coordLast%lon).GT. 180 )ll_test= .TRUE.
+                 zdistNorth2 = distance2(pointToCoordF(NorthPoint),coordlast ,ll_test )
+              ENDIF
+
+              ! d. select the points which are closer to end-point than current point
+              !----------------------------------------------------------------------
+              zdistref=distance2(pointToCoordF(sec%listPoint(jseg)),coordlast ,ll_test )
+              WRITE(cltmp,'( A56,f10.3 )' )'distance between actual point and last point: zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              lest   = .FALSE. ; IF( zdistEst2   .LE. zdistref ) lest  = .TRUE.
+              lwest  = .FALSE. ; IF( zdistwest2  .LE. zdistref ) lwest = .TRUE.
+              lnorth = .FALSE. ; IF( zdistnorth2 .LE. zdistref ) lnorth= .TRUE.
+              lsouth = .FALSE. ; IF( zdistsouth2 .LE. zdistref ) lsouth= .TRUE.
+
+              !debug
+              IF( .NOT. lest   )CALL write_debug(jsec,'Est   point eliminated')
+              IF( .NOT. lwest  )CALL write_debug(jsec,'West  point eliminated')
+              IF( .NOT. lnorth )CALL write_debug(jsec,'North point eliminated')
+              IF( .NOT. lsouth )CALL write_debug(jsec,'South point eliminated')
+
+              l_oldmethod = .FALSE.
+
+              IF( ( COUNT((/lest/))+COUNT((/lwest/))+COUNT((/lnorth/))+COUNT((/lsouth/)) ) .NE. 0 )THEN
+
+                 ! e.1 If at least one point is selected, select the point 
+                 !     which is the closest to original section among selected points 
+                 !-------------------------------------------------------------------
+
+                 zdistWest3  = 9999999.9
+                 IF( lwest )zdistWest3  = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(WestPoint) ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistEst3   = 9999999.9
+                 IF( lest )zdistEst3   =  &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(EstPoint)  ,pointToCoordF(endingPoint) ,lkdebug )
+                 zdistSouth3 = 9999999.9
+                 IF( lsouth )zdistSouth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(SouthPoint),pointToCoordF(endingPoint) ,lkdebug )
+                 zdistNorth3 = 9999999.9
+                 IF( lnorth )zdistNorth3 = &
+                    distance3(pointToCoordF(sec%listPoint(1)),pointToCoordF(NorthPoint),pointToCoordF(endingPoint) ,lkdebug )
+
+                 zdistEst3   = zdistEst3   + (1-COUNT((/lest/))  )*9999999.9
+                 zdistWest3  = zdistWest3  + (1-COUNT((/lwest/)) )*9999999.9
+                 zdistNorth3 = zdistNorth3 + (1-COUNT((/lnorth/)))*9999999.9
+                 zdistSouth3 = zdistSouth3 + (1-COUNT((/lsouth/)))*9999999.9
+
+                 zdistnew = MIN(zdistEst3,zdistWest3,zdistnorth3,zdistSouth3)
+
+              ELSE 
+
+                 ! e.2 If no point is selected, select the point which is the closest to end-point 
+                 !--------------------------------------------------------------------------------
+                 l_oldmethod = .TRUE.
+
+                 !debug
+                 WRITE(cltmp,'(A30,i3.3)' )'SEARCH NEW POINT WITH OLD METHOD: ',jsec
+                 CALL write_debug(jsec,cltmp)
+                   
+                 !be careful! we can't go backward.
+                 zdistNorth = zdistNorth2    ; zdistSouth = zdistSouth2
+                 zdistEst   = zdistEst2      ; zdistWest  = zdistWest2 
+
+                 IF(     prevPoint%I .EQ. NorthPoint%I .AND. prevPoint%J .EQ. NorthPoint%J) THEN
+                     zdistnew = MIN(zdistEst,zdistWest,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. SouthPoint%I .AND. prevPoint%J .EQ. SouthPoint%J) THEN
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth)
+                 ELSE IF(prevPoint%I .EQ. WestPoint%I  .AND. prevPoint%J .EQ. WestPoint%J ) THEN
+                    zdistnew = MIN(zdistEst,zdistNorth,zdistSouth)
+                 ELSE IF(prevPoint%I .EQ. EstPoint%I   .AND. prevPoint%J .EQ. EstPoint%J  ) THEN
+                    zdistnew = MIN(zdistWest,zdistNorth,zdistSouth)
+                 ELSE 
+                    zdistnew = MIN(zdistEst,zdistWest,zdistNorth,zdistSouth)
+                 ENDIF              
+
+              ENDIF
+
+              !debug
+              WRITE(cltmp,'(A11, f8.3)')'zdistref = ',zdistref
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance2 :',zdistEst2,zdistWest2,zdistNorth2,zdistSouth2 
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp, 103         )'distance3 :',zdistEst3,zdistWest3,zdistNorth3,zdistSouth3
+              CALL write_debug(jsec,cltmp)
+              WRITE(cltmp,'(A11, f8.3)')"zdistnew = ",zdistnew
+              CALL write_debug(jsec,cltmp)
+
+103 FORMAT (A12,"E",f12.3," W",f12.3," N",f12.3," S",f12.3)
+
+              !f. save next point and direction of velocity.
+              !--------------------------------------------- 
+              !nextPoint will be the one which is the closest to endingPoint.
+              !sec%direction will be direction between current point and nextPoint:
+              !It will be used to compute velocity through the segment [CurrentPoint,nextPoint}:
+              !                 
+              !A:Current Point    NorthPoint(I,J+1)   Nextpoint=NorthPoint(I,J+1) => sec%direction=3
+              !                   |                   Nextpoint=SouthPoint(I,J-1) => sec%direction=2   
+              !                   |                   Nextpoint=WestPoint(I-1,J)  => sec%direction=0   
+              !                   |==>V(I,J+1)        Nextpoint=EastPoint(I+1,J)  => sec%direction=1
+              !            U(I,J) |       U(I+1,J)
+              !            ^      |       ^
+              !   West_____|______A_______|_____EstPoint 
+              !   Point           |(I,J)        (I+1,J)  
+              !   (I-1,J)         |               
+              !                   |==>V(I,J)
+              !                   |
+              !              SoutPoint(I,J-1)
+              IF( l_oldmethod )THEN
+                 IF( zdistnew == zdistWest )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF
+              ELSE 
+                 IF( zdistnew == zdistWest3 )      THEN
+                      sec%direction(jseg)=0 ; nextPoint = WestPoint
+                 ELSE IF( zdistnew == zdistEst3 )  THEN
+                      sec%direction(jseg)=1 ; nextPoint = EstPoint
+                 ELSE IF( zdistnew == zdistSouth3 )THEN
+                      sec%direction(jseg)=2 ; nextPoint = SouthPoint
+                 ELSE IF( zdistnew == zdistNorth3 )THEN
+                      sec%direction(jseg)=3 ; nextPoint= NorthPoint
+                 ENDIF 
+              ENDIF
+
+              WRITE(cltmp,'(A11, 2(i4.4,1X) )')'nextPoint = ', nextPoint
+              CALL write_debug(jsec,cltmp)
+        
+              !f. Save nextPoint and go to nextPoint
+              !-------------------------------------
+              prevPoint = sec%listPoint(jseg)
+              jseg = jseg+1                   !increment of number of segments that form the section
+              sec%listPoint(jseg) = nextPoint !Save next point
+   
+           ENDIF ! southP/northP/WestP/EstP == endingpoint ?
+
+        ENDDO                  !End of loop on jseg
+        sec%nb_point = jseg    !Save the number of segments that form the section
+
+
+     ELSE ! isec%nb_point == 0
+        DO jseg=1,nb_point_max 
+           sec%listPoint(:)=POINT_SECTION(0,0)
+        ENDDO
+        sec%direction(:)=0.
+        sec%nb_point = 0
+     ENDIF
+
+     !debug     
+     IF( sec%nb_point .ne. 0 )THEN
+        CALL write_debug(jsec,"-------------------------------------")
+        CALL write_debug(jsec,"list of points in the grid : ")
+        DO jseg=1,sec%nb_point 
+           ji=sec%listPoint(jseg)%I ; jj=sec%listPoint(jseg)%J
+           WRITE(cltmp, '(i4.4,X,i4.4,X,i4.4,X,f8.3,X,f8.3)' )jseg,ji,jj,glamf(ji,jj),gphif(ji,jj)
+           CALL write_debug(jsec,cltmp)
+        ENDDO
+    
+        !test if we are an end-point
+        IF( sec%listPoint(sec%nb_point)%I .NE. endingPoint%J .AND. sec%listPoint(sec%nb_point)%J .NE. endingPoint%J )THEN   
+           PRINT*,TRIM(sec%name)," NOT ARRIVED TO endingPoint FOR jsec =  ",jsec
+        ENDIF
+     ENDIF
+
+     !now compute new slopeSection with ij-coordinates of first and last point 
+     sec%slopeSection = 0  ! default value
+     IF( sec%nb_point .ne. 0 )THEN
+        IF (  sec%listPoint(sec%nb_point)%I .NE.  sec%listPoint(1)%I ) THEN
+           sec%slopeSection = ( sec%listPoint(sec%nb_point)%J - sec%listPoint(1)%J ) /  &
+                              ( sec%listPoint(sec%nb_point)%I - sec%listPoint(1)%I )      
+        ELSE
+           sec%slopeSection = 10000._wp
+        ENDIF
+     ENDIF
+ 
+  END SUBROUTINE compsec
+
+END MODULE compute_sections 
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/declarations.f90	(revision 3294)
@@ -0,0 +1,61 @@
+MODULE declarations 
+  !!----------------------------------------------------------------------------
+  !!             *** declarations global varibles 
+  !!
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !!
+  !!----------------------------------------------------------------------------
+
+  IMPLICIT NONE
+  PUBLIC
+
+  !! * Shared module variables 
+  INTEGER, PUBLIC, PARAMETER   :: dp=8 , sp=4, wp=dp
+  INTEGER, PUBLIC, PARAMETER   :: nb_class_max  = 10            ! Max number of classes
+  INTEGER, PUBLIC, PARAMETER   :: nb_sec_max    = 150           ! Max number of sections
+  INTEGER, PUBLIC, PARAMETER   :: nb_point_max  = 2000          ! Max number of segments per section
+  INTEGER, PUBLIC, PARAMETER   :: nb_type_class = 14            ! Max number of types of classes
+  INTEGER, PUBLIC, PARAMETER   :: numnam=3                      ! Unit for namelist
+  INTEGER, PUBLIC, PARAMETER   :: numdctin=1                    ! Unit for input file
+  INTEGER, PUBLIC, PARAMETER   :: numdctout=2                   ! Unit for output file
+
+  INTEGER, PUBLIC              :: jpi,jpj                       ! domain dimensions
+  INTEGER, PUBLIC              :: nb_sec                        ! Number of sections read from input file
+  INTEGER, PUBLIC              :: nsecdebug = 0                 ! Number of the section to debug
+
+  REAL(wp), PUBLIC ,DIMENSION(:,:)  , ALLOCATABLE :: glamf,gphif,glamt,gphit,e1t
+  INTEGER,  PUBLIC ,DIMENSION(nb_sec_max)         :: num_sec_debug
+
+  TYPE POINT_SECTION
+     INTEGER :: I,J
+  END TYPE POINT_SECTION
+
+  TYPE COORD_SECTION
+     REAL(wp) :: lon,lat
+  END TYPE COORD_SECTION
+
+  TYPE SECTION
+     CHARACTER(len=60)                              :: name                ! name of the sec
+     LOGICAL                                        :: llstrpond           ! true if you want the computation of salt 
+                                                                           ! and heat transport
+     LOGICAL                                        :: ll_ice_section      ! ice surface and icevolume transport computation
+     LOGICAL                                        :: ll_date_line        ! = T if the section crosses the date-line
+     TYPE(COORD_SECTION), DIMENSION(2)              :: coordSec            ! longitude and latitude of the extremities of the section
+     INTEGER                                        :: nb_class            ! number of boundaries for density classes
+     INTEGER, DIMENSION(nb_point_max)               :: direction           ! vector direction of the point in the section
+     CHARACTER(len=40),DIMENSION(nb_class_max)      :: classname           ! characteristics of the class
+     REAL(wp), DIMENSION(nb_class_max)              :: zsigi             ,&! insitu density classes    (99 if you don't want)
+                                                       zsigp             ,&! potential density classes    (99 if you don't want)
+                                                       zsal              ,&! salinity classes   (99 if you don't want)
+                                                       ztem              ,&! temperature classes(99 if you don't want)
+                                                       zlay                ! depth level classes      (99 if you don't want)
+     REAL(wp)                                       :: slopeSection        ! slope of the section 
+     INTEGER                                        :: nb_point            ! number of points in the section
+     TYPE(POINT_SECTION),DIMENSION(nb_point_max)    :: listPoint           ! list of points in the section
+  END TYPE SECTION
+
+  TYPE(SECTION),DIMENSION(nb_sec_max) :: secs ! Array of sections
+
+
+
+END MODULE declarations
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/diadct_sections.f90	(revision 3294)
@@ -0,0 +1,114 @@
+PROGRAM generate_sections
+     !!==============================================================================
+     !!                       ***  PROGRAM generate_sections    ***
+     !!
+     !! create a binary file containig the IJ positions of sections in global 
+     !! coordinates for the diagnostic routine diadct.F90 of NEMO
+     !!
+     !!
+     !! History: 09/2011: Clement Bricaud ( Mercator-Ocean )
+     !!
+     !!==============================================================================
+     !! * Modules used
+     USE declarations
+     USE sections_tools
+     USE readcoordmesh 
+     USE readsections
+     USE compute_sections
+     USE writesections    
+
+     IMPLICIT NONE
+ 
+     !! * Module Variables used
+     INTEGER            :: iargc, narg
+     CHARACTER(LEN=80)  :: cdum
+     INTEGER            :: jsec ,&! loop on sections
+                           jseg   ! loop on segments (parts of the section)
+     CHARACTER(len=40)  :: clname
+     LOGICAL            :: llok
+
+     NAMELIST/namdct/nsecdebug
+     !!==============================================================================     
+ 
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+     PRINT*,'CREATION OF SECTIONS FOR NEMO diadct.F90 ROUTINE'
+     PRINT*,'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
+ 
+     !-------------------!
+     !1. Read namelist   !
+     !-------------------!
+     PRINT*,'              '
+     PRINT*,'READ NAMELIST'
+     PRINT*,'--------------'
+
+     !!open, read and close namelist
+     nsecdebug=0
+     clname='namelist'
+     CALL file_open(numnam,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+     IF ( llok ) THEN
+          REWIND( numnam )
+          READ  ( numnam, namdct )
+          PRINT*,'  '
+          PRINT*,'read namelist'
+          IF( nsecdebug==-1      )THEN ; PRINT*,' Debug all sections'
+          ELSE IF ( nsecdebug==0 )THEN ; PRINT*,' No section to debug'
+          ELSE IF ( nsecdebug .GE. 1 .AND. nsecdebug .LE. nb_sec_max )THEN
+              PRINT*,' Debug section number ',nsecdebug
+          ELSE
+              PRINT*,'Wrong number for nsecdebug = ',nsecdebug
+          ENDIF
+     ENDIF
+     CLOSE(numnam)
+     PRINT*,'read namelist ok'
+
+     !-------------------------------------!
+     !2. Read coordinates and meshmask     !
+     !-------------------------------------!
+     CALL read_coord_mesh
+ 
+     PRINT*,'domain sizes: '
+     PRINT*,'jpi    jpj    = ',jpi   ,jpj 
+     PRINT*,'domain boundaries: '
+     PRINT*,' 1   1   ',glamt(1,1),gphit(1,1)
+     PRINT*,' 1   jpj ',glamt(1,jpj),gphit(1,jpj)
+     PRINT*,' jpi 1   ',glamt(jpi,1),gphit(jpi,1)
+     PRINT*,'jpi jpj  ',glamt(jpi,jpj),gphit(jpi,jpj)
+
+
+
+     !----------------------!
+     !3. Read list_sections !
+     !----------------------!
+     num_sec_debug(:)=0     ! Unit numbers for debug files
+     CALL read_list_sections
+
+     !----------------------!
+     !4.Compute sections    !
+     !----------------------!
+     DO jsec=1,nb_sec
+          !we use compsec to generate the series of grid points making the section
+          IF(jsec == nsecdebug .OR. nsecdebug ==-1)THEN
+             CALL compsec(jsec,secs(jsec),.true.)
+          ELSE
+             CALL compsec(jsec,secs(jsec),.false.)
+          ENDIF
+          IF (jsec == nb_sec)PRINT*,'compute section ok '
+     ENDDO
+
+     !--------------------------------!
+     !5.Write section_ijglobal.diadct !
+     !--------------------------------!
+     CALL write_sections
+
+     !----------------------! 
+     !END                   !
+     !----------------------!
+    
+     !close debug files
+     DO jsec=1,nb_sec
+        IF( num_sec_debug(jsec) .NE. 0 )CLOSE(num_sec_debug(jsec))
+     ENDDO
+
+     PRINT*,'END END END END END END END END END END END END'
+
+END PROGRAM generate_sections
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readcoordmesh.f90	(revision 3294)
@@ -0,0 +1,199 @@
+MODULE readcoordmesh
+  !!=====================================================================
+  !!                       ***  MODULE  readcoordmesh  ***
+  !! 
+  !! History: 2011: Clement Bricaud, Mercator-Ocean
+  !! 
+  !!=====================================================================
+  !! * Modules used
+  USE netcdf
+  USE declarations
+
+  IMPLICIT NONE
+  PRIVATE
+  
+  PUBLIC  read_coord_mesh
+
+CONTAINS
+
+  SUBROUTINE read_coord_mesh
+  !!---------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate file and a meshmask file in NetCDF format 
+  !!
+  !!---------------------------------------------------------------------      
+  PRINT*,'              '
+  PRINT*,'READ COORDINATES AND MESHMASK'
+  PRINT*,'-----------------------------'
+
+  ! Get coordinates dimensions
+  CALL getdim(cdfile="coordinates.nc")
+
+  !Allocate coordinates array with domain size
+  ALLOCATE(glamt(jpi,jpj)) ; ALLOCATE(gphit(jpi,jpj))
+  ALLOCATE(glamf(jpi,jpj)) ; ALLOCATE(gphif(jpi,jpj))
+  ALLOCATE(e1t(jpi,jpj)  )   
+
+  !Read glamt
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamt",ksize=(/jpi,jpj,1,1/),ptab=glamt)
+
+  !Read gphit
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphit",ksize=(/jpi,jpj,1,1/),ptab=gphit)
+
+  !Read glamf
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="glamf",ksize=(/jpi,jpj,1,1/),ptab=glamf)
+
+  !Read gphif
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="gphif",ksize=(/jpi,jpj,1,1/),ptab=gphif)
+
+  !Read e1t
+  CALL read_ncdf(cdfile="coordinates.nc",cdvar="e1t",ksize=(/jpi,jpj,1,1/),ptab=e1t)
+
+  END SUBROUTINE read_coord_mesh
+
+  SUBROUTINE getdim(cdfile)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE getdim  ***
+  !!
+  !! ** Purpose :   get dimensions of a netcdf file
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),INTENT(IN):: cdfile
+
+  !! * Local declarations
+  INTEGER           :: ncid                 ! file unit
+  INTEGER           :: idims                ! number of dimensions
+  INTEGER           :: istatus, id_var      ! dummy variable
+  CHARACTER(len=30) :: clname               ! dimension name   
+  INTEGER, ALLOCATABLE,DIMENSION(:) :: ndim ! dimension value
+  !!----------------------------------------------------------------------
+
+  !Open file
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ELSE
+ 
+     ! read number of dimensions   
+     istatus=NF90_INQUIRE(ncid,ndimensions=idims)
+
+     ALLOCATE( ndim(idims) )
+
+     ! read each dimension
+     PRINT*,'     File dimensions: '
+     DO id_var=1,idims
+        istatus=NF90_Inquire_Dimension(ncid,id_var,clname,ndim(id_var))
+        PRINT*,'       ',id_var,clname,ndim(id_var)
+     ENDDO
+
+     !close
+     istatus=NF90_CLOSE( ncid )              
+     IF( istatus/=NF90_NOERR )THEN 
+        PRINT*,'Problem for closing ',TRIM(cdfile);STOP
+     ELSE
+        PRINT*,'     close ',TRIM(cdfile),' OK'
+     ENDIF
+
+  ENDIF
+
+  !domain dimensions
+  jpi = ndim(1)
+  jpj = ndim(2)
+
+  DEALLOCATE( ndim )
+  END SUBROUTINE getdim
+
+  SUBROUTINE read_ncdf(cdfile,cdvar,ksize,ptab,kstart,kcount)
+  !!----------------------------------------------------------------------
+  !!              ***  ROUTINE coord_mesh_read  ***
+  !!
+  !! ** Purpose :   Read a coordinate and a meshmask file in NetCDF format
+  !!
+  !!----------------------------------------------------------------------
+  !! * Arguments
+  CHARACTER(*),        INTENT(IN)                                    :: cdfile
+  CHARACTER(*),        INTENT(IN)                                    :: cdvar
+  INTEGER,DIMENSION(4),INTENT(IN)                                    :: ksize
+  INTEGER,DIMENSION(4),INTENT(IN),OPTIONAL                           :: kstart,kcount
+  REAL(wp),DIMENSION(ksize(1),ksize(2),ksize(3),ksize(4)),INTENT(OUT):: ptab
+
+  !! * Local declarations
+  INTEGER                                 ::istatus,ncid,id_var,len
+  CHARACTER(len=30) :: clname , cdvar2
+
+  INTEGER :: idims
+  INTEGER,DIMENSION(3)::idimids 
+  !!----------------------------------------------------------------------
+  ptab=0.
+  PRINT*,'read ',TRIM(cdvar),' in ',TRIM(cdfile)
+  
+  !OPEN
+  !----
+  istatus=NF90_OPEN(TRIM(cdfile),nf90_nowrite,ncid)
+  IF( istatus/= NF90_NOERR )THEN
+     PRINT*,TRIM(cdfile),' not found.stop ' ; STOP
+  ENDIF
+
+  !READ
+  !----
+  !search variable
+  istatus=NF90_INQ_VARID (ncid,TRIM(cdvar),id_var)
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,TRIM(cdvar),' not found in ',TRIM(cdfile),'.stop';STOP
+  ENDIF
+
+  !get variable
+  !------------
+  istatus=nf90_inquire_variable(ncid,id_var, cdvar2, ndims=idims, dimids=idimids)
+  IF ( PRESENT(kstart) .AND. PRESENT(kcount) )THEN  
+      istatus=NF90_GET_VAR(ncid,id_var,ptab,start=kstart,count=kcount)
+  ELSE
+      istatus=NF90_GET_VAR(ncid,id_var,ptab)
+  ENDIF
+
+  CALL ERR_HDL(istatus)
+
+  IF( istatus/=NF90_NOERR )THEN
+           PRINT*,'Problem for reading ',TRIM(cdvar),' in ',TRIM(cdfile); STOP
+  ELSE
+      PRINT*,'     read ',TRIM(cdvar),' OK'
+  ENDIF
+
+  !CLOSE
+  !-----
+  istatus=NF90_CLOSE( ncid )
+  IF( istatus/=NF90_NOERR )THEN
+      PRINT*,'Problem for closing ',TRIM(cdfile);stop
+  ELSE
+      PRINT*,'     close ',TRIM(cdfile),' OK'
+  ENDIF
+
+
+  END SUBROUTINE read_ncdf
+
+  SUBROUTINE ERR_HDL(kstatus)
+  !! ----------------------------------------------------------
+  !!   ***  SUBROUTINE err_hdl
+  !!
+  !!   ** Purpose :  Error handle for NetCDF routine.
+  !!          Stop if kstatus indicates error conditions.
+  !!
+  !! History :
+  !!     Original: J.M. Molines (01/99)
+  !!
+  !! -----------------------------------------------------------
+  INTEGER, INTENT(in) ::  kstatus
+
+  !! -----------------------------------------------------------
+  IF( kstatus /=  NF90_NOERR ) THEN
+     PRINT *, 'ERROR in NETCDF routine, status=',kstatus
+     PRINT *,NF90_STRERROR(kstatus)
+     STOP
+  END IF
+
+  END SUBROUTINE ERR_HDL
+
+END MODULE readcoordmesh
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/readsections.f90	(revision 3294)
@@ -0,0 +1,200 @@
+MODULE readsections 
+   !!=====================================================================
+   !!                       ***  MODULE  readsections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC read_list_sections 
+ 
+CONTAINS
+
+  SUBROUTINE read_list_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose: read ascii file 'list_sections.ascii' that contains
+     !!             section descriptions
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec !loop on section number
+     INTEGER             :: iost,ji
+     INTEGER             :: iclass , jclass
+     LOGICAL             :: llok,llstrpond,llice,lldate
+     REAL(wp)            :: plon1,plat1,plon2,plat2
+     REAL(wp)            :: zslope
+     CHARACTER(len=5)    :: clclass
+     CHARACTER(len=5)    :: cdice
+     CHARACTER(len=9)    :: cdstrpond
+     CHARACTER(len=110)  :: clname,cdsecname,cltmp
+     REAL,DIMENSION(nb_type_class)     :: zclass_value
+     TYPE(COORD_SECTION)               :: coord_point1,coord_point2,coordTemp
+     TYPE(COORD_SECTION), DIMENSION(2) :: coord_sec
+     !!---------------------------------------------------------------------
+     PRINT*,'              '
+     PRINT*,'READ list_sections'
+     PRINT*,'------------------'
+     PRINT*,'               '
+
+     nb_sec=0 !initialize number of sections read in list_sections.ascii
+
+     !open and read input file
+     clname='list_sections.ascii'
+     PRINT*,'               '
+     CALL file_open(numdctin,clname,llok,cdform="FORMATTED",cdstatus="OLD",cdaction="READ")
+
+     IF ( llok ) THEN
+          PRINT*,'list_sections.ascii open '
+           PRINT*,'nb_sec_max = ',nb_sec_max
+          PRINT*,'                         '
+     
+          DO jsec=1,nb_sec_max
+
+                 !read a line corresponding to one section
+                 READ(numdctin,'(F7.2,1X,F7.2,1X,F7.2,1X,F7.2,1X,I2,1X,A9,1X,A5,1X,A40)',iostat=iost) & 
+                 &    plon1,plat1,plon2,plat2,iclass,cdstrpond,cdice,cdsecname
+                 IF (iost /= 0) EXIT  ! end of file
+
+                 ! cdsecname: change space to underscore for cdsecname
+                 cdsecname=ADJUSTL(cdsecname)
+                 ji = SCAN(TRIM(cdsecname)," ")
+                 DO WHILE(ji .NE. 0)
+                    cdsecname(ji:ji) = "_"
+                    ji = SCAN(TRIM(cdsecname)," ")
+                 ENDDO
+
+                 !computation of heat and salt transport ?
+                 llstrpond=.FALSE. ; IF( cdstrpond .EQ. 'okstrpond' ) llstrpond=.TRUE.
+
+                 !computation of ice tranpsort ?
+                 llice=.FALSE. ; IF( cdice .EQ. 'okice' ) llice=.TRUE.
+
+                 !store coordinates of the extremities
+                 coord_point1=COORD_SECTION(plon1,plat1)
+                 coord_point2=COORD_SECTION(plon2,plat2)
+                 coord_sec=(/coord_point1,coord_point2/)
+
+                 !Extremities of the section are classed
+                 lldate=.FALSE.
+                 IF(  coord_sec(2)%lon .LT. coord_sec(1)%lon  .OR.   &
+                    ((coord_sec(2)%lon .EQ. coord_sec(1)%lon) .AND.  &
+                     (coord_sec(2)%lat .LT. coord_sec(1)%lat)) ) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                 ENDIF
+                 IF((coord_sec(2)%lon - coord_sec(1)%lon) .GT. 180) THEN
+                      coordTemp   =coord_sec(1)
+                      coord_sec(1)=coord_sec(2)
+                      coord_sec(2)=coordTemp
+                      lldate=.TRUE.
+                 ENDIF
+
+                 !slope of the section (equidistant cylindric projection)
+                 zslope=slope_coeff(coord_sec(1),coord_sec(2),lldate)
+
+                 !!initialise global array secs
+                 secs(jsec)%llstrpond=.FALSE.  
+                 secs(jsec)%ll_date_line=.FALSE. ; secs(jsec)%nb_class=0
+                 secs(jsec)%zsigi=99.            ; secs(jsec)%zsigp=99.
+                 secs(jsec)%zsal=99.             ; secs(jsec)%ztem=99.
+                 secs(jsec)%zlay=99.
+                 secs(jsec)%nb_point=0
+
+                 !store all information in global array secs
+                 secs(jsec)%name           = cdsecname
+                 secs(jsec)%llstrpond      = llstrpond
+                 secs(jsec)%ll_ice_section = llice
+                 secs(jsec)%coordSec       = (/ coord_sec(1) , coord_sec(2) /)
+                 secs(jsec)%slopeSection   = zslope
+                 secs(jsec)%ll_date_line   = lldate
+
+                 !debug information
+                 CALL write_debug(jsec,'Informations read in ascii file:')
+                 CALL write_debug(jsec,'--------------------------------')
+                 CALL write_debug(jsec,'section name: '//secs(jsec)%name )
+                 IF( secs(jsec)%llstrpond )THEN ; CALL write_debug(jsec,'salt/heat transport computing' )
+                 ELSE                           ; CALL write_debug(jsec,'no salt/heat transport computing' )
+                 ENDIF
+                 IF( secs(jsec)%ll_ice_section )THEN ; CALL write_debug(jsec,'Ice transport computing' )
+                 ELSE                                ; CALL write_debug(jsec,'no Ice transport computing' )
+                 ENDIF
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 1 :',secs(jsec)%coordSec(1)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,2f8.3)')'Extremity 2 :',secs(jsec)%coordSec(2)
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,f8.3)')'Slope coefficient :',secs(jsec)%slopeSection
+                 CALL write_debug(jsec,cltmp)
+                 WRITE(cltmp,'(A20,i3.3)')'number of classes : ',iclass
+                 CALL write_debug(jsec,cltmp)
+                 IF( secs(jsec)%ll_date_line ) THEN ;  CALL write_debug(jsec,'section crosses date line')
+                 ELSE                                ; CALL write_debug(jsec,'section don t crosse date line')
+                 ENDIF
+                 CALL write_debug(jsec,'                        ')
+
+                 !verify number of sections and store it
+                 IF ( iclass .GT. nb_class_max) THEN
+                     PRINT*,"WARNING:  nb_class_max needs to be greater than ", iclass ; STOP
+                 ENDIF
+                 secs(jsec)%nb_class=iclass
+
+                 !read classes
+                 IF ( iclass .NE. 0 )THEN
+
+                      !classname=zsigi/zsigp/zsal/ztem/zlay
+                      READ(numdctin,'(A5)')clclass
+                      DO jclass = 1,iclass
+                         READ(numdctin,'(F9.3)',iostat=iost) zclass_value(jclass) 
+                      ENDDO 
+                      IF      ( TRIM(clclass) .EQ. 'zsigi' )THEN
+                           secs(jsec)%zsigi(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsigp' )THEN
+                           secs(jsec)%zsigp(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'zsal'  )THEN
+                           secs(jsec)%zsal(1:iclass)=zclass_value(1:iclass) 
+                      ELSE IF ( TRIM(clclass) .EQ. 'ztem'  )THEN
+                           secs(jsec)%ztem(1:iclass)=zclass_value(1:iclass)
+                      ELSE IF ( TRIM(clclass) .EQ. 'zlay'  )THEN
+                           secs(jsec)%zlay(1:iclass)=zclass_value(1:iclass)
+                      ELSE
+                          PRINT*,'Wrong name of class for section/clclass: ', cdsecname,TRIM(clclass)
+                      ENDIF
+
+                      IF ( jsec==nsecdebug .OR. nsecdebug==-1)THEN
+                           PRINT*,'class type = ',clclass
+                           PRINT*,'class values = ',zclass_value(1:iclass)
+                      ENDIF
+
+                 ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctin) !Close file
+          IF( jsec .EQ. nb_sec_max)THEN
+              PRINT*,'   '
+              PRINT*,' nb_sec_max is less than the number of sections written in list_sections.ascii'
+              STOP
+          ELSE 
+             nb_sec=jsec-1 !number of read sections
+             PRINT*,'   '
+             PRINT*,'Number of sections read in list_sections.ascii: ',nb_sec 
+             PRINT*,'Reading of list_sections.ascii ok'
+             PRINT*,'   '
+          ENDIF
+
+     ENDIF
+
+  END SUBROUTINE  read_list_sections
+
+END MODULE readsections 
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/sections_tools.f90	(revision 3294)
@@ -0,0 +1,563 @@
+MODULE sections_tools
+   !!=====================================================================
+   !!                       ***  MODULE  sections_tools  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC pointToCoordF         ! define a point with geographical coordinates
+   PUBLIC distance2             ! compute distance between 2 points
+   PUBLIC distance3             ! compute distance between a point and a line
+   PUBLIC intersec              ! intersection between 2 lines
+   PUBLIC slope_coeff           ! slope coefficient of a line
+   PUBLIC qcksrt                ! organize a list of point
+   PUBLIC write_debug           ! write debug messages
+   PUBLIC file_open             ! open a file ( ascii, bin)
+ 
+CONTAINS
+
+  TYPE(COORD_SECTION) FUNCTION pointToCoordF(p)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION pointToCoordF  ***
+     !!           
+     !! ** Purpose: define a point with geographical coordinates
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(POINT_SECTION), INTENT(IN) ::  p
+
+     !!---------------------------------------------------------------------
+
+     pointToCoordF = COORD_SECTION(glamf(p%I,p%J),gphif(p%I,p%J))
+
+     RETURN
+
+  END FUNCTION pointToCoordF
+
+  REAL(wp) FUNCTION distance2(coordA,coordB,ld_date_line)
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION distance  ***
+     !!
+     !! ** Purpose:compute distance between coordA and coordB
+     !!            We add 360 to coordB%long if the line (coordA,coordB)
+     !!            crosses the date-line.
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_date_line
+
+     !! * Local declarations 
+     REAL(wp) :: zrad, zrayon
+     REAL(wp) :: zpi = 3.141592653589793
+     REAL(wp) :: zlam1, zlam2, zphi1, zphi2
+
+     !-----------------------------------------------
+     zrayon = 6367000.0
+     zrad   = zpi/180.
+     zlam1  = coordA%lon*zrad
+     zlam2  = coordB%lon*zrad
+     zphi1  = coordA%lat*zrad
+     zphi2  = coordB%lat*zrad
+     !
+     !function output
+     distance2=0.001*2.*zrayon *ASIN(SQRT(SIN((zphi2-zphi1)/2.0)**2.0+COS(zphi1)*COS(zphi2)*SIN((zlam2-zlam1)/2.0)**2.0) )
+     !
+     RETURN
+  END FUNCTION distance2
+
+  REAL(wp) FUNCTION distance3(coordA,coordB,coordC,ll_debug) 
+     !!---------------------------------------------------------------------
+     !!         ***  FUNCTION cosinus  ***
+     !!
+     !! ** Purpose: compute distance between a point B and a line (AC)
+     !!
+     !! ** Methode: use Al-Kashi theorem
+     !!
+     !!              B                   A first point of the section
+     !!             / \                  B intermediate point on the section
+     !!            / | \                 C last point of the section
+     !!           /  |  \               
+     !!          /   |   \               angle=ACB
+     !!         /    |    \              
+     !!        /     |     \             distance3=Bd
+     !!       /      |      \
+     !!    C  -------d------- A  
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA,coordB,coordC
+     LOGICAL                         :: ll_debug
+
+     !! * Local declarations
+     REAL(wp)                        :: ztmp
+     REAL(wp)                        :: za, zb, zc, zangle
+
+     !-----------------------------------------------
+     za = SQRT( (coordB%lon-coordC%lon)**2 + (coordB%lat-coordC%lat)**2 )
+     zb = SQRT( (coordA%lon-coordC%lon)**2 + (coordA%lat-coordC%lat)**2 )
+     zc = SQRT( (coordA%lon-coordB%lon)**2 + (coordA%lat-coordB%lat)**2 )
+     !
+     IF( za /= 0. .AND. zb /= 0. )THEN
+        ztmp = ( za**2 + zb**2  - zc**2 ) / ( 2.0*za*zb )
+        ztmp = MIN(ztmp,1.00_wp)
+        IF( ztmp==1.00_wp )THEN ; zangle = 0.0 
+        ELSE                    ; zangle = ABS(acos(ztmp)) 
+        ENDIF
+     ELSE
+        PRINT*,'You should not have this situation: za zb =',za,zb ; STOP
+     ENDIF
+     !
+     distance3 = za*ABS(sin(zangle)) 
+     !
+     !function output
+     RETURN
+  END FUNCTION distance3
+
+  REAL(wp) FUNCTION slope_coeff(coordA,coordB,ld_dateline)
+     !!---------------------------------------------------------------------
+     !!         ***  Function slope_coeff  ***
+     !!
+     !! ** Purpose: Compute slope coefficient of the line (coordA,coordB)
+     !!
+     !! ** Method:
+     !!           Usual method :
+     !!                   slope_coeff = (latB-latA)/(lonB-lonA)
+     !!           Special case: the segment [A,B] crosses the date-line (lddate=T)
+     !!                   slope_coeff = (latB-latA)/(360+lonB-lonA)
+     !!---------------------------------------------------------------------
+     !! * arguments
+     TYPE(COORD_SECTION), INTENT(IN) :: coordA, coordB
+     LOGICAL,INTENT(IN),OPTIONAL     :: ld_dateline
+
+     !! * Local declarations
+     REAL(wp)                        :: zcoeff
+     INTEGER                         :: idateline
+
+     !!---------------------------------------------------------
+     !initialization
+     zcoeff = 1.e20
+     idateline=0
+     IF( PRESENT( ld_dateline))THEN
+       IF( ld_dateline )idateline=1
+     ENDIF
+
+     !compute slope coefficient
+     IF ( coordB%lon-coordA%lon .NE. 0.) &
+         zcoeff=(coordB%lat-coordA%lat)/(360*idateline+coordB%lon-coordA%lon)
+
+     !output
+     slope_coeff = zcoeff
+     RETURN
+
+  END FUNCTION slope_coeff 
+
+  TYPE(COORD_SECTION) FUNCTION intersec(sec,coord_a,coord_b)
+     !!---------------------------------------------------------------------
+     !!         ***  Function intersec  ***
+     !!
+     !! ** Purpose:Return the coordinates of the intersection point, 
+     !!            between segment [a,b] and the section.
+     !!            If no intersection the point = -9999.
+     !!
+     !! ** Method:(coord_a,coord_b) => y=za2*x+zb2  (2)
+     !!            sec              => y=za1*x+zb1  (1)
+     !!    Intersection = (X,Y) solves (1) and (2)
+     !!    Vefify that (X,Y) is in [coord_a,coord_b] AND in the section
+     !!         
+     !! ** Action: 1. compute za1, za1 
+     !!            2. compute zb1, zb2
+     !!            3. compute X and Y
+     !!            4.Verify that (zX,zY) is in [coord_a,coord_b] 
+     !!              and in [sec%coordSec(1),sec%coordSec(2)]    
+     !!
+     !! History: Author: 10/05 Matthieu Laborie
+     !!          Additions:
+     !!           05-2007: (C Bricaud) add special cases
+     !!                                (crossing date line)
+     !----------------------------------------------------------------------------- 
+     !! * arguments
+     TYPE(SECTION), INTENT(IN)        :: sec
+     TYPE(COORD_SECTION)  , INTENT(IN):: coord_a, coord_b
+
+     !! * Local declarations
+     TYPE(COORD_SECTION) :: coordInter
+     REAL(wp)            :: za1,za2, &! slope coefficient
+                            zb1,zb2, &! 
+                            zX,zY     ! coordinates of intersection
+     LOGICAL             :: ll_date_line=.FALSE. !segment [a,b] crosses the date-line ?
+
+     !----------------------------------------------------------------------------
+
+     !=================!
+     !0. INITALIZATION !
+     !=================!
+     coordInter=COORD_SECTION(-9999.,-9999.) 
+     ll_date_line=.FALSE.    
+     !we need to know if [coord_a,coord_b] crosses the date-line 
+     if(coord_a%lon-coord_b%lon .GT. 180)ll_date_line=.TRUE.
+
+     !=======================!
+     !1. compute za1 and za2 !
+     !=======================!
+     za1=sec%slopeSection
+     za2=slope_coeff(coord_a,coord_b,ll_date_line)
+ 
+     !=======================!
+     !2. compute zb1 and zb2 !
+     !=======================!
+
+     ! Compute coefficient b for a straight line y=a*x+b
+     !        Usual method:  knowing value of a, we compute b with coordinates of 1 point:
+     !                       b=latA-a.lonA or b=latB-a.lonB
+     !        Particular case: the straight line crosses the date line; so it is in 2 parts:
+     !                         one on the left of the date-line and one the right
+     !                         then,b can could have 2 values:
+     ! As the date-line can be crossed by the section and the segment of the mesh [a,b],
+     ! we have to check if the segment [a,b] crosses the date-line (we know it already for the
+     ! section(sec%ll_date_line): ll_date_line
+     ! Then, there are 4 cases for computing b1 and b2 ( sec%ll_date_line=T/F AND ll_date_line=T/F )
+     !=========================================================================================!
+     ! CASE A :                               !CASE C:
+     ! sec%ll_date_line=T AND ll_date_line =T !sec%ll_date_line=F AND ll_date_line =T
+     !                                        !     |  -180 !+180   |
+     ! this case doesn't exist                !     |       !       |
+     !========================================! a___|_______!_______|__b
+     !CASE B:                                 !     |       !       |
+     !sec%ll_date_line=T AND ll_date_line=F   !     |       !       |
+     !     \     |                            ! section  date-line  section
+     !   a__\__b |                            ! b1: usual method
+     !       \   |                            ! b2: depend of longitude of
+     !        \  |                            !     sec%coordSec(1) et de  sec%coordSec(2)
+     !         \ |                            !=================================================!
+     !          \|                            !CASE D:
+     !     +180  \  -180                      !sec%ll_date_line=F AND ll_date_line =F
+     !           |\                           !      |       !       |
+     !           | \                          !      | +180  ! -180  |
+     !           |  \                         !  a___|___b   !   a___|___b
+     !           |a__\__b                     !      |       !       |
+     !           |    \                       !      |       !       |
+     !    date-line   section                 !   section date-line section
+     !b2: usual method                        !b1: usual method
+     !b1: depend of longitude of a and b.     !b2: usual method
+     !==========================================================================================!
+
+     IF( sec%ll_date_line )THEN
+          IF( ll_date_line )THEN
+              !CASE A: this case doesn't exist
+              !-------
+              zb1=1.e20
+              zb2=1.e20
+          ELSE 
+              !CASE B:
+              !-------
+              !compute zb2: 
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon 
+              zb2=coord_b%lat - za2 * coord_b%lon  
+
+              !compute zb1:
+              IF( coord_a%lon .GT. 0 .AND. coord_b%lon .GT. 0  )THEN
+                  zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+              ELSE  
+                  zb1 = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              ENDIF 
+          ENDIF
+     ELSE
+          IF( ll_date_line )THEN
+              !CASE C:
+              !-------
+              !Compute zb1: 
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon 
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon 
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !Compute zb2:
+              IF( sec%coordSec(1)%lon .GT. 0 .AND. sec%coordSec(2)%lon .GT. 0 )THEN
+                  zb2 = coord_a%lat - za2 * coord_a%lon
+              ELSE  
+                  zb2 = coord_b%lat - za2 * coord_b%lon
+              ENDIF
+          ELSE
+              !CASE D:
+              !-------
+              !compute zb1:
+              !zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon  
+              !    = sec%coordSec(2)%lat - za1 * sec%coordSec(2)%lon
+              zb1 = sec%coordSec(1)%lat - za1 * sec%coordSec(1)%lon
+
+              !compute zb2:
+              !zb2 = coord_b%lat - za2 * coord_b%lon = coord_a%lat - za2 * coord_a%lon
+              zb2 = coord_b%lat - za2 * coord_b%lon  
+          ENDIF
+     ENDIF 
+
+     IF( (za1 - za2) .NE. 0) THEN
+          !================================!
+          !3. Compute intersection (zX,zY) !
+          !================================!
+          IF( za1 == 1.e20 ) THEN ! Case X=constant
+              zX = sec%coordSec(1)%lon
+              zY = za2 * zX + zb2
+          ELSE IF ( za2 == 1.e20) THEN ! Case X=constant
+              zX = coord_b%lon
+              zY = za1 * zX + zb1
+          ELSE ! Case zY=A*zX+B
+              zX = (zb2 - zb1) / (za1 - za2)
+              zY = (za1 * zX ) + zb1
+          ENDIF
+           
+          !==============================================!
+          !4.Verify that (zX,zY) is in [coord_a,coord_b] !
+          !  and in [sec%coordSec(1),sec%coordSec(2)]    !
+          !==============================================!
+          !Be careful! The test is not the same for all configurations
+          IF( sec%ll_date_line )THEN
+
+              IF( ll_date_line )THEN
+                  !CASE A: this case doesn't exist
+                  !-------
+                  coordInter=COORD_SECTION(-9999.,-9999.)
+              ELSE
+                  !CASE B:
+                  !-------   
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                    ((zX .LE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .GE. -180) .OR.  &
+                     (zX .GE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. 180)) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                     coordInter = COORD_SECTION(zX, zY)
+                  ENDIF
+              ENDIF
+          ELSE
+
+              IF( ll_date_line )THEN
+                  !CASE C:
+                  !-------
+                  IF( ((zX .LE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .GE. -180 )  .OR. &
+                       (zX .GE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                        zX .LE. 180 )) .AND. & 
+                        zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                        zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                        zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                        zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                        zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN 
+                        coordInter = COORD_SECTION(zX, zY)   
+                  ENDIF 
+              ELSE
+                  !CASE D:
+                  !-------
+                  IF( zX .GE. MIN(coord_a%lon,coord_b%lon ) .AND. &
+                      zX .LE. MAX(coord_a%lon,coord_b%lon ) .AND. &
+                      zY .GE. MIN(coord_a%lat,coord_b%lat ) .AND. &
+                      zY .LE. MAX(coord_a%lat,coord_b%lat ) .AND. &
+                      zX .GE. MIN(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zX .LE. MAX(sec%coordSec(1)%lon,sec%coordSec(2)%lon ) .AND. &
+                      zY .GE. MIN(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) .AND. &
+                      zY .LE. MAX(sec%coordSec(1)%lat,sec%coordSec(2)%lat ) ) THEN
+                      coordInter = COORD_SECTION(zX, zY)
+                  ENDIF             
+              ENDIF
+          ENDIF   
+            
+     ENDIF
+      
+     !output
+     intersec = coordInter
+     RETURN
+   
+  END FUNCTION intersec
+
+  SUBROUTINE qcksrt(arr1,arr2,n)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE qcksrt  ***
+     !!
+     !! ** Purpose : organize a list point by latitude , and after by longitude
+     !!              using "numerical recipies " routine.
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER,INTENT(IN)                 :: n           ! number of points
+     REAL(wp),DIMENSION(n),INTENT(INOUT):: arr1,arr2   ! longitude and latitude
+
+     !! * Local declarations
+     INTEGER , PARAMETER                :: m = 7, nstack = 500
+     REAL(wp), PARAMETER                :: fm=7875.,fa=211.,fc=1663.,fmi=1./fm
+     INTEGER                            :: il, ir, i, iq, ist    !local integers
+     INTEGER                            :: jj                    !loop indices
+     REAL(wp)                           :: zfx, za, zb           !local real
+     INTEGER,DIMENSION(nstack)          :: istack(nstack)        !temp array
+     !---------------------------------------------------
+     ist=0
+     il=1
+     ir=n
+     zfx=0.
+     !
+ 10  IF( ir-il .LT. m )THEN
+
+        DO jj = il+1,ir
+           za = arr1(jj)
+           zb = arr2(jj)
+           DO i = jj-1,1,-1
+              IF( arr1(i) .LE. za )GOTO 12
+              arr1(i+1) = arr1(i)
+              arr2(i+1) = arr2(i)
+           ENDDO
+           i=0
+ 12        arr1(i+1) = za
+           arr2(i+1) = zb
+        ENDDO
+        IF( ist .EQ. 0 )RETURN
+        ir  = istack(ist)
+        il  = istack(ist-1)
+        ist = ist-2
+     ELSE
+        i  = il
+        jj = ir
+        zfx = MOD(zfx*fa+fc,fm)
+        iq = il+(ir-il+1)*(zfx*fmi)
+        za  = arr1(iq)
+        arr1(iq) = arr1(il)
+        zb = arr2(iq)
+        arr2(iq) = arr2(il)
+ 20     CONTINUE
+ 21     IF( jj .GT. 0 )THEN
+           IF( za .LT. arr1(jj) )THEN
+              jj = jj-1
+              GOTO 21
+           ENDIF
+        ENDIF
+        IF( jj .LE. i )THEN
+           arr1(i) = za
+           arr2(i) = zb
+           GOTO 30
+        ENDIF
+        arr1(i) = arr1(jj)
+        arr2(i) = arr2(jj)
+        i=i+1
+ 22     IF( i .LE. n )THEN
+           IF( za .GT. arr1(i) )THEN
+              i = i+1
+              GOTO 22
+           ENDIF
+        ENDIF 
+        IF( jj .LE.i )THEN
+           arr1(jj) = za
+           arr2(jj) = zb
+           i        = jj
+           GOTO 30
+        ENDIF
+        arr1(jj) = arr1(i)
+        arr2(jj) = arr2(i)
+        jj = jj - 1
+        GOTO 20
+ 30     ist = ist + 2
+        IF( ist .GT. nstack )PAUSE 'nstack too small'
+        IF( ir-i .GE. i-1 )THEN
+           istack(ist  ) = ir
+           istack(ist-1) = i + 1
+           ir = i-1
+        ELSE
+           istack(ist  ) = i-1
+           istack(ist-1) = il
+           il = i+1
+        ENDIF
+     ENDIF
+     GOTO 10
+  END SUBROUTINE qcksrt
+
+  SUBROUTINE write_debug(ksec,cd_write)
+     !!---------------------------------------------------------------------
+     !!         ***  SUBROUTINE write_debug  ***
+     !!
+     !! ** Purpose: write debug messages
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER           :: ksec       !number of section
+     CHARACTER(len=*)  :: cd_write   !message to write
+
+     !! * Local declarations
+     INTEGER           :: iunit
+     LOGICAL           :: llok
+     CHARACTER(len=80) :: clfilename
+   
+     !!---------------------------------------------------------------------
+     IF( ksec == nsecdebug .OR. nsecdebug == -1 )THEN
+
+
+        !open / verify is debug output file is open
+
+        clfilename=TRIM(secs(ksec)%name)//"_debug"
+        iunit = num_sec_debug(ksec)
+
+        IF( iunit .EQ. 0 )THEN
+           PRINT*,"Open debug file: "//TRIM(clfilename)
+           iunit = 100 + ksec
+           num_sec_debug(ksec) = iunit 
+ 
+           CALL file_open(iunit,clfilename,llok,cdform="FORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+        
+           IF( .NOT. llok )THEN 
+               PRINT*,"Can not open TRIM(clfilename)." ; STOP
+           ENDIF   
+        ENDIF
+      
+       WRITE(iunit,*)TRIM(cd_write)
+
+     ENDIF
+
+  END SUBROUTINE write_debug
+
+  SUBROUTINE file_open(knum,cdfile,ldok,cdform,cdstatus,cdaction)
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE file_open ***
+     !!
+     !! ** Purpose: open a file
+     !!
+     !!---------------------------------------------------------------------
+     !! * arguments
+     INTEGER          ,INTENT(IN)  :: knum       ! file unit number
+     CHARACTER(len=*),INTENT(IN)   :: cdfile     ! file name to open
+     LOGICAL          ,INTENT(OUT) :: ldok       ! =.TRUE. if file exists and is corectly opened
+     CHARACTER(len=*),INTENT(IN)   :: cdform,   &! FORM arguments for OPEN function
+                                      cdstatus, &! STATUS arguments for OPEN function
+                                      cdaction   ! ACTION arguments for OPEN function
+                                      
+     !! * Local declarations
+     INTEGER :: iost
+     LOGICAL :: llbon=.FALSE. !check existence of file
+     !!---------------------------------------------------------------------
+     ldok = .FALSE.                        ! initialization; file not found and not opened
+
+     !check presence of file
+     IF( cdstatus .EQ. "OLD" ) THEN
+        INQUIRE( FILE=cdfile, EXIST=llbon ) ! check presence of namelist
+        IF( llbon )THEN ;  PRINT*,TRIM(cdfile)//' EXISTS'
+        ELSE            ;  PRINT*,TRIM(cdfile)//' NOT EXISTS' ; STOP
+        ENDIF
+     ENDIF
+
+     !open file
+     OPEN(UNIT=knum,FILE=TRIM(cdfile),FORM=cdform,status=cdstatus,action=cdaction,iostat=iost)
+     IF ( iost == 0 )THEN
+          ldok=.TRUE.
+     ELSE
+          PRINT*,TRIM(cdfile)//' bad opening. STOP.'; STOP
+     ENDIF
+
+  END SUBROUTINE file_open
+
+END MODULE sections_tools 
Index: trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90
===================================================================
--- trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 3294)
+++ trunk/NEMOGCM/TOOLS/SECTIONS_DIADCT/src/writesections.f90	(revision 3294)
@@ -0,0 +1,91 @@
+MODULE writesections 
+   !!=====================================================================
+   !!                       ***  MODULE  writesections  ***
+   !! 
+   !! History: 2011: Clement Bricaud, Mercator-Ocean
+   !! 
+   !!=====================================================================
+   !! * Modules used
+   USE declarations   
+   USE sections_tools
+ 
+   IMPLICIT NONE
+   PRIVATE
+
+   !! * Routine accessibility
+   PUBLIC  write_sections 
+   PRIVATE file_open 
+ 
+CONTAINS
+
+  SUBROUTINE write_sections
+     !!---------------------------------------------------------------------
+     !!         ***  ROUTINE read_list_sections ***
+     !!
+     !! ** Purpose
+     !!
+     !! ** Method
+     !!
+     !! ** Input
+     !!
+     !! ** Action
+     !!
+     !! History
+     !!---------------------------------------------------------------------
+     !! * arguments
+
+     !! * Local declarations
+     INTEGER             :: jsec ,&!loop on sections 
+                            jseg   !loop on segments
+     INTEGER             :: i1, i2 !temporary integers
+     LOGICAL             :: llok   !
+     CHARACTER(len=40)   :: clname !
+     TYPE(POINT_SECTION) :: point  !coordinates of a point
+
+     !!---------------------------------------------------------------------
+
+     PRINT*,'              '
+     PRINT*,'WRITE SECTIONS'
+     PRINT*,'--------------'
+
+     !open output file
+     llok=.FALSE.
+     clname='section_ijglobal.diadct'
+     CALL file_open(numdctout,clname,llok,cdform="UNFORMATTED",cdstatus="REPLACE",cdaction="WRITE")
+
+     !print informations
+     IF ( llok ) THEN
+          PRINT*,TRIM(clname),' open. '
+
+          DO jsec=1,nb_sec
+  
+             WRITE(numdctout)jsec
+             WRITE(numdctout)secs(jsec)%name
+             WRITE(numdctout)secs(jsec)%llstrpond
+             WRITE(numdctout)secs(jsec)%ll_ice_section
+             WRITE(numdctout)secs(jsec)%ll_date_line
+             WRITE(numdctout)secs(jsec)%coordSec
+             WRITE(numdctout)secs(jsec)%nb_class
+             WRITE(numdctout)secs(jsec)%zsigi
+             WRITE(numdctout)secs(jsec)%zsigp
+             WRITE(numdctout)secs(jsec)%zsal
+             WRITE(numdctout)secs(jsec)%ztem
+             WRITE(numdctout)secs(jsec)%zlay
+             WRITE(numdctout)secs(jsec)%slopeSection
+             WRITE(numdctout)secs(jsec)%nb_point
+             IF( secs(jsec)%nb_point .NE. 0 )THEN
+                DO jseg=1,secs(jsec)%nb_point
+                   i1 = secs(jsec)%listPoint(jseg)%I  ; i2 = secs(jsec)%listPoint(jseg)%J
+                   WRITE(numdctout)i1,i2
+                ENDDO
+                WRITE(numdctout)secs(jsec)%direction(1:secs(jsec)%nb_point)
+             ENDIF
+
+          ENDDO !end of loop on sections
+         
+          CLOSE(numdctout) !Close file
+     ENDIF
+
+  END SUBROUTINE  write_sections
+
+END MODULE writesections 
Index: trunk/NEMOGCM/TOOLS/maketools
===================================================================
--- trunk/NEMOGCM/TOOLS/maketools	(revision 2734)
+++ trunk/NEMOGCM/TOOLS/maketools	(revision 3294)
@@ -84,4 +84,5 @@
 #-
 #- Choice of the options ---
+x_h="";
 x_n="";
 x_m="";
@@ -92,7 +93,9 @@
   do
 	 case $V in
-		(h)  echo "Usage	 : "${b_n} \
+		(h)  x_h=${OPTARG};
+                          echo "Usage	 : "${b_n} \
 					 " [-h] [-n name] [-m arch] [-j No] [-t tmpdir]";
 			  echo " -h	 : help";
+                          echo " -h institute : specific help for consortium members";
 			  echo " -n name : tool name, [-n help] to list existing tools";
 			  echo " -m arch : choose compiler, [-m help] to list exiting compilers";
@@ -105,5 +108,5 @@
                           printf "%s\n" "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools`;
 			  echo "";
-                          . ${COMPIL_DIR}/Flist_archfile.sh  ;
+                          . ${COMPIL_DIR}/Flist_archfile.sh  ${x_h};
 			  echo "";
 			  echo "Default : previous tool and compiler";
@@ -140,5 +143,5 @@
 #- Check if the tool or the compiler exist or list it
 [ "${NEW_CONF}" == help ] && printf "%s\n"  "Available tools :" `ls ${TOOLS_DIR}|grep -v COMPILE | grep -v maketools` && exit
-[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh && exit
+[ "${CMP_NAM}" ==  help ] && . ${COMPIL_DIR}/Flist_archfile.sh all && exit
 
 #- When used for the first time, choose a compiler ---
