Changeset 1991 for vendors

Timestamp:

2010-07-08T15:39:26+02:00 (14 years ago)

Author:

smasson

Message:

Load working_directory into vendors/IOIPSL/current.

Location:

vendors/IOIPSL/current

Files:

• example/testflio.f90 (modified) (2 diffs)
• example/testhist1.f90 (modified) (2 diffs)
• example/testhist2.f90 (modified) (3 diffs)
• example/testopp.f90 (modified) (2 diffs)
• src/calendar.f90 (modified) (2 diffs)
• src/errioipsl.f90 (modified) (2 diffs)
• src/fliocom.f90 (modified) (22 diffs)
• src/getincom.f90 (modified) (13 diffs)
• src/histcom.f90 (modified) (88 diffs)
• src/mathelp.f90 (modified) (12 diffs)
• src/stringop.f90 (modified) (2 diffs)
• tools/flio_rbld.f90 (modified) (2 diffs)
• tools/rebuild (modified) (3 diffs, 1 prop)

vendors/IOIPSL/current/example/testflio.f90

@@ -1 +1 @@
 PROGRAM testflio
 !-
-!$Id: testflio.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: testflio.f90 887 2010-02-08 09:48:39Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -106 +106 @@
   CALL fliodefv (fid,'my_var_1',(/ 5 /), &
  &               v_t=flio_r4,units='1',long_name='my_var_1', &
- &               valid_min=-10.,valid_max=+20.)
+ &               valid_min=-10.,valid_max=+20.,fillvalue=+50.)
   CALL fliodefv (fid,'Var_vr4', &
  &               v_t=flio_r4,units='1',long_name='Var_vr4')

vendors/IOIPSL/current/example/testhist1.f90

@@ -1 +1 @@
 PROGRAM testhist1
 !-
-!$Id: testhist1.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: testhist1.f90 807 2009-11-23 12:11:55Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -72 +72 @@
   CALL histdef (id,"champ1","Some field","m", &
  &       iim,jjm,hori_id,1,1,1,-99,32,"inst(scatter(x))", &
- &       dt_op,dt_wrt,var_range=(/1.,-1./))
+ &       dt_op,dt_wrt,var_range=(/1.,-1./),standard_name='thickness')
 !-
   CALL histdef (id,"champ2","Another field","m", &
  &       iim,jjm,hori_id,llm,1,llm,sig_id,32,"t_max(max(x,1.0)*2)", &
- &       deltat,dt_wrt,var_range=(/0.,90./))
+ &       deltat,dt_wrt,var_range=(/0.,90./),standard_name='thickness')
 !-
   CALL histdef (id,"champ3","A field without time","m", &
  &       iim,jjm,hori_id,1,1,1,-99, 32,"once", &
- &       deltat,dt_wrt)
+ &       deltat,dt_wrt,standard_name='thickness')
 !-
   CALL histend (id)

vendors/IOIPSL/current/example/testhist2.f90

@@ -1 +1 @@
 PROGRAM testhist2
 !-
-!$Id: testhist2.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: testhist2.f90 807 2009-11-23 12:11:55Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -76 +76 @@
   CALL histvert (id,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
 !-
-  CALL histdef (id,"champ1","Some field","m", &
- &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
+  CALL histdef (id,"champ1","Some field","m",iim,jjm,hori_id, &
+ &  1,1,1,-99,32,"t_sum",dt_op,dt_wrt,standard_name='thickness')
 !-
-  CALL histdef (id,"champ2","summed field","m", &
- &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op,dt_wrt)
+  CALL histdef (id,"champ2","summed field","m",iim,jjm,hori_id, &
+ &  1,1,1,-99,32,"t_sum",dt_op,dt_wrt,standard_name='thickness')
 !-
   CALL histend (id)
@@ -92 +92 @@
   CALL histvert (id2,"sigma","Sigma levels"," ",llm,lev,sig_id,pdirect="up")
 !-
-  CALL histdef (id2,"champ1","Some field","m", &
- &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
+  CALL histdef (id2,"champ1","Some field","m",iim,jjm,hori_id, &
+ &  1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2,standard_name='thickness')
 !-
-  CALL histdef (id2,"champ2","summed field","m", &
- &       iim,jjm,hori_id,1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2)
+  CALL histdef (id2,"champ2","summed field","m",iim,jjm,hori_id, &
+ &  1,1,1,-99,32,"t_sum",dt_op2,dt_wrt2,standard_name='thickness')
 !-
   CALL histend (id2)

vendors/IOIPSL/current/example/testopp.f90

@@ -1 +1 @@
 PROGRAM testopp
 !-
-!$Id: testopp.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: testopp.f90 846 2009-12-10 16:26:58Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -34 +34 @@
      WRITE(*,*) ' '
      WRITE(*,*) 'String to be analyzed : ',TRIM(opp)
-     CALL buildop (opp,ex_topps,tmp_topp,nbopp_max,missing_val, &
-    &              tmp_sopp,tmp_scal,nbopp)
+     CALL buildop (TRIM(opp),ex_topps,tmp_topp,missing_val, &
+ &                 tmp_sopp,tmp_scal,nbopp)
 !-
-     WRITE(*,*) 'Time operation : ',TRIM(tmp_topp)
-     WRITE(*,*) 'Other operations  :', nbopp
+     WRITE(*,*) 'Time operation   : ',TRIM(tmp_topp)
+     WRITE(*,*) 'Other operations : ',nbopp
      DO i=1,nbopp
-       WRITE(*,*) 'i = ',i,' opp : ',tmp_sopp(i), &
-      &           ' scalar : ',tmp_scal(i)
+       WRITE(*,*) ' ',i,' opp : ',tmp_sopp(i),' scalar : ',tmp_scal(i)
      ENDDO
    ENDDO

vendors/IOIPSL/current/src/calendar.f90

@@ -1 +1 @@
 MODULE calendar
 !-
-!$Id: calendar.f90 693 2009-07-29 15:49:31Z bellier $
+!$Id: calendar.f90 1011 2010-05-07 13:05:34Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -511 +511 @@
 !- action is smaller than the one from the next expected
 !- check to the next action.
-!- When the test is done on the time steps simplifactions make
+!- When the test is done on the time steps simplifications make
 !- it more difficult to read in the code.
 !- For the real time case it is easier to understand !

vendors/IOIPSL/current/src/errioipsl.f90

@@ -1 +1 @@
 MODULE errioipsl
 !-
-!$Id: errioipsl.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: errioipsl.f90 759 2009-10-22 08:53:27Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -80 +80 @@
    ENDIF
    IF ( (plev == 3).AND.lact_mode) THEN
-     STOP 'Fatal error from IOIPSL. See stdout for more details'
+     WRITE(n_l,'("Fatal error from IOIPSL. STOP in ipslerr with code")')
+     STOP 1
    ENDIF
 !---------------------

vendors/IOIPSL/current/src/fliocom.f90

@@ -1 +1 @@
 MODULE fliocom
 !-
-!$Id: fliocom.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: fliocom.f90 965 2010-04-07 08:38:54Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -12 +12 @@
  &                    ioconf_calendar,ju2ymds,ymds2ju
 USE errioipsl, ONLY : ipslerr,ipsldbg
-USE stringop,  ONLY : strlowercase
+USE stringop,  ONLY : strlowercase,str_xfw
 !-
 IMPLICIT NONE
@@ -86 +86 @@
 !!              This argument can be equal to FLIO_DOM_DEFAULT
 !!              (see "flio_dom_defset").
-!! (C) mode   : Mode used to create the file.
-!!              Supported modes : REPLACE, REP, 32, 64, REP32, REP64.
-!!              If this argument is present with the value "REP[32/64]"
-!!              or the value "REPLACE", the file will be created
-!!              in mode "CLOBBER", else the file will be created
-!!              in mode "NOCLOBBER".
+!! (C) mode   : String of (case insensitive) blank-separated words
+!!              defining the mode used to create the file.
+!!              Supported keywords : REPLACE, 32, 64
+!!              If this argument is present with the keyword "REPLACE",
+!!              the file will be created in mode "CLOBBER",
+!!              else the file will be created in mode "NOCLOBBER".
 !!              "32/64" defines the offset mode.
-!!              The default offset mode is 32 bits.
+!!              The default offset mode is 64 bits.
+!!              Keywords "NETCDF4" and "CLASSIC" are reserved
+!!              for future use.
 !!
 !! Optional OUTPUT arguments
@@ -205 +207 @@
 !! SUBROUTINE fliodefv &
 !! & (f_i,v_n,[v_d],v_t, &
-!! &  axis,standard_name,long_name,units,valid_min,valid_max)
+!! &  axis,standard_name,long_name,units, &
+!! &  valid_min,valid_max,fillvalue)
 !!
 !! INPUT
@@ -227 +230 @@
 !! (C) axis,standard_name,long_name,units : Attributes
 !!     (axis should be used only for coordinates)
-!! (R) valid_min,valid_max : Attributes
+!! (R) valid_min,valid_max,fillvalue : Attributes
 !!--------------------------------------------------------------------
   MODULE PROCEDURE &
@@ -805 +808 @@
 !-
 ! Maximum number of simultaneously defined domains
-  INTEGER,PARAMETER :: dom_max_nb=10
+  INTEGER,PARAMETER :: dom_max_nb=64
 !-
 ! Maximum number of distributed dimensions for each domain
@@ -848 +851 @@
   INTEGER :: i_rc,f_e,idid,ii,m_c,n_u
   CHARACTER(LEN=NF90_MAX_NAME) :: f_nw
+  INTEGER,PARAMETER :: l_string=80,l_word=10
+  CHARACTER(LEN=l_string) :: c_string
+  CHARACTER(LEN=l_word)   :: c_word
+  LOGICAL :: l_ok
+  INTEGER,PARAMETER :: k_replace=1
+  INTEGER,PARAMETER :: k_32=1,k_64=2
+!- !? : Code to be activated for NETCDF4
+!?  INTEGER,PARAMETER :: k_netcdf4=1,k_classic=1
+  INTEGER,PARAMETER :: n_opt=4
+  INTEGER,DIMENSION(n_opt) :: i_opt
 !-
   LOGICAL :: l_dbg
@@ -881 +894 @@
 !-
 ! Check the mode
+!-
+  i_opt(:)=-1
+!-
   IF (PRESENT(mode)) THEN
-    SELECT CASE (TRIM(mode))
-    CASE('REPLACE','REP','REP32')
-      m_c = NF90_CLOBBER
-    CASE('32')
-      m_c = NF90_NOCLOBBER
-    CASE('64')
-      m_c = IOR(NF90_NOCLOBBER,NF90_64BIT_OFFSET)
-    CASE('REP64')
-      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
-    CASE DEFAULT
-      m_c = NF90_NOCLOBBER
-    END SELECT
+!---
+    IF (LEN_TRIM(mode) > l_string) THEN
+      CALL ipslerr (3,'fliocrfd', &
+ &     '"mode" argument','too long','to be treated')
+    ENDIF
+    c_string = mode(:)
+    CALL strlowercase (c_string)
+!---
+    DO
+      CALL str_xfw  (c_string,c_word,l_ok)
+      IF (l_ok) THEN
+!- !? : Code to be activated for NETCDF4
+        SELECT CASE (TRIM(c_word))
+        CASE('replace')
+          IF (i_opt(1) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Replace option','already','defined')
+          ELSE
+            i_opt(1) = k_replace
+          ENDIF
+!?      CASE('netcdf4')
+!?        IF (i_opt(2) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 format','already','defined')
+!?        ELSE
+!?          i_opt(2) = k_netcdf4
+!?        ENDIF
+        CASE('32')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_32
+          ENDIF
+        CASE('64')
+          IF (i_opt(3) > 0) THEN
+            CALL ipslerr (3,'fliocrfd', &
+ &           'Offset format','already','defined')
+          ELSE
+            i_opt(3) = k_64
+          ENDIF
+!?      CASE('CLASSIC')
+!?        IF (i_opt(4) > 0) THEN
+!?          CALL ipslerr (3,'fliocrfd', &
+!? &         'Netcdf4 classic format','already','defined')
+!?        ELSE
+!?          i_opt(4) = k_classic
+!?        ENDIF
+        CASE DEFAULT
+          CALL ipslerr (3,'fliocrfd', &
+ &         'Option '//TRIM(c_word),'not','supported')
+        END SELECT
+      ELSE
+        EXIT
+      ENDIF
+    ENDDO
+  ENDIF
+!-
+  IF (i_opt(1) == k_replace) THEN
+    m_c = NF90_CLOBBER
   ELSE
     m_c = NF90_NOCLOBBER
   ENDIF
+!-
+!- Code to be replaced by the following for NETCDF4
+!?  IF (i_opt(2) == k_netcdf4) THEN
+!?    m_c = IOR(m_c,NF90_NETCDF4)
+!?    IF (i_opt(3) > 0) THEN
+!?      CALL ipslerr (3,'fliocrfd', &
+!? &     'Netcdf4 format','and offset option','are not compatible')
+!?    ELSE IF (i_opt(4) == k_classic) THEN
+!?      m_c = IOR(m_c,NF90_CLASSIC_MODEL)
+!?    ENDIF
+!?   LSE IF (i_opt(4) > 0) THEN
+!?    CALL ipslerr (3,'fliocrfd', &
+!? &   'Classic option','is reserved','for the Netcdf4 format')
+!?  ELSE
+    IF (i_opt(3) /= k_32) THEN
+      m_c = IOR(m_c,NF90_64BIT_OFFSET)
+    ENDIF
+!?  ENDIF
 !-
 ! Create file (and enter the definition mode)
@@ -1229 +1311 @@
 ! Ensuring data mode
 !-
-    CALL flio_hdm (f_i,f_e,.FALSE.)
+  CALL flio_hdm (f_i,f_e,.FALSE.)
 !-
 ! Create the longitude axis
@@ -1287 +1369 @@
 SUBROUTINE fliodv_r0d &
  & (f_i,v_n,v_t, &
- &  axis,standard_name,long_name,units,valid_min,valid_max)
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -1296 +1378 @@
   CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
  & axis,standard_name,long_name,units
-  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
 !---------------------------------------------------------------------
   CALL flio_udv &
  &  (f_i,0,v_n,(/0/),v_t, &
- &   axis,standard_name,long_name,units,valid_min,valid_max)
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
 !------------------------
 END SUBROUTINE fliodv_r0d
@@ -1306 +1388 @@
 SUBROUTINE fliodv_rnd &
  & (f_i,v_n,v_d,v_t, &
- &  axis,standard_name,long_name,units,valid_min,valid_max)
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -1316 +1398 @@
   CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
  & axis,standard_name,long_name,units
-  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
 !---------------------------------------------------------------------
   CALL flio_udv &
  &  (f_i,SIZE(v_d),v_n,v_d,v_t, &
- &   axis,standard_name,long_name,units,valid_min,valid_max)
+ &   axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
 !------------------------
 END SUBROUTINE fliodv_rnd
@@ -1326 +1408 @@
 SUBROUTINE flio_udv &
  & (f_i,n_d,v_n,v_d,v_t, &
- &  axis,standard_name,long_name,units,valid_min,valid_max)
+ &  axis,standard_name,long_name,units,valid_min,valid_max,fillvalue)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -1336 +1418 @@
   CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: &
  & axis,standard_name,long_name,units
-  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max
+  REAL,OPTIONAL,INTENT(IN) :: valid_min,valid_max,fillvalue
 !-
   INTEGER :: f_e,m_k,i_v,i_rc,ii,idd
@@ -1380 +1462 @@
 !---
     IF (PRESENT(v_t)) THEN
-      IF      (v_t == flio_i) THEN
+      SELECT CASE (v_t)
+      CASE(flio_i)
         IF (i_std == i_8) THEN
-!-------- Not yet supported by NETCDF
+!-------- I8 not yet supported by NETCDF
 !-------- m_k = flio_i8
           m_k = flio_i4
@@ -1388 +1471 @@
           m_k = flio_i4
         ENDIF
-      ELSE IF (v_t == flio_r) THEN
+      CASE(flio_r)
         IF (r_std == r_8) THEN
           m_k = flio_r8
@@ -1394 +1477 @@
           m_k = flio_r4
         ENDIF
-      ELSE
+      CASE(flio_c,flio_i1,flio_i2,flio_i4,flio_r4,flio_r8)
         m_k = v_t
-      ENDIF
+      CASE DEFAULT
+        CALL ipslerr (3,'fliodefv', &
+ &        'Variable '//TRIM(v_n),'External type','not supported')
+      END SELECT
     ELSE IF (r_std == r_8) THEN
       m_k = flio_r8
@@ -1402 +1488 @@
       m_k = flio_r4
     ENDIF
+!---
     IF (n_d > 0) THEN
       i_rc = NF90_DEF_VAR(f_e,v_n,m_k,a_i(1:n_d),i_v)
@@ -1427 +1514 @@
     ENDIF
     IF (PRESENT(valid_min)) THEN
-      i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',valid_min)
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',NINT(valid_min,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_min',REAL(valid_min,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_min', &
+   &      'not supported for this external type')
+      END SELECT
     ENDIF
     IF (PRESENT(valid_max)) THEN
-      i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',valid_max)
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',NINT(valid_max,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'valid_max',REAL(valid_max,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute valid_max', &
+   &      'not supported for this external type')
+      END SELECT
+    ENDIF
+    IF (PRESENT(fillvalue)) THEN
+      SELECT CASE (m_k)
+      CASE(flio_i1,flio_i2)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_2))
+      CASE(flio_i4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',NINT(fillvalue,KIND=i_4))
+      CASE(flio_r4)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_4))
+      CASE(flio_r8)
+        i_rc = NF90_PUT_ATT(f_e,i_v,'_FillValue',REAL(fillvalue,KIND=r_8))
+      CASE DEFAULT
+        CALL ipslerr (2,'fliodefv', &
+   &      'Variable '//TRIM(v_n),'attribute fillvalue', &
+   &      'not supported for this external type')
+      END SELECT
     ENDIF
 !---
@@ -2177 +2306 @@
 !-
   IF (PRESENT(mode)) THEN
-    IF (TRIM(MODE) == "WRITE") THEN
+    IF (TRIM(mode) == "WRITE") THEN
       m_c = NF90_WRITE
     ELSE
@@ -4893 +5022 @@
   INTEGER :: kv,k,n_r,l_d,n_d,i_rc,dimnb
   CHARACTER(LEN=1)  :: c_ax
-  CHARACTER(LEN=9)  :: c_sn
+  CHARACTER(LEN=18) :: c_sn
   CHARACTER(LEN=15),DIMENSION(10) :: c_r
   CHARACTER(LEN=40) :: c_t1,c_t2

vendors/IOIPSL/current/src/getincom.f90

@@ -1 +1 @@
 MODULE getincom
 !-
-!$Id: getincom.f90 536 2009-01-30 11:46:27Z bellier $
+!$Id: getincom.f90 963 2010-03-31 15:26:11Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -13 +13 @@
 !-
 PRIVATE
-PUBLIC :: getin, getin_dump
+PUBLIC :: getin_name, getin, getin_dump
+!-
+!!--------------------------------------------------------------------
+!! The "getin_name" routine allows the user to change the name
+!! of the definition file in which the data will be read.
+!! ("run.def" by default)
+!!
+!!  SUBROUTINE getin_name (file_name)
+!!
+!! OPTIONAL INPUT argument
+!!
+!! (C) file_name :  the name of the file
+!!                  in which the data will be read
+!!--------------------------------------------------------------------
+!-
 !-
 INTERFACE getin
@@ -19 +33 @@
 !! The "getin" routines get a variable.
 !! We first check if we find it in the database
-!! and if not we get it from the run.def file.
+!! and if not we get it from the definition file.
 !!
 !! SUBROUTINE getin (target,ret_val)
@@ -41 +55 @@
 !!--------------------------------------------------------------------
 !! The "getin_dump" routine will dump the content of the database
-!! into a file which has the same format as the run.def file.
+!! into a file which has the same format as the definition file.
 !! The idea is that the user can see which parameters were used
 !! and re-use the file for another run.
@@ -57 +71 @@
   INTEGER,SAVE      :: nbfiles
 !-
+  INTEGER,SAVE :: allread=0
+  CHARACTER(LEN=100),SAVE :: def_file = 'run.def'
+!-
   INTEGER,PARAMETER :: i_txtslab=1000,l_n=30
   INTEGER,SAVE :: nb_lines,i_txtsize=0
@@ -78 +95 @@
 !-
 ! keystatus definition
-! keystatus = 1 : Value comes from run.def
+! keystatus = 1 : Value comes from the file defined by 'def_file'
 ! keystatus = 2 : Default value is used
 ! keystatus = 3 : Some vector elements were taken from default
@@ -112 +129 @@
 !-
 CONTAINS
+!-
+!=== DEFINITION FILE NAME INTERFACE
+!-
+SUBROUTINE getin_name (cname)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*) :: cname
+!---------------------------------------------------------------------
+  IF (allread == 0) THEN
+    def_file = ADJUSTL(cname)
+  ELSE
+    CALL ipslerr (3,'getin_name', &
+ &   'The name of the database file (any_name.def)', &
+ &   'must be changed *before* any attempt','to read the database.')
+  ENDIF
+!------------------------
+END SUBROUTINE getin_name
 !-
 !=== INTEGER INTERFACE
@@ -1008 +1043 @@
   IMPLICIT NONE
 !-
-  INTEGER,SAVE :: allread=0
   INTEGER,SAVE :: current
 !---------------------------------------------------------------------
@@ -1021 +1055 @@
 !-- Start with reading the files
     nbfiles = 1
-    filelist(1) = 'run.def'
+    filelist(1) = TRIM(def_file)
     current = 1
 !--
@@ -1146 +1180 @@
 !-
   IF (check) THEN
-    OPEN (UNIT=22,file='run.def.test')
+    OPEN (UNIT=22,file=TRIM(def_file)//'.test')
     DO i=1,nb_lines
       WRITE(UNIT=22,FMT=*) targetlist(i)," : ",fichier(i)
@@ -1416 +1450 @@
 !-
   TYPE(t_key),ALLOCATABLE,DIMENSION(:) :: tmp_key_tab
-  CHARACTER(LEN=100),ALLOCATABLE :: tmp_str(:)
 !-
   INTEGER :: ier
@@ -1787 +1820 @@
         CASE(1)
           WRITE(22,*) '# Values of ', &
- &          TRIM(key_tab(ikey)%keystr),' comes from the run.def.'
+ &          TRIM(key_tab(ikey)%keystr),' comes from ',TRIM(def_file)
         CASE(2)
           WRITE(22,*) '# Values of ', &
@@ -1794 +1827 @@
           WRITE(22,*) '# Values of ', &
  &          TRIM(key_tab(ikey)%keystr), &
- &          ' are a mix of run.def and defaults.'
+ &          ' are a mix of ',TRIM(def_file),' and defaults.'
         CASE DEFAULT
           WRITE(22,*) '# Dont know from where the value of ', &

vendors/IOIPSL/current/src/histcom.f90

@@ -1 +1 @@
 MODULE histcom
 !-
-!$Id: histcom.f90 740 2009-09-17 08:26:28Z bellier $
+!$Id: histcom.f90 1028 2010-05-20 15:17:30Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -35 +35 @@
 !- to describe the grid, just two vectors.
 !---------------------------------------------------------------------
+!-
+  INTERFACE histbeg
+    MODULE PROCEDURE histb_reg1d,histb_reg2d,histb_irreg
+  END INTERFACE
+!-
+  INTERFACE histhori
+    MODULE PROCEDURE histh_reg1d,histh_reg2d,histh_irreg
+  END INTERFACE
+!-
   INTERFACE histwrite
 !---------------------------------------------------------------------
@@ -46 +55 @@
 !-
 !- INPUT
-!- pfileid  : The ID of the file on which this variable is to be,
+!- idf      : The ID of the file on which this variable is to be,
 !-            written. The variable should have been defined in
 !-            this file before.
@@ -63 +72 @@
   END INTERFACE
 !-
-  INTERFACE histbeg
-    MODULE PROCEDURE histbeg_totreg,histbeg_regular,histbeg_irregular
-  END INTERFACE
-!-
-  INTERFACE histhori
-    MODULE PROCEDURE histhori_regular,histhori_irregular
-  END INTERFACE
-!-
 ! Fixed parameter
 !-
@@ -76 +77 @@
  &                     nb_hax_max=5,nb_zax_max=10,nbopp_max=10
   REAL,PARAMETER :: missing_val=nf90_fill_real
-!-
-  INTEGER :: bufftmp_max(nb_files_max) = 1
-!-
-! Time variables
-!-
-  INTEGER,SAVE :: itau0(nb_files_max)=0
-  REAL,DIMENSION(nb_files_max),SAVE ::date0,deltat
-!-
-! Counter of elements
-!-
-  INTEGER,SAVE :: nb_files=0
-  INTEGER,DIMENSION(nb_files_max),SAVE :: nb_var=0,nb_tax=0
-!-
-! DOMAIN IDs for files
-!-
-  INTEGER,DIMENSION(nb_files_max),SAVE :: dom_id_svg=-1
-!-
-! NETCDF IDs for files and axes
-!-
-  INTEGER,DIMENSION(nb_files_max),SAVE :: ncdf_ids,xid,yid,tid
-!-
-! General definitions in the NETCDF file
-!-
-  INTEGER,DIMENSION(nb_files_max,2),SAVE :: &
- &   full_size=0,slab_ori,slab_sz
-!-
-! The horizontal axes
-!-
-  INTEGER,SAVE :: nb_hax(nb_files_max)=0
-  CHARACTER(LEN=25),SAVE :: hax_name(nb_files_max,nb_hax_max,2)
-!-
-! The vertical axes
-!-
-  INTEGER,SAVE :: nb_zax(nb_files_max)=0
-  INTEGER,DIMENSION(nb_files_max,nb_zax_max),SAVE :: &
-  &  zax_size,zax_ids
-  CHARACTER(LEN=20),SAVE :: zax_name(nb_files_max,nb_zax_max)
-!-
-! Informations on each variable
-!-
-  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  nbopp
-  CHARACTER(LEN=20),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  name,unit_name
-  CHARACTER(LEN=80),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  title,fullop
-  CHARACTER(LEN=7),SAVE :: topp(nb_files_max,nb_var_max)
-  CHARACTER(LEN=7),SAVE :: sopps(nb_files_max,nb_var_max,nbopp_max)
-  REAL,SAVE :: scal(nb_files_max,nb_var_max,nbopp_max)
-!- Sizes of the associated grid and zommed area
-  INTEGER,DIMENSION(nb_files_max,nb_var_max,3),SAVE :: &
- &   scsize,zorig,zsize
-!- Sizes for the data as it goes through the various math operations
-  INTEGER,SAVE :: datasz_in(nb_files_max,nb_var_max,3) = -1
-  INTEGER,SAVE :: datasz_max(nb_files_max,nb_var_max) = -1
-!-
-  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  var_haxid,var_zaxid,var_axid,ncvar_ids
-!-
-  REAL,DIMENSION(nb_files_max,nb_var_max,2),SAVE :: hist_minmax
-  LOGICAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
-!-
-  REAL,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  freq_opp,freq_wrt
-  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt,point
-!-
-! Book keeping for the buffers
-!-
-  INTEGER,SAVE :: buff_pos=0
-  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buffer
-  LOGICAL,DIMENSION(nb_files_max),SAVE :: zoom=.FALSE.,regular=.TRUE.
-!-
-! Book keeping of the axes
-!-
-  INTEGER,DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  tdimid,tax_last
-  CHARACTER(LEN=40),DIMENSION(nb_files_max,nb_var_max),SAVE :: &
- &  tax_name
+  INTEGER,PARAMETER,PUBLIC :: &
+ &  hist_r4=nf90_real4, hist_r8=nf90_real8
+!-
+! Variable derived type
+!-
+TYPE T_D_V
+  INTEGER :: ncvid
+  INTEGER :: nbopp
+  CHARACTER(LEN=20)  :: v_name,unit_name
+  CHARACTER(LEN=256) :: title,std_name
+  CHARACTER(LEN=80)  :: fullop
+  CHARACTER(LEN=7)   :: topp
+  CHARACTER(LEN=7),DIMENSION(nbopp_max) :: sopp
+  REAL,DIMENSION(nbopp_max) :: scal
+!-External type (for R4/R8)
+  INTEGER :: v_typ
+!-Sizes of the associated grid and zommed area
+  INTEGER,DIMENSION(3) :: scsize,zorig,zsize
+!-Sizes for the data as it goes through the various math operations
+  INTEGER,DIMENSION(3) :: datasz_in = -1
+  INTEGER :: datasz_max = -1
+!-
+  INTEGER :: h_axid,z_axid,t_axid
+!-
+  REAL,DIMENSION(2) :: hist_minmax
+  LOGICAL :: hist_calc_rng=.FALSE.,hist_wrt_rng=.FALSE.
+!-Book keeping of the axes
+  INTEGER :: tdimid,tbndid=-1,tax_last
+  LOGICAL :: l_bnd
+  CHARACTER(LEN=40) :: tax_name
+!-
+  REAL :: freq_opp,freq_wrt
+  INTEGER :: &
+ &  last_opp,last_wrt,last_opp_chk,last_wrt_chk,nb_opp,nb_wrt
+!- For future optimization
+  REAL,POINTER,DIMENSION(:) :: t_bf
+!#  REAL,ALLOCATABLE,DIMENSION(:) :: V_1_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:) :: V_2_D
+!#  REAL,ALLOCATABLE,DIMENSION(:,:,:) :: V_3_D
+END TYPE T_D_V
+!-
+! File derived type
+!-
+TYPE :: T_D_F
+!-NETCDF IDs for file
+  INTEGER :: ncfid=-1
+!-Time variables
+  INTEGER :: itau0=0
+  REAL :: date0,deltat
+!-Counter of elements (variables, time-horizontal-vertical axis
+  INTEGER :: n_var=0,n_tax=0,n_hax=0,n_zax=0
+!-NETCDF dimension IDs for time-[time_bounds]-longitude-latitude
+  INTEGER :: tid,bid,xid,yid
+!-General definitions in the NETCDF file
+  INTEGER,DIMENSION(2) :: full_size=0,slab_ori,slab_siz
+!-The horizontal axes
+  CHARACTER(LEN=25),DIMENSION(nb_hax_max,2) :: hax_name
+!-The vertical axes
+  INTEGER,DIMENSION(nb_zax_max) :: zax_size,zax_ids
+  CHARACTER(LEN=20),DIMENSION(nb_zax_max) :: zax_name
+!-
+  LOGICAL :: regular=.TRUE.
+!-DOMAIN ID
+  INTEGER :: dom_id_svg=-1
+!-
+  TYPE(T_D_V),DIMENSION(nb_var_max) :: W_V
+END TYPE T_D_F
+!-
+TYPE(T_D_F),DIMENSION(nb_files_max),SAVE :: W_F
 !-
 ! A list of functions which require special action
@@ -161 +151 @@
 !  but they are well located here)
 !-
-  CHARACTER(LEN=120),SAVE :: &
- &  indchfun = 'scatter, fill, gather, coll', &
- &  fuchnbout = 'scatter, fill'
+  CHARACTER(LEN=30),SAVE :: fuchnbout = 'scatter, fill'
 !- Some configurable variables with locks
   CHARACTER(LEN=80),SAVE :: model_name='An IPSL model'
@@ -172 +160 @@
 !===
 !-
-SUBROUTINE histbeg_totreg                 &
- & (pfilename,pim,plon,pjm,plat,          &
- &  par_orix,par_szx,par_oriy,par_szy,    &
- &  pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id)
-!---------------------------------------------------------------------
-!- This is just an interface for histbeg_regular in case when
-!- the user provides plon and plat as vectors.
-!- Obviously this can only be used for very regular grids.
-!-
-!- INPUT
-!-
-!- pfilename : Name of the netcdf file to be created
-!- pim       : Size of arrays in longitude direction
-!- plon      : Coordinates of points in longitude
-!- pjm       : Size of arrays in latitude direction
-!- plat      : Coordinates of points in latitude
-!-
-!- The next 4 arguments allow to define a horizontal zoom
-!- for this file. It is assumed that all variables to come
-!- have the same index space. This can not be assumed for
-!- the z axis and thus we define the zoom in histdef.
-!-
-!- par_orix  : Origin of the slab of data within the X axis (pim)
-!- par_szx   : Size of the slab of data in X
-!- par_oriy  : Origin of the slab of data within the Y axis (pjm)
-!- par_szy   : Size of the slab of data in Y
-!-
-!- pitau0    : time step at which the history tape starts
-!- pdate0    : The Julian date at which the itau was equal to 0
-!- pdeltat   : Time step in seconds. Time step of the counter itau
-!-             used in histwrite for instance
-!-
-!- OUTPUT
-!-
-!- phoriid   : ID of the horizontal grid
-!- pfileid   : ID of the netcdf file
-!-
-!- Optional INPUT arguments
-!-
-!- domain_id       : Domain identifier
-!-
-!- TO DO
-!-
-!- This package should be written in f90
-!- and use the following features :
-!-    - structures for the meta-data of the files and variables
-!-    - memory allocation as needed
-!-    - Pointers
-!-
-!- VERSION
-!-
+SUBROUTINE histb_reg1d                 &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode)
+!---------------------------------------------------------------------
+!- histbeg for 1D regular horizontal coordinates (see histb_all)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -233 +176 @@
   INTEGER,INTENT(IN) :: pitau0
   REAL,INTENT(IN) :: pdate0,pdeltat
-  INTEGER,INTENT(OUT) :: pfileid,phoriid
+  INTEGER,INTENT(OUT) :: idf,phoriid
   INTEGER,INTENT(IN),OPTIONAL :: domain_id
-!-
-  REAL,ALLOCATABLE,DIMENSION(:,:) :: lon_tmp,lat_tmp
-  LOGICAL :: l_dbg
-!---------------------------------------------------------------------
-  CALL ipsldbg (old_status=l_dbg)
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_totreg"
-!-
-  ALLOCATE(lon_tmp(pim,pjm),lat_tmp(pim,pjm))
-!-
-  lon_tmp(:,:) = SPREAD(plon(:),2,pjm)
-  lat_tmp(:,:) = SPREAD(plat(:),1,pim)
-!-
-  CALL histbeg_regular &
- &  (pfilename,pim,lon_tmp,pjm,lat_tmp, &
- &   par_orix,par_szx,par_oriy,par_szy, &
- &   pitau0,pdate0,pdeltat,phoriid,pfileid, &
- &   .TRUE.,domain_id)
-!-
-  DEALLOCATE(lon_tmp,lat_tmp)
-!----------------------------
-END SUBROUTINE histbeg_totreg
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (1,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d=plon,y_1d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy, &
+ &  domain_id=domain_id,mode=mode)
+!-------------------------
+END SUBROUTINE histb_reg1d
 !===
-SUBROUTINE histbeg_regular &
- & (pfilename,pim,plon,pjm,plat,           &
- &  par_orix,par_szx,par_oriy,par_szy,     &
- &  pitau0,pdate0,pdeltat,phoriid,pfileid, &
- &  opt_rectilinear,domain_id)
-!---------------------------------------------------------------------
-!- This subroutine initializes a netcdf file and returns the ID.
-!- It will set up the geographical space on which the data will be
-!- stored and offers the possibility of seting a zoom.
-!- It also gets the global parameters into the I/O subsystem.
-!-
-!- INPUT
-!-
-!- pfilename : Name of the netcdf file to be created
-!- pim       : Size of arrays in longitude direction
-!- plon      : Coordinates of points in longitude
-!- pjm       : Size of arrays in latitude direction
-!- plat      : Coordinates of points in latitude
-!-
-!- The next 4 arguments allow to define a horizontal zoom
-!- for this file. It is assumed that all variables to come
-!- have the same index space. This can not be assumed for
-!- the z axis and thus we define the zoom in histdef.
-!-
-!- par_orix  : Origin of the slab of data within the X axis (pim)
-!- par_szx   : Size of the slab of data in X
-!- par_oriy  : Origin of the slab of data within the Y axis (pjm)
-!- par_szy   : Size of the slab of data in Y
-!-
-!- pitau0    : time step at which the history tape starts
-!- pdate0    : The Julian date at which the itau was equal to 0
-!- pdeltat   : Time step in seconds. Time step of the counter itau
-!-             used in histwrite for instance
-!-
-!- OUTPUT
-!-
-!- phoriid   : ID of the horizontal grid
-!- pfileid   : ID of the netcdf file
-!-
-!- Optional INPUT arguments
-!-
-!- opt_rectilinear : If true we know the grid is rectilinear
-!- domain_id       : Domain identifier
-!-
-!- TO DO
-!-
-!- This package should be written in F90 and use the following
-!- feature :
-!-   - structures for the meta-data of the files and variables
-!-   - memory allocation as needed
-!-   - Pointers
-!-
-!- VERSION
-!-
+SUBROUTINE histb_reg2d &
+ & (pfilename,pim,plon,pjm,plat,       &
+ &  par_orix,par_szx,par_oriy,par_szy, &
+ &  pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode)
+!---------------------------------------------------------------------
+!- histbeg for 2D regular horizontal coordinates (see histb_all)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -321 +203 @@
   INTEGER,INTENT(IN) :: pitau0
   REAL,INTENT(IN) :: pdate0,pdeltat
-  INTEGER,INTENT(OUT) :: pfileid,phoriid
-  LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear
+  INTEGER,INTENT(OUT) :: idf,phoriid
   INTEGER,INTENT(IN),OPTIONAL :: domain_id
-!-
-  INTEGER :: ncid,iret
-  CHARACTER(LEN=120) :: file
-  CHARACTER(LEN=30) :: timenow
-  LOGICAL :: rectilinear
-  LOGICAL :: l_dbg
-!---------------------------------------------------------------------
-  CALL ipsldbg (old_status=l_dbg)
-!-
-  nb_files = nb_files+1
-  pfileid  = nb_files
-!-
-! 1.0 Transfering into the common for future use
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_regular 1.0"
-!-
-  itau0(pfileid) = pitau0
-  date0(pfileid) = pdate0
-  deltat(pfileid) = pdeltat
-!-
-  IF (PRESENT(opt_rectilinear)) THEN
-    rectilinear = opt_rectilinear
-  ELSE
-    rectilinear = .FALSE.
-  ENDIF
-!-
-! 2.0 Initializes all variables for this file
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_regular 2.0"
-!-
-  IF (nb_files > nb_files_max) THEN
-    CALL ipslerr (3,"histbeg", &
-   &  'Table of files too small. You should increase nb_files_max', &
-   &  'in histcom.f90 in order to accomodate all these files',' ')
-  ENDIF
-!-
-  nb_var(pfileid) = 0
-  nb_tax(pfileid) = 0
-  nb_hax(pfileid) = 0
-  nb_zax(pfileid) = 0
-!-
-  slab_ori(pfileid,1:2) = (/ par_orix,par_oriy /)
-  slab_sz(pfileid,1:2)  = (/ par_szx, par_szy  /)
-!-
-! 3.0 Opening netcdf file and defining dimensions
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_regular 3.0"
-!-
-! Add DOMAIN number and ".nc" suffix in file name if needed
-!-
-  file = pfilename
-  CALL flio_dom_file (file,domain_id)
-!-
-  iret = NF90_CREATE (file,NF90_CLOBBER,ncid)
-!-
-  IF (rectilinear) THEN
-    iret = NF90_DEF_DIM (ncid,'lon',par_szx,xid(nb_files))
-    iret = NF90_DEF_DIM (ncid,'lat',par_szy,yid(nb_files))
-  ELSE
-    iret = NF90_DEF_DIM (ncid,'x',par_szx,xid(nb_files))
-    iret = NF90_DEF_DIM (ncid,'y',par_szy,yid(nb_files))
-  ENDIF
-!-
-! 4.0 Declaring the geographical coordinates and other attributes
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_regular 4.0"
-!-
-! 4.3 Global attributes
-!-
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
-  lock_modname = .TRUE.
-  CALL ioget_timestamp (timenow)
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
-!-
-! 5.0 Saving some important information on this file in the common
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_regular 5.0"
-!-
-  IF (PRESENT(domain_id)) THEN
-    dom_id_svg(pfileid) = domain_id
-  ENDIF
-  ncdf_ids(pfileid) = ncid
-  full_size(pfileid,1:2) = (/ pim,pjm /)
-!-
-! 6.0 storing the geographical coordinates
-!-
-  zoom(pfileid) = (pim /= par_szx).OR.(pjm /= par_szy)
-  regular(pfileid)=.TRUE.
-!-
-  CALL histhori_regular (pfileid,pim,plon,pjm,plat, &
- &  ' ' ,'Default grid',phoriid,rectilinear)
-!-----------------------------
-END SUBROUTINE histbeg_regular
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (2,pfilename,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_2d=plon,y_2d=plat, &
+ &  k_orx=par_orix,k_szx=par_szx,k_ory=par_oriy,k_szy=par_szy,    &
+ &  domain_id=domain_id,mode=mode)
+!-------------------------
+END SUBROUTINE histb_reg2d
 !===
-SUBROUTINE histbeg_irregular &
- &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds,   &
- &   pitau0,pdate0,pdeltat,phoriid,pfileid,domain_id)
-!---------------------------------------------------------------------
-!- This subroutine initializes a netcdf file and returns the ID.
-!- This version is for totaly irregular grids. In this case all
-!- all the data comes in as vectors and for the grid we have
-!- the coordinates of the 4 corners.
-!- It also gets the global parameters into the I/O subsystem.
-!-
-!- INPUT
-!-
-!- pfilename   : Name of the netcdf file to be created
-!- pim         : Size of arrays in longitude direction
-!- plon        : Coordinates of points in longitude
-!- plon_bounds : The 2 corners of the grid in longitude
-!- plat        : Coordinates of points in latitude
-!- plat_bounds : The 2 corners of the grid in latitude
-!-
-!- pitau0    : time step at which the history tape starts
-!- pdate0    : The Julian date at which the itau was equal to 0
-!- pdeltat   : Time step in seconds. Time step of the counter itau
-!-             used in histwrite for instance
-!-
-!- OUTPUT
-!-
-!- phoriid   : ID of the horizontal grid
-!- pfileid   : ID of the netcdf file
-!-
-!- Optional INPUT arguments
-!-
-!- domain_id       : Domain identifier
-!-
-!- TO DO
-!-
-!- This package should be written in F90 and use the following
-!- feature :
-!-   - structures for the meta-data of the files and variables
-!-   - memory allocation as needed
-!-   - Pointers
-!-
-!- VERSION
-!-
+SUBROUTINE histb_irreg &
+ &  (pfilename,pim,plon,plon_bounds,plat,plat_bounds, &
+ &   pitau0,pdate0,pdeltat,phoriid,idf,domain_id,mode)
+!---------------------------------------------------------------------
+!- histbeg for irregular horizontal coordinates (see histb_all)
 !---------------------------------------------------------------------
   IMPLICIT NONE
@@ -472 +229 @@
   INTEGER,INTENT(IN) :: pitau0
   REAL,INTENT(IN) :: pdate0,pdeltat
-  INTEGER,INTENT(OUT) :: pfileid,phoriid
+  INTEGER,INTENT(OUT) :: idf,phoriid
   INTEGER,INTENT(IN),OPTIONAL :: domain_id
-!-
-  INTEGER :: ncid,iret
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+!---------------------------------------------------------------------
+  CALL histb_all &
+ & (3,pfilename,pim,pim,pitau0,pdate0,pdeltat,phoriid,idf,  &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds, &
+ &  domain_id=domain_id,mode=mode)
+!-------------------------
+END SUBROUTINE histb_irreg
+!===
+SUBROUTINE histb_all &
+ & (k_typ,nc_name,pim,pjm,pitau0,pdate0,pdeltat,phoriid,idf, &
+ &  x_1d,y_1d,x_2d,y_2d,k_orx,k_szx,k_ory,k_szy, &
+ &  x_bnds,y_bnds,domain_id,mode)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine initializes a netcdf file and returns the ID.
+!- It will set up the geographical space on which the data will be
+!- stored and offers the possibility of seting a zoom.
+!- In the case of irregular grids, all the data comes in as vectors
+!- and for the grid we have the coordinates of the 4 corners.
+!- It also gets the global parameters into the I/O subsystem.
+!-
+!- INPUT
+!-
+!- k_typ    : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- nc_name  : Name of the netcdf file to be created
+!- pim      : Size of arrays in longitude direction
+!- pjm      : Size of arrays in latitude direction (pjm=pim for type 3)
+!-
+!- pitau0   : time step at which the history tape starts
+!- pdate0   : The Julian date at which the itau was equal to 0
+!- pdeltat  : Time step, in seconds, of the counter itau
+!-            used in histwrite for instance
+!-
+!- OUTPUT
+!-
+!- phoriid  : Identifier of the horizontal grid
+!- idf      : Identifier of the file
+!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For regular grid (reg1d or reg2d),
+!- the next 4 arguments allow to define a horizontal zoom
+!- for this file. It is assumed that all variables to come
+!- have the same index space. This can not be assumed for
+!- the z axis and thus we define the zoom in histdef.
+!- k_orx  : Origin of the slab of data within the X axis (pim)
+!- k_szx  : Size of the slab of data in X
+!- k_ory  : Origin of the slab of data within the Y axis (pjm)
+!- k_szy  : Size of the slab of data in Y
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
+!-
+!- For all grids.
+!-
+!- domain_id  : Domain identifier
+!-
+!- mode       : String of (case insensitive) blank-separated words
+!-              defining the mode used to create the file.
+!-              Supported keywords : 32, 64
+!-              "32/64" defines the offset mode.
+!-              The default offset mode is 64 bits.
+!-              Keywords "NETCDF4" and "CLASSIC" are reserved
+!-              for future use.
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: k_typ
+  CHARACTER(LEN=*),INTENT(IN) :: nc_name
+  INTEGER,INTENT(IN) :: pim,pjm
+  INTEGER,INTENT(IN) :: pitau0
+  REAL,INTENT(IN) :: pdate0,pdeltat
+  INTEGER,INTENT(OUT) :: idf,phoriid
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  INTEGER,INTENT(IN),OPTIONAL :: k_orx,k_szx,k_ory,k_szy
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
+  INTEGER,INTENT(IN),OPTIONAL :: domain_id
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: mode
+!-
+  INTEGER :: nfid,iret,m_c
   CHARACTER(LEN=120) :: file
   CHARACTER(LEN=30) :: timenow
+  CHARACTER(LEN=11) :: c_nam
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
   CALL ipsldbg (old_status=l_dbg)
 !-
-  nb_files = nb_files+1
-  pfileid  = nb_files
-!-
-! 1.0 Transfering into the common for future use
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_irregular 1.0"
-!-
-  itau0(pfileid) = pitau0
-  date0(pfileid) = pdate0
-  deltat(pfileid) = pdeltat
-!-
-! 2.0 Initializes all variables for this file
-!-
-  IF (l_dbg) WRITE(*,*) "histbeg_irregular 2.0"
-!-
-  IF (nb_files > nb_files_max) THEN
+  IF     (k_typ == 1) THEN
+    c_nam = 'histb_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histb_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histb_irreg'
+  ELSE
+    CALL ipslerr (3,"histbeg", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 0.0"
+!-
+! Search for a free index
+!-
+  idf = -1
+  DO nfid=1,nb_files_max
+    IF (W_F(nfid)%ncfid < 0) THEN
+      idf = nfid; EXIT;
+    ENDIF
+  ENDDO
+  IF (idf < 0) THEN
     CALL ipslerr (3,"histbeg", &
    &  'Table of files too small. You should increase nb_files_max', &
@@ -503 +356 @@
   ENDIF
 !-
-  nb_var(pfileid) = 0
-  nb_tax(pfileid) = 0
-  nb_hax(pfileid) = 0
-  nb_zax(pfileid) = 0
-!-
-  slab_ori(pfileid,1:2) = (/ 1,1 /)
-  slab_sz(pfileid,1:2)  = (/ pim,1 /)
+! 1.0 Transfering into the common for future use
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  W_F(idf)%itau0  = pitau0
+  W_F(idf)%date0  = pdate0
+  W_F(idf)%deltat = pdeltat
+!-
+! 2.0 Initializes all variables for this file
+!-
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  W_F(idf)%n_var = 0
+  W_F(idf)%n_tax = 0
+  W_F(idf)%n_hax = 0
+  W_F(idf)%n_zax = 0
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%slab_ori(1:2) = (/ k_orx,k_ory /)
+    W_F(idf)%slab_siz(1:2)  = (/ k_szx,k_szy /)
+  ELSE
+    W_F(idf)%slab_ori(1:2) = (/ 1,1 /)
+    W_F(idf)%slab_siz(1:2) = (/ pim,1 /)
+  ENDIF
 !-
 ! 3.0 Opening netcdf file and defining dimensions
 !-
-  IF (l_dbg) WRITE(*,*) "histbeg_irregular 3.0"
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
 !-
 ! Add DOMAIN number and ".nc" suffix in file name if needed
 !-
-  file  = pfilename
+  file = nc_name
   CALL flio_dom_file (file,domain_id)
 !-
-  iret = NF90_CREATE (file,NF90_CLOBBER,ncid)
-!-
-  iret = NF90_DEF_DIM (ncid,'x',pim,xid(nb_files))
-  yid(nb_files) = 0
+! Check the mode
+!? See fliocom for HDF4 ????????????????????????????????????????????????
+!-
+  IF (PRESENT(mode)) THEN
+    SELECT CASE (TRIM(mode))
+    CASE('32')
+      m_c = NF90_CLOBBER
+    CASE('64')
+      m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+    CASE DEFAULT
+      CALL ipslerr (3,"histbeg", &
+ &      'Invalid argument mode for file :',TRIM(file), &
+ &      'Supported values are 32 or 64')
+    END SELECT
+  ELSE
+    m_c = IOR(NF90_CLOBBER,NF90_64BIT_OFFSET)
+  ENDIF
+!-
+! Create file
+!-
+  iret = NF90_CREATE(file,m_c,nfid)
+!-
+  IF     (k_typ == 1) THEN
+    iret = NF90_DEF_DIM(nfid,'lon',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'lat',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 2) THEN
+    iret = NF90_DEF_DIM(nfid,'x',k_szx,W_F(idf)%xid)
+    iret = NF90_DEF_DIM(nfid,'y',k_szy,W_F(idf)%yid)
+  ELSEIF (k_typ == 3) THEN
+    iret = NF90_DEF_DIM(nfid,'x',pim,W_F(idf)%xid)
+    W_F(idf)%yid = W_F(idf)%xid
+  ENDIF
 !-
 ! 4.0 Declaring the geographical coordinates and other attributes
 !-
-  IF (l_dbg) WRITE(*,*) "histbeg_irregular 4.0"
-!-
-! 4.3 Global attributes
-!-
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'Conventions','CF-1.1')
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'file_name',TRIM(file))
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'production',TRIM(model_name))
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'Conventions','CF-1.1')
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'file_name',TRIM(file))
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'production',TRIM(model_name))
   lock_modname = .TRUE.
   CALL ioget_timestamp (timenow)
-  iret = NF90_PUT_ATT (ncid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
+  iret = NF90_PUT_ATT(nfid,NF90_GLOBAL,'TimeStamp',TRIM(timenow))
 !-
 ! 5.0 Saving some important information on this file in the common
 !-
-  IF (l_dbg) WRITE(*,*) "histbeg_irregular 5.0"
+  IF (l_dbg) WRITE(*,*) c_nam//" 5.0"
 !-
   IF (PRESENT(domain_id)) THEN
-    dom_id_svg(pfileid) = domain_id
-  ENDIF
-  ncdf_ids(pfileid) = ncid
-  full_size(pfileid,1:2) = (/ pim,1 /)
+    W_F(idf)%dom_id_svg = domain_id
+  ENDIF
+  W_F(idf)%ncfid = nfid
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,pjm /)
+    W_F(idf)%regular=.TRUE.
+  ELSEIF (k_typ == 3) THEN
+    W_F(idf)%full_size(1:2) = (/ pim,1 /)
+    W_F(idf)%regular=.FALSE.
+  ENDIF
 !-
 ! 6.0 storing the geographical coordinates
 !-
-  zoom(pfileid)=.FALSE.
-  regular(pfileid)=.FALSE.
-!-
-  CALL histhori_irregular &
- &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, &
- &   ' ' ,'Default grid',phoriid)
-!-------------------------------
-END SUBROUTINE histbeg_irregular
+  IF     (k_typ == 1) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d)
+  ELSEIF (k_typ == 2) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pjm,' ','Default grid',phoriid, &
+ &    x_2d=x_2d,y_2d=y_2d)
+  ELSEIF (k_typ == 3) THEN
+    CALL histh_all &
+ &   (k_typ,idf,pim,pim,' ','Default grid',phoriid, &
+ &    x_1d=x_1d,y_1d=y_1d,x_bnds=x_bnds,y_bnds=y_bnds)
+  ENDIF
+!-----------------------
+END SUBROUTINE histb_all
 !===
-SUBROUTINE histhori_regular &
- &  (pfileid,pim,plon,pjm,plat,phname,phtitle,phid,opt_rectilinear)
-!---------------------------------------------------------------------
-!- This subroutine is made to declare a new horizontale grid.
+SUBROUTINE histh_reg1d &
+ &  (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 1d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (1,idf,pim,pjm,phname,phtitle,phid,x_1d=plon,y_1d=plat)
+!-------------------------
+END SUBROUTINE histh_reg1d
+!===
+SUBROUTINE histh_reg2d &
+ & (idf,pim,plon,pjm,plat,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for 2d regular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim,pjm
+  REAL,INTENT(IN),DIMENSION(:,:) :: plon,plat
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (2,idf,pim,pjm,phname,phtitle,phid,x_2d=plon,y_2d=plat)
+!-------------------------
+END SUBROUTINE histh_reg2d
+!===
+SUBROUTINE histh_irreg &
+ & (idf,pim,plon,plon_bounds,plat,plat_bounds,phname,phtitle,phid)
+!---------------------------------------------------------------------
+!- histhori for irregular grid (see histh_all)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  INTEGER,INTENT(IN) :: idf,pim
+  REAL,DIMENSION(:),INTENT(IN) :: plon,plat
+  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
+  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
+  INTEGER,INTENT(OUT) :: phid
+!---------------------------------------------------------------------
+  CALL histh_all &
+ & (3,idf,pim,pim,phname,phtitle,phid, &
+ &  x_1d=plon,y_1d=plat,x_bnds=plon_bounds,y_bnds=plat_bounds)
+!-------------------------
+END SUBROUTINE histh_irreg
+!===
+SUBROUTINE histh_all &
+ & (k_typ,idf,pim,pjm,phname,phtitle,phid, &
+ &  x_1d,y_1d,x_2d,y_2d,x_bnds,y_bnds)
+!---------------------------------------------------------------------
+!- General interface for horizontal grids.
+!- This subroutine is made to declare a new horizontal grid.
 !- It has to have the same number of points as
 !- the original and thus in this routine we will only
@@ -572 +536 @@
 !- INPUT
 !-
-!- pfileid : The id of the file to which the grid should be added
+!- k_typ   : Type of the grid (1 rectilinear, 2 regular, 3 irregular)
+!- idf     : The id of the file to which the grid should be added
 !- pim     : Size in the longitude direction
-!- plon    : The longitudes
-!- pjm     : Size in the latitude direction
-!- plat    : The latitudes
+!- pjm     : Size in the latitude direction (pjm=pim for type 3)
 !- phname  : The name of grid
 !- phtitle : The title of the grid
@@ -584 +547 @@
 !- phid    : Id of the created grid
 !-
-!- OPTIONAL
-!-
-!- opt_rectilinear : If true we know the grid is rectilinear.
-!-
+!- Optional INPUT arguments
+!-
+!- For rectilinear or irregular grid
+!- x_1d  : The longitudes
+!- y_1d  : The latitudes
+!- For regular grid
+!- x_2d  : The longitudes
+!- y_2d  : The latitudes
+!- One pair (x_1d,y_1d) or (x_2d,y_2d) must be supplied.
+!-
+!- For irregular grid.
+!- x_bnds : The boundaries of the grid in longitude
+!- y_bnds : The boundaries of the grid in latitude
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pim,pjm
-  REAL,INTENT(IN),DIMENSION(pim,pjm) :: plon,plat
+  INTEGER,INTENT(IN) :: k_typ
+  INTEGER,INTENT(IN) :: idf,pim,pjm
   CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
   INTEGER,INTENT(OUT) :: phid
-  LOGICAL,INTENT(IN),OPTIONAL :: opt_rectilinear
+  REAL,DIMENSION(:),INTENT(IN),OPTIONAL :: x_1d,y_1d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_2d,y_2d
+  REAL,DIMENSION(:,:),INTENT(IN),OPTIONAL :: x_bnds,y_bnds
 !-
   CHARACTER(LEN=25) :: lon_name,lat_name
-  CHARACTER(LEN=80) :: tmp_title,tmp_name
-  INTEGER :: ndim
-  INTEGER,DIMENSION(2) :: dims
+  CHARACTER(LEN=30) :: lonbound_name,latbound_name
+  INTEGER :: i_s,i_e
+  INTEGER,DIMENSION(2) :: dims,dims_b
+  INTEGER :: nbbounds
+  INTEGER :: nlonidb,nlatidb,twoid
+  LOGICAL :: transp = .FALSE.
+  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
+  REAL :: wmn,wmx
   INTEGER :: nlonid,nlatid
-  INTEGER :: orix,oriy,par_szx,par_szy
-  INTEGER :: iret,ncid
-  LOGICAL :: rectilinear
+  INTEGER :: o_x,o_y,s_x,s_y
+  INTEGER :: iret,nfid
+  CHARACTER(LEN=11) :: c_nam
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
   CALL ipsldbg (old_status=l_dbg)
 !-
+  IF     (k_typ == 1) THEN
+    c_nam = 'histh_reg1d'
+  ELSEIF (k_typ == 2) THEN
+    c_nam = 'histh_reg2d'
+  ELSEIF (k_typ == 3) THEN
+    c_nam = 'histh_irreg'
+  ELSE
+    CALL ipslerr (3,"histhori", &
+ &    'Illegal value of k_typ argument','in internal interface','?')
+  ENDIF
+!-
 ! 1.0 Check that all fits in the buffers
 !-
-  IF (    (pim /= full_size(pfileid,1)) &
-    & .OR.(pjm /= full_size(pfileid,2)) ) THEN
+  IF (    (pim /= W_F(idf)%full_size(1)) &
+ &    .OR.(W_F(idf)%regular.AND.(pjm /= W_F(idf)%full_size(2)))  &
+ &    .OR.(.NOT.W_F(idf)%regular.AND.(W_F(idf)%full_size(2) /= 1)) ) THEN
     CALL ipslerr (3,"histhori", &
-   &  'The new horizontal grid does not have the same size', &
-   &  'as the one provided to histbeg. This is not yet ', &
-   &  'possible in the hist package.')
-  ENDIF
-!-
-  IF (PRESENT(opt_rectilinear)) THEN
-    rectilinear = opt_rectilinear
-  ELSE
-    rectilinear = .FALSE.
+ &   'The new horizontal grid does not have the same size', &
+ &   'as the one provided to histbeg. This is not yet ', &
+ &   'possible in the hist package.')
   ENDIF
 !-
 ! 1.1 Create all the variables needed
 !-
-  IF (l_dbg) WRITE(*,*) "histhori_regular 1.0"
-!-
-  ncid = ncdf_ids(pfileid)
-!-
-  ndim = 2
-  dims(1:2) = (/ xid(pfileid),yid(pfileid) /)
-!-
-  tmp_name = phname
-  IF (rectilinear) THEN
-    IF (nb_hax(pfileid) == 0) THEN
+  IF (l_dbg) WRITE(*,*) c_nam//" 1.0"
+!-
+  nfid = W_F(idf)%ncfid
+!-
+  IF (k_typ == 3) THEN
+    IF     (SIZE(x_bnds,DIM=1) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=2)
+      transp = .TRUE.
+    ELSEIF (SIZE(x_bnds,DIM=2) == pim) THEN
+      nbbounds = SIZE(x_bnds,DIM=1)
+      transp = .FALSE.
+    ELSE
+      CALL ipslerr (3,"histhori", &
+ &     'The boundary variable does not have any axis corresponding', &
+ &     'to the size of the longitude or latitude variable','.')
+    ENDIF
+    ALLOCATE(bounds_trans(nbbounds,pim))
+    iret = NF90_DEF_DIM(nfid,'nbnd',nbbounds,twoid)
+    dims_b(1:2) = (/ twoid,W_F(idf)%xid /)
+  ENDIF
+!-
+  dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
+!-
+  IF     (k_typ == 1) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
       lon_name = 'lon'
       lat_name = 'lat'
     ELSE
-      lon_name = 'lon_'//TRIM(tmp_name)
-      lat_name = 'lat_'//TRIM(tmp_name)
-    ENDIF
-  ELSE
-    IF (nb_hax(pfileid) == 0) THEN
+      lon_name = 'lon_'//TRIM(phname)
+      lat_name = 'lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 2) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
       lon_name = 'nav_lon'
       lat_name = 'nav_lat'
     ELSE
-      lon_name = 'nav_lon_'//TRIM(tmp_name)
-      lat_name = 'nav_lat_'//TRIM(tmp_name)
-    ENDIF
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+    IF (W_F(idf)%n_hax == 0) THEN
+      lon_name = 'nav_lon'
+      lat_name = 'nav_lat'
+    ELSE
+      lon_name = 'nav_lon_'//TRIM(phname)
+      lat_name = 'nav_lat_'//TRIM(phname)
+    ENDIF
+    lonbound_name = TRIM(lon_name)//'_bounds'
+    latbound_name = TRIM(lat_name)//'_bounds'
   ENDIF
 !-
 ! 1.2 Save the informations
 !-
-  phid =  nb_hax(pfileid)+1
-  nb_hax(pfileid) = phid
-!-
-  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /)
-  tmp_title = phtitle
+  phid = W_F(idf)%n_hax+1
+  W_F(idf)%n_hax = phid
+  W_F(idf)%hax_name(phid,1:2) = (/ lon_name,lat_name /)
 !-
 ! 2.0 Longitude
 !-
-  IF (l_dbg) WRITE(*,*) "histhori_regular 2.0"
-!-
-  IF (rectilinear) THEN
-    ndim = 1
-    dims(1:1) = (/ xid(pfileid) /)
-  ENDIF
-  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid)
-  IF (rectilinear) THEN
-    iret = NF90_PUT_ATT (ncid,nlonid,'axis',"X")
-  ENDIF
-  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude")
-  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east")
-  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', &
- &                     REAL(MINVAL(plon),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', &
- &                     REAL(MAXVAL(plon),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude")
-  iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title))
+  IF (l_dbg) WRITE(*,*) c_nam//" 2.0"
+!-
+  i_s = 1;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_e = 1; wmn = MINVAL(x_1d); wmx = MAXVAL(x_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_e = 2; wmn = MINVAL(x_2d); wmx = MAXVAL(x_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lon_name,NF90_REAL4,dims(i_s:i_e),nlonid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlonid,'axis',"X")
+  ENDIF
+  iret = NF90_PUT_ATT(nfid,nlonid,'standard_name',"longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'units',"degrees_east")
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlonid,'long_name',"Longitude")
+  iret = NF90_PUT_ATT(nfid,nlonid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 2.1 Longitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlonid,'bounds',TRIM(lonbound_name))
+    iret = NF90_DEF_VAR(nfid,lonbound_name,NF90_REAL4,dims_b(1:2),nlonidb)
+    iret = NF90_PUT_ATT(nfid,nlonidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lon_name))
+  ENDIF
 !-
 ! 3.0 Latitude
 !-
-  IF (l_dbg) WRITE(*,*) "histhori_regular 3.0"
-!-
-  IF (rectilinear) THEN
-    ndim = 1
-    dims(1:1) = (/ yid(pfileid) /)
-  ENDIF
-  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid)
-  IF (rectilinear) THEN
-    iret = NF90_PUT_ATT (ncid,nlatid,'axis',"Y")
-  ENDIF
-  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude")
-  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north")
-  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', &
- &                     REAL(MINVAL(plat),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', &
- &                     REAL(MAXVAL(plat),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude")
-  iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title))
-!-
-  iret = NF90_ENDDEF (ncid)
+  IF (l_dbg) WRITE(*,*) c_nam//" 3.0"
+!-
+  i_e = 2;
+  IF ( (k_typ == 1).OR.(k_typ == 3) ) THEN
+    i_s = 2; wmn = MINVAL(y_1d); wmx = MAXVAL(y_1d);
+  ELSEIF (k_typ == 2) THEN
+    i_s = 1; wmn = MINVAL(y_2d); wmx = MAXVAL(y_2d);
+  ENDIF
+  iret = NF90_DEF_VAR(nfid,lat_name,NF90_REAL4,dims(i_s:i_e),nlatid)
+  IF (k_typ == 1) THEN
+    iret = NF90_PUT_ATT(nfid,nlatid,'axis',"Y")
+  ENDIF
+!-
+  iret = NF90_PUT_ATT(nfid,nlatid,'standard_name',"latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'units',"degrees_north")
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_min',REAL(wmn,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'valid_max',REAL(wmx,KIND=4))
+  iret = NF90_PUT_ATT(nfid,nlatid,'long_name',"Latitude")
+  iret = NF90_PUT_ATT(nfid,nlatid,'nav_model',TRIM(phtitle))
+!-
+  IF (k_typ == 3) THEN
+!---
+!-- 3.1 Latitude bounds
+!---
+    iret = NF90_PUT_ATT(nfid,nlatid,'bounds',TRIM(latbound_name))
+    iret = NF90_DEF_VAR(nfid,latbound_name,NF90_REAL4,dims_b(1:2),nlatidb)
+    iret = NF90_PUT_ATT(nfid,nlatidb,'long_name', &
+ &          'Boundaries for coordinate variable '//TRIM(lat_name))
+  ENDIF
+!-
+  iret = NF90_ENDDEF(nfid)
 !-
 ! 4.0 storing the geographical coordinates
 !-
-  IF (l_dbg) WRITE(*,*) "histhori_regular 4.0"
-!-
-  orix = slab_ori(pfileid,1)
-  oriy = slab_ori(pfileid,2)
-  par_szx = slab_sz(pfileid,1)
-  par_szy = slab_sz(pfileid,2)
-!-
-! Transfer the longitude
-!-
-  IF (rectilinear) THEN
-    iret = NF90_PUT_VAR (ncid,nlonid,plon(orix:orix+par_szx-1,1))
-  ELSE
-    iret = NF90_PUT_VAR (ncid,nlonid, &
- &           plon(orix:orix+par_szx-1,oriy:oriy+par_szy-1))
-  ENDIF
-!-
-! Transfer the latitude
-!-
-  IF (rectilinear) THEN
-    iret = NF90_PUT_VAR (ncid,nlatid,plat(1,oriy:oriy+par_szy-1))
-  ELSE
-    iret = NF90_PUT_VAR (ncid,nlatid, &
- &           plat(orix:orix+par_szx-1,oriy:oriy+par_szy-1))
-  ENDIF
-!-
-  iret = NF90_REDEF (ncid)
-!------------------------------
-END SUBROUTINE histhori_regular
+  IF (l_dbg) WRITE(*,*) c_nam//" 4.0"
+!-
+  IF ( (k_typ == 1).OR.(k_typ == 2) ) THEN
+    o_x = W_F(idf)%slab_ori(1)
+    o_y = W_F(idf)%slab_ori(2)
+    s_x = W_F(idf)%slab_siz(1)
+    s_y = W_F(idf)%slab_siz(2)
+!---
+!-- Transfer the longitude and  the latitude
+!---
+    IF     (k_typ == 1) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid,x_1d(o_x:o_x+s_x-1))
+      iret = NF90_PUT_VAR(nfid,nlatid,y_1d(o_y:o_y+s_y-1))
+    ELSEIF (k_typ == 2) THEN
+      iret = NF90_PUT_VAR(nfid,nlonid, &
+ &            x_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+      iret = NF90_PUT_VAR(nfid,nlatid, &
+ &            y_2d(o_x:o_x+s_x-1,o_y:o_y+s_y-1))
+    ENDIF
+  ELSEIF (k_typ == 3) THEN
+!---
+!-- Transfer the longitude and the longitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlonid,x_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(x_bnds)
+    ELSE
+      bounds_trans = x_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlonidb,bounds_trans(1:nbbounds,1:pim))
+!---
+!-- Transfer the latitude and the latitude bounds
+!---
+    iret = NF90_PUT_VAR(nfid,nlatid,y_1d(1:pim))
+!---
+    IF (transp) THEN
+      bounds_trans = TRANSPOSE(y_bnds)
+    ELSE
+      bounds_trans = y_bnds
+    ENDIF
+    iret = NF90_PUT_VAR(nfid,nlatidb,bounds_trans(1:nbbounds,1:pim))
+!---
+    DEALLOCATE(bounds_trans)
+  ENDIF
+!-
+  iret = NF90_REDEF(nfid)
+!-----------------------
+END SUBROUTINE histh_all
 !===
-SUBROUTINE histhori_irregular &
- &  (pfileid,pim,plon,plon_bounds,plat,plat_bounds, &
- &   phname,phtitle,phid)
-!---------------------------------------------------------------------
-!- This subroutine is made to declare a new horizontale grid.
-!- It has to have the same number of points as
-!- the original and thus in this routine we will only
-!- add two variable (longitude and latitude).
-!- Any variable in the file can thus point to this pair
-!- through an attribute. This routine is very usefull
-!- to allow staggered grids.
-!-
-!- INPUT
-!-
-!- pfileid     : The id of the file to which the grid should be added
-!- pim         : Size in the longitude direction
-!- plon        : The longitudes
-!- plon_bounds : The boundaries of the grid in longitude
-!- plat        : The latitudes
-!- plat_bounds : Boundaries of the grid in latitude
-!- phname      : The name of grid
-!- phtitle     : The title of the grid
-!-
-!- OUTPUT
-!-
-!- phid    : Id of the created grid
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER,INTENT(IN) :: pfileid,pim
-  REAL,DIMENSION(pim),INTENT(IN) :: plon,plat
-  REAL,DIMENSION(:,:),INTENT(IN) :: plon_bounds,plat_bounds
-  CHARACTER(LEN=*),INTENT(IN) :: phname,phtitle
-  INTEGER,INTENT(OUT) :: phid
-!-
-  CHARACTER(LEN=25) :: lon_name,lat_name
-  CHARACTER(LEN=30) :: lonbound_name,latbound_name
-  CHARACTER(LEN=80) :: tmp_title,tmp_name,longname
-  INTEGER :: ndim,dims(2)
-  INTEGER :: ndimb,dimsb(2)
-  INTEGER :: nbbounds
-  INTEGER :: nlonid,nlatid,nlonidb,nlatidb
-  INTEGER :: iret,ncid,twoid
-  LOGICAL :: transp = .FALSE.
-  REAL,ALLOCATABLE,DIMENSION(:,:) :: bounds_trans
-  LOGICAL :: l_dbg
-!---------------------------------------------------------------------
-  CALL ipsldbg (old_status=l_dbg)
-!-
-! 1.0 Check that all fits in the buffers
-!-
-  IF (    (pim /= full_size(pfileid,1)) &
-    & .OR.(full_size(pfileid,2) /= 1) ) THEN
-    CALL ipslerr (3,"histhori", &
-   &  'The new horizontal grid does not have the same size', &
-   &  'as the one provided to histbeg. This is not yet ', &
-   &  'possible in the hist package.')
-  ENDIF
-!-
-! 1.1 Create all the variables needed
-!-
-  IF (l_dbg) WRITE(*,*) 'histhori_irregular 1.0'
-!-
-  ncid = ncdf_ids(pfileid)
-!-
-  IF     (SIZE(plon_bounds,DIM=1) == pim) THEN
-    nbbounds = SIZE(plon_bounds,DIM=2)
-    transp = .TRUE.
-  ELSEIF (SIZE(plon_bounds,DIM=2) == pim) THEN
-    nbbounds = SIZE(plon_bounds,DIM=1)
-    transp = .FALSE.
-  ELSE
-    CALL ipslerr (3,"histhori", &
-   &  'The boundary variable does not have any axis corresponding', &
-   &  'to the size of the longitude or latitude variable', &
-   &  '.')
-  ENDIF
-!-
-  ALLOCATE(bounds_trans(nbbounds,pim))
-!-
-  iret = NF90_DEF_DIM (ncid,'nbnd',nbbounds,twoid)
-  ndim = 1
-  dims(1) = xid(pfileid)
-  ndimb = 2
-  dimsb(1:2) = (/ twoid,xid(pfileid) /)
-!-
-  tmp_name = phname
-  IF (nb_hax(pfileid) == 0) THEN
-    lon_name = 'nav_lon'
-    lat_name = 'nav_lat'
-  ELSE
-    lon_name = 'nav_lon_'//TRIM(tmp_name)
-    lat_name = 'nav_lat_'//TRIM(tmp_name)
-  ENDIF
-  lonbound_name = TRIM(lon_name)//'_bounds'
-  latbound_name = TRIM(lat_name)//'_bounds'
-!-
-! 1.2 Save the informations
-!-
-  phid =  nb_hax(pfileid)+1
-  nb_hax(pfileid) = phid
-!-
-  hax_name(pfileid,phid,1:2) = (/ lon_name,lat_name /)
-  tmp_title = phtitle
-!-
-! 2.0 Longitude
-!-
-  IF (l_dbg) WRITE(*,*) "histhori_irregular 2.0"
-!-
-  iret = NF90_DEF_VAR (ncid,lon_name,NF90_FLOAT,dims(1:ndim),nlonid)
-  iret = NF90_PUT_ATT (ncid,nlonid,'standard_name',"longitude")
-  iret = NF90_PUT_ATT (ncid,nlonid,'units',"degrees_east")
-  iret = NF90_PUT_ATT (ncid,nlonid,'valid_min', &
- &                     REAL(MINVAL(plon),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlonid,'valid_max', &
- &                     REAL(MAXVAL(plon),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlonid,'long_name',"Longitude")
-  iret = NF90_PUT_ATT (ncid,nlonid,'nav_model',TRIM(tmp_title))
-!-
-! 2.1 Longitude bounds
-!-
-  iret = NF90_PUT_ATT (ncid,nlonid,'bounds',TRIM(lonbound_name))
-  iret = NF90_DEF_VAR (ncid,lonbound_name,NF90_FLOAT, &
- &                     dimsb(1:ndimb),nlonidb)
-  longname = 'Boundaries for coordinate variable '//TRIM(lon_name)
-  iret = NF90_PUT_ATT (ncid,nlonidb,'long_name',TRIM(longname))
-!-
-! 3.0 Latitude
-!-
-  IF (l_dbg) WRITE(*,*) "histhori_irregular 3.0"
-!-
-  iret = NF90_DEF_VAR (ncid,lat_name,NF90_FLOAT,dims(1:ndim),nlatid)
-  iret = NF90_PUT_ATT (ncid,nlatid,'standard_name',"latitude")
-  iret = NF90_PUT_ATT (ncid,nlatid,'units',"degrees_north")
-  iret = NF90_PUT_ATT (ncid,nlatid,'valid_min', &
- &                     REAL(MINVAL(plat),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlatid,'valid_max', &
- &                     REAL(MAXVAL(plat),KIND=4))
-  iret = NF90_PUT_ATT (ncid,nlatid,'long_name',"Latitude")
-  iret = NF90_PUT_ATT (ncid,nlatid,'nav_model',TRIM(tmp_title))
-!-
-! 3.1 Latitude bounds
-!-
-  iret = NF90_PUT_ATT (ncid,nlatid,'bounds',TRIM(latbound_name))
-  iret = NF90_DEF_VAR (ncid,latbound_name,NF90_FLOAT, &
- &                     dimsb(1:ndimb),nlatidb)
-  longname = 'Boundaries for coordinate variable '//TRIM(lat_name)
-  iret = NF90_PUT_ATT (ncid,nlatidb,'long_name',TRIM(longname))
-!-
-  iret = NF90_ENDDEF (ncid)
-!-
-! 4.0 storing the geographical coordinates
-!-
-  IF (l_dbg) WRITE(*,*) "histhori_irregular 4.0"
-!-
-! 4.1 Write the longitude
-!-
-  iret = NF90_PUT_VAR (ncid,nlonid,plon(1:pim))
-!-
-! 4.2 Write the longitude bounds
-!-
-  IF (transp) THEN
-    bounds_trans = TRANSPOSE(plon_bounds)
-  ELSE
-    bounds_trans = plon_bounds
-  ENDIF
-  iret = NF90_PUT_VAR (ncid,nlonidb,bounds_trans(1:nbbounds,1:pim))
-!-
-! 4.3 Write the latitude
-!-
-  iret = NF90_PUT_VAR (ncid,nlatid,plat(1:pim))
-!-
-! 4.4 Write the latitude bounds
-!-
-  IF (transp) THEN
-    bounds_trans = TRANSPOSE(plat_bounds)
-  ELSE
-    bounds_trans = plat_bounds
-  ENDIF
-  iret = NF90_PUT_VAR (ncid,nlatidb,bounds_trans(1:nbbounds,1:pim))
-!-
-  DEALLOCATE(bounds_trans)
-!-
-  iret = NF90_REDEF (ncid)
-!--------------------------------
-END SUBROUTINE histhori_irregular
-!===
-SUBROUTINE histvert (pfileid,pzaxname,pzaxtitle,pzaxunit, &
+SUBROUTINE histvert (idf,pzaxname,pzaxtitle,pzaxunit, &
  &                   pzsize,pzvalues,pzaxid,pdirect)
 !---------------------------------------------------------------------
@@ -933 +796 @@
 !- INPUT
 !-
-!- pfileid  : ID of the file the variable should be archived in
+!- idf      : ID of the file the variable should be archived in
 !- pzaxname : Name of the vertical axis
 !- pzaxtitle: title of the vertical axis
@@ -952 +815 @@
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pzsize
+  INTEGER,INTENT(IN) :: idf,pzsize
   CHARACTER(LEN=*),INTENT(IN) :: pzaxname,pzaxunit,pzaxtitle
   REAL,INTENT(IN) :: pzvalues(pzsize)
@@ -960 +823 @@
   INTEGER :: pos,iv,zdimid,zaxid_tmp
   CHARACTER(LEN=70) :: str71
-  CHARACTER(LEN=80) :: str80
   CHARACTER(LEN=20) :: direction
-  INTEGER :: iret,leng,ncid
+  INTEGER :: iret,leng,nfid
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
@@ -974 +836 @@
  &                      pzaxname,'---',pzaxunit,'---',pzaxtitle
 !-
-! - Direction of axis. Can we get if from the user.
-!   If not we put unknown.
+! Direction of the vertical axis. Can we get if from the user.
 !-
   IF (PRESENT(pdirect)) THEN
@@ -986 +847 @@
 ! Check the consistency of the attribute
 !-
-  IF (     (direction /= 'unknown') &
- &    .AND.(direction /= 'up')      &
- &    .AND.(direction /= 'down')   ) THEN
+  IF (     PRESENT(pdirect)    &
+ &    .AND.(direction /= 'up') &
+ &    .AND.(direction /= 'down') ) THEN
     direction = 'unknown'
-    str80 = 'The specified axis was : '//TRIM(direction)
     CALL ipslerr (2,"histvert",&
-   & "The specified direction for the vertical axis is not possible.",&
-   & "it is replaced by : unknown",str80)
-  ENDIF
-!-
-  IF (nb_zax(pfileid)+1 > nb_zax_max) THEN
+ & "The specified positive direction for the vertical axis is invalid.",&
+ & "The value must be up or down.","The attribute will not be written.")
+  ENDIF
+!-
+  IF (W_F(idf)%n_zax+1 > nb_zax_max) THEN
     CALL ipslerr (3,"histvert", &
    &  'Table of vertical axes too small. You should increase ',&
@@ -1003 +863 @@
   ENDIF
 !-
-  iv = nb_zax(pfileid)
+  iv = W_F(idf)%n_zax
   IF (iv > 1) THEN
-    CALL find_str (zax_name(pfileid,1:iv-1),pzaxname,pos)
+    CALL find_str (W_F(idf)%zax_name(1:iv-1),pzaxname,pos)
   ELSE
     pos = 0
@@ -1012 +872 @@
   IF (pos > 0) THEN
     WRITE(str71,'("Check variable ",A," in file",I3)') &
- &    TRIM(pzaxname),pfileid
+ &    TRIM(pzaxname),idf
     CALL ipslerr (3,"histvert", &
  &    "Vertical axis already exists",TRIM(str71), &
@@ -1018 +878 @@
   ENDIF
 !-
-  iv = nb_zax(pfileid)+1
+  iv = W_F(idf)%n_zax+1
 !-
 ! 2.0 Add the information to the file
@@ -1025 +885 @@
  &  WRITE(*,*) "histvert : 2.0 Add the information to the file"
 !-
-  ncid = ncdf_ids(pfileid)
+  nfid = W_F(idf)%ncfid
 !-
   leng = MIN(LEN_TRIM(pzaxname),20)
-  iret = NF90_DEF_DIM (ncid,pzaxname(1:leng),pzsize,zaxid_tmp)
-  iret = NF90_DEF_VAR (ncid,pzaxname(1:leng),NF90_FLOAT, &
+  iret = NF90_DEF_DIM (nfid,pzaxname(1:leng),pzsize,zaxid_tmp)
+  iret = NF90_DEF_VAR (nfid,pzaxname(1:leng),NF90_REAL4, &
  &                     zaxid_tmp,zdimid)
-  iret = NF90_PUT_ATT (ncid,zdimid,'axis',"Z")
-  iret = NF90_PUT_ATT (ncid,zdimid,'standard_name',"model_level_number")
+  iret = NF90_PUT_ATT (nfid,zdimid,'axis',"Z")
+  iret = NF90_PUT_ATT (nfid,zdimid,'standard_name',"model_level_number")
   leng = MIN(LEN_TRIM(pzaxunit),20)
   IF (leng > 0) THEN
-    iret = NF90_PUT_ATT (ncid,zdimid,'units',pzaxunit(1:leng))
-  ENDIF
-  iret = NF90_PUT_ATT (ncid,zdimid,'positive',TRIM(direction))
-  iret = NF90_PUT_ATT (ncid,zdimid,'valid_min', &
+    iret = NF90_PUT_ATT (nfid,zdimid,'units',pzaxunit(1:leng))
+  ENDIF
+  IF (direction /= 'unknown') THEN
+    iret = NF90_PUT_ATT (nfid,zdimid,'positive',TRIM(direction))
+  ENDIF
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_min', &
  &                     REAL(MINVAL(pzvalues(1:pzsize)),KIND=4))
-  iret = NF90_PUT_ATT (ncid,zdimid,'valid_max', &
+  iret = NF90_PUT_ATT (nfid,zdimid,'valid_max', &
  &                     REAL(MAXVAL(pzvalues(1:pzsize)),KIND=4))
   leng = MIN(LEN_TRIM(pzaxname),20)
-  iret = NF90_PUT_ATT (ncid,zdimid,'title',pzaxname(1:leng))
+  iret = NF90_PUT_ATT (nfid,zdimid,'title',pzaxname(1:leng))
   leng = MIN(LEN_TRIM(pzaxtitle),80)
-  iret = NF90_PUT_ATT (ncid,zdimid,'long_name',pzaxtitle(1:leng))
-!-
-  iret = NF90_ENDDEF (ncid)
-!-
-  iret = NF90_PUT_VAR (ncid,zdimid,pzvalues(1:pzsize))
-!-
-  iret = NF90_REDEF (ncid)
+  iret = NF90_PUT_ATT (nfid,zdimid,'long_name',pzaxtitle(1:leng))
+!-
+  iret = NF90_ENDDEF (nfid)
+!-
+  iret = NF90_PUT_VAR (nfid,zdimid,pzvalues(1:pzsize))
+!-
+  iret = NF90_REDEF (nfid)
 !-
 !- 3.0 add the information to the common
@@ -1058 +920 @@
   &  WRITE(*,*) "histvert : 3.0 add the information to the common"
 !-
-  nb_zax(pfileid) = iv
-  zax_size(pfileid,iv) = pzsize
-  zax_name(pfileid,iv) = pzaxname
-  zax_ids(pfileid,iv) = zaxid_tmp
-  pzaxid =  iv
+  W_F(idf)%n_zax = iv
+  W_F(idf)%zax_size(iv) = pzsize
+  W_F(idf)%zax_name(iv) = pzaxname
+  W_F(idf)%zax_ids(iv) = zaxid_tmp
+  pzaxid = iv
 !----------------------
 END SUBROUTINE histvert
 !===
-SUBROUTINE histdef (pfileid,pvarname,ptitle,punit, &
- &                  pxsize,pysize,phoriid,pzsize,  &
- &                  par_oriz,par_szz,pzid,         &
- &                  pnbbyt,popp,pfreq_opp,pfreq_wrt,var_range)
+SUBROUTINE histdef &
+ &  (idf,pvarname,ptitle,punit, &
+ &   pxsize,pysize,phoriid,pzsize,par_oriz,par_szz,pzid, &
+ &   xtype,popp,pfreq_opp,pfreq_wrt,var_range,standard_name)
 !---------------------------------------------------------------------
 !- With this subroutine each variable to be archived on the history
@@ -1080 +942 @@
 !- INPUT
 !-
-!- pfileid  : ID of the file the variable should be archived in
+!- idf      : ID of the file the variable should be archived in
 !- pvarname : Name of the variable, short and easy to remember
 !- ptitle   : Full name of the variable
@@ -1104 +966 @@
 !- pzid     : ID of the vertical axis to use. It has to have
 !-            the size of the zoom.
-!- pnbbyt   : Number of bytes on which to store in netCDF (Not opp.)
+!- xtype    : External netCDF type (hist_r4/hist_r8)
 !- popp     : Operation to be performed. The following options
 !-            exist today :
@@ -1120 +982 @@
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pxsize,pysize,pzsize,pzid
-  INTEGER,INTENT(IN) :: par_oriz,par_szz,pnbbyt,phoriid
+  INTEGER,INTENT(IN) :: idf,pxsize,pysize,pzsize,pzid
+  INTEGER,INTENT(IN) :: par_oriz,par_szz,xtype,phoriid
   CHARACTER(LEN=*),INTENT(IN) :: pvarname,punit,popp,ptitle
   REAL,INTENT(IN) :: pfreq_opp,pfreq_wrt
   REAL,DIMENSION(2),OPTIONAL,INTENT(IN) :: var_range
-!-
-  INTEGER :: iv,i
+  CHARACTER(LEN=*),OPTIONAL,INTENT(IN) :: standard_name
+!-
+  INTEGER :: iv
   CHARACTER(LEN=70) :: str70,str71,str72
   CHARACTER(LEN=20) :: tmp_name
   CHARACTER(LEN=40) :: str40
   CHARACTER(LEN=10) :: str10
-  CHARACTER(LEN=80) :: tmp_str80
-  CHARACTER(LEN=7) :: tmp_topp,tmp_sopp(nbopp_max)
   CHARACTER(LEN=120) :: ex_topps
-  REAL :: tmp_scal(nbopp_max),un_an,un_jour,test_fopp,test_fwrt
+  REAL :: un_an,un_jour,test_fopp,test_fwrt
   INTEGER :: pos,buff_sz
   LOGICAL :: l_dbg
@@ -1142 +1003 @@
   ex_topps = 'ave, inst, t_min, t_max, t_sum, once, never, l_max, l_min'
 !-
-  nb_var(pfileid) = nb_var(pfileid)+1
-  iv = nb_var(pfileid)
+  W_F(idf)%n_var = W_F(idf)%n_var+1
+  iv = W_F(idf)%n_var
 !-
   IF (iv > nb_var_max) THEN
@@ -1158 +1019 @@
 !-
   IF (iv > 1) THEN
-    CALL find_str (name(pfileid,1:iv-1),pvarname,pos)
+    CALL find_str (W_F(idf)%W_V(1:iv-1)%v_name,pvarname,pos)
   ELSE
     pos = 0
@@ -1166 +1027 @@
     str70 = "Variable already exists"
     WRITE(str71,'("Check variable  ",a," in file",I3)') &
- &    TRIM(pvarname),pfileid
+ &    TRIM(pvarname),idf
     str72 = "Can also be a wrong file ID in another declaration"
     CALL ipslerr (3,"histdef",str70,str71,str72)
   ENDIF
 !-
-  name(pfileid,iv) = pvarname
-  title(pfileid,iv) = ptitle
-  unit_name(pfileid,iv) = punit
-  tmp_name =  name(pfileid,iv)
+  W_F(idf)%W_V(iv)%v_name = pvarname
+  W_F(idf)%W_V(iv)%title = ptitle
+  W_F(idf)%W_V(iv)%unit_name = punit
+  IF (PRESENT(standard_name)) THEN
+    W_F(idf)%W_V(iv)%std_name = standard_name
+  ELSE
+    W_F(idf)%W_V(iv)%std_name = ptitle
+  ENDIF
+  tmp_name = W_F(idf)%W_V(iv)%v_name
 !-
 ! 1.1 decode the operations
 !-
-  fullop(pfileid,iv) = popp
-  tmp_str80 = popp
+  W_F(idf)%W_V(iv)%fullop = popp
   CALL buildop &
- &  (tmp_str80,ex_topps,tmp_topp,nbopp_max,missing_val, &
- &   tmp_sopp,tmp_scal,nbopp(pfileid,iv))
-!-
-  topp(pfileid,iv) = tmp_topp
-  DO i=1,nbopp(pfileid,iv)
-    sopps(pfileid,iv,i) = tmp_sopp(i)
-    scal(pfileid,iv,i) = tmp_scal(i)
-  ENDDO
+ &  (TRIM(popp),ex_topps,W_F(idf)%W_V(iv)%topp,missing_val, &
+ &   W_F(idf)%W_V(iv)%sopp,W_F(idf)%W_V(iv)%scal, &
+ &   W_F(idf)%W_V(iv)%nbopp)
 !-
 ! 1.2 If we have an even number of operations
 !     then we need to add identity
 !-
-  IF (2*INT(nbopp(pfileid,iv)/2.0) == nbopp(pfileid,iv)) THEN
-    nbopp(pfileid,iv) = nbopp(pfileid,iv)+1
-    sopps(pfileid,iv,nbopp(pfileid,iv)) = 'ident'
-    scal(pfileid,iv,nbopp(pfileid,iv)) = missing_val
+  IF ( MOD(W_F(idf)%W_V(iv)%nbopp,2) == 0) THEN
+    W_F(idf)%W_V(iv)%nbopp = W_F(idf)%W_V(iv)%nbopp+1
+    W_F(idf)%W_V(iv)%sopp(W_F(idf)%W_V(iv)%nbopp) = 'ident'
+    W_F(idf)%W_V(iv)%scal(W_F(idf)%W_V(iv)%nbopp) = missing_val
+  ENDIF
+!-
+! 1.3 External type of the variable
+!-
+  IF (xtype == hist_r8) THEN
+    W_F(idf)%W_V(iv)%v_typ = hist_r8
+  ELSE
+    W_F(idf)%W_V(iv)%v_typ = hist_r4
   ENDIF
 !-
 ! 2.0 Put the size of the variable in the common and check
 !-
-  IF (l_dbg) &
- &  WRITE(*,*) "histdef : 2.0",pfileid,iv,nbopp(pfileid,iv), &
- &    sopps(pfileid,iv,1:nbopp(pfileid,iv)), &
- &    scal(pfileid,iv,1:nbopp(pfileid,iv))
-!-
-  scsize(pfileid,iv,1:3) = (/ pxsize,pysize,pzsize /)
-!-
-  zorig(pfileid,iv,1:3) = &
- &  (/ slab_ori(pfileid,1),slab_ori(pfileid,2),par_oriz /)
-!-
-  zsize(pfileid,iv,1:3) = &
- &  (/ slab_sz(pfileid,1),slab_sz(pfileid,2),par_szz /)
-!-
-! Is the size of the full array the same as that of the coordinates  ?
-!-
-  IF (    (pxsize > full_size(pfileid,1)) &
- &    .OR.(pysize > full_size(pfileid,2)) ) THEN
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 2.0",idf,iv,W_F(idf)%W_V(iv)%nbopp, &
+ &    W_F(idf)%W_V(iv)%sopp(1:W_F(idf)%W_V(iv)%nbopp), &
+ &    W_F(idf)%W_V(iv)%scal(1:W_F(idf)%W_V(iv)%nbopp)
+  ENDIF
+!-
+  W_F(idf)%W_V(iv)%scsize(1:3) = (/ pxsize,pysize,pzsize /)
+  W_F(idf)%W_V(iv)%zorig(1:3) = &
+ &  (/ W_F(idf)%slab_ori(1),W_F(idf)%slab_ori(2),par_oriz /)
+  W_F(idf)%W_V(iv)%zsize(1:3) = &
+ &  (/ W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2),par_szz /)
+!-
+! Is the size of the full array the same as that of the coordinates ?
+!-
+  IF (    (pxsize > W_F(idf)%full_size(1)) &
+ &    .OR.(pysize > W_F(idf)%full_size(2)) ) THEN
 !-
     str70 = "The size of the variable is different "// &
  &          "from the one of the coordinates"
     WRITE(str71,'("Size of coordinates :",2I4)') &
- &   full_size(pfileid,1),full_size(pfileid,2)
+ &   W_F(idf)%full_size(1),W_F(idf)%full_size(2)
     WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
  &   TRIM(tmp_name),pxsize,pysize
@@ -1228 +1095 @@
   ENDIF
 !-
-! Is the size of the zoom smaler than the coordinates ?
-!-
-  IF (    (full_size(pfileid,1) < slab_sz(pfileid,1)) &
- &    .OR.(full_size(pfileid,2) < slab_sz(pfileid,2)) ) THEN
+! Is the size of the zoom smaller than the coordinates ?
+!-
+  IF (    (W_F(idf)%full_size(1) < W_F(idf)%slab_siz(1)) &
+ &    .OR.(W_F(idf)%full_size(2) < W_F(idf)%slab_siz(2)) ) THEN
     str70 = &
  &   "Size of variable should be greater or equal to those of the zoom"
     WRITE(str71,'("Size of XY zoom :",2I4)') &
- &   slab_sz(pfileid,1),slab_sz(pfileid,1)
-    WRITE(str72,'("Size declared for variable ",a," :",2I4)') &
+ &   W_F(idf)%slab_siz(1),W_F(idf)%slab_siz(2)
+    WRITE(str72,'("Size declared for variable ",A," :",2I4)') &
  &   TRIM(tmp_name),pxsize,pysize
     CALL ipslerr (3,"histdef",str70,str71,str72)
@@ -1244 +1111 @@
 !     and a fall back onto the default grid
 !-
-  IF ( (phoriid > 0).AND.(phoriid <= nb_hax(pfileid)) ) THEN
-    var_haxid(pfileid,iv) = phoriid
+  IF ( (phoriid > 0).AND.(phoriid <= W_F(idf)%n_hax) ) THEN
+    W_F(idf)%W_V(iv)%h_axid = phoriid
   ELSE
-    var_haxid(pfileid,iv) = 1
+    W_F(idf)%W_V(iv)%h_axid = 1
     CALL ipslerr (2,"histdef", &
    &  'We use the default grid for variable as an invalide',&
@@ -1259 +1126 @@
 !-- Does the vertical coordinate exist ?
 !-
-    IF (pzid > nb_zax(pfileid)) THEN
+    IF (pzid > W_F(idf)%n_zax) THEN
       WRITE(str70, &
- &    '("The vertical coordinate chosen for variable ",a)') &
+ &    '("The vertical coordinate chosen for variable ",A)') &
  &     TRIM(tmp_name)
       str71 = " Does not exist."
@@ -1269 +1136 @@
 !-- Is the vertical size of the variable equal to that of the axis ?
 !-
-    IF (par_szz /= zax_size(pfileid,pzid)) THEN
+    IF (par_szz /= W_F(idf)%zax_size(pzid)) THEN
       str70 = "The size of the zoom does not correspond "// &
  &            "to the size of the chosen vertical axis"
       WRITE(str71,'("Size of zoom in z :",I4)') par_szz
       WRITE(str72,'("Size declared for axis ",A," :",I4)') &
- &     TRIM(zax_name(pfileid,pzid)),zax_size(pfileid,pzid)
+ &     TRIM(W_F(idf)%zax_name(pzid)),W_F(idf)%zax_size(pzid)
       CALL ipslerr (3,"histdef",str70,str71,str72)
     ENDIF
 !-
-!-- Is the zoom smaler that the total size of the variable ?
+!-- Is the zoom smaller that the total size of the variable ?
 !-
     IF (pzsize < par_szz) THEN
@@ -1288 +1155 @@
       CALL ipslerr (3,"histdef",str70,str71,str72)
     ENDIF
-    var_zaxid(pfileid,iv) = pzid
+    W_F(idf)%W_V(iv)%z_axid = pzid
   ELSE
-    var_zaxid(pfileid,iv) = -99
-  ENDIF
-!-
-! 3.0 Determine the position of the variable in the buffer
-!     If it is instantaneous output then we do not use the buffer
-!-
-  IF (l_dbg) WRITE(*,*) "histdef : 3.0"
-!-
-! 3.1 We get the size of the arrays histwrite will get and check
-!     that they fit into the tmp_buffer
-!-
-  buff_sz = zsize(pfileid,iv,1)*zsize(pfileid,iv,2)*zsize(pfileid,iv,3)
-!-
-! 3.2 move the pointer of the buffer array for operation
-!     which need bufferisation
-!-
-  IF (     (TRIM(tmp_topp) /= "inst") &
- &    .AND.(TRIM(tmp_topp) /= "once") &
- &    .AND.(TRIM(tmp_topp) /= "never") )THEN
-    point(pfileid,iv) = buff_pos+1
-    buff_pos = buff_pos+buff_sz
+    W_F(idf)%W_V(iv)%z_axid = -99
+  ENDIF
+!-
+! 3.0 We get the size of the arrays histwrite will get
+!     and eventually allocate the time_buffer
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histdef : 3.0"
+  ENDIF
+!-
+  buff_sz = W_F(idf)%W_V(iv)%zsize(1) &
+ &         *W_F(idf)%W_V(iv)%zsize(2) &
+ &         *W_F(idf)%W_V(iv)%zsize(3)
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= "inst") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "once") &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= "never") )THEN
+    ALLOCATE(W_F(idf)%W_V(iv)%t_bf(buff_sz))
+    W_F(idf)%W_V(iv)%t_bf(:) = 0.
     IF (l_dbg) THEN
-      WRITE(*,*) "histdef : 3.2 bufpos for iv = ",iv, &
- &               " pfileid = ",pfileid," is = ",point(pfileid,iv)
+      WRITE(*,*) "histdef : 3.0 allocating time_buffer for", &
+ &      " idf = ",idf," iv = ",iv," size = ",buff_sz
     ENDIF
   ENDIF
@@ -1324 +1189 @@
   IF (l_dbg) WRITE(*,*) "histdef : 4.0"
 !-
-  freq_opp(pfileid,iv) = pfreq_opp
-  freq_wrt(pfileid,iv) = pfreq_wrt
+  W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+  W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
 !-
   CALL ioget_calendar(un_an,un_jour)
@@ -1343 +1208 @@
 ! 4.1 Frequency of operations and output should be larger than deltat !
 !-
-  IF (test_fopp < deltat(pfileid)) THEN
+  IF (test_fopp < W_F(idf)%deltat) THEN
     str70 = 'Frequency of operations should be larger than deltat'
     WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
@@ -1351 +1216 @@
     CALL ipslerr (2,"histdef",str70,str71,str72)
 !-
-    freq_opp(pfileid,iv) = deltat(pfileid)
-  ENDIF
-!-
-  IF (test_fwrt < deltat(pfileid)) THEN
+    W_F(idf)%W_V(iv)%freq_opp = W_F(idf)%deltat
+  ENDIF
+!-
+  IF (test_fwrt < W_F(idf)%deltat) THEN
     str70 = 'Frequency of output should be larger than deltat'
     WRITE(str71,'("It is not the case for variable ",a," :",F10.4)') &
@@ -1362 +1227 @@
     CALL ipslerr (2,"histdef",str70,str71,str72)
 !-
-    freq_wrt(pfileid,iv) = deltat(pfileid)
+    W_F(idf)%W_V(iv)%freq_wrt = W_F(idf)%deltat
   ENDIF
 !-
@@ -1368 +1233 @@
 !     its compaticility with the choice of frequencies
 !-
-  IF (TRIM(tmp_topp) == "inst") THEN
+  IF (TRIM(W_F(idf)%W_V(iv)%topp) == "inst") THEN
     IF (test_fopp /= test_fwrt) THEN
       str70 = 'For instantaneous output the frequency '// &
@@ -1378 +1243 @@
       CALL ipslerr (2,"histdef",str70,str71,str72)
       IF (test_fopp < test_fwrt) THEN
-        freq_opp(pfileid,iv) = pfreq_opp
-        freq_wrt(pfileid,iv) = pfreq_opp
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_opp
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_opp
       ELSE
-        freq_opp(pfileid,iv) = pfreq_wrt
-        freq_wrt(pfileid,iv) = pfreq_wrt
+        W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
+        W_F(idf)%W_V(iv)%freq_wrt = pfreq_wrt
       ENDIF
     ENDIF
-  ELSE IF (INDEX(ex_topps,TRIM(tmp_topp)) > 0) THEN
+  ELSE IF (INDEX(ex_topps,TRIM(W_F(idf)%W_V(iv)%topp)) > 0) THEN
     IF (test_fopp > test_fwrt) THEN
       str70 = 'For averages the frequency of operations '// &
-&             'should be smaller or equal'
+ &            'should be smaller or equal'
       WRITE(str71, &
  &     '("to that of output. It is not the case for variable ",a)') &
@@ -1394 +1259 @@
       str72 = 'PATCH : The output frequency is used for both'
       CALL ipslerr (2,"histdef",str70,str71,str72)
-      freq_opp(pfileid,iv) = pfreq_wrt
+      W_F(idf)%W_V(iv)%freq_opp = pfreq_wrt
     ENDIF
   ELSE
-    WRITE (str70,'("Operation on variable ",a," is unknown")') &
-&    TRIM(tmp_name)
-    WRITE (str71,'("operation requested is :",a)') tmp_topp
-    WRITE (str72,'("File ID :",I3)') pfileid
+    WRITE (str70,'("Operation on variable ",A," is unknown")') &
+ &   TRIM(tmp_name)
+    WRITE (str71,'("operation requested is :",A)') &
+ &   W_F(idf)%W_V(iv)%topp
+    WRITE (str72,'("File ID :",I3)') idf
     CALL ipslerr (3,"histdef",str70,str71,str72)
   ENDIF
@@ -1408 +1274 @@
   IF (l_dbg) WRITE(*,*) "histdef : 5.0"
 !-
-  hist_wrt_rng(pfileid,iv) = (PRESENT(var_range))
-  IF (hist_wrt_rng(pfileid,iv)) THEN
-    hist_calc_rng(pfileid,iv) = (var_range(1) > var_range(2))
-    IF (hist_calc_rng(pfileid,iv)) THEN
-      hist_minmax(pfileid,iv,1:2) = &
+  W_F(idf)%W_V(iv)%hist_wrt_rng = (PRESENT(var_range))
+  IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+    W_F(idf)%W_V(iv)%hist_calc_rng = (var_range(1) > var_range(2))
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = &
  &      (/ ABS(missing_val),-ABS(missing_val) /)
     ELSE
-      hist_minmax(pfileid,iv,1:2) = var_range(1:2)
-    ENDIF
-  ENDIF
-!-
-! - freq_opp(pfileid,iv)/2./deltat(pfileid)
-  last_opp(pfileid,iv) = itau0(pfileid)
-! - freq_wrt(pfileid,iv)/2./deltat(pfileid)
-  last_wrt(pfileid,iv) = itau0(pfileid)
-! - freq_opp(pfileid,iv)/2./deltat(pfileid)
-  last_opp_chk(pfileid,iv) = itau0(pfileid)
-! - freq_wrt(pfileid,iv)/2./deltat(pfileid)
-  last_wrt_chk(pfileid,iv) = itau0(pfileid)
-  nb_opp(pfileid,iv) = 0
-  nb_wrt(pfileid,iv) = 0
+      W_F(idf)%W_V(iv)%hist_minmax(1:2) = var_range(1:2)
+    ENDIF
+  ENDIF
+!-
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt = W_F(idf)%itau0
+! - freq_opp(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_opp_chk = W_F(idf)%itau0
+! - freq_wrt(idf,iv)/2./deltat(idf)
+  W_F(idf)%W_V(iv)%last_wrt_chk = W_F(idf)%itau0
+  W_F(idf)%W_V(iv)%nb_opp = 0
+  W_F(idf)%W_V(iv)%nb_wrt = 0
 !-
 ! 6.0 Get the time axis for this variable
@@ -1434 +1300 @@
   IF (l_dbg) WRITE(*,*) "histdef : 6.0"
 !-
-  IF (freq_wrt(pfileid,iv) > 0) THEN
-    WRITE(str10,'(I8.8)') INT(freq_wrt(pfileid,iv))
-    str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
+! No time axis for once, l_max, l_min or never operation
+!-
+  IF (     (TRIM(W_F(idf)%W_V(iv)%topp) /= 'once')  &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'never') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_max') &
+ &    .AND.(TRIM(W_F(idf)%W_V(iv)%topp) /= 'l_min') ) THEN
+    IF (TRIM(W_F(idf)%W_V(iv)%topp) == 'inst') THEN
+      str10 = 't_inst_'
+    ELSE
+      str10 = 't_op_'
+    ENDIF
+    IF (W_F(idf)%W_V(iv)%freq_wrt > 0) THEN
+      WRITE (UNIT=str40,FMT='(A,I8.8)') &
+&      TRIM(str10),INT(W_F(idf)%W_V(iv)%freq_wrt)
+    ELSE
+      WRITE (UNIT=str40,FMT='(A,I2.2,"month")') &
+&      TRIM(str10),ABS(INT(W_F(idf)%W_V(iv)%freq_wrt))
+    ENDIF
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_tax)%tax_name,str40,pos)
+    IF (pos < 0) THEN
+      W_F(idf)%n_tax = W_F(idf)%n_tax+1
+      W_F(idf)%W_V(iv)%l_bnd = &
+ &      (TRIM(W_F(idf)%W_V(iv)%topp) /= 'inst')
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_name = str40
+      W_F(idf)%W_V(W_F(idf)%n_tax)%tax_last = 0
+      W_F(idf)%W_V(iv)%t_axid = W_F(idf)%n_tax
+    ELSE
+      W_F(idf)%W_V(iv)%t_axid = pos
+    ENDIF
   ELSE
-    WRITE(str10,'(I2.2,"month")') ABS(INT(freq_wrt(pfileid,iv)))
-    str40 = TRIM(tmp_topp)//"_"//TRIM(str10)
-  ENDIF
-  CALL find_str (tax_name(pfileid,1:nb_tax(pfileid)),str40,pos)
-!-
-! No time axis for once, l_max, l_min or never operation
-!-
-  IF (     (TRIM(tmp_topp) /= 'once')  &
- &    .AND.(TRIM(tmp_topp) /= 'never') &
- &    .AND.(TRIM(tmp_topp) /= 'l_max') &
- &    .AND.(TRIM(tmp_topp) /= 'l_min') ) THEN
-    IF (pos < 0) THEN
-      nb_tax(pfileid) = nb_tax(pfileid)+1
-      tax_name(pfileid,nb_tax(pfileid)) = str40
-      tax_last(pfileid,nb_tax(pfileid)) = 0
-      var_axid(pfileid,iv) = nb_tax(pfileid)
-    ELSE
-      var_axid(pfileid,iv) = pos
-    ENDIF
-  ELSE
-    IF (l_dbg)   WRITE(*,*) "histdef : 7.0 ",TRIM(tmp_topp),'----'
-    var_axid(pfileid,iv) = -99
+    IF (l_dbg) THEN
+      WRITE(*,*) "histdef : 7.0 ",TRIM(W_F(idf)%W_V(iv)%topp),'----'
+    ENDIF
+    W_F(idf)%W_V(iv)%t_axid = -99
   ENDIF
 !-
@@ -1465 +1339 @@
 !     for never or once operation
 !-
-  IF (    (TRIM(tmp_topp) == 'once')  &
- &    .OR.(TRIM(tmp_topp) == 'never') ) THEN
-    freq_opp(pfileid,iv) = 0.
-    freq_wrt(pfileid,iv) = 0.
+  IF (    (TRIM(W_F(idf)%W_V(iv)%topp) == 'once')  &
+ &    .OR.(TRIM(W_F(idf)%W_V(iv)%topp) == 'never') ) THEN
+    W_F(idf)%W_V(iv)%freq_opp = 0.
+    W_F(idf)%W_V(iv)%freq_wrt = 0.
   ENDIF
 !---------------------
 END SUBROUTINE histdef
 !===
-SUBROUTINE histend (pfileid)
+SUBROUTINE histend (idf)
 !---------------------------------------------------------------------
 !- This subroutine end the decalaration of variables and sets the
@@ -1480 +1354 @@
 !- INPUT
 !-
-!- pfileid : ID of the file to be worked on
+!- idf : ID of the file to be worked on
 !-
 !- VERSION
@@ -1487 +1361 @@
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid
-!-
-  INTEGER :: ncid,ncvarid,iret,ndim,iv,itx,ziv,itax,dim_cnt
+  INTEGER,INTENT(IN) :: idf
+!-
+  INTEGER :: nfid,nvid,iret,ndim,iv,itx,ziv,itax,dim_cnt
   INTEGER,DIMENSION(4) :: dims
   INTEGER :: year,month,day,hours,minutes
@@ -1495 +1369 @@
   REAL :: rtime0
   CHARACTER(LEN=30) :: str30
+  CHARACTER(LEN=35) :: str35
   CHARACTER(LEN=120) :: assoc
   CHARACTER(LEN=70) :: str70
@@ -1501 +1376 @@
  &     'JUL','AUG','SEP','OCT','NOV','DEC' /)
   CHARACTER(LEN=7) :: tmp_opp
+  LOGICAL :: l_b
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
   CALL ipsldbg (old_status=l_dbg)
 !-
-  ncid = ncdf_ids(pfileid)
+  nfid = W_F(idf)%ncfid
 !-
 ! 1.0 Create the time axes
 !-
   IF (l_dbg) WRITE(*,*) "histend : 1.0"
-!---
-  iret = NF90_DEF_DIM (ncid,'time_counter',NF90_UNLIMITED,tid(pfileid))
-!-
-! 1.1 Define all the time axes needed for this file
-!-
-  DO itx=1,nb_tax(pfileid)
-    dims(1) = tid(pfileid)
-    IF (nb_tax(pfileid) > 1) THEN
-      str30 = "t_"//tax_name(pfileid,itx)
+!-
+! 1.1 Define the time dimensions needed for this file
+!-
+  iret = NF90_DEF_DIM (nfid,'time_counter', &
+ &                     NF90_UNLIMITED,W_F(idf)%tid)
+  DO iv=1,W_F(idf)%n_var
+    IF (W_F(idf)%W_V(iv)%l_bnd) THEN
+      iret = NF90_DEF_DIM (nfid,'tbnds',2,W_F(idf)%bid)
+      EXIT
+    ENDIF
+  ENDDO
+!-
+! 1.2 Define all the time axes needed for this file
+!-
+  DO itx=1,W_F(idf)%n_tax
+    dims(1) = W_F(idf)%tid
+    l_b = (INDEX(W_F(idf)%W_V(itx)%tax_name,"t_op_") == 1)
+    IF (itx > 1) THEN
+      str30 = W_F(idf)%W_V(itx)%tax_name
     ELSE
       str30 = "time_counter"
     ENDIF
-    iret = NF90_DEF_VAR (ncid,str30,NF90_DOUBLE, &
- &                       dims(1),tdimid(pfileid,itx))
-    IF (nb_tax(pfileid) <= 1) THEN
-      iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'axis',"T")
-    ENDIF
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'standard_name',"time")
+    IF (l_b) THEN
+      str35 = TRIM(str30)//'_bnds'
+    ENDIF
+    iret = NF90_DEF_VAR (nfid,TRIM(str30),NF90_REAL8, &
+ &          dims(1),W_F(idf)%W_V(itx)%tdimid)
+    IF (itx <= 1) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid,'axis',"T")
+    ENDIF
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &          'standard_name',"time")
 !---
 !   To transform the current itau into a real date and take it
@@ -1535 +1425 @@
 !   if there is a ioconf routine to control it.
 !---
-!-- rtime0 = itau2date(itau0(pfileid),date0(pfileid),deltat(pfileid))
-    rtime0 = date0(pfileid)
+!-- rtime0 = itau2date(itau0(idf),date0(idf),deltat(idf))
+    rtime0 = W_F(idf)%date0
 !-
     CALL ju2ymds(rtime0,year,month,day,sec)
@@ -1553 +1443 @@
  &   FMT='(A,I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
  &    'seconds since ',year,month,day,hours,minutes,INT(sec)
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'units',TRIM(str70))
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'units',TRIM(str70))
 !-
     CALL ioget_calendar (str30)
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
- &                       'calendar',TRIM(str30))
-!-
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx),'title','Time')
-!-
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
- &                       'long_name','Time axis')
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'calendar',TRIM(str30))
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'title','Time')
+!-
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'long_name','Time axis')
 !-
     WRITE (UNIT=str70, &
  &   FMT='(" ",I4.4,"-",A3,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') &
  &    year,cal(month),day,hours,minutes,INT(sec)
-    iret = NF90_PUT_ATT (ncid,tdimid(pfileid,itx), &
- &                       'time_origin',TRIM(str70))
+    iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &           'time_origin',TRIM(str70))
+!---
+    IF (l_b) THEN
+      iret = NF90_PUT_ATT (nfid,W_F(idf)%W_V(itx)%tdimid, &
+ &             'bounds',TRIM(str35))
+      dims(1:2) = (/ W_F(idf)%bid,W_F(idf)%tid /)
+      iret = NF90_DEF_VAR (nfid,TRIM(str35),NF90_REAL8, &
+ &            dims(1:2),W_F(idf)%W_V(itx)%tbndid)
+    ENDIF
   ENDDO
 !-
@@ -1575 +1475 @@
   IF (l_dbg) WRITE(*,*) "histend : 2.0"
 !-
-  DO iv=1,nb_var(pfileid)
-!---
-    itax = var_axid(pfileid,iv)
-!---
-    IF (regular(pfileid) ) THEN
-      dims(1:2) = (/ xid(pfileid),yid(pfileid) /)
+  DO iv=1,W_F(idf)%n_var
+!---
+    itax = W_F(idf)%W_V(iv)%t_axid
+!---
+    IF (W_F(idf)%regular) THEN
+      dims(1:2) = (/ W_F(idf)%xid,W_F(idf)%yid /)
       dim_cnt = 2
     ELSE
-      dims(1) = xid(pfileid)
+      dims(1) = W_F(idf)%xid
       dim_cnt = 1
     ENDIF
 !---
-    tmp_opp = topp(pfileid,iv)
-    ziv = var_zaxid(pfileid,iv)
+    tmp_opp = W_F(idf)%W_V(iv)%topp
+    ziv = W_F(idf)%W_V(iv)%z_axid
 !---
 !   2.1 dimension of field
@@ -1598 +1498 @@
         IF (ziv == -99) THEN
           ndim = dim_cnt+1
-          dims(dim_cnt+1:dim_cnt+2) = (/ tid(pfileid),0 /)
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%tid,0 /)
         ELSE
           ndim = dim_cnt+2
-          dims(dim_cnt+1:dim_cnt+2) = (/zax_ids(pfileid,ziv),tid(pfileid)/)
+          dims(dim_cnt+1:dim_cnt+2) = &
+ &         (/ W_F(idf)%zax_ids(ziv),W_F(idf)%tid /)
         ENDIF
       ELSE
@@ -1609 +1510 @@
         ELSE
           ndim = dim_cnt+1
-          dims(dim_cnt+1:dim_cnt+2) = (/ zax_ids(pfileid,ziv),0 /)
+          dims(dim_cnt+1:dim_cnt+2) = (/ W_F(idf)%zax_ids(ziv),0 /)
         ENDIF
       ENDIF
 !-
-      iret = NF90_DEF_VAR (ncid,TRIM(name(pfileid,iv)),NF90_FLOAT, &
- &                         dims(1:ABS(ndim)),ncvarid)
-!-
-      ncvar_ids(pfileid,iv) = ncvarid
-!-
-      IF (LEN_TRIM(unit_name(pfileid,iv)) > 0) THEN
-        iret = NF90_PUT_ATT (ncid,ncvarid,'units', &
- &                           TRIM(unit_name(pfileid,iv)))
+      iret = NF90_DEF_VAR (nfid,TRIM(W_F(idf)%W_V(iv)%v_name), &
+ &             W_F(idf)%W_V(iv)%v_typ,dims(1:ABS(ndim)),nvid)
+!-
+      W_F(idf)%W_V(iv)%ncvid = nvid
+!-
+      IF (LEN_TRIM(W_F(idf)%W_V(iv)%unit_name) > 0) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'units', &
+ &                           TRIM(W_F(idf)%W_V(iv)%unit_name))
       ENDIF
-      iret = NF90_PUT_ATT (ncid,ncvarid,'standard_name', &
- &                         TRIM(title(pfileid,iv)))
-!-
-      iret = NF90_PUT_ATT (ncid,ncvarid,'_FillValue', &
- &                         REAL(missing_val,KIND=4))
-      IF (hist_wrt_rng(pfileid,iv)) THEN
-        iret = NF90_PUT_ATT (ncid,ncvarid,'valid_min', &
- &                           REAL(hist_minmax(pfileid,iv,1),KIND=4))
-        iret = NF90_PUT_ATT (ncid,ncvarid,'valid_max', &
- &                           REAL(hist_minmax(pfileid,iv,2),KIND=4))
+      iret = NF90_PUT_ATT (nfid,nvid,'standard_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%std_name))
+!-
+      IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL8)
+      ELSE
+        iret = NF90_PUT_ATT (nfid,nvid,'_FillValue',NF90_FILL_REAL4)
       ENDIF
-      iret = NF90_PUT_ATT (ncid,ncvarid,'long_name', &
- &                         TRIM(title(pfileid,iv)))
-      iret = NF90_PUT_ATT (ncid,ncvarid,'online_operation', &
- &                         TRIM(fullop(pfileid,iv)))
+      IF (W_F(idf)%W_V(iv)%hist_wrt_rng) THEN
+        IF (W_F(idf)%W_V(iv)%v_typ == hist_r8) THEN
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=8))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=8))
+        ELSE
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_min', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(1),KIND=4))
+          iret = NF90_PUT_ATT (nfid,nvid,'valid_max', &
+ &                 REAL(W_F(idf)%W_V(iv)%hist_minmax(2),KIND=4))
+        ENDIF
+      ENDIF
+      iret = NF90_PUT_ATT (nfid,nvid,'long_name', &
+ &                         TRIM(W_F(idf)%W_V(iv)%title))
+      iret = NF90_PUT_ATT (nfid,nvid,'online_operation', &
+ &                         TRIM(W_F(idf)%W_V(iv)%fullop))
 !-
       SELECT CASE(ndim)
@@ -1646 +1557 @@
       END SELECT
 !-
-      assoc=TRIM(hax_name(pfileid,var_haxid(pfileid,iv),2))  &
- &   //' '//TRIM(hax_name(pfileid,var_haxid(pfileid,iv),1))
-!-
-      ziv = var_zaxid(pfileid,iv)
+      assoc=TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,2)) &
+ &   //' '//TRIM(W_F(idf)%hax_name(W_F(idf)%W_V(iv)%h_axid,1))
+!-
+      ziv = W_F(idf)%W_V(iv)%z_axid
       IF (ziv > 0) THEN
-        str30 = zax_name(pfileid,ziv)
+        str30 = W_F(idf)%zax_name(ziv)
         assoc = TRIM(str30)//' '//TRIM(assoc)
       ENDIF
 !-
       IF (itax > 0) THEN
-        IF (nb_tax(pfileid) > 1) THEN
-          str30 = "t_"//tax_name(pfileid,itax)
+        IF (itax > 1) THEN
+          str30 = W_F(idf)%W_V(itax)%tax_name
         ELSE
           str30 = "time_counter"
@@ -1665 +1576 @@
         IF (l_dbg) THEN
           WRITE(*,*) "histend : 2.0.n, freq_opp, freq_wrt", &
- &                   freq_opp(pfileid,iv),freq_wrt(pfileid,iv)
+ &          W_F(idf)%W_V(iv)%freq_opp,W_F(idf)%W_V(iv)%freq_wrt
         ENDIF
 !-
-        iret = NF90_PUT_ATT (ncid,ncvarid,'interval_operation', &
- &                           REAL(freq_opp(pfileid,iv),KIND=4))
-        iret = NF90_PUT_ATT (ncid,ncvarid,'interval_write', &
- &                           REAL(freq_wrt(pfileid,iv),KIND=4))
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_operation', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_opp,KIND=4))
+        iret = NF90_PUT_ATT (nfid,nvid,'interval_write', &
+ &                           REAL(W_F(idf)%W_V(iv)%freq_wrt,KIND=4))
       ENDIF
-      iret = NF90_PUT_ATT (ncid,ncvarid,'coordinates',TRIM(assoc))
+      iret = NF90_PUT_ATT (nfid,nvid,'coordinates',TRIM(assoc))
     ENDIF
   ENDDO
@@ -1679 +1590 @@
 ! 2.2 Add DOMAIN attributes if needed
 !-
-  IF (dom_id_svg(pfileid) >= 0) THEN
-    CALL flio_dom_att (ncid,dom_id_svg(pfileid))
+  IF (W_F(idf)%dom_id_svg >= 0) THEN
+    CALL flio_dom_att (nfid,W_F(idf)%dom_id_svg)
   ENDIF
 !-
@@ -1687 +1598 @@
   IF (l_dbg) WRITE(*,*) "histend : 3.0"
 !-
-  iret = NF90_ENDDEF (ncid)
+  iret = NF90_ENDDEF (nfid)
 !-
 ! 4.0 Give some informations to the user
@@ -1693 +1604 @@
   IF (l_dbg) WRITE(*,*) "histend : 4.0"
 !-
-  WRITE(str70,'("All variables have been initialized on file :",I3)') pfileid
+  WRITE(str70,'("All variables have been initialized on file :",I3)') idf
   CALL ipslerr (1,'histend',str70,'',' ')
 !---------------------
 END SUBROUTINE histend
 !===
-SUBROUTINE histwrite_r1d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+SUBROUTINE histwrite_r1d (idf,pvarname,pitau,pdata,nbindex,nindex)
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
   INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
   REAL,DIMENSION(:),INTENT(IN) :: pdata
   CHARACTER(LEN=*),INTENT(IN) :: pvarname
 !---------------------------------------------------------------------
-  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_1d=pdata)
 !---------------------------
 END SUBROUTINE histwrite_r1d
 !===
-SUBROUTINE histwrite_r2d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+SUBROUTINE histwrite_r2d (idf,pvarname,pitau,pdata,nbindex,nindex)
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
   INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
   REAL,DIMENSION(:,:),INTENT(IN) :: pdata
   CHARACTER(LEN=*),INTENT(IN) :: pvarname
 !---------------------------------------------------------------------
-  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_2d=pdata)
 !---------------------------
 END SUBROUTINE histwrite_r2d
 !===
-SUBROUTINE histwrite_r3d (pfileid,pvarname,pitau,pdata,nbindex,nindex)
+SUBROUTINE histwrite_r3d (idf,pvarname,pitau,pdata,nbindex,nindex)
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
   INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
   REAL,DIMENSION(:,:,:),INTENT(IN) :: pdata
   CHARACTER(LEN=*),INTENT(IN) :: pvarname
 !---------------------------------------------------------------------
-  CALL histw_rnd (pfileid,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
+  CALL histw_rnd (idf,pvarname,pitau,nbindex,nindex,pdata_3d=pdata)
 !---------------------------
 END SUBROUTINE histwrite_r3d
 !===
-SUBROUTINE histw_rnd (pfileid,pvarname,pitau,nbindex,nindex, &
+SUBROUTINE histw_rnd (idf,pvarname,pitau,nbindex,nindex, &
   &                   pdata_1d,pdata_2d,pdata_3d)
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pitau,nbindex
+  INTEGER,INTENT(IN) :: idf,pitau,nbindex
   INTEGER,DIMENSION(nbindex),INTENT(IN) :: nindex
   CHARACTER(LEN=*),INTENT(IN) :: pvarname
@@ -1750 +1661 @@
 !-
   LOGICAL :: do_oper,do_write,largebuf,l1d,l2d,l3d
-  INTEGER :: varid,io,nbpt_out
+  INTEGER :: iv,io,nbpt_out
   INTEGER              :: nbpt_in1
   INTEGER,DIMENSION(2) :: nbpt_in2
   INTEGER,DIMENSION(3) :: nbpt_in3
-  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp
-  INTEGER,SAVE :: buff_tmp_sz
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_1
   CHARACTER(LEN=7) :: tmp_opp
   CHARACTER(LEN=13) :: c_nam
@@ -1771 +1681 @@
   ENDIF
 !-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite : ",c_nam
+  ENDIF
+!-
 ! 1.0 Try to catch errors like specifying the wrong file ID.
 !     Thanks Marine for showing us what errors users can make !
 !-
-  IF ( (pfileid < 1).OR.(pfileid > nb_files) ) THEN
+  IF ( (idf < 1).OR.(idf > nb_files_max) ) THEN
     CALL ipslerr (3,"histwrite", &
  &    'Illegal file ID in the histwrite of variable',pvarname,' ')
@@ -1781 +1695 @@
 ! 1.1 Find the id of the variable to be written and the real time
 !-
-  CALL histvar_seq (pfileid,pvarname,varid)
+  CALL histvar_seq (idf,pvarname,iv)
 !-
 ! 2.0 do nothing for never operation
 !-
-  tmp_opp = topp(pfileid,varid)
+  tmp_opp = W_F(idf)%W_V(iv)%topp
 !-
   IF (TRIM(tmp_opp) == "never") THEN
-    last_opp_chk(pfileid,varid) = -99
-    last_wrt_chk(pfileid,varid) = -99
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
   ENDIF
 !-
 ! 3.0 We check if we need to do an operation
 !-
-  IF (last_opp_chk(pfileid,varid) == pitau) THEN
+  IF (W_F(idf)%W_V(iv)%last_opp_chk == pitau) THEN
     CALL ipslerr (3,"histwrite", &
  &    'This variable has already been analysed at the present', &
@@ -1801 +1715 @@
 !-
   CALL isittime &
- &  (pitau,date0(pfileid),deltat(pfileid),freq_opp(pfileid,varid), &
- &   last_opp(pfileid,varid),last_opp_chk(pfileid,varid),do_oper)
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp, &
+ &   W_F(idf)%W_V(iv)%last_opp_chk,do_oper)
 !-
 ! 4.0 We check if we need to write the data
 !-
-  IF (last_wrt_chk(pfileid,varid) == pitau) THEN
+  IF (W_F(idf)%W_V(iv)%last_wrt_chk == pitau) THEN
     CALL ipslerr (3,"histwrite", &
- &    'This variable has already been written for the present', &
- &    'time step',TRIM(pvarname))
+ &    'This variable as already been written for the present', &
+ &    'time step',' ')
   ENDIF
 !-
   CALL isittime &
- &  (pitau,date0(pfileid),deltat(pfileid),freq_wrt(pfileid,varid), &
- &   last_wrt(pfileid,varid),last_wrt_chk(pfileid,varid),do_write)
+ &  (pitau,W_F(idf)%date0,W_F(idf)%deltat, &
+ &   W_F(idf)%W_V(iv)%freq_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt, &
+ &   W_F(idf)%W_V(iv)%last_wrt_chk,do_write)
 !-
 ! 5.0 histwrite called
@@ -1822 +1740 @@
 !-- 5.1 Get the sizes of the data we will handle
 !-
-    IF (datasz_in(pfileid,varid,1) <= 0) THEN
+    IF (W_F(idf)%W_V(iv)%datasz_in(1) <= 0) THEN
 !---- There is the risk here that the user has over-sized the array.
 !---- But how can we catch this ?
 !---- In the worst case we will do impossible operations
 !---- on part of the data !
-      datasz_in(pfileid,varid,1:3) = -1
+      W_F(idf)%W_V(iv)%datasz_in(1:3) = -1
       IF      (l1d) THEN
-        datasz_in(pfileid,varid,1) = SIZE(pdata_1d)
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_1d)
       ELSE IF (l2d) THEN
-        datasz_in(pfileid,varid,1) = SIZE(pdata_2d,DIM=1)
-        datasz_in(pfileid,varid,2) = SIZE(pdata_2d,DIM=2)
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_2d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_2d,DIM=2)
       ELSE IF (l3d) THEN
-        datasz_in(pfileid,varid,1) = SIZE(pdata_3d,DIM=1)
-        datasz_in(pfileid,varid,2) = SIZE(pdata_3d,DIM=2)
-        datasz_in(pfileid,varid,3) = SIZE(pdata_3d,DIM=3)
+        W_F(idf)%W_V(iv)%datasz_in(1) = SIZE(pdata_3d,DIM=1)
+        W_F(idf)%W_V(iv)%datasz_in(2) = SIZE(pdata_3d,DIM=2)
+        W_F(idf)%W_V(iv)%datasz_in(3) = SIZE(pdata_3d,DIM=3)
       ENDIF
     ENDIF
@@ -1842 +1760 @@
 !-- 5.2 The maximum size of the data will give the size of the buffer
 !-
-    IF (datasz_max(pfileid,varid) <= 0) THEN
+    IF (W_F(idf)%W_V(iv)%datasz_max <= 0) THEN
       largebuf = .FALSE.
-      DO io=1,nbopp(pfileid,varid)
-        IF (INDEX(fuchnbout,sopps(pfileid,varid,io)) > 0) THEN
+      DO io=1,W_F(idf)%W_V(iv)%nbopp
+        IF (INDEX(fuchnbout,W_F(idf)%W_V(iv)%sopp(io)) > 0) THEN
           largebuf = .TRUE.
         ENDIF
       ENDDO
       IF (largebuf) THEN
-        datasz_max(pfileid,varid) = &
- &        scsize(pfileid,varid,1) &
- &       *scsize(pfileid,varid,2) &
- &       *scsize(pfileid,varid,3)
+        W_F(idf)%W_V(iv)%datasz_max = &
+ &        W_F(idf)%W_V(iv)%scsize(1) &
+ &       *W_F(idf)%W_V(iv)%scsize(2) &
+ &       *W_F(idf)%W_V(iv)%scsize(3)
       ELSE
         IF      (l1d) THEN
-          datasz_max(pfileid,varid) = &
- &          datasz_in(pfileid,varid,1)
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1)
         ELSE IF (l2d) THEN
-          datasz_max(pfileid,varid) = &
- &          datasz_in(pfileid,varid,1) &
- &         *datasz_in(pfileid,varid,2)
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2)
         ELSE IF (l3d) THEN
-          datasz_max(pfileid,varid) = &
- &          datasz_in(pfileid,varid,1) &
- &         *datasz_in(pfileid,varid,2) &
- &         *datasz_in(pfileid,varid,3)
+          W_F(idf)%W_V(iv)%datasz_max = &
+ &          W_F(idf)%W_V(iv)%datasz_in(1) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(2) &
+ &         *W_F(idf)%W_V(iv)%datasz_in(3)
         ENDIF
       ENDIF
     ENDIF
 !-
-    IF (.NOT.ALLOCATED(buff_tmp)) THEN
+    IF (.NOT.ALLOCATED(tbf_1)) THEN
       IF (l_dbg) THEN
         WRITE(*,*) &
- &       c_nam//" : allocate buff_tmp for buff_sz = ", &
- &       datasz_max(pfileid,varid)
+ &       c_nam//" : allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
       ENDIF
-      ALLOCATE(buff_tmp(datasz_max(pfileid,varid)))
-      buff_tmp_sz = datasz_max(pfileid,varid)
-    ELSE IF (datasz_max(pfileid,varid) > buff_tmp_sz) THEN
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
+    ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_1)) THEN
       IF (l_dbg) THEN
         WRITE(*,*) &
- &       c_nam//" : re-allocate buff_tmp for buff_sz = ", &
- &       datasz_max(pfileid,varid)
+ &       c_nam//" : re-allocate tbf_1 for size = ", &
+ &       W_F(idf)%W_V(iv)%datasz_max
       ENDIF
-      DEALLOCATE(buff_tmp)
-      ALLOCATE(buff_tmp(datasz_max(pfileid,varid)))
-      buff_tmp_sz = datasz_max(pfileid,varid)
+      DEALLOCATE(tbf_1)
+      ALLOCATE(tbf_1(W_F(idf)%W_V(iv)%datasz_max))
     ENDIF
 !-
@@ -1894 +1810 @@
 !-- of the data at the same time. This should speed up things.
 !-
-    nbpt_out = datasz_max(pfileid,varid)
+    nbpt_out = W_F(idf)%W_V(iv)%datasz_max
     IF      (l1d) THEN
-      nbpt_in1 = datasz_in(pfileid,varid,1)
-      CALL mathop (sopps(pfileid,varid,1),nbpt_in1,pdata_1d, &
+      nbpt_in1 = W_F(idf)%W_V(iv)%datasz_in(1)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in1,pdata_1d, &
  &                 missing_val,nbindex,nindex, &
- &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
     ELSE IF (l2d) THEN
-      nbpt_in2(1:2) = datasz_in(pfileid,varid,1:2)
-      CALL mathop (sopps(pfileid,varid,1),nbpt_in2,pdata_2d, &
+      nbpt_in2(1:2) = W_F(idf)%W_V(iv)%datasz_in(1:2)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in2,pdata_2d, &
  &                 missing_val,nbindex,nindex, &
- &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
     ELSE IF (l3d) THEN
-      nbpt_in3(1:3) = datasz_in(pfileid,varid,1:3)
-      CALL mathop (sopps(pfileid,varid,1),nbpt_in3,pdata_3d, &
+      nbpt_in3(1:3) = W_F(idf)%W_V(iv)%datasz_in(1:3)
+      CALL mathop (W_F(idf)%W_V(iv)%sopp(1),nbpt_in3,pdata_3d, &
  &                 missing_val,nbindex,nindex, &
- &                 scal(pfileid,varid,1),nbpt_out,buff_tmp)
-    ENDIF
-    CALL histwrite_real (pfileid,varid,pitau,nbpt_out, &
- &            buff_tmp,nbindex,nindex,do_oper,do_write)
+ &                 W_F(idf)%W_V(iv)%scal(1),nbpt_out,tbf_1)
+    ENDIF
+    CALL histwrite_real (idf,iv,pitau,nbpt_out, &
+ &            tbf_1,nbindex,nindex,do_oper,do_write)
   ENDIF
 !-
@@ -1918 +1834 @@
 !-
   IF ((TRIM(tmp_opp) /= "once").AND.(TRIM(tmp_opp) /= "never")) THEN
-    last_opp_chk(pfileid,varid) = pitau
-    last_wrt_chk(pfileid,varid) = pitau
+    W_F(idf)%W_V(iv)%last_opp_chk = pitau
+    W_F(idf)%W_V(iv)%last_wrt_chk = pitau
   ELSE
-    last_opp_chk(pfileid,varid) = -99
-    last_wrt_chk(pfileid,varid) = -99
+    W_F(idf)%W_V(iv)%last_opp_chk = -99
+    W_F(idf)%W_V(iv)%last_wrt_chk = -99
   ENDIF
 !-----------------------
@@ -1928 +1844 @@
 !===
 SUBROUTINE histwrite_real &
- & (pfileid,varid,pitau,nbdpt,buff_tmp,nbindex,nindex,do_oper,do_write)
+ & (idf,iv,pitau,nbdpt,tbf_1,nbindex,nindex,do_oper,do_write)
 !---------------------------------------------------------------------
 !- This subroutine is internal and does the calculations and writing
@@ -1936 +1852 @@
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(IN) :: pfileid,pitau,varid, &
+  INTEGER,INTENT(IN) :: idf,pitau,iv, &
  &                      nbindex,nindex(nbindex),nbdpt
-  REAL,DIMENSION(:)  :: buff_tmp
+  REAL,DIMENSION(:)  :: tbf_1
   LOGICAL,INTENT(IN) :: do_oper,do_write
 !-
-  INTEGER :: tsz,ncid,ncvarid,i,iret,ipt,itax,io,nbin,nbout
+  INTEGER :: tsz,nfid,nvid,iret,itax,io,nbin,nbout
   INTEGER :: nx,ny,nz,ky,kz,kt,kc
   INTEGER,DIMENSION(4) :: corner,edges
@@ -1947 +1863 @@
 !-
   REAL :: rtime
+  REAL,DIMENSION(2) :: t_bnd
   CHARACTER(LEN=7) :: tmp_opp
-  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: buff_tmp2,buffer_used
-  INTEGER,SAVE :: buff_tmp2_sz,buffer_sz
+  REAL,ALLOCATABLE,DIMENSION(:),SAVE :: tbf_2
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
@@ -1955 +1871 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) "histwrite 0.0 : VAR : ",name(pfileid,varid)
-    WRITE(*,*) "histwrite 0.0 : nbindex,nindex :", &
- &  nbindex,nindex(1:MIN(3,nbindex)),'...',nindex(MAX(1,nbindex-3):nbindex)
+    WRITE(*,*) "histwrite 0.0 : VAR : ",W_F(idf)%W_V(iv)%v_name
+    WRITE(*,*) "histwrite 0.0 : nbindex :",nbindex
+    WRITE(*,*) "histwrite 0.0 : nindex  :",nindex(1:MIN(3,nbindex)),'...'
   ENDIF
 !-
 ! The sizes which can be encoutered
 !-
-  tsz =  zsize(pfileid,varid,1) &
- &      *zsize(pfileid,varid,2) &
- &      *zsize(pfileid,varid,3)
-!-
-! 1.0 We allocate the memory needed to store the data between write
-!     and the temporary space needed for operations.
-!     We have to keep precedent buffer if needed
-!-
-  IF (.NOT. ALLOCATED(buffer)) THEN
-    IF (l_dbg) WRITE(*,*) "histwrite_real 1.0 allocate buffer ",buff_pos
-    ALLOCATE(buffer(buff_pos))
-    buffer_sz = buff_pos
-    buffer(:)=0.0
-  ELSE IF (buffer_sz < buff_pos) THEN
+  tsz =  W_F(idf)%W_V(iv)%zsize(1) &
+ &      *W_F(idf)%W_V(iv)%zsize(2) &
+ &      *W_F(idf)%W_V(iv)%zsize(3)
+!-
+! 1.0 We allocate and the temporary space needed for operations.
+!     The buffers are only deallocated when more space is needed.
+!     This reduces the umber of allocates but increases memory needs.
+!-
+  IF (.NOT.ALLOCATED(tbf_2)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite_real 1.0.1 re-allocate buffer for ", &
- &      buff_pos," instead of ",SIZE(buffer)
-    ENDIF
-    IF (SUM(buffer)/=0.0) THEN
-      IF (l_dbg) WRITE (*,*) 'histwrite : buffer has been used. ', &
- &      'We have to save it before re-allocating.'
-      ALLOCATE(buffer_used(buffer_sz))
-      buffer_used(:)=buffer(:)
-      DEALLOCATE(buffer)
-      ALLOCATE(buffer(buff_pos))
-      buffer_sz = buff_pos
-      buffer(:)=0.0
-      buffer(:SIZE(buffer_used))=buffer_used
-      DEALLOCATE(buffer_used)
-    ELSE
-      IF (l_dbg) WRITE (*,*) 'histwrite : buffer has not been used. ', &
- &      'We have just to re-allocate it.'
-      DEALLOCATE(buffer)
-      ALLOCATE(buffer(buff_pos))
-      buffer_sz = buff_pos
-      buffer(:)=0.0
-    ENDIF
-  ENDIF
-!-
-! The buffers are only deallocated when more space is needed. This
-! reduces the umber of allocates but increases memory needs.
-!-
-  IF (.NOT.ALLOCATED(buff_tmp2)) THEN
+      WRITE(*,*) "histwrite_real 1.1 allocate tbf_2 ",SIZE(tbf_1)
+    ENDIF
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ELSE IF (W_F(idf)%W_V(iv)%datasz_max > SIZE(tbf_2)) THEN
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite_real 1.1 allocate buff_tmp2 ",SIZE(buff_tmp)
-    ENDIF
-    ALLOCATE(buff_tmp2(datasz_max(pfileid,varid)))
-    buff_tmp2_sz = datasz_max(pfileid,varid)
-  ELSE IF (datasz_max(pfileid,varid) > buff_tmp2_sz) THEN
-    IF (l_dbg) THEN
-      WRITE(*,*) "histwrite_real 1.2 re-allocate buff_tmp2 : ", &
-     & SIZE(buff_tmp)," instead of ",SIZE(buff_tmp2)
-    ENDIF
-    DEALLOCATE(buff_tmp2)
-    ALLOCATE(buff_tmp2(datasz_max(pfileid,varid)))
-    buff_tmp2_sz = datasz_max(pfileid,varid)
-  ENDIF
-!-
-  rtime = pitau * deltat(pfileid)
-  tmp_opp = topp(pfileid,varid)
-!-
-! 3.0 Do the operations or transfer the slab of data into buff_tmp
-!-
-  IF (l_dbg) WRITE(*,*) "histwrite: 3.0",pfileid
+      WRITE(*,*) "histwrite_real 1.2 re-allocate tbf_2 : ", &
+     & SIZE(tbf_1)," instead of ",SIZE(tbf_2)
+    ENDIF
+    DEALLOCATE(tbf_2)
+    ALLOCATE(tbf_2(W_F(idf)%W_V(iv)%datasz_max))
+  ENDIF
+!-
+  rtime = pitau*W_F(idf)%deltat
+  tmp_opp = W_F(idf)%W_V(iv)%topp
+!-
+! 3.0 Do the operations or transfer the slab of data into tbf_1
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "histwrite: 3.0",idf
+  ENDIF
 !-
 ! 3.1 DO the Operations only if needed
 !-
   IF (do_oper) THEN
-    i = pfileid
     nbout = nbdpt
 !-
@@ -2036 +1917 @@
 !--     we started in the interface routine
 !-
-    DO io = 2,nbopp(i,varid),2
+    DO io=2,W_F(idf)%W_V(iv)%nbopp,2
       nbin = nbout
-      nbout = datasz_max(i,varid)
-      CALL mathop(sopps(i,varid,io),nbin,buff_tmp,missing_val, &
- &      nbindex,nindex,scal(i,varid,io),nbout,buff_tmp2)
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io),nbin,tbf_1, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io), &
+ &      nbout,tbf_2)
       IF (l_dbg) THEN
         WRITE(*,*) &
- &       "histwrite: 3.4a nbout : ",nbin,nbout,sopps(i,varid,io)
+ &       "histwrite: 3.4a nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io)
       ENDIF
 !-
       nbin = nbout
-      nbout = datasz_max(i,varid)
-      CALL mathop(sopps(i,varid,io+1),nbin,buff_tmp2,missing_val, &
- &      nbindex,nindex,scal(i,varid,io+1),nbout,buff_tmp)
+      nbout = W_F(idf)%W_V(iv)%datasz_max
+      CALL mathop(W_F(idf)%W_V(iv)%sopp(io+1),nbin,tbf_2, &
+ &      missing_val,nbindex,nindex,W_F(idf)%W_V(iv)%scal(io+1), &
+ &      nbout,tbf_1)
       IF (l_dbg) THEN
         WRITE(*,*) &
- &       "histwrite: 3.4b nbout : ",nbin,nbout,sopps(i,varid,io+1)
+ &     "histwrite: 3.4b nbout : ",nbin,nbout,W_F(idf)%W_V(iv)%sopp(io+1)
       ENDIF
     ENDDO
@@ -2060 +1943 @@
     IF (l_dbg) THEN
       WRITE(*,*) &
- &     "histwrite: 3.5 size(buff_tmp) : ",SIZE(buff_tmp)
+ &     "histwrite: 3.5 size(tbf_1) : ",SIZE(tbf_1)
       WRITE(*,*) &
- &     "histwrite: 3.5 slab in X :",zorig(i,varid,1),zsize(i,varid,1)
+ &     "histwrite: 3.5 slab in X :", &
+ &     W_F(idf)%W_V(iv)%zorig(1),W_F(idf)%W_V(iv)%zsize(1)
       WRITE(*,*) &
- &     "histwrite: 3.5 slab in Y :",zorig(i,varid,2),zsize(i,varid,2)
+ &     "histwrite: 3.5 slab in Y :", &
+ &     W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zsize(2)
       WRITE(*,*) &
- &     "histwrite: 3.5 slab in Z :",zorig(i,varid,3),zsize(i,varid,3)
+ &     "histwrite: 3.5 slab in Z :", &
+ &     W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zsize(3)
       WRITE(*,*) &
  &     "histwrite: 3.5 slab of input:", &
- &     scsize(i,varid,1),scsize(i,varid,2),scsize(i,varid,3)
+ &     W_F(idf)%W_V(iv)%scsize(1), &
+ &     W_F(idf)%W_V(iv)%scsize(2), &
+ &     W_F(idf)%W_V(iv)%scsize(3)
     ENDIF
 !---
 !-- We have to consider blocks of contiguous data
 !---
-    nx=MAX(zsize(i,varid,1),1)
-    ny=MAX(zsize(i,varid,2),1)
-    nz=MAX(zsize(i,varid,3),1)
-    IF     (     (zorig(i,varid,1) == 1) &
-   &        .AND.(zsize(i,varid,1) == scsize(i,varid,1)) &
-   &        .AND.(zorig(i,varid,2) == 1) &
-   &        .AND.(zsize(i,varid,2) == scsize(i,varid,2))) THEN
-      kt = (zorig(i,varid,3)-1)*nx*ny
-      buff_tmp2(1:nx*ny*nz) = buff_tmp(kt+1:kt+nx*ny*nz)
-    ELSEIF (     (zorig(i,varid,1) == 1) &
-   &        .AND.(zsize(i,varid,1) == scsize(i,varid,1))) THEN
+    nx=MAX(W_F(idf)%W_V(iv)%zsize(1),1)
+    ny=MAX(W_F(idf)%W_V(iv)%zsize(2),1)
+    nz=MAX(W_F(idf)%W_V(iv)%zsize(3),1)
+    IF     (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1)) &
+ &          .AND.(W_F(idf)%W_V(iv)%zorig(2) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(2) &
+ &                == W_F(idf)%W_V(iv)%scsize(2))) THEN
+      kt = (W_F(idf)%W_V(iv)%zorig(3)-1)*nx*ny
+      tbf_2(1:nx*ny*nz) = tbf_1(kt+1:kt+nx*ny*nz)
+    ELSEIF (     (W_F(idf)%W_V(iv)%zorig(1) == 1) &
+ &          .AND.(   W_F(idf)%W_V(iv)%zsize(1) &
+ &                == W_F(idf)%W_V(iv)%scsize(1))) THEN
       kc = -nx*ny
-      DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
         kc = kc+nx*ny
-        kt = ((kz-1)*scsize(i,varid,2)+zorig(i,varid,2)-1)*nx
-        buff_tmp2(kc+1:kc+nx*ny) = buff_tmp(kt+1:kt+nx*ny)
+        kt = ( (kz-1)*W_F(idf)%W_V(iv)%scsize(2) &
+ &            +W_F(idf)%W_V(iv)%zorig(2)-1)*nx
+        tbf_2(kc+1:kc+nx*ny) = tbf_1(kt+1:kt+nx*ny)
       ENDDO
     ELSE
       kc = -nx
-      DO kz=zorig(i,varid,3),zorig(i,varid,3)+nz-1
-        DO ky=zorig(i,varid,2),zorig(i,varid,2)+ny-1
+      DO kz=W_F(idf)%W_V(iv)%zorig(3),W_F(idf)%W_V(iv)%zorig(3)+nz-1
+        DO ky=W_F(idf)%W_V(iv)%zorig(2),W_F(idf)%W_V(iv)%zorig(2)+ny-1
           kc = kc+nx
-          kt = ((kz-1)*scsize(i,varid,2)+ky-1)*scsize(i,varid,1) &
-   &          +zorig(i,varid,1)-1
-          buff_tmp2(kc+1:kc+nx) = buff_tmp(kt+1:kt+nx)
+          kt = ((kz-1)*W_F(idf)%W_V(iv)%scsize(2)+ky-1) &
+ &            *W_F(idf)%W_V(iv)%scsize(1) &
+ &            +W_F(idf)%W_V(iv)%zorig(1)-1
+          tbf_2(kc+1:kc+nx) = tbf_1(kt+1:kt+nx)
         ENDDO
       ENDDO
     ENDIF
 !-
-!-- 4.0 Get the min and max of the field (buff_tmp)
-!-
-    IF (l_dbg) WRITE(*,*) "histwrite: 4.0 buff_tmp",pfileid,varid, &
- &    TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
-!-
-    IF (hist_calc_rng(pfileid,varid)) THEN
-      hist_minmax(pfileid,varid,1) = &
- &      MIN(hist_minmax(pfileid,varid,1), &
- &      MINVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val))
-      hist_minmax(pfileid,varid,2) = &
- &      MAX(hist_minmax(pfileid,varid,2), &
- &      MAXVAL(buff_tmp2(1:tsz),MASK=buff_tmp2(1:tsz) /= missing_val))
+!-- 4.0 Get the min and max of the field
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 4.0 tbf_1",idf,iv, &
+ &      TRIM(tmp_opp),' ---- ',LEN_TRIM(tmp_opp),nbindex
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%hist_calc_rng) THEN
+      W_F(idf)%W_V(iv)%hist_minmax(1) = &
+ &      MIN(W_F(idf)%W_V(iv)%hist_minmax(1), &
+ &      MINVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
+      W_F(idf)%W_V(iv)%hist_minmax(2) = &
+ &      MAX(W_F(idf)%W_V(iv)%hist_minmax(2), &
+ &      MAXVAL(tbf_2(1:tsz),MASK=tbf_2(1:tsz) /= missing_val))
     ENDIF
 !-
 !-- 5.0 Do the operations if needed. In the case of instantaneous
-!--     output we do not transfer to the buffer.
-!-
-    IF (l_dbg) WRITE(*,*) "histwrite: 5.0",pfileid,"tsz :",tsz
-!-
-    ipt = point(pfileid,varid)
-!-
-!   WRITE(*,*) 'OPE ipt, buffer :',pvarname,ipt,varid
+!--     output we do not transfer to the time_buffer.
+!-
+    IF (l_dbg) THEN
+      WRITE(*,*) "histwrite: 5.0 idf : ",idf," iv : ",iv," tsz : ",tsz
+    ENDIF
 !-
     IF (     (TRIM(tmp_opp) /= "inst") &
-   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
-      CALL moycum(tmp_opp,tsz,buffer(ipt:), &
-     &       buff_tmp2,nb_opp(pfileid,varid))
-    ENDIF
-!-
-    last_opp(pfileid,varid) = pitau
-    nb_opp(pfileid,varid) = nb_opp(pfileid,varid)+1
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      CALL moycum(tmp_opp,tsz,W_F(idf)%W_V(iv)%t_bf, &
+ &           tbf_2,W_F(idf)%W_V(iv)%nb_opp)
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_opp = pitau
+    W_F(idf)%W_V(iv)%nb_opp = W_F(idf)%W_V(iv)%nb_opp+1
 !-
   ENDIF
@@ -2139 +2032 @@
 ! 6.0 Write to file if needed
 !-
-  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",pfileid
+  IF (l_dbg) WRITE(*,*) "histwrite: 6.0",idf
 !-
   IF (do_write) THEN
 !-
-    ncvarid = ncvar_ids(pfileid,varid)
-    ncid = ncdf_ids(pfileid)
+    nfid = W_F(idf)%ncfid
+    nvid = W_F(idf)%W_V(iv)%ncvid
 !-
 !-- 6.1 Do the operations that are needed before writting
 !-
-    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",pfileid
+    IF (l_dbg) WRITE(*,*) "histwrite: 6.1",idf
 !-
     IF (     (TRIM(tmp_opp) /= "inst") &
-   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
-      rtime = (rtime+last_wrt(pfileid,varid)*deltat(pfileid))/2.0
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+      t_bnd(1:2) = (/ W_F(idf)%W_V(iv)%last_wrt*W_F(idf)%deltat,rtime /)
+      rtime = (t_bnd(1)+t_bnd(2))/2.0
     ENDIF
 !-
@@ -2158 +2052 @@
 !-
     IF (     (TRIM(tmp_opp) /= "l_max") &
-   &    .AND.(TRIM(tmp_opp) /= "l_min") &
-   &    .AND.(TRIM(tmp_opp) /= "once") ) THEN
-!-
-      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",pfileid
-!-
-      itax = var_axid(pfileid,varid)
-      itime = nb_wrt(pfileid,varid)+1
-!-
-      IF (tax_last(pfileid,itax) < itime) THEN
-        iret = NF90_PUT_VAR (ncid,tdimid(pfileid,itax),(/ rtime /), &
- &                            start=(/ itime /),count=(/ 1 /))
-        tax_last(pfileid,itax) = itime
+ &      .AND.(TRIM(tmp_opp) /= "l_min") &
+ &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
+!-
+      IF (l_dbg) WRITE(*,*) "histwrite: 6.2",idf
+!-
+      itax  = W_F(idf)%W_V(iv)%t_axid
+      itime = W_F(idf)%W_V(iv)%nb_wrt+1
+!-
+      IF (W_F(idf)%W_V(itax)%tax_last < itime) THEN
+        iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tdimid, &
+ &               (/ rtime /),start=(/ itime /),count=(/ 1 /))
+        IF (W_F(idf)%W_V(itax)%tbndid > 0) THEN
+          iret = NF90_PUT_VAR (nfid,W_F(idf)%W_V(itax)%tbndid, &
+ &                 t_bnd,start=(/ 1,itime /),count=(/ 2,1 /))
+        ENDIF
+        W_F(idf)%W_V(itax)%tax_last = itime
       ENDIF
     ELSE
@@ -2179 +2077 @@
 !-
     IF (l_dbg) THEN
-      WRITE(*,*) "histwrite: 6.3",pfileid,ncid,ncvarid,varid,itime
-    ENDIF
-!-
-    IF (scsize(pfileid,varid,3) == 1) THEN
-      IF (regular(pfileid)) THEN
+      WRITE(*,*) "histwrite: 6.3",idf,nfid,nvid,iv,itime
+    ENDIF
+!-
+    IF (W_F(idf)%W_V(iv)%scsize(3) == 1) THEN
+      IF (W_F(idf)%regular) THEN
         corner(1:4) = (/ 1,1,itime,0 /)
-        edges(1:4) = (/ zsize(pfileid,varid,1), &
- &                      zsize(pfileid,varid,2),1,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2),1,0 /)
       ELSE
         corner(1:4) = (/ 1,itime,0,0 /)
-        edges(1:4) = (/ zsize(pfileid,varid,1),1,0,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1),1,0,0 /)
       ENDIF
     ELSE
-      IF (regular(pfileid)) THEN
+      IF (W_F(idf)%regular) THEN
         corner(1:4) = (/ 1,1,1,itime /)
-        edges(1:4) = (/ zsize(pfileid,varid,1), &
- &                      zsize(pfileid,varid,2), &
- &                      zsize(pfileid,varid,3),1 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(2), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1 /)
       ELSE
         corner(1:4) = (/ 1,1,itime,0 /)
-        edges(1:4) = (/ zsize(pfileid,varid,1), &
- &                      zsize(pfileid,varid,3),1,0 /)
+        edges(1:4) = (/ W_F(idf)%W_V(iv)%zsize(1), &
+ &                      W_F(idf)%W_V(iv)%zsize(3),1,0 /)
       ENDIF
     ENDIF
-!-
-    ipt = point(pfileid,varid)
 !-
     IF (     (TRIM(tmp_opp) /= "inst") &
  &      .AND.(TRIM(tmp_opp) /= "once") ) THEN
-      iret = NF90_PUT_VAR (ncid,ncvarid,buffer(ipt:), &
- &                       start=corner(1:4),count=edges(1:4))
+      iret = NF90_PUT_VAR (nfid,nvid,W_F(idf)%W_V(iv)%t_bf, &
+ &                         start=corner(1:4),count=edges(1:4))
     ELSE
-      iret = NF90_PUT_VAR (ncid,ncvarid,buff_tmp2, &
- &                       start=corner(1:4),count=edges(1:4))
-    ENDIF
-!-
-    last_wrt(pfileid,varid) = pitau
-    nb_wrt(pfileid,varid) = nb_wrt(pfileid,varid)+1
-    nb_opp(pfileid,varid) = 0
+      iret = NF90_PUT_VAR (nfid,nvid,tbf_2, &
+ &                         start=corner(1:4),count=edges(1:4))
+    ENDIF
+!-
+    W_F(idf)%W_V(iv)%last_wrt = pitau
+    W_F(idf)%W_V(iv)%nb_wrt = W_F(idf)%W_V(iv)%nb_wrt+1
+    W_F(idf)%W_V(iv)%nb_opp = 0
 !---
 !   After the write the file can be synchronized so that no data is
@@ -2224 +2120 @@
 !   needed here to switch to this mode.
 !---
-!   iret = NF90_SYNC (ncid)
+!   iret = NF90_SYNC (nfid)
 !-
   ENDIF
@@ -2230 +2126 @@
 END SUBROUTINE histwrite_real
 !===
-SUBROUTINE histvar_seq (pfid,pvarname,pvid)
-!---------------------------------------------------------------------
-!- This subroutine optimized the search for the variable in the table.
+SUBROUTINE histvar_seq (idf,pvarname,idv)
+!---------------------------------------------------------------------
+!- This subroutine optimize the search for the variable in the table.
 !- In a first phase it will learn the succession of the variables
 !- called and then it will use the table to guess what comes next.
@@ -2240 +2136 @@
 !- ARGUMENTS :
 !-
-!- pfid  : id of the file on which we work
+!- idf      : id of the file on which we work
 !- pvarname : The name of the variable we are looking for
-!- pvid     : The var id we found
+!- idv      : The var id we found
 !---------------------------------------------------------------------
   IMPLICIT NONE
 !-
-  INTEGER,INTENT(in)  :: pfid
+  INTEGER,INTENT(in)  :: idf
   CHARACTER(LEN=*),INTENT(IN) :: pvarname
-  INTEGER,INTENT(out) :: pvid
+  INTEGER,INTENT(out) :: idv
 !-
   LOGICAL,SAVE :: learning(nb_files_max)=.TRUE.
@@ -2263 +2159 @@
 !-
   IF (l_dbg) THEN
-    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(pfid)
-  ENDIF
-!-
-  IF (learning(pfid)) THEN
+    WRITE(*,*) 'histvar_seq, start of the subroutine :',learning(idf)
+  ENDIF
+!-
+  IF (learning(idf)) THEN
 !-
 !-- 1.0 We compute the length over which we are going
 !--     to check the overlap
 !-
-    IF (overlap(pfid) <= 0) THEN
-      IF (nb_var(pfid) > 6) THEN
-        overlap(pfid) = nb_var(pfid)/3*2
+    IF (overlap(idf) <= 0) THEN
+      IF (W_F(idf)%n_var > 6) THEN
+        overlap(idf) = W_F(idf)%n_var/3*2
       ELSE
-        overlap(pfid) = nb_var(pfid)
+        overlap(idf) = W_F(idf)%n_var
       ENDIF
     ENDIF
@@ -2281 +2177 @@
 !-- 1.1 Find the position of this string
 !-
-    CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
+    CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
     IF (pos > 0) THEN
-      pvid = pos
+      idv = pos
     ELSE
       CALL ipslerr (3,"histvar_seq", &
@@ -2294 +2190 @@
 !--     in the sequence of calls
 !-
-    IF (varseq_err(pfid) >= 0) THEN
-      sp = varseq_len(pfid)+1
+    IF (varseq_err(idf) >= 0) THEN
+      sp = varseq_len(idf)+1
       IF (sp <= nb_var_max*3) THEN
-        varseq(pfid,sp) = pvid
-        varseq_len(pfid) = sp
+        varseq(idf,sp) = idv
+        varseq_len(idf) = sp
       ELSE
         CALL ipslerr (2,"histvar_seq",&
@@ -2308 +2204 @@
  &       ' contact the IOIPSL team. ')
         WRITE(*,*) 'The sequence we have found up to now :'
-        WRITE(*,*) varseq(pfid,1:sp-1)
-        varseq_err(pfid) = -1
+        WRITE(*,*) varseq(idf,1:sp-1)
+        varseq_err(idf) = -1
       ENDIF
 !-
 !---- 1.3 Check if we have found the right overlap
 !-
-      IF (varseq_len(pfid) .GE. overlap(pfid)*2) THEN
+      IF (varseq_len(idf) >= overlap(idf)*2) THEN
 !-
 !------ We skip a few variables if needed as they could come
 !------ from the initialisation of the model.
 !-
-        DO ib = 0,sp-overlap(pfid)*2
-          IF ( learning(pfid) .AND.&
-            & SUM(ABS(varseq(pfid,ib+1:ib+overlap(pfid)) -&
-            & varseq(pfid,sp-overlap(pfid)+1:sp))) == 0 ) THEN
-            learning(pfid) = .FALSE.
-            varseq_len(pfid) = sp-overlap(pfid)-ib
-            varseq_pos(pfid) = overlap(pfid)+ib
-            varseq(pfid,1:varseq_len(pfid)) = &
- &            varseq(pfid,ib+1:ib+varseq_len(pfid))
+        DO ib = 0,sp-overlap(idf)*2
+          IF ( learning(idf) .AND.&
+            & SUM(ABS(varseq(idf,ib+1:ib+overlap(idf)) -&
+            & varseq(idf,sp-overlap(idf)+1:sp))) == 0 ) THEN
+            learning(idf) = .FALSE.
+            varseq_len(idf) = sp-overlap(idf)-ib
+            varseq_pos(idf) = overlap(idf)+ib
+            varseq(idf,1:varseq_len(idf)) = &
+ &            varseq(idf,ib+1:ib+varseq_len(idf))
           ENDIF
         ENDDO
@@ -2337 +2233 @@
 !--     and we can get a guess at the var ID
 !-
-    nn = varseq_pos(pfid)+1
-    IF (nn > varseq_len(pfid)) nn = 1
-!-
-    pvid = varseq(pfid,nn)
-!-
-    IF (TRIM(name(pfid,pvid)) /= TRIM(pvarname)) THEN
-      CALL find_str (name(pfid,1:nb_var(pfid)),pvarname,pos)
+    nn = varseq_pos(idf)+1
+    IF (nn > varseq_len(idf)) nn = 1
+!-
+    idv = varseq(idf,nn)
+!-
+    IF (TRIM(W_F(idf)%W_V(idv)%v_name) /= TRIM(pvarname)) THEN
+      CALL find_str (W_F(idf)%W_V(1:W_F(idf)%n_var)%v_name,pvarname,pos)
       IF (pos > 0) THEN
-        pvid = pos
+        idv = pos
       ELSE
         CALL ipslerr (3,"histvar_seq", &
@@ -2352 +2248 @@
  &  TRIM(pvarname))
       ENDIF
-      varseq_err(pfid) = varseq_err(pfid)+1
+      varseq_err(idf) = varseq_err(idf)+1
     ELSE
 !-
@@ -2359 +2255 @@
 !---- not defeat the process.
 !-
-      varseq_pos(pfid) = nn
-    ENDIF
-!-
-    IF (varseq_err(pfid) .GE. 10) THEN
-      WRITE(str70,'("for file ",I3)') pfid
+      varseq_pos(idf) = nn
+    ENDIF
+!-
+    IF (varseq_err(idf) >= 10) THEN
+      WRITE(str70,'("for file ",I3)') idf
       CALL ipslerr (2,"histvar_seq", &
  &  'There were 10 errors in the learned sequence of variables',&
  &  str70,'This looks like a bug, please report it.')
-         varseq_err(pfid) = 0
+         varseq_err(idf) = 0
     ENDIF
   ENDIF
@@ -2373 +2269 @@
   IF (l_dbg) THEN
     WRITE(*,*) &
- &   'histvar_seq, end of the subroutine :',TRIM(pvarname),pvid
+ &   'histvar_seq, end of the subroutine :',TRIM(pvarname),idv
   ENDIF
 !-------------------------
 END SUBROUTINE histvar_seq
 !===
-SUBROUTINE histsync (file)
+SUBROUTINE histsync (idf)
 !---------------------------------------------------------------------
 !- This subroutine will synchronise all
@@ -2388 +2284 @@
   IMPLICIT NONE
 !-
-! file  : optional argument for fileid
-  INTEGER,INTENT(in),OPTIONAL :: file
-!-
-  INTEGER :: ifile,ncid,iret
-!-
-  LOGICAL :: file_exists
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,iret,i_s,i_e
+!-
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
   CALL ipsldbg (old_status=l_dbg)
 !-
-  IF (l_dbg) WRITE(*,*) 'Entering loop on files : ',nb_files
-!-
-! 1.The loop on files to synchronise
-!-
-  DO ifile = 1,nb_files
-!-
-    IF (PRESENT(file)) THEN
-      file_exists = (ifile == file)
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histsync"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histsync', &
+ &       'Unable to synchronise the file :','probably','not opened')
+      ENDIF
     ELSE
-      file_exists = .TRUE.
-    ENDIF
-!-
-    IF (file_exists) THEN
+      CALL ipslerr (3,'histsync','Invalid file identifier',' ',' ')
+    ENDIF
+  ELSE
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
       IF (l_dbg) THEN
-        WRITE(*,*) 'Synchronising specified file number :',file
+        WRITE(*,*) '  histsync - synchronising file number ',ifile
       ENDIF
-      ncid = ncdf_ids(ifile)
-      iret = NF90_SYNC (ncid)
-    ENDIF
-!-
+      iret = NF90_SYNC(W_F(ifile)%ncfid)
+    ENDIF
   ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histsync"
+  ENDIF
 !----------------------
 END SUBROUTINE histsync
 !===
-SUBROUTINE histclo (fid)
+SUBROUTINE histclo (idf)
 !---------------------------------------------------------------------
 !- This subroutine will close all (or one if defined) opened files
@@ -2431 +2340 @@
   IMPLICIT NONE
 !-
-! fid  : optional argument for fileid
-  INTEGER,INTENT(in),OPTIONAL :: fid
-!-
-  INTEGER :: ifile,ncid,iret,iv
-  INTEGER :: start_loop,end_loop
-  CHARACTER(LEN=70) :: str70
+! idf  : optional argument for fileid
+  INTEGER,INTENT(in),OPTIONAL :: idf
+!-
+  INTEGER :: ifile,nfid,nvid,iret,iv,i_s,i_e
   LOGICAL :: l_dbg
 !---------------------------------------------------------------------
   CALL ipsldbg (old_status=l_dbg)
 !-
-  IF (l_dbg) WRITE(*,*) 'Entering loop on files :',nb_files
-!-
-  IF (PRESENT(fid)) THEN
-    start_loop = fid
-    end_loop = fid
+  IF (l_dbg) THEN
+    WRITE(*,*) "->histclo"
+  ENDIF
+!-
+  IF (PRESENT(idf)) THEN
+    IF ( (idf >= 1).AND.(idf <= nb_files_max) ) THEN
+      IF (W_F(idf)%ncfid > 0) THEN
+        i_s = idf
+        i_e = idf
+      ELSE
+        i_s = 1
+        i_e = 0
+        CALL ipslerr (2,'histclo', &
+ &       'Unable to close the file :','probably','not opened')
+      ENDIF
+    ELSE
+      CALL ipslerr (3,'histclo','Invalid file identifier',' ',' ')
+    ENDIF
   ELSE
-    start_loop = 1
-    end_loop = nb_files
-  ENDIF
-!-
-  DO ifile=start_loop,end_loop
-    IF (l_dbg) WRITE(*,*) 'Closing specified file number :',ifile
-    ncid = ncdf_ids(ifile)
-    iret = NF90_REDEF (ncid)
-!---
-!-- 1. Loop on the number of variables to add some final information
-!---
-    IF (l_dbg) WRITE(*,*) 'Entering loop on vars : ',nb_var(ifile)
-    DO iv=1,nb_var(ifile)
-      IF (hist_wrt_rng(ifile,iv)) THEN
-        IF (l_dbg) THEN
-          WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
-         &           ' is : ',hist_minmax(ifile,iv,1)
-          WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
-         &           ' is : ',hist_minmax(ifile,iv,2)
+    i_s = 1
+    i_e = nb_files_max
+  ENDIF
+!-
+  DO ifile=i_s,i_e
+    IF (W_F(ifile)%ncfid > 0) THEN
+      IF (l_dbg) THEN
+        WRITE(*,*) '  histclo - closing specified file number :',ifile
+      ENDIF
+      nfid = W_F(ifile)%ncfid
+      iret = NF90_REDEF(nfid)
+!-----
+!---- 1. Loop on the number of variables to add some final information
+!-----
+      IF (l_dbg) THEN
+        WRITE(*,*) '  Entering loop on vars : ',W_F(ifile)%n_var
+      ENDIF
+      DO iv=1,W_F(ifile)%n_var
+!------ Extrema
+        IF (W_F(ifile)%W_V(iv)%hist_wrt_rng) THEN
+          IF (l_dbg) THEN
+            WRITE(*,*) 'min value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(1)
+            WRITE(*,*) 'max value for file :',ifile,' var n. :',iv, &
+ &                     ' is : ',W_F(ifile)%W_V(iv)%hist_minmax(2)
+          ENDIF
+          IF (W_F(ifile)%W_V(iv)%hist_calc_rng) THEN
+!---------- Put the min and max values on the file
+            nvid = W_F(ifile)%W_V(iv)%ncvid
+            IF (W_F(ifile)%W_V(iv)%v_typ == hist_r8) THEN
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=8))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=8))
+            ELSE
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_min', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(1),KIND=4))
+              iret = NF90_PUT_ATT(nfid,nvid,'valid_max', &
+ &                     REAL(W_F(ifile)%W_V(iv)%hist_minmax(2),KIND=4))
+            ENDIF
+          ENDIF
         ENDIF
-        IF (hist_calc_rng(ifile,iv)) THEN
-!-------- Put the min and max values on the file
-          iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_min', &
- &                             REAL(hist_minmax(ifile,iv,1),KIND=4))
-          iret = NF90_PUT_ATT (ncid,ncvar_ids(ifile,iv),'valid_max', &
- &                             REAL(hist_minmax(ifile,iv,2),KIND=4))
+!------ Time-Buffers
+        IF (ASSOCIATED(W_F(ifile)%W_V(iv)%t_bf)) THEN
+          DEALLOCATE(W_F(ifile)%W_V(iv)%t_bf)
         ENDIF
-      ENDIF
-    ENDDO
-!---
-!-- 2. Close the file
-!---
-    IF (l_dbg) WRITE(*,*) 'close file :',ncid
-    iret = NF90_CLOSE (ncid)
-    IF (iret /= NF90_NOERR) THEN
-      WRITE(str70,'("This file has been already closed :",I3)') ifile
-      CALL ipslerr (2,'histclo',str70,'','')
+!------ Reinitialize the sizes
+        W_F(ifile)%W_V(iv)%datasz_in(:) = -1
+        W_F(ifile)%W_V(iv)%datasz_max = -1
+      ENDDO
+!-----
+!---- 2. Close the file
+!-----
+      IF (l_dbg) WRITE(*,*) '  close file :',nfid
+      iret = NF90_CLOSE(nfid)
+      W_F(ifile)%ncfid = -1
+      W_F(ifile)%dom_id_svg = -1
     ENDIF
   ENDDO
+!-
+  IF (l_dbg) THEN
+    WRITE(*,*) "<-histclo"
+  ENDIF
 !---------------------
 END SUBROUTINE histclo

vendors/IOIPSL/current/src/mathelp.f90

@@ -1 +1 @@
 MODULE mathelp
 !-
-!$Id: mathelp.f90 440 2008-11-26 10:58:38Z bellier $
+!$Id: mathelp.f90 845 2009-12-10 16:26:03Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -28 +28 @@
 CONTAINS
 !===
-SUBROUTINE buildop (str,ex_topps,topp,nbops_max, &
- &                  missing_val,opps,scal,nbops)
+SUBROUTINE buildop (c_str,ex_topps,topp,fill_val,opps,scal,nbops)
 !---------------------------------------------------------------------
 !- This subroutine decomposes the input string in the elementary
@@ -39 +38 @@
 !- INPUT
 !-
-!- str      : String containing the operations
-!- ex_toops : The time operations that can be expected
-!-            within the string
+!- c_str    : String containing the operations
+!- ex_toops : Time operations that can be expected within the string
+!- fill_val :
 !-
 !- OUTPUT
 !-
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=80) :: str
-  CHARACTER(LEN=*) :: ex_topps
-  CHARACTER(LEN=7) :: topp
-  INTEGER :: nbops_max,nbops
-  CHARACTER(LEN=7) :: opps(nbops_max)
-  REAL :: scal(nbops_max),missing_val
-!-
-  CHARACTER(LEN=80) :: new_str
+!- topp   : Time operation
+!- opps   :
+!- scal   :
+!- nbops  :
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: c_str,ex_topps
+  CHARACTER(LEN=*),INTENT(OUT) :: topp
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,INTENT(IN) :: fill_val
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=LEN(c_str)) :: str,new_str
   INTEGER :: leng,ind_opb,ind_clb
 !-
@@ -62 +65 @@
   IF (check) WRITE(*,*) 'buildop : Some preliminary cleaning'
 !-
+  str = c_str
   leng = LEN_TRIM(str)
   IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
@@ -94 +98 @@
  &          ' buildop : Call decoop ',new_str,ind_opb,ind_clb
         ENDIF
-        CALL decoop (new_str,nbops_max,missing_val,opps,scal,nbops)
+        CALL decoop (new_str,fill_val,opps,scal,nbops)
       ELSE
         CALL ipslerr(3,'buildop', &
@@ -115 +119 @@
 END SUBROUTINE buildop
 !===
-SUBROUTINE decoop (pstr,nbops_max,missing_val,opps,scal,nbops)
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  CHARACTER(LEN=80) :: pstr
-  INTEGER :: nbops_max,nbops
-  CHARACTER(LEN=7) :: opps(nbops_max)
-  REAL :: scal(nbops_max),missing_val
-!-
-  CHARACTER(LEN=1) :: f_char(2),s_char(2)
-  INTEGER :: nbsep,f_pos(2),s_pos(2)
+SUBROUTINE decoop (pstr,fill_val,opps,scal,nbops)
+!---------------------------------------------------------------------
+  IMPLICIT NONE
+!-
+  CHARACTER(LEN=*),INTENT(IN) :: pstr
+  REAL,INTENT(IN) :: fill_val
+  CHARACTER(LEN=*),DIMENSION(:),INTENT(OUT) :: opps
+  REAL,DIMENSION(:),INTENT(OUT) :: scal
+  INTEGER,INTENT(OUT) :: nbops
+!-
+  CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
+  INTEGER,DIMENSION(2) :: f_pos,s_pos
   CHARACTER(LEN=20) :: opp_str,scal_str
-  CHARACTER(LEN=80) :: str
-  INTEGER :: xpos,leng,ppos,epos,int_tmp
+  CHARACTER(LEN=LEN(pstr)) :: str
+  INTEGER :: nbsep,nbops_max,xpos,leng,ppos,epos,int_tmp
   CHARACTER(LEN=3) :: tl,dl
   CHARACTER(LEN=10) :: fmt
@@ -134 +139 @@
   LOGICAL :: check = .FALSE.,prio
 !---------------------------------------------------------------------
-  IF (check) WRITE(*,'(2a)') ' decoop : Incoming string : ',pstr
-!-
-  nbops = 0
-  str = pstr
+  IF (check) WRITE(*,'(2A)') ' decoop : Incoming string : ',pstr
+!-
+  str = pstr; nbops = 0;
 !-
   CALL findsep (str,nbsep,f_char,f_pos,s_char,s_pos)
   IF (check) WRITE(*,*) 'decoop : Out of findsep',nbsep
+!-
+  nbops_max = min(SIZE(opps),SIZE(scal))
+!-
   DO WHILE (nbsep > 0)
+    IF (nbops >= nbops_max) THEN
+      CALL ipslerr(3,'decoop','Expression too complex',TRIM(str),' ')
+    ENDIF
+!--
     xpos = INDEX(str,'X')
     leng = LEN_TRIM(str)
@@ -147 +158 @@
 !--
     IF (check) THEN
-      WRITE(*,*) 'decoop : str -->',str(1:leng)
+      WRITE(*,*) 'decoop : str   -> ',TRIM(str)
+      WRITE(*,*) 'decoop : nbops -> ',nbops
       WRITE(*,*) s_char(1),'-',f_char(1),'|',f_char(2),'-',s_char(2)
       WRITE(*,*) s_pos(1),'-',f_pos(1),'|',f_pos(2),'-',s_pos(2)
     ENDIF
-!--
-    IF (nbops > nbops_max-1) THEN
-      CALL ipslerr(3,'decoop','Expression too complex',str,' ')
-    ENDIF
-!--
-    IF (check) WRITE(*,*) 'decoop : --',nbops,' ',str(1:leng)
 !---
 !-- Start the analysis of the syntax. 3 types of constructs
@@ -236 +242 @@
       IF (INDEX(funcs,opp_str(1:LEN_TRIM(opp_str))) > 0) THEN
         opps(nbops) = opp_str(1:LEN_TRIM(opp_str))
-        scal(nbops) =  missing_val
+        scal(nbops) = fill_val
       ELSE
         CALL ipslerr(3,'decoop', &
@@ -313 +319 @@
   IMPLICIT NONE
 !-
-  CHARACTER(LEN=80) :: str
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
   INTEGER :: nbsep
   CHARACTER(LEN=1),DIMENSION(2) :: f_char,s_char
   INTEGER,DIMENSION(2) :: f_pos,s_pos
 !-
-  CHARACTER(LEN=70) :: str_tmp
+  CHARACTER(LEN=10) :: str_tmp
   LOGICAL :: f_found,s_found
   INTEGER :: ind,xpos,leng,i
@@ -385 +391 @@
     WRITE(str_tmp,'("number :",I3)') nbsep
     CALL ipslerr(3,'findsep', &
- &    'How can I find that many separators',str_tmp,str)
+ &    'How can I find that many separators',str_tmp,TRIM(str))
   ENDIF
 !-
@@ -399 +405 @@
   IMPLICIT NONE
 !-
-  CHARACTER(LEN=80) :: str
+  CHARACTER(LEN=*),INTENT(INOUT) :: str
 !-
   INTEGER :: ind,leng,ic,it

vendors/IOIPSL/current/src/stringop.f90

@@ -1 +1 @@
 MODULE stringop
 !-
-!$Id: stringop.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: stringop.f90 936 2010-03-04 11:01:32Z bellier $
 !-
 ! This software is governed by the CeCILL license
 ! See IOIPSL/IOIPSL_License_CeCILL.txt
-!---------------------------------------------------------------------
-!-
-  INTEGER,DIMENSION(30) :: &
- & prime=(/1,2,3,5,7,11,13,17,19,23,29,31,37,41,43, &
- & 47,53,59,61,67,71,73,79,83,89,97,101,103,107,109/)
-!-
 !---------------------------------------------------------------------
 CONTAINS
@@ -160 +154 @@
 END SUBROUTINE struppercase
 !===
-SUBROUTINE gensig (str,sig)
+SUBROUTINE str_xfw (c_string,c_word,l_ok)
 !---------------------------------------------------------------------
-!- Generate a signature from the first 30 characters of the string
-!- This signature is not unique and thus when one looks for the
-!- one needs to also verify the string.
+!- Given a character string "c_string", of arbitrary length,
+!- returns a logical flag "l_ok" if a word is found in it,
+!- the first word "c_word" if found and the new string "c_string"
+!- without the first word "c_word"
 !---------------------------------------------------------------------
-  IMPLICIT NONE
+  CHARACTER(LEN=*),INTENT(INOUT) :: c_string
+  CHARACTER(LEN=*),INTENT(OUT) :: c_word
+  LOGICAL,INTENT(OUT) :: l_ok
 !-
-  CHARACTER(LEN=*) :: str
-  INTEGER          :: sig
-!-
-  INTEGER :: i
+  INTEGER :: i_b,i_e
 !---------------------------------------------------------------------
-  sig = 0
-  DO i=1,MIN(LEN_TRIM(str),30)
-    sig = sig + prime(i)*IACHAR(str(i:i))
-  ENDDO
-!--------------------
-END SUBROUTINE gensig
-!===
-SUBROUTINE find_sig (nb_sig,str_tab,str,sig_tab,sig,pos)
-!---------------------------------------------------------------------
-!- Find the string signature in a list of signatures
-!---------------------------------------------------------------------
-!- INPUT
-!-   nb_sig      : length of table of signatures
-!-   str_tab     : Table of strings
-!-   str         : Target string we are looking for
-!-   sig_tab     : Table of signatures
-!-   sig         : Target signature we are looking for
-!- OUTPUT
-!-   pos         : -1 if str not found, else value in the table
-!---------------------------------------------------------------------
-  IMPLICIT NONE
-!-
-  INTEGER :: nb_sig
-  CHARACTER(LEN=*),DIMENSION(nb_sig) :: str_tab
-  CHARACTER(LEN=*) :: str
-  INTEGER,DIMENSION(nb_sig) :: sig_tab
-  INTEGER :: sig
-!-
-  INTEGER :: pos
-  INTEGER,DIMENSION(nb_sig) :: loczeros
-!-
-  INTEGER :: il,len
-  INTEGER,DIMENSION(1) :: minpos
-!---------------------------------------------------------------------
-  pos = -1
-  il = LEN_TRIM(str)
-!-
-  IF ( nb_sig > 0 ) THEN
-    loczeros = ABS(sig_tab(1:nb_sig)-sig)
-    IF ( COUNT(loczeros < 1) == 1 ) THEN
-      minpos = MINLOC(loczeros)
-      len = LEN_TRIM(str_tab(minpos(1)))
-      IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
-          .AND.(len == il) ) THEN
-        pos = minpos(1)
-      ENDIF
-    ELSE IF ( COUNT(loczeros < 1) > 1 ) THEN
-      DO WHILE (COUNT(loczeros < 1) >= 1 .AND. pos < 0 )
-        minpos = MINLOC(loczeros)
-        len = LEN_TRIM(str_tab(minpos(1)))
-        IF (     (INDEX(str_tab(minpos(1)),str(1:il)) > 0) &
-            .AND.(len == il) ) THEN
-          pos = minpos(1)
-        ELSE
-          loczeros(minpos(1)) = 99999
-        ENDIF
-      ENDDO
+  l_ok = (LEN_TRIM(c_string) > 0)
+  IF (l_ok) THEN
+    i_b = VERIFY(c_string,' ')
+    i_e = INDEX(c_string(i_b:),' ')
+    IF (i_e == 0) THEN
+      c_word = c_string(i_b:)
+      c_string = ""
+    ELSE
+      c_word = c_string(i_b:i_b+i_e-2)
+      c_string = ADJUSTL(c_string(i_b+i_e-1:))
     ENDIF
   ENDIF
-!-----------------------
- END SUBROUTINE find_sig
+!---------------------
+END SUBROUTINE str_xfw
 !===
 !------------------

vendors/IOIPSL/current/tools/flio_rbld.f90

@@ -1 +1 @@
 PROGRAM flio_rbld
 !
-!$Id: flio_rbld.f90 386 2008-09-04 08:38:48Z bellier $
+!$Id: flio_rbld.f90 1025 2010-05-20 07:49:57Z bellier $
 !-
 ! This software is governed by the CeCILL license
@@ -602 +602 @@
     ENDIF
 !-- copy all variable attributes
-    ALLOCATE(v_a_nm(v_a_nb))
-    CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
-    DO ia=1,v_a_nb
-      CALL fliocpya &
- &     (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
- &      f_id_o,TRIM(f_v_nm(iv)))
-    ENDDO
-    DEALLOCATE(v_a_nm)
+    IF (v_a_nb > 0) THEN
+      ALLOCATE(v_a_nm(v_a_nb))
+      CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
+      DO ia=1,v_a_nb
+        CALL fliocpya &
+ &       (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
+ &        f_id_o,TRIM(f_v_nm(iv)))
+      ENDDO
+      DEALLOCATE(v_a_nm)
+    ENDIF
   ENDDO
 !-

vendors/IOIPSL/current/tools/rebuild

@@ -1 +1 @@
 #!/bin/ksh
 #
-#$Id: rebuild 386 2008-09-04 08:38:48Z bellier $
+#$Id: rebuild 761 2009-10-26 16:30:14Z bellier $
 #
 # This software is governed by the CeCILL license
@@ -100 +100 @@
 #-
 ${d_n}/flio_rbld < tmp.$$
+r_c=$?
 #-
 # Clear
@@ -107 +108 @@
 # End
 #-
-exit 0;
+exit ${r_c};